{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveFunctor #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.StackSet
-- Copyright   :  (c) Don Stewart 2007
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  dons@galois.com
-- Stability   :  experimental
-- Portability :  portable, Haskell 98
--

module XMonad.StackSet (
        -- * Introduction
        -- $intro

        -- ** The Zipper
        -- $zipper

        -- ** Xinerama support
        -- $xinerama

        -- ** Master and Focus
        -- $focus

        StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..),
        -- *  Construction
        -- $construction
        new, view, greedyView,
        -- * Xinerama operations
        -- $xinerama
        lookupWorkspace,
        screens, workspaces, allWindows, currentTag,
        -- *  Operations on the current stack
        -- $stackOperations
        peek, index, integrate, integrate', differentiate,
        focusUp, focusDown, focusUp', focusDown', focusMaster, focusWindow,
        tagMember, renameTag, ensureTags, member, findTag, mapWorkspace, mapLayout,
        -- * Modifying the stackset
        -- $modifyStackset
        insertUp, delete, delete', filter,
        -- * Setting the master window
        -- $settingMW
        swapUp, swapDown, swapMaster, shiftMaster, modify, modify', float, sink, -- needed by users
        -- * Composite operations
        -- $composite
        shift, shiftWin,

        -- for testing
        abort
    ) where

import Prelude hiding (filter)
import Control.Applicative.Backwards (Backwards (Backwards, forwards))
import Data.Foldable (foldr, toList)
import Data.Maybe   (listToMaybe,isJust,fromMaybe)
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
import Data.List ( (\\) )
import qualified Data.Map  as M (Map,insert,delete,empty)

-- $intro
--
-- The 'StackSet' data type encodes a window manager abstraction. The
-- window manager is a set of virtual workspaces. On each workspace is a
-- stack of windows. A given workspace is always current, and a given
-- window on each workspace has focus. The focused window on the current
-- workspace is the one which will take user input. It can be visualised
-- as follows:
--
-- > Workspace  { 0*}   { 1 }   { 2 }   { 3 }   { 4 }
-- >
-- > Windows    [1      []      [3*     [6*]    []
-- >            ,2*]            ,4
-- >                            ,5]
--
-- Note that workspaces are indexed from 0, windows are numbered
-- uniquely. A '*' indicates the window on each workspace that has
-- focus, and which workspace is current.

-- $zipper
--
-- We encode all the focus tracking directly in the data structure, with a 'zipper':
--
--    A Zipper is essentially an `updateable' and yet pure functional
--    cursor into a data structure. Zipper is also a delimited
--    continuation reified as a data structure.
--
--    The Zipper lets us replace an item deep in a complex data
--    structure, e.g., a tree or a term, without a mutation.  The
--    resulting data structure will share as much of its components with
--    the old structure as possible.
--
--      Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"
--
-- We use the zipper to keep track of the focused workspace and the
-- focused window on each workspace, allowing us to have correct focus
-- by construction. We closely follow Huet's original implementation:
--
--      G. Huet, /Functional Pearl: The Zipper/,
--      1997, J. Functional Programming 75(5):549-554.
-- and:
--      R. Hinze and J. Jeuring, /Functional Pearl: The Web/.
--
-- and Conor McBride's zipper differentiation paper.
-- Another good reference is:
--
--      The Zipper, Haskell wikibook

-- $xinerama
-- Xinerama in X11 lets us view multiple virtual workspaces
-- simultaneously. While only one will ever be in focus (i.e. will
-- receive keyboard events), other workspaces may be passively
-- viewable.  We thus need to track which virtual workspaces are
-- associated (viewed) on which physical screens.  To keep track of
-- this, 'StackSet' keeps separate lists of visible but non-focused
-- workspaces, and non-visible workspaces.

-- $focus
--
-- Each stack tracks a focused item, and for tiling purposes also tracks
-- a 'master' position. The connection between 'master' and 'focus'
-- needs to be well defined, particularly in relation to 'insert' and
-- 'delete'.
--

------------------------------------------------------------------------
-- |
-- A cursor into a non-empty list of workspaces.
--
-- We puncture the workspace list, producing a hole in the structure
-- used to track the currently focused workspace. The two other lists
-- that are produced are used to track those workspaces visible as
-- Xinerama screens, and those workspaces not visible anywhere.

data StackSet i l a sid sd =
    StackSet { StackSet i l a sid sd -> Screen i l a sid sd
current  :: !(Screen i l a sid sd)    -- ^ currently focused workspace
             , StackSet i l a sid sd -> [Screen i l a sid sd]
visible  :: [Screen i l a sid sd]     -- ^ non-focused workspaces, visible in xinerama
             , StackSet i l a sid sd -> [Workspace i l a]
hidden   :: [Workspace i l a]         -- ^ workspaces not visible anywhere
             , StackSet i l a sid sd -> Map a RationalRect
floating :: M.Map a RationalRect      -- ^ floating windows
             } deriving (Int -> StackSet i l a sid sd -> ShowS
[StackSet i l a sid sd] -> ShowS
StackSet i l a sid sd -> String
(Int -> StackSet i l a sid sd -> ShowS)
-> (StackSet i l a sid sd -> String)
-> ([StackSet i l a sid sd] -> ShowS)
-> Show (StackSet i l a sid sd)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i l a sid sd.
(Show i, Show l, Show sid, Show sd, Show a) =>
Int -> StackSet i l a sid sd -> ShowS
forall i l a sid sd.
(Show i, Show l, Show sid, Show sd, Show a) =>
[StackSet i l a sid sd] -> ShowS
forall i l a sid sd.
(Show i, Show l, Show sid, Show sd, Show a) =>
StackSet i l a sid sd -> String
showList :: [StackSet i l a sid sd] -> ShowS
$cshowList :: forall i l a sid sd.
(Show i, Show l, Show sid, Show sd, Show a) =>
[StackSet i l a sid sd] -> ShowS
show :: StackSet i l a sid sd -> String
$cshow :: forall i l a sid sd.
(Show i, Show l, Show sid, Show sd, Show a) =>
StackSet i l a sid sd -> String
showsPrec :: Int -> StackSet i l a sid sd -> ShowS
$cshowsPrec :: forall i l a sid sd.
(Show i, Show l, Show sid, Show sd, Show a) =>
Int -> StackSet i l a sid sd -> ShowS
Show, ReadPrec [StackSet i l a sid sd]
ReadPrec (StackSet i l a sid sd)
Int -> ReadS (StackSet i l a sid sd)
ReadS [StackSet i l a sid sd]
(Int -> ReadS (StackSet i l a sid sd))
-> ReadS [StackSet i l a sid sd]
-> ReadPrec (StackSet i l a sid sd)
-> ReadPrec [StackSet i l a sid sd]
-> Read (StackSet i l a sid sd)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall i l a sid sd.
(Read i, Read l, Read sid, Read sd, Read a, Ord a) =>
ReadPrec [StackSet i l a sid sd]
forall i l a sid sd.
(Read i, Read l, Read sid, Read sd, Read a, Ord a) =>
ReadPrec (StackSet i l a sid sd)
forall i l a sid sd.
(Read i, Read l, Read sid, Read sd, Read a, Ord a) =>
Int -> ReadS (StackSet i l a sid sd)
forall i l a sid sd.
(Read i, Read l, Read sid, Read sd, Read a, Ord a) =>
ReadS [StackSet i l a sid sd]
readListPrec :: ReadPrec [StackSet i l a sid sd]
$creadListPrec :: forall i l a sid sd.
(Read i, Read l, Read sid, Read sd, Read a, Ord a) =>
ReadPrec [StackSet i l a sid sd]
readPrec :: ReadPrec (StackSet i l a sid sd)
$creadPrec :: forall i l a sid sd.
(Read i, Read l, Read sid, Read sd, Read a, Ord a) =>
ReadPrec (StackSet i l a sid sd)
readList :: ReadS [StackSet i l a sid sd]
$creadList :: forall i l a sid sd.
(Read i, Read l, Read sid, Read sd, Read a, Ord a) =>
ReadS [StackSet i l a sid sd]
readsPrec :: Int -> ReadS (StackSet i l a sid sd)
$creadsPrec :: forall i l a sid sd.
(Read i, Read l, Read sid, Read sd, Read a, Ord a) =>
Int -> ReadS (StackSet i l a sid sd)
Read, StackSet i l a sid sd -> StackSet i l a sid sd -> Bool
(StackSet i l a sid sd -> StackSet i l a sid sd -> Bool)
-> (StackSet i l a sid sd -> StackSet i l a sid sd -> Bool)
-> Eq (StackSet i l a sid sd)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i l a sid sd.
(Eq i, Eq l, Eq sid, Eq sd, Eq a) =>
StackSet i l a sid sd -> StackSet i l a sid sd -> Bool
/= :: StackSet i l a sid sd -> StackSet i l a sid sd -> Bool
$c/= :: forall i l a sid sd.
(Eq i, Eq l, Eq sid, Eq sd, Eq a) =>
StackSet i l a sid sd -> StackSet i l a sid sd -> Bool
== :: StackSet i l a sid sd -> StackSet i l a sid sd -> Bool
$c== :: forall i l a sid sd.
(Eq i, Eq l, Eq sid, Eq sd, Eq a) =>
StackSet i l a sid sd -> StackSet i l a sid sd -> Bool
Eq)

-- | Visible workspaces, and their Xinerama screens.
data Screen i l a sid sd = Screen { Screen i l a sid sd -> Workspace i l a
workspace :: !(Workspace i l a)
                                  , Screen i l a sid sd -> sid
screen :: !sid
                                  , Screen i l a sid sd -> sd
screenDetail :: !sd }
    deriving (Int -> Screen i l a sid sd -> ShowS
[Screen i l a sid sd] -> ShowS
Screen i l a sid sd -> String
(Int -> Screen i l a sid sd -> ShowS)
-> (Screen i l a sid sd -> String)
-> ([Screen i l a sid sd] -> ShowS)
-> Show (Screen i l a sid sd)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i l a sid sd.
(Show i, Show l, Show a, Show sid, Show sd) =>
Int -> Screen i l a sid sd -> ShowS
forall i l a sid sd.
(Show i, Show l, Show a, Show sid, Show sd) =>
[Screen i l a sid sd] -> ShowS
forall i l a sid sd.
(Show i, Show l, Show a, Show sid, Show sd) =>
Screen i l a sid sd -> String
showList :: [Screen i l a sid sd] -> ShowS
$cshowList :: forall i l a sid sd.
(Show i, Show l, Show a, Show sid, Show sd) =>
[Screen i l a sid sd] -> ShowS
show :: Screen i l a sid sd -> String
$cshow :: forall i l a sid sd.
(Show i, Show l, Show a, Show sid, Show sd) =>
Screen i l a sid sd -> String
showsPrec :: Int -> Screen i l a sid sd -> ShowS
$cshowsPrec :: forall i l a sid sd.
(Show i, Show l, Show a, Show sid, Show sd) =>
Int -> Screen i l a sid sd -> ShowS
Show, ReadPrec [Screen i l a sid sd]
ReadPrec (Screen i l a sid sd)
Int -> ReadS (Screen i l a sid sd)
ReadS [Screen i l a sid sd]
(Int -> ReadS (Screen i l a sid sd))
-> ReadS [Screen i l a sid sd]
-> ReadPrec (Screen i l a sid sd)
-> ReadPrec [Screen i l a sid sd]
-> Read (Screen i l a sid sd)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall i l a sid sd.
(Read i, Read l, Read a, Read sid, Read sd) =>
ReadPrec [Screen i l a sid sd]
forall i l a sid sd.
(Read i, Read l, Read a, Read sid, Read sd) =>
ReadPrec (Screen i l a sid sd)
forall i l a sid sd.
(Read i, Read l, Read a, Read sid, Read sd) =>
Int -> ReadS (Screen i l a sid sd)
forall i l a sid sd.
(Read i, Read l, Read a, Read sid, Read sd) =>
ReadS [Screen i l a sid sd]
readListPrec :: ReadPrec [Screen i l a sid sd]
$creadListPrec :: forall i l a sid sd.
(Read i, Read l, Read a, Read sid, Read sd) =>
ReadPrec [Screen i l a sid sd]
readPrec :: ReadPrec (Screen i l a sid sd)
$creadPrec :: forall i l a sid sd.
(Read i, Read l, Read a, Read sid, Read sd) =>
ReadPrec (Screen i l a sid sd)
readList :: ReadS [Screen i l a sid sd]
$creadList :: forall i l a sid sd.
(Read i, Read l, Read a, Read sid, Read sd) =>
ReadS [Screen i l a sid sd]
readsPrec :: Int -> ReadS (Screen i l a sid sd)
$creadsPrec :: forall i l a sid sd.
(Read i, Read l, Read a, Read sid, Read sd) =>
Int -> ReadS (Screen i l a sid sd)
Read, Screen i l a sid sd -> Screen i l a sid sd -> Bool
(Screen i l a sid sd -> Screen i l a sid sd -> Bool)
-> (Screen i l a sid sd -> Screen i l a sid sd -> Bool)
-> Eq (Screen i l a sid sd)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i l a sid sd.
(Eq i, Eq l, Eq a, Eq sid, Eq sd) =>
Screen i l a sid sd -> Screen i l a sid sd -> Bool
/= :: Screen i l a sid sd -> Screen i l a sid sd -> Bool
$c/= :: forall i l a sid sd.
(Eq i, Eq l, Eq a, Eq sid, Eq sd) =>
Screen i l a sid sd -> Screen i l a sid sd -> Bool
== :: Screen i l a sid sd -> Screen i l a sid sd -> Bool
$c== :: forall i l a sid sd.
(Eq i, Eq l, Eq a, Eq sid, Eq sd) =>
Screen i l a sid sd -> Screen i l a sid sd -> Bool
Eq)

-- |
-- A workspace is just a tag, a layout, and a stack.
--
data Workspace i l a = Workspace  { Workspace i l a -> i
tag :: !i, Workspace i l a -> l
layout :: l, Workspace i l a -> Maybe (Stack a)
stack :: Maybe (Stack a) }
    deriving (Int -> Workspace i l a -> ShowS
[Workspace i l a] -> ShowS
Workspace i l a -> String
(Int -> Workspace i l a -> ShowS)
-> (Workspace i l a -> String)
-> ([Workspace i l a] -> ShowS)
-> Show (Workspace i l a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i l a.
(Show i, Show l, Show a) =>
Int -> Workspace i l a -> ShowS
forall i l a.
(Show i, Show l, Show a) =>
[Workspace i l a] -> ShowS
forall i l a. (Show i, Show l, Show a) => Workspace i l a -> String
showList :: [Workspace i l a] -> ShowS
$cshowList :: forall i l a.
(Show i, Show l, Show a) =>
[Workspace i l a] -> ShowS
show :: Workspace i l a -> String
$cshow :: forall i l a. (Show i, Show l, Show a) => Workspace i l a -> String
showsPrec :: Int -> Workspace i l a -> ShowS
$cshowsPrec :: forall i l a.
(Show i, Show l, Show a) =>
Int -> Workspace i l a -> ShowS
Show, ReadPrec [Workspace i l a]
ReadPrec (Workspace i l a)
Int -> ReadS (Workspace i l a)
ReadS [Workspace i l a]
(Int -> ReadS (Workspace i l a))
-> ReadS [Workspace i l a]
-> ReadPrec (Workspace i l a)
-> ReadPrec [Workspace i l a]
-> Read (Workspace i l a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall i l a.
(Read i, Read l, Read a) =>
ReadPrec [Workspace i l a]
forall i l a.
(Read i, Read l, Read a) =>
ReadPrec (Workspace i l a)
forall i l a.
(Read i, Read l, Read a) =>
Int -> ReadS (Workspace i l a)
forall i l a. (Read i, Read l, Read a) => ReadS [Workspace i l a]
readListPrec :: ReadPrec [Workspace i l a]
$creadListPrec :: forall i l a.
(Read i, Read l, Read a) =>
ReadPrec [Workspace i l a]
readPrec :: ReadPrec (Workspace i l a)
$creadPrec :: forall i l a.
(Read i, Read l, Read a) =>
ReadPrec (Workspace i l a)
readList :: ReadS [Workspace i l a]
$creadList :: forall i l a. (Read i, Read l, Read a) => ReadS [Workspace i l a]
readsPrec :: Int -> ReadS (Workspace i l a)
$creadsPrec :: forall i l a.
(Read i, Read l, Read a) =>
Int -> ReadS (Workspace i l a)
Read, Workspace i l a -> Workspace i l a -> Bool
(Workspace i l a -> Workspace i l a -> Bool)
-> (Workspace i l a -> Workspace i l a -> Bool)
-> Eq (Workspace i l a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall i l a.
(Eq i, Eq l, Eq a) =>
Workspace i l a -> Workspace i l a -> Bool
/= :: Workspace i l a -> Workspace i l a -> Bool
$c/= :: forall i l a.
(Eq i, Eq l, Eq a) =>
Workspace i l a -> Workspace i l a -> Bool
== :: Workspace i l a -> Workspace i l a -> Bool
$c== :: forall i l a.
(Eq i, Eq l, Eq a) =>
Workspace i l a -> Workspace i l a -> Bool
Eq)

-- | A structure for window geometries
data RationalRect = RationalRect !Rational !Rational !Rational !Rational
    deriving (Int -> RationalRect -> ShowS
[RationalRect] -> ShowS
RationalRect -> String
(Int -> RationalRect -> ShowS)
-> (RationalRect -> String)
-> ([RationalRect] -> ShowS)
-> Show RationalRect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RationalRect] -> ShowS
$cshowList :: [RationalRect] -> ShowS
show :: RationalRect -> String
$cshow :: RationalRect -> String
showsPrec :: Int -> RationalRect -> ShowS
$cshowsPrec :: Int -> RationalRect -> ShowS
Show, ReadPrec [RationalRect]
ReadPrec RationalRect
Int -> ReadS RationalRect
ReadS [RationalRect]
(Int -> ReadS RationalRect)
-> ReadS [RationalRect]
-> ReadPrec RationalRect
-> ReadPrec [RationalRect]
-> Read RationalRect
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RationalRect]
$creadListPrec :: ReadPrec [RationalRect]
readPrec :: ReadPrec RationalRect
$creadPrec :: ReadPrec RationalRect
readList :: ReadS [RationalRect]
$creadList :: ReadS [RationalRect]
readsPrec :: Int -> ReadS RationalRect
$creadsPrec :: Int -> ReadS RationalRect
Read, RationalRect -> RationalRect -> Bool
(RationalRect -> RationalRect -> Bool)
-> (RationalRect -> RationalRect -> Bool) -> Eq RationalRect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RationalRect -> RationalRect -> Bool
$c/= :: RationalRect -> RationalRect -> Bool
== :: RationalRect -> RationalRect -> Bool
$c== :: RationalRect -> RationalRect -> Bool
Eq)

-- |
-- A stack is a cursor onto a window list.
-- The data structure tracks focus by construction, and
-- the master window is by convention the top-most item.
-- Focus operations will not reorder the list that results from
-- flattening the cursor. The structure can be envisaged as:
--
-- >    +-- master:  < '7' >
-- > up |            [ '2' ]
-- >    +---------   [ '3' ]
-- > focus:          < '4' >
-- > dn +----------- [ '8' ]
--
-- A 'Stack' can be viewed as a list with a hole punched in it to make
-- the focused position. Under the zipper\/calculus view of such
-- structures, it is the differentiation of a [a], and integrating it
-- back has a natural implementation used in 'index'.
--
data Stack a = Stack { Stack a -> a
focus  :: !a        -- focused thing in this set
                     , Stack a -> [a]
up     :: [a]       -- clowns to the left
                     , Stack a -> [a]
down   :: [a] }     -- jokers to the right
    deriving (Int -> Stack a -> ShowS
[Stack a] -> ShowS
Stack a -> String
(Int -> Stack a -> ShowS)
-> (Stack a -> String) -> ([Stack a] -> ShowS) -> Show (Stack a)
forall a. Show a => Int -> Stack a -> ShowS
forall a. Show a => [Stack a] -> ShowS
forall a. Show a => Stack a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stack a] -> ShowS
$cshowList :: forall a. Show a => [Stack a] -> ShowS
show :: Stack a -> String
$cshow :: forall a. Show a => Stack a -> String
showsPrec :: Int -> Stack a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Stack a -> ShowS
Show, ReadPrec [Stack a]
ReadPrec (Stack a)
Int -> ReadS (Stack a)
ReadS [Stack a]
(Int -> ReadS (Stack a))
-> ReadS [Stack a]
-> ReadPrec (Stack a)
-> ReadPrec [Stack a]
-> Read (Stack a)
forall a. Read a => ReadPrec [Stack a]
forall a. Read a => ReadPrec (Stack a)
forall a. Read a => Int -> ReadS (Stack a)
forall a. Read a => ReadS [Stack a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Stack a]
$creadListPrec :: forall a. Read a => ReadPrec [Stack a]
readPrec :: ReadPrec (Stack a)
$creadPrec :: forall a. Read a => ReadPrec (Stack a)
readList :: ReadS [Stack a]
$creadList :: forall a. Read a => ReadS [Stack a]
readsPrec :: Int -> ReadS (Stack a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Stack a)
Read, Stack a -> Stack a -> Bool
(Stack a -> Stack a -> Bool)
-> (Stack a -> Stack a -> Bool) -> Eq (Stack a)
forall a. Eq a => Stack a -> Stack a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stack a -> Stack a -> Bool
$c/= :: forall a. Eq a => Stack a -> Stack a -> Bool
== :: Stack a -> Stack a -> Bool
$c== :: forall a. Eq a => Stack a -> Stack a -> Bool
Eq, a -> Stack b -> Stack a
(a -> b) -> Stack a -> Stack b
(forall a b. (a -> b) -> Stack a -> Stack b)
-> (forall a b. a -> Stack b -> Stack a) -> Functor Stack
forall a b. a -> Stack b -> Stack a
forall a b. (a -> b) -> Stack a -> Stack b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Stack b -> Stack a
$c<$ :: forall a b. a -> Stack b -> Stack a
fmap :: (a -> b) -> Stack a -> Stack b
$cfmap :: forall a b. (a -> b) -> Stack a -> Stack b
Functor)

instance Foldable Stack where
    toList :: Stack a -> [a]
toList = Stack a -> [a]
forall a. Stack a -> [a]
integrate
    foldr :: (a -> b -> b) -> b -> Stack a -> b
foldr a -> b -> b
f b
z = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z ([a] -> b) -> (Stack a -> [a]) -> Stack a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance Traversable Stack where
    traverse :: (a -> f b) -> Stack a -> f (Stack b)
traverse a -> f b
f Stack a
s =
        (b -> [b] -> [b] -> Stack b) -> [b] -> b -> [b] -> Stack b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> [b] -> [b] -> Stack b
forall a. a -> [a] -> [a] -> Stack a
Stack
            -- 'Backwards' applies the Applicative in reverse order.
            ([b] -> b -> [b] -> Stack b) -> f [b] -> f (b -> [b] -> Stack b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Backwards f [b] -> f [b]
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards ((a -> Backwards f b) -> [a] -> Backwards f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (f b -> Backwards f b
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f b -> Backwards f b) -> (a -> f b) -> a -> Backwards f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) (Stack a -> [a]
forall a. Stack a -> [a]
up Stack a
s))
            f (b -> [b] -> Stack b) -> f b -> f ([b] -> Stack b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f (Stack a -> a
forall a. Stack a -> a
focus Stack a
s)
            f ([b] -> Stack b) -> f [b] -> f (Stack b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f (Stack a -> [a]
forall a. Stack a -> [a]
down Stack a
s)

-- | this function indicates to catch that an error is expected
abort :: String -> a
abort :: String -> a
abort String
x = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"xmonad: StackSet: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x

-- ---------------------------------------------------------------------
-- $construction

-- | /O(n)/. Create a new stackset, of empty stacks, with given tags,
-- with physical screens whose descriptions are given by 'm'. The
-- number of physical screens (@length 'm'@) should be less than or
-- equal to the number of workspace tags.  The first workspace in the
-- list will be current.
--
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
--
new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd
new :: l -> [i] -> [sd] -> StackSet i l a s sd
new l
l [i]
wids [sd]
m | Bool -> Bool
not ([i] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [i]
wids) Bool -> Bool -> Bool
&& [sd] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [sd]
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [i] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [i]
wids Bool -> Bool -> Bool
&& Bool -> Bool
not ([sd] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [sd]
m)
  = Screen i l a s sd
-> [Screen i l a s sd]
-> [Workspace i l a]
-> Map a RationalRect
-> StackSet i l a s sd
forall i l a sid sd.
Screen i l a sid sd
-> [Screen i l a sid sd]
-> [Workspace i l a]
-> Map a RationalRect
-> StackSet i l a sid sd
StackSet Screen i l a s sd
forall a. Screen i l a s sd
cur [Screen i l a s sd]
forall a. [Screen i l a s sd]
visi [Workspace i l a]
forall a. [Workspace i l a]
unseen Map a RationalRect
forall k a. Map k a
M.empty
  where ([Workspace i l a]
seen,[Workspace i l a]
unseen) = Int -> [Workspace i l a] -> ([Workspace i l a], [Workspace i l a])
forall a. Int -> [a] -> ([a], [a])
L.splitAt ([sd] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [sd]
m) ([Workspace i l a] -> ([Workspace i l a], [Workspace i l a]))
-> [Workspace i l a] -> ([Workspace i l a], [Workspace i l a])
forall a b. (a -> b) -> a -> b
$ (i -> Workspace i l a) -> [i] -> [Workspace i l a]
forall a b. (a -> b) -> [a] -> [b]
map (\i
i -> i -> l -> Maybe (Stack a) -> Workspace i l a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace i
i l
l Maybe (Stack a)
forall a. Maybe a
Nothing) [i]
wids
        (Screen i l a s sd
cur:[Screen i l a s sd]
visi)    = [ Workspace i l a -> s -> sd -> Screen i l a s sd
forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
Screen Workspace i l a
i s
s sd
sd |  (Workspace i l a
i, s
s, sd
sd) <- [Workspace i l a] -> [s] -> [sd] -> [(Workspace i l a, s, sd)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Workspace i l a]
forall a. [Workspace i l a]
seen [s
0..] [sd]
m ]
                -- now zip up visibles with their screen id
new l
_ [i]
_ [sd]
_ = String -> StackSet i l a s sd
forall a. String -> a
abort String
"non-positive argument to StackSet.new"

-- |
-- /O(w)/. Set focus to the workspace with index \'i\'.
-- If the index is out of range, return the original 'StackSet'.
--
-- Xinerama: If the workspace is not visible on any Xinerama screen, it
-- becomes the current screen. If it is in the visible list, it becomes
-- current.

view :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
view :: i -> StackSet i l a s sd -> StackSet i l a s sd
view i
i StackSet i l a s sd
s
    | i
i i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== StackSet i l a s sd -> i
forall i l a s sd. StackSet i l a s sd -> i
currentTag StackSet i l a s sd
s = StackSet i l a s sd
s  -- current

    | Just Screen i l a s sd
x <- (Screen i l a s sd -> Bool)
-> [Screen i l a s sd] -> Maybe (Screen i l a s sd)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((i
ii -> i -> Bool
forall a. Eq a => a -> a -> Bool
==)(i -> Bool)
-> (Screen i l a s sd -> i) -> Screen i l a s sd -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag(Workspace i l a -> i)
-> (Screen i l a s sd -> Workspace i l a) -> Screen i l a s sd -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace) (StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
s)
    -- if it is visible, it is just raised
    = StackSet i l a s sd
s { current :: Screen i l a s sd
current = Screen i l a s sd
x, visible :: [Screen i l a s sd]
visible = StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
s Screen i l a s sd -> [Screen i l a s sd] -> [Screen i l a s sd]
forall a. a -> [a] -> [a]
: (Screen i l a s sd -> Screen i l a s sd -> Bool)
-> Screen i l a s sd -> [Screen i l a s sd] -> [Screen i l a s sd]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
L.deleteBy ((Screen i l a s sd -> s)
-> Screen i l a s sd -> Screen i l a s sd -> Bool
forall a t. Eq a => (t -> a) -> t -> t -> Bool
equating Screen i l a s sd -> s
forall i l a sid sd. Screen i l a sid sd -> sid
screen) Screen i l a s sd
x (StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
s) }

    | Just Workspace i l a
x <- (Workspace i l a -> Bool)
-> [Workspace i l a] -> Maybe (Workspace i l a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((i
ii -> i -> Bool
forall a. Eq a => a -> a -> Bool
==)(i -> Bool) -> (Workspace i l a -> i) -> Workspace i l a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag)           (StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden  StackSet i l a s sd
s) -- must be hidden then
    -- if it was hidden, it is raised on the xine screen currently used
    = StackSet i l a s sd
s { current :: Screen i l a s sd
current = (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
s) { workspace :: Workspace i l a
workspace = Workspace i l a
x }
        , hidden :: [Workspace i l a]
hidden = Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
s) Workspace i l a -> [Workspace i l a] -> [Workspace i l a]
forall a. a -> [a] -> [a]
: (Workspace i l a -> Workspace i l a -> Bool)
-> Workspace i l a -> [Workspace i l a] -> [Workspace i l a]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
L.deleteBy ((Workspace i l a -> i)
-> Workspace i l a -> Workspace i l a -> Bool
forall a t. Eq a => (t -> a) -> t -> t -> Bool
equating Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag) Workspace i l a
x (StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden StackSet i l a s sd
s) }

    | Bool
otherwise = StackSet i l a s sd
s -- not a member of the stackset

  where equating :: (t -> a) -> t -> t -> Bool
equating t -> a
f = \t
x t
y -> t -> a
f t
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== t -> a
f t
y

    -- 'Catch'ing this might be hard. Relies on monotonically increasing
    -- workspace tags defined in 'new'
    --
    -- and now tags are not monotonic, what happens here?

-- |
-- Set focus to the given workspace.  If that workspace does not exist
-- in the stackset, the original workspace is returned.  If that workspace is
-- 'hidden', then display that workspace on the current screen, and move the
-- current workspace to 'hidden'.  If that workspace is 'visible' on another
-- screen, the workspaces of the current screen and the other screen are
-- swapped.

greedyView :: (Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView :: i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView i
w StackSet i l a s sd
ws
     | (Workspace i l a -> Bool) -> [Workspace i l a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Workspace i l a -> Bool
forall l a. Workspace i l a -> Bool
wTag (StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden StackSet i l a s sd
ws) = i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view i
w StackSet i l a s sd
ws
     | (Just Screen i l a s sd
s) <- (Screen i l a s sd -> Bool)
-> [Screen i l a s sd] -> Maybe (Screen i l a s sd)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Workspace i l a -> Bool
forall l a. Workspace i l a -> Bool
wTag (Workspace i l a -> Bool)
-> (Screen i l a s sd -> Workspace i l a)
-> Screen i l a s sd
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace) (StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
ws)
                            = StackSet i l a s sd
ws { current :: Screen i l a s sd
current = (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
ws) { workspace :: Workspace i l a
workspace = Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace Screen i l a s sd
s }
                                 , visible :: [Screen i l a s sd]
visible = Screen i l a s sd
s { workspace :: Workspace i l a
workspace = Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
ws) }
                                           Screen i l a s sd -> [Screen i l a s sd] -> [Screen i l a s sd]
forall a. a -> [a] -> [a]
: (Screen i l a s sd -> Bool)
-> [Screen i l a s sd] -> [Screen i l a s sd]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not (Bool -> Bool)
-> (Screen i l a s sd -> Bool) -> Screen i l a s sd -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> Bool
forall l a. Workspace i l a -> Bool
wTag (Workspace i l a -> Bool)
-> (Screen i l a s sd -> Workspace i l a)
-> Screen i l a s sd
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace) (StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
ws) }
     | Bool
otherwise = StackSet i l a s sd
ws
   where wTag :: Workspace i l a -> Bool
wTag = (i
w i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== ) (i -> Bool) -> (Workspace i l a -> i) -> Workspace i l a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag

-- ---------------------------------------------------------------------
-- $xinerama

-- | Find the tag of the workspace visible on Xinerama screen 'sc'.
-- 'Nothing' if screen is out of bounds.
lookupWorkspace :: Eq s => s -> StackSet i l a s sd -> Maybe i
lookupWorkspace :: s -> StackSet i l a s sd -> Maybe i
lookupWorkspace s
sc StackSet i l a s sd
w = [i] -> Maybe i
forall a. [a] -> Maybe a
listToMaybe [ Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag Workspace i l a
i | Screen Workspace i l a
i s
s sd
_ <- StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
w Screen i l a s sd -> [Screen i l a s sd] -> [Screen i l a s sd]
forall a. a -> [a] -> [a]
: StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
w, s
s s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
sc ]

-- ---------------------------------------------------------------------
-- $stackOperations

-- |
-- The 'with' function takes a default value, a function, and a
-- StackSet. If the current stack is Nothing, 'with' returns the
-- default value. Otherwise, it applies the function to the stack,
-- returning the result. It is like 'maybe' for the focused workspace.
--
with :: b -> (Stack a -> b) -> StackSet i l a s sd -> b
with :: b -> (Stack a -> b) -> StackSet i l a s sd -> b
with b
dflt Stack a -> b
f = b -> (Stack a -> b) -> Maybe (Stack a) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
dflt Stack a -> b
f (Maybe (Stack a) -> b)
-> (StackSet i l a s sd -> Maybe (Stack a))
-> StackSet i l a s sd
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack (Workspace i l a -> Maybe (Stack a))
-> (StackSet i l a s sd -> Workspace i l a)
-> StackSet i l a s sd
-> Maybe (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (Screen i l a s sd -> Workspace i l a)
-> (StackSet i l a s sd -> Screen i l a s sd)
-> StackSet i l a s sd
-> Workspace i l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current

-- |
-- Apply a function, and a default value for 'Nothing', to modify the current stack.
--
modify :: Maybe (Stack a) -> (Stack a -> Maybe (Stack a)) -> StackSet i l a s sd -> StackSet i l a s sd
modify :: Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
modify Maybe (Stack a)
d Stack a -> Maybe (Stack a)
f StackSet i l a s sd
s = StackSet i l a s sd
s { current :: Screen i l a s sd
current = (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
s)
                        { workspace :: Workspace i l a
workspace = (Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
s)) { stack :: Maybe (Stack a)
stack = Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> Maybe (Stack a)
forall b a i l s sd.
b -> (Stack a -> b) -> StackSet i l a s sd -> b
with Maybe (Stack a)
d Stack a -> Maybe (Stack a)
f StackSet i l a s sd
s }}}

-- |
-- Apply a function to modify the current stack if it isn't empty, and we don't
--  want to empty it.
--
modify' :: (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' :: (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' Stack a -> Stack a
f = Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a i l s sd.
Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
modify Maybe (Stack a)
forall a. Maybe a
Nothing (Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a -> Maybe (Stack a))
-> (Stack a -> Stack a) -> Stack a -> Maybe (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> Stack a
f)

-- |
-- /O(1)/. Extract the focused element of the current stack.
-- Return 'Just' that element, or 'Nothing' for an empty stack.
--
peek :: StackSet i l a s sd -> Maybe a
peek :: StackSet i l a s sd -> Maybe a
peek = Maybe a -> (Stack a -> Maybe a) -> StackSet i l a s sd -> Maybe a
forall b a i l s sd.
b -> (Stack a -> b) -> StackSet i l a s sd -> b
with Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a) -> (Stack a -> a) -> Stack a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> a
forall a. Stack a -> a
focus)

-- |
-- /O(n)/. Flatten a 'Stack' into a list.
--
integrate :: Stack a -> [a]
integrate :: Stack a -> [a]
integrate (Stack a
x [a]
l [a]
r) = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
r

-- |
-- /O(n)/ Flatten a possibly empty stack into a list.
integrate' :: Maybe (Stack a) -> [a]
integrate' :: Maybe (Stack a) -> [a]
integrate' = [a] -> (Stack a -> [a]) -> Maybe (Stack a) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack a -> [a]
forall a. Stack a -> [a]
integrate

-- |
-- /O(n)/. Turn a list into a possibly empty stack (i.e., a zipper):
-- the first element of the list is current, and the rest of the list
-- is down.
differentiate :: [a] -> Maybe (Stack a)
differentiate :: [a] -> Maybe (Stack a)
differentiate []     = Maybe (Stack a)
forall a. Maybe a
Nothing
differentiate (a
x:[a]
xs) = Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
x [] [a]
xs

-- |
-- /O(n)/. 'filter p s' returns the elements of 's' such that 'p' evaluates to
-- 'True'.  Order is preserved, and focus moves as described for 'delete'.
--
filter :: (a -> Bool) -> Stack a -> Maybe (Stack a)
filter :: (a -> Bool) -> Stack a -> Maybe (Stack a)
filter a -> Bool
p (Stack a
f [a]
ls [a]
rs) = case (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter a -> Bool
p (a
fa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs) of
    a
f':[a]
rs' -> Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
f' ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter a -> Bool
p [a]
ls) [a]
rs'    -- maybe move focus down
    []     -> case (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter a -> Bool
p [a]
ls of                  -- filter back up
                    a
f':[a]
ls' -> Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
f' [a]
ls' [] -- else up
                    []     -> Maybe (Stack a)
forall a. Maybe a
Nothing

-- |
-- /O(s)/. Extract the stack on the current workspace, as a list.
-- The order of the stack is determined by the master window -- it will be
-- the head of the list. The implementation is given by the natural
-- integration of a one-hole list cursor, back to a list.
--
index :: StackSet i l a s sd -> [a]
index :: StackSet i l a s sd -> [a]
index = [a] -> (Stack a -> [a]) -> StackSet i l a s sd -> [a]
forall b a i l s sd.
b -> (Stack a -> b) -> StackSet i l a s sd -> b
with [] Stack a -> [a]
forall a. Stack a -> [a]
integrate

-- |
-- /O(1), O(w) on the wrapping case/.
--
-- focusUp, focusDown. Move the window focus up or down the stack,
-- wrapping if we reach the end. The wrapping should model a 'cycle'
-- on the current stack. The 'master' window, and window order,
-- are unaffected by movement of focus.
--
-- swapUp, swapDown, swap the neighbour in the stack ordering, wrapping
-- if we reach the end. Again the wrapping model should 'cycle' on
-- the current stack.
--
focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd
focusUp :: StackSet i l a s sd -> StackSet i l a s sd
focusUp   = (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' Stack a -> Stack a
forall a. Stack a -> Stack a
focusUp'
focusDown :: StackSet i l a s sd -> StackSet i l a s sd
focusDown = (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' Stack a -> Stack a
forall a. Stack a -> Stack a
focusDown'

swapUp :: StackSet i l a s sd -> StackSet i l a s sd
swapUp    = (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' Stack a -> Stack a
forall a. Stack a -> Stack a
swapUp'
swapDown :: StackSet i l a s sd -> StackSet i l a s sd
swapDown  = (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' (Stack a -> Stack a
forall a. Stack a -> Stack a
reverseStack (Stack a -> Stack a) -> (Stack a -> Stack a) -> Stack a -> Stack a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> Stack a
forall a. Stack a -> Stack a
swapUp' (Stack a -> Stack a) -> (Stack a -> Stack a) -> Stack a -> Stack a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> Stack a
forall a. Stack a -> Stack a
reverseStack)

-- | Variants of 'focusUp' and 'focusDown' that work on a
-- 'Stack' rather than an entire 'StackSet'.
focusUp', focusDown' :: Stack a -> Stack a
focusUp' :: Stack a -> Stack a
focusUp' (Stack a
t (a
l:[a]
ls) [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
l [a]
ls (a
ta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)
focusUp' (Stack a
t []     [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
x [a]
xs [] where (a
x:[a]
xs) = [a] -> [a]
forall a. [a] -> [a]
reverse (a
ta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)
focusDown' :: Stack a -> Stack a
focusDown'                   = Stack a -> Stack a
forall a. Stack a -> Stack a
reverseStack (Stack a -> Stack a) -> (Stack a -> Stack a) -> Stack a -> Stack a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> Stack a
forall a. Stack a -> Stack a
focusUp' (Stack a -> Stack a) -> (Stack a -> Stack a) -> Stack a -> Stack a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> Stack a
forall a. Stack a -> Stack a
reverseStack

swapUp' :: Stack a -> Stack a
swapUp' :: Stack a -> Stack a
swapUp'  (Stack a
t (a
l:[a]
ls) [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
t [a]
ls (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)
swapUp'  (Stack a
t []     [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
t ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rs) []

-- | reverse a stack: up becomes down and down becomes up.
reverseStack :: Stack a -> Stack a
reverseStack :: Stack a -> Stack a
reverseStack (Stack a
t [a]
ls [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
t [a]
rs [a]
ls

--
-- | /O(1) on current window, O(n) in general/. Focus the window 'w',
-- and set its workspace as current.
--
focusWindow :: (Eq s, Eq a, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
focusWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
focusWindow a
w StackSet i l a s sd
s | a -> Maybe a
forall a. a -> Maybe a
Just a
w Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== StackSet i l a s sd -> Maybe a
forall i l a s sd. StackSet i l a s sd -> Maybe a
peek StackSet i l a s sd
s = StackSet i l a s sd
s
                | Bool
otherwise        = StackSet i l a s sd
-> Maybe (StackSet i l a s sd) -> StackSet i l a s sd
forall a. a -> Maybe a -> a
fromMaybe StackSet i l a s sd
s (Maybe (StackSet i l a s sd) -> StackSet i l a s sd)
-> Maybe (StackSet i l a s sd) -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ do
                    i
n <- a -> StackSet i l a s sd -> Maybe i
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
findTag a
w StackSet i l a s sd
s
                    StackSet i l a s sd -> Maybe (StackSet i l a s sd)
forall (m :: * -> *) a. Monad m => a -> m a
return (StackSet i l a s sd -> Maybe (StackSet i l a s sd))
-> StackSet i l a s sd -> Maybe (StackSet i l a s sd)
forall a b. (a -> b) -> a -> b
$ (StackSet i l a s sd -> Bool)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a. (a -> Bool) -> (a -> a) -> a -> a
until ((a -> Maybe a
forall a. a -> Maybe a
Just a
w Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe a -> Bool)
-> (StackSet i l a s sd -> Maybe a) -> StackSet i l a s sd -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> Maybe a
forall i l a s sd. StackSet i l a s sd -> Maybe a
peek) StackSet i l a s sd -> StackSet i l a s sd
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
focusUp (i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view i
n StackSet i l a s sd
s)

-- | Get a list of all screens in the 'StackSet'.
screens :: StackSet i l a s sd -> [Screen i l a s sd]
screens :: StackSet i l a s sd -> [Screen i l a s sd]
screens StackSet i l a s sd
s = StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
s Screen i l a s sd -> [Screen i l a s sd] -> [Screen i l a s sd]
forall a. a -> [a] -> [a]
: StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
s

-- | Get a list of all workspaces in the 'StackSet'.
workspaces :: StackSet i l a s sd -> [Workspace i l a]
workspaces :: StackSet i l a s sd -> [Workspace i l a]
workspaces StackSet i l a s sd
s = Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
s) Workspace i l a -> [Workspace i l a] -> [Workspace i l a]
forall a. a -> [a] -> [a]
: (Screen i l a s sd -> Workspace i l a)
-> [Screen i l a s sd] -> [Workspace i l a]
forall a b. (a -> b) -> [a] -> [b]
map Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
s) [Workspace i l a] -> [Workspace i l a] -> [Workspace i l a]
forall a. [a] -> [a] -> [a]
++ StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden StackSet i l a s sd
s

-- | Get a list of all windows in the 'StackSet' in no particular order
allWindows :: Eq a => StackSet i l a s sd -> [a]
allWindows :: StackSet i l a s sd -> [a]
allWindows = [a] -> [a]
forall a. Eq a => [a] -> [a]
L.nub ([a] -> [a])
-> (StackSet i l a s sd -> [a]) -> StackSet i l a s sd -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workspace i l a -> [a]) -> [Workspace i l a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
integrate' (Maybe (Stack a) -> [a])
-> (Workspace i l a -> Maybe (Stack a)) -> Workspace i l a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack) ([Workspace i l a] -> [a])
-> (StackSet i l a s sd -> [Workspace i l a])
-> StackSet i l a s sd
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
workspaces

-- | Get the tag of the currently focused workspace.
currentTag :: StackSet i l a s sd -> i
currentTag :: StackSet i l a s sd -> i
currentTag = Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag (Workspace i l a -> i)
-> (StackSet i l a s sd -> Workspace i l a)
-> StackSet i l a s sd
-> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (Screen i l a s sd -> Workspace i l a)
-> (StackSet i l a s sd -> Screen i l a s sd)
-> StackSet i l a s sd
-> Workspace i l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current

-- | Is the given tag present in the 'StackSet'?
tagMember :: Eq i => i -> StackSet i l a s sd -> Bool
tagMember :: i -> StackSet i l a s sd -> Bool
tagMember i
t = i -> [i] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem i
t ([i] -> Bool)
-> (StackSet i l a s sd -> [i]) -> StackSet i l a s sd -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workspace i l a -> i) -> [Workspace i l a] -> [i]
forall a b. (a -> b) -> [a] -> [b]
map Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag ([Workspace i l a] -> [i])
-> (StackSet i l a s sd -> [Workspace i l a])
-> StackSet i l a s sd
-> [i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
workspaces

-- | Rename a given tag if present in the 'StackSet'.
renameTag :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
renameTag :: i -> i -> StackSet i l a s sd -> StackSet i l a s sd
renameTag i
o i
n = (Workspace i l a -> Workspace i l a)
-> StackSet i l a s sd -> StackSet i l a s sd
forall i l a s sd.
(Workspace i l a -> Workspace i l a)
-> StackSet i l a s sd -> StackSet i l a s sd
mapWorkspace Workspace i l a -> Workspace i l a
forall l a. Workspace i l a -> Workspace i l a
rename
    where rename :: Workspace i l a -> Workspace i l a
rename Workspace i l a
w = if Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag Workspace i l a
w i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
o then Workspace i l a
w { tag :: i
tag = i
n } else Workspace i l a
w

-- | Ensure that a given set of workspace tags is present by renaming
-- existing workspaces and\/or creating new hidden workspaces as
-- necessary.
ensureTags :: Eq i => l -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
ensureTags :: l -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
ensureTags l
l [i]
allt StackSet i l a s sd
st = [i] -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
forall i a s sd.
Eq i =>
[i] -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
et [i]
allt ((Workspace i l a -> i) -> [Workspace i l a] -> [i]
forall a b. (a -> b) -> [a] -> [b]
map Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag (StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
workspaces StackSet i l a s sd
st) [i] -> [i] -> [i]
forall a. Eq a => [a] -> [a] -> [a]
\\ [i]
allt) StackSet i l a s sd
st
    where et :: [i] -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
et [] [i]
_ StackSet i l a s sd
s = StackSet i l a s sd
s
          et (i
i:[i]
is) [i]
rn StackSet i l a s sd
s | i
i i -> StackSet i l a s sd -> Bool
forall i l a s sd. Eq i => i -> StackSet i l a s sd -> Bool
`tagMember` StackSet i l a s sd
s = [i] -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
et [i]
is [i]
rn StackSet i l a s sd
s
          et (i
i:[i]
is) [] StackSet i l a s sd
s = [i] -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
et [i]
is [] (StackSet i l a s sd
s { hidden :: [Workspace i l a]
hidden = i -> l -> Maybe (Stack a) -> Workspace i l a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace i
i l
l Maybe (Stack a)
forall a. Maybe a
Nothing Workspace i l a -> [Workspace i l a] -> [Workspace i l a]
forall a. a -> [a] -> [a]
: StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden StackSet i l a s sd
s })
          et (i
i:[i]
is) (i
r:[i]
rs) StackSet i l a s sd
s = [i] -> [i] -> StackSet i l a s sd -> StackSet i l a s sd
et [i]
is [i]
rs (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ i -> i -> StackSet i l a s sd -> StackSet i l a s sd
forall i l a s sd.
Eq i =>
i -> i -> StackSet i l a s sd -> StackSet i l a s sd
renameTag i
r i
i StackSet i l a s sd
s

-- | Map a function on all the workspaces in the 'StackSet'.
mapWorkspace :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWorkspace :: (Workspace i l a -> Workspace i l a)
-> StackSet i l a s sd -> StackSet i l a s sd
mapWorkspace Workspace i l a -> Workspace i l a
f StackSet i l a s sd
s = StackSet i l a s sd
s { current :: Screen i l a s sd
current = Screen i l a s sd -> Screen i l a s sd
forall sid sd. Screen i l a sid sd -> Screen i l a sid sd
updScr (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
s)
                     , visible :: [Screen i l a s sd]
visible = (Screen i l a s sd -> Screen i l a s sd)
-> [Screen i l a s sd] -> [Screen i l a s sd]
forall a b. (a -> b) -> [a] -> [b]
map Screen i l a s sd -> Screen i l a s sd
forall sid sd. Screen i l a sid sd -> Screen i l a sid sd
updScr (StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
s)
                     , hidden :: [Workspace i l a]
hidden  = (Workspace i l a -> Workspace i l a)
-> [Workspace i l a] -> [Workspace i l a]
forall a b. (a -> b) -> [a] -> [b]
map Workspace i l a -> Workspace i l a
f (StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden StackSet i l a s sd
s) }
    where updScr :: Screen i l a sid sd -> Screen i l a sid sd
updScr Screen i l a sid sd
scr = Screen i l a sid sd
scr { workspace :: Workspace i l a
workspace = Workspace i l a -> Workspace i l a
f (Screen i l a sid sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace Screen i l a sid sd
scr) }

-- | Map a function on all the layouts in the 'StackSet'.
mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd
mapLayout :: (l -> l') -> StackSet i l a s sd -> StackSet i l' a s sd
mapLayout l -> l'
f (StackSet Screen i l a s sd
v [Screen i l a s sd]
vs [Workspace i l a]
hs Map a RationalRect
m) = Screen i l' a s sd
-> [Screen i l' a s sd]
-> [Workspace i l' a]
-> Map a RationalRect
-> StackSet i l' a s sd
forall i l a sid sd.
Screen i l a sid sd
-> [Screen i l a sid sd]
-> [Workspace i l a]
-> Map a RationalRect
-> StackSet i l a sid sd
StackSet (Screen i l a s sd -> Screen i l' a s sd
forall i a sid sd. Screen i l a sid sd -> Screen i l' a sid sd
fScreen Screen i l a s sd
v) ((Screen i l a s sd -> Screen i l' a s sd)
-> [Screen i l a s sd] -> [Screen i l' a s sd]
forall a b. (a -> b) -> [a] -> [b]
map Screen i l a s sd -> Screen i l' a s sd
forall i a sid sd. Screen i l a sid sd -> Screen i l' a sid sd
fScreen [Screen i l a s sd]
vs) ((Workspace i l a -> Workspace i l' a)
-> [Workspace i l a] -> [Workspace i l' a]
forall a b. (a -> b) -> [a] -> [b]
map Workspace i l a -> Workspace i l' a
forall i a. Workspace i l a -> Workspace i l' a
fWorkspace [Workspace i l a]
hs) Map a RationalRect
m
 where
    fScreen :: Screen i l a sid sd -> Screen i l' a sid sd
fScreen (Screen Workspace i l a
ws sid
s sd
sd) = Workspace i l' a -> sid -> sd -> Screen i l' a sid sd
forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
Screen (Workspace i l a -> Workspace i l' a
forall i a. Workspace i l a -> Workspace i l' a
fWorkspace Workspace i l a
ws) sid
s sd
sd
    fWorkspace :: Workspace i l a -> Workspace i l' a
fWorkspace (Workspace i
t l
l Maybe (Stack a)
s) = i -> l' -> Maybe (Stack a) -> Workspace i l' a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace i
t (l -> l'
f l
l) Maybe (Stack a)
s

-- | /O(n)/. Is a window in the 'StackSet'?
member :: Eq a => a -> StackSet i l a s sd -> Bool
member :: a -> StackSet i l a s sd -> Bool
member a
a StackSet i l a s sd
s = Maybe i -> Bool
forall a. Maybe a -> Bool
isJust (a -> StackSet i l a s sd -> Maybe i
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
findTag a
a StackSet i l a s sd
s)

-- | /O(1) on current window, O(n) in general/.
-- Return 'Just' the workspace tag of the given window, or 'Nothing'
-- if the window is not in the 'StackSet'.
findTag :: Eq a => a -> StackSet i l a s sd -> Maybe i
findTag :: a -> StackSet i l a s sd -> Maybe i
findTag a
a StackSet i l a s sd
s = [i] -> Maybe i
forall a. [a] -> Maybe a
listToMaybe
    [ Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag Workspace i l a
w | Workspace i l a
w <- StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
workspaces StackSet i l a s sd
s, a -> Maybe (Stack a) -> Bool
forall a. Eq a => a -> Maybe (Stack a) -> Bool
has a
a (Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace i l a
w) ]
    where has :: a -> Maybe (Stack a) -> Bool
has a
_ Maybe (Stack a)
Nothing         = Bool
False
          has a
x (Just (Stack a
t [a]
l [a]
r)) = a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (a
t a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
r)

-- ---------------------------------------------------------------------
-- $modifyStackset

-- |
-- /O(n)/. (Complexity due to duplicate check). Insert a new element
-- into the stack, above the currently focused element. The new
-- element is given focus; the previously focused element is moved
-- down.
--
-- If the element is already in the stackset, the original stackset is
-- returned unmodified.
--
-- Semantics in Huet's paper is that insert doesn't move the cursor.
-- However, we choose to insert above, and move the focus.
--
insertUp :: Eq a => a -> StackSet i l a s sd -> StackSet i l a s sd
insertUp :: a -> StackSet i l a s sd -> StackSet i l a s sd
insertUp a
a StackSet i l a s sd
s = if a -> StackSet i l a s sd -> Bool
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Bool
member a
a StackSet i l a s sd
s then StackSet i l a s sd
s else StackSet i l a s sd
insert
  where insert :: StackSet i l a s sd
insert = Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a i l s sd.
Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
modify (Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
a [] []) (\(Stack a
t [a]
l [a]
r) -> Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
a [a]
l (a
ta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)) StackSet i l a s sd
s

-- insertDown :: a -> StackSet i l a s sd -> StackSet i l a s sd
-- insertDown a = modify (Stack a [] []) $ \(Stack t l r) -> Stack a (t:l) r
-- Old semantics, from Huet.
-- >    w { down = a : down w }

-- |
-- /O(1) on current window, O(n) in general/. Delete window 'w' if it exists.
-- There are 4 cases to consider:
--
--   * delete on an 'Nothing' workspace leaves it Nothing
--
--   * otherwise, try to move focus to the down
--
--   * otherwise, try to move focus to the up
--
--   * otherwise, you've got an empty workspace, becomes 'Nothing'
--
-- Behaviour with respect to the master:
--
--   * deleting the master window resets it to the newly focused window
--
--   * otherwise, delete doesn't affect the master.
--
delete :: (Ord a) => a -> StackSet i l a s sd -> StackSet i l a s sd
delete :: a -> StackSet i l a s sd -> StackSet i l a s sd
delete a
w = a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
sink a
w (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
delete' a
w

-- | Only temporarily remove the window from the stack, thereby not destroying special
-- information saved in the 'Stackset'
delete' :: (Eq a) => a -> StackSet i l a s sd -> StackSet i l a s sd
delete' :: a -> StackSet i l a s sd -> StackSet i l a s sd
delete' a
w StackSet i l a s sd
s = StackSet i l a s sd
s { current :: Screen i l a s sd
current = Screen i l a s sd -> Screen i l a s sd
forall i l sid sd. Screen i l a sid sd -> Screen i l a sid sd
removeFromScreen        (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
s)
                , visible :: [Screen i l a s sd]
visible = (Screen i l a s sd -> Screen i l a s sd)
-> [Screen i l a s sd] -> [Screen i l a s sd]
forall a b. (a -> b) -> [a] -> [b]
map Screen i l a s sd -> Screen i l a s sd
forall i l sid sd. Screen i l a sid sd -> Screen i l a sid sd
removeFromScreen    (StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
s)
                , hidden :: [Workspace i l a]
hidden  = (Workspace i l a -> Workspace i l a)
-> [Workspace i l a] -> [Workspace i l a]
forall a b. (a -> b) -> [a] -> [b]
map Workspace i l a -> Workspace i l a
forall i l. Workspace i l a -> Workspace i l a
removeFromWorkspace (StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden  StackSet i l a s sd
s) }
    where removeFromWorkspace :: Workspace i l a -> Workspace i l a
removeFromWorkspace Workspace i l a
ws = Workspace i l a
ws { stack :: Maybe (Stack a)
stack = Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace i l a
ws Maybe (Stack a) -> (Stack a -> Maybe (Stack a)) -> Maybe (Stack a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Bool) -> Stack a -> Maybe (Stack a)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
w) }
          removeFromScreen :: Screen i l a sid sd -> Screen i l a sid sd
removeFromScreen Screen i l a sid sd
scr   = Screen i l a sid sd
scr { workspace :: Workspace i l a
workspace = Workspace i l a -> Workspace i l a
forall i l. Workspace i l a -> Workspace i l a
removeFromWorkspace (Screen i l a sid sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace Screen i l a sid sd
scr) }

------------------------------------------------------------------------

-- | Given a window, and its preferred rectangle, set it as floating
-- A floating window should already be managed by the 'StackSet'.
float :: Ord a => a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
float :: a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
float a
w RationalRect
r StackSet i l a s sd
s = StackSet i l a s sd
s { floating :: Map a RationalRect
floating = a -> RationalRect -> Map a RationalRect -> Map a RationalRect
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
w RationalRect
r (StackSet i l a s sd -> Map a RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
floating StackSet i l a s sd
s) }

-- | Clear the floating status of a window
sink :: Ord a => a -> StackSet i l a s sd -> StackSet i l a s sd
sink :: a -> StackSet i l a s sd -> StackSet i l a s sd
sink a
w StackSet i l a s sd
s = StackSet i l a s sd
s { floating :: Map a RationalRect
floating = a -> Map a RationalRect -> Map a RationalRect
forall k a. Ord k => k -> Map k a -> Map k a
M.delete a
w (StackSet i l a s sd -> Map a RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
floating StackSet i l a s sd
s) }

------------------------------------------------------------------------
-- $settingMW

-- | /O(s)/. Set the master window to the focused window.
-- The old master window is swapped in the tiling order with the focused window.
-- Focus stays with the item moved.
swapMaster :: StackSet i l a s sd -> StackSet i l a s sd
swapMaster :: StackSet i l a s sd -> StackSet i l a s sd
swapMaster = (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' ((Stack a -> Stack a)
 -> StackSet i l a s sd -> StackSet i l a s sd)
-> (Stack a -> Stack a)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ \Stack a
c -> case Stack a
c of
    Stack a
_ [] [a]
_  -> Stack a
c    -- already master.
    Stack a
t [a]
ls [a]
rs -> a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
t [] ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs) where (a
x:[a]
xs) = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ls

-- natural! keep focus, move current to the top, move top to current.

-- | /O(s)/. Set the master window to the focused window.
-- The other windows are kept in order and shifted down on the stack, as if you
-- just hit mod-shift-k a bunch of times.
-- Focus stays with the item moved.
shiftMaster :: StackSet i l a s sd -> StackSet i l a s sd
shiftMaster :: StackSet i l a s sd -> StackSet i l a s sd
shiftMaster = (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' ((Stack a -> Stack a)
 -> StackSet i l a s sd -> StackSet i l a s sd)
-> (Stack a -> Stack a)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ \Stack a
c -> case Stack a
c of
    Stack a
_ [] [a]
_ -> Stack a
c     -- already master.
    Stack a
t [a]
ls [a]
rs -> a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
t [] ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ls [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rs)

-- | /O(s)/. Set focus to the master window.
focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
focusMaster = (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' ((Stack a -> Stack a)
 -> StackSet i l a s sd -> StackSet i l a s sd)
-> (Stack a -> Stack a)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ \Stack a
c -> case Stack a
c of
    Stack a
_ [] [a]
_  -> Stack a
c
    Stack a
t [a]
ls [a]
rs -> a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
x [] ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
t a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs) where (a
x:[a]
xs) = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ls

--
-- ---------------------------------------------------------------------
-- $composite

-- | /O(w)/. shift. Move the focused element of the current stack to stack
-- 'n', leaving it as the focused element on that stack. The item is
-- inserted above the currently focused element on that workspace.
-- The actual focused workspace doesn't change. If there is no
-- element on the current stack, the original stackSet is returned.
--
shift :: (Ord a, Eq s, Eq i) => i -> StackSet i l a s sd -> StackSet i l a s sd
shift :: i -> StackSet i l a s sd -> StackSet i l a s sd
shift i
n StackSet i l a s sd
s = StackSet i l a s sd
-> (a -> StackSet i l a s sd) -> Maybe a -> StackSet i l a s sd
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StackSet i l a s sd
s (\a
w -> i -> a -> StackSet i l a s sd -> StackSet i l a s sd
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftWin i
n a
w StackSet i l a s sd
s) (StackSet i l a s sd -> Maybe a
forall i l a s sd. StackSet i l a s sd -> Maybe a
peek StackSet i l a s sd
s)

-- | /O(n)/. shiftWin. Searches for the specified window 'w' on all workspaces
-- of the stackSet and moves it to stack 'n', leaving it as the focused
-- element on that stack. The item is inserted above the currently
-- focused element on that workspace.
-- The actual focused workspace doesn't change. If the window is not
-- found in the stackSet, the original stackSet is returned.
shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftWin :: i -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftWin i
n a
w StackSet i l a s sd
s = case a -> StackSet i l a s sd -> Maybe i
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
findTag a
w StackSet i l a s sd
s of
                    Just i
from | i
n i -> StackSet i l a s sd -> Bool
forall i l a s sd. Eq i => i -> StackSet i l a s sd -> Bool
`tagMember` StackSet i l a s sd
s Bool -> Bool -> Bool
&& i
n i -> i -> Bool
forall a. Eq a => a -> a -> Bool
/= i
from -> i -> StackSet i l a s sd -> StackSet i l a s sd
forall s l sd.
Eq s =>
i -> StackSet i l a s sd -> StackSet i l a s sd
go i
from StackSet i l a s sd
s
                    Maybe i
_                                        -> StackSet i l a s sd
s
 where go :: i -> StackSet i l a s sd -> StackSet i l a s sd
go i
from = i
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall i s l a sd.
(Eq i, Eq s) =>
i
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
onWorkspace i
n (a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
insertUp a
w) (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall i s l a sd.
(Eq i, Eq s) =>
i
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
onWorkspace i
from (a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
delete' a
w)

onWorkspace :: (Eq i, Eq s) => i -> (StackSet i l a s sd -> StackSet i l a s sd)
            -> (StackSet i l a s sd -> StackSet i l a s sd)
onWorkspace :: i
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
onWorkspace i
n StackSet i l a s sd -> StackSet i l a s sd
f StackSet i l a s sd
s = i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view (StackSet i l a s sd -> i
forall i l a s sd. StackSet i l a s sd -> i
currentTag StackSet i l a s sd
s) (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> StackSet i l a s sd
f (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view i
n (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ StackSet i l a s sd
s