Hierarchify

darcs-hash:20071101180846-a5988-25ba1c9ce37a35c1533e4075cc9494c6f7dd5ade

1 files changed, 0 insertions, 565 deletions

diff --git a/StackSet.hs b/StackSet.hs
deleted file mode 100644
index 807cb1b..0000000
--- a/StackSet.hs
+++ /dev/null
@@ -1,565 +0,0 @@
-{-# LANGUAGE PatternGuards #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  StackSet
--- Copyright   :  (c) Don Stewart 2007
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  dons@galois.com
--- Stability   :  experimental
--- Portability :  portable, Haskell 98
---
-
-module StackSet (
-        -- * Introduction
-        -- $intro
-        StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..),
-        -- *  Construction
-        -- $construction
-        new, view, greedyView,
-        -- * Xinerama operations
-        -- $xinerama
-        lookupWorkspace,
-        screens, workspaces, allWindows,
-        -- *  Operations on the current stack
-        -- $stackOperations
-        peek, index, integrate, integrate', differentiate,
-        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, modify, modify', float, sink, -- needed by users
-        -- * Composite operations
-        -- $composite
-        shift, shiftWin,
-
-        -- for testing
-        abort
-    ) where
-
-import Prelude hiding (filter)
-import Data.Maybe   (listToMaybe,fromJust)
-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 an  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 support:
---
--- 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.  
---
--- Master and 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'.
---
-
--- |
--- API changes from xmonad 0.1:
--- StackSet constructor arguments changed. StackSet workspace window screen
---
--- * new,                    -- was: empty
---
--- * view,
---
--- * index,
---
--- * peek,                   -- was: peek\/peekStack
---
--- * focusUp, focusDown,     -- was: rotate
---
--- * swapUp, swapDown
---
--- * focus                   -- was: raiseFocus
---
--- * insertUp,               -- was: insert\/push
---
--- * delete,
---
--- * swapMaster,             -- was: promote\/swap
---
--- * member,
---
--- * shift,
---
--- * lookupWorkspace,        -- was: workspace
---
--- * visibleWorkspaces       -- gone.
---
-------------------------------------------------------------------------
--- |
--- 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 { current  :: !(Screen i l a sid sd)    -- ^ currently focused workspace
-             , visible  :: [Screen i l a sid sd]     -- ^ non-focused workspaces, visible in xinerama
-             , hidden   :: [Workspace i l a]         -- ^ workspaces not visible anywhere
-             , floating :: M.Map a RationalRect      -- ^ floating windows
-             } deriving (Show, Read, Eq)
-
--- | Visible workspaces, and their Xinerama screens.
-data Screen i l a sid sd = Screen { workspace :: !(Workspace i l a)
-                                  , screen :: !sid
-                                  , screenDetail :: !sd }
-    deriving (Show, Read, Eq)
-
--- |
--- A workspace is just a tag - its index - and a stack
---
-data Workspace i l a = Workspace  { tag :: !i, layout :: l, stack :: Maybe (Stack a) }
-    deriving (Show, Read, Eq)
-
--- | A structure for window geometries
-data RationalRect = RationalRect Rational Rational Rational Rational
-    deriving (Show, Read, Eq)
-
--- |
--- A stack is a cursor onto a (possibly empty) 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 { focus  :: !a        -- focused thing in this set
-                     , up     :: [a]       -- clowns to the left
-                     , down   :: [a] }     -- jokers to the right
-    deriving (Show, Read, Eq)
-
-
--- | this function indicates to catch that an error is expected
-abort :: String -> a
-abort x = error $ "xmonad: StackSet: " ++ 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 wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty
-  where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
-        (cur:visi)    = [ Screen i s sd |  (i, s, sd) <- zip3 seen [0..] m ]
-                -- now zip up visibles with their screen id
-new _ _ _ = abort "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 s
-    | not (i `tagMember` s)
-      || i == tag (workspace (current s)) = s  -- out of bounds or current
-
-    | Just x <- L.find ((i==).tag.workspace) (visible s)
-    -- if it is visible, it is just raised
-    = s { current = x, visible = current s : L.deleteBy (equating screen) x (visible s) }
-
-    | Just x <- L.find ((i==).tag)           (hidden  s) -- must be hidden then
-    -- if it was hidden, it is raised on the xine screen currently used
-    = s { current = (current s) { workspace = x }
-        , hidden = workspace (current s) : L.deleteBy (equating tag) x (hidden s) }
-
-    | otherwise = s -- can't happen: all workspaces are either invalid, current, visible, or hidden
-
-  where equating f = \x y -> f x == f 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 w ws
-     | any wTag (hidden ws) = view w ws
-     | (Just s) <- L.find (wTag . workspace) (visible ws)
-                            = ws { current = (current ws) { workspace = workspace s }
-                                 , visible = s { workspace = workspace (current ws) }
-                                           : L.filter (not . wTag . workspace) (visible ws) }
-     | otherwise = ws
-   where wTag = (w == ) . 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 sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible w, 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 dflt f = maybe dflt f . stack . workspace . 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 d f s = s { current = (current s)
-                        { workspace = (workspace (current s)) { stack = with d f 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' f = modify Nothing (Just . 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 = with Nothing (return . focus)
-
--- |
--- /O(n)/. Flatten a Stack into a list.
---
-integrate :: Stack a -> [a]
-integrate (Stack x l r) = reverse l ++ x : r
-
--- |
--- /O(n)/ Flatten a possibly empty stack into a list.
-integrate' :: Maybe (Stack a) -> [a]
-integrate' = maybe [] 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 []     = Nothing
-differentiate (x:xs) = Just $ Stack x [] 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 p (Stack f ls rs) = case L.filter p (f:rs) of
-    f':rs' -> Just $ Stack f' (L.filter p ls) rs'    -- maybe move focus down
-    []     -> case L.filter p ls of                  -- filter back up
-                    f':ls' -> Just $ Stack f' ls' [] -- else up
-                    []     -> 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 = with [] 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   = modify' focusUp'
-focusDown = modify' (reverseStack . focusUp' . reverseStack)
-
-swapUp    = modify' swapUp'
-swapDown  = modify' (reverseStack . swapUp' . reverseStack)
-
-focusUp', swapUp' :: Stack a -> Stack a
-focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
-focusUp' (Stack t []     rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
-
-swapUp'  (Stack t (l:ls) rs) = Stack t ls (l:rs)
-swapUp'  (Stack t []     rs) = Stack t (reverse rs) []
-
--- | reverse a stack: up becomes down and down becomes up.
-reverseStack :: Stack a -> Stack a
-reverseStack (Stack t ls rs) = Stack t rs 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 w s | Just w == peek s = s
-                | otherwise        = maybe s id $ do
-                    n <- findTag w s
-                    return $ until ((Just w ==) . peek) focusUp (view n s)
-
--- | Get a list of all screens in the StackSet.
-screens :: StackSet i l a s sd -> [Screen i l a s sd]
-screens s = current s : visible s
-
--- | Get a list of all workspaces in the StackSet.
-workspaces :: StackSet i l a s sd -> [Workspace i l a]
-workspaces s = workspace (current s) : map workspace (visible s) ++ hidden 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 = L.nub . concatMap (integrate' . stack) . workspaces
-
--- | Is the given tag present in the StackSet?
-tagMember :: Eq i => i -> StackSet i l a s sd -> Bool
-tagMember t = elem t . map tag . 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 o n = mapWorkspace rename
-    where rename w = if tag w == o then w { tag = n } else 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 allt st = et allt (map tag (workspaces st) \\ allt) st
-    where et [] _ s = s
-          et (i:is) rn s | i `tagMember` s = et is rn s
-          et (i:is) [] s = et is [] (s { hidden = Workspace i l Nothing : hidden s })
-          et (i:is) (r:rs) s = et is rs $ renameTag r i 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 f s = s { current = updScr (current s)
-                     , visible = map updScr (visible s)
-                     , hidden  = map f (hidden s) }
-    where updScr scr = scr { workspace = f (workspace 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 f (StackSet v vs hs m) = StackSet (fScreen v) (map fScreen vs) (map fWorkspace hs) m
- where
-    fScreen (Screen ws s sd) = Screen (fWorkspace ws) s sd
-    fWorkspace (Workspace t l s) = Workspace t (f l) s
-
--- | /O(n)/. Is a window in the StackSet.
-member :: Eq a => a -> StackSet i l a s sd -> Bool
-member a s = maybe False (const True) (findTag a 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 s = listToMaybe
-    [ tag w | w <- workspaces s, has a (stack w) ]
-    where has _ Nothing         = False
-          has x (Just (Stack t l r)) = x `elem` (t : l ++ 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 s = if member a s then s else insert
-  where insert = modify (Just $ Stack a [] []) (\(Stack t l r) -> Just $ Stack a l (t:r)) 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, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
-delete w = sink w . delete' w
-
--- | Only temporarily remove the window from the stack, thereby not destroying special
--- information saved in the Stackset
-delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
-delete' w s = s { current = removeFromScreen        (current s)
-                , visible = map removeFromScreen    (visible s)
-                , hidden  = map removeFromWorkspace (hidden  s) }
-    where removeFromWorkspace ws = ws { stack = stack ws >>= filter (/=w) }
-          removeFromScreen scr   = scr { workspace = removeFromWorkspace (workspace 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 w r s = s { floating = M.insert w r (floating 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 w s = s { floating = M.delete w (floating 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 = modify' $ \c -> case c of
-    Stack _ [] _  -> c    -- already master.
-    Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls
-
--- natural! keep focus, move current to the top, move top to current.
-
--- | /O(s)/. Set focus to the master window.
-focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
-focusMaster = modify' $ \c -> case c of
-    Stack _ [] _  -> c
-    Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse 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 n s | n `tagMember` s && n /= curtag = maybe s go (peek s)
-          | otherwise                      = s
-    where go w = view curtag . insertUp w . view n . delete' w $ s
-          curtag = tag (workspace (current 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.
--- TODO how does this duplicate 'shift's behaviour?
-shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
-shiftWin n w s | from == Nothing                     = s -- not found
-               | n `tagMember` s && (Just n) /= from = go
-               | otherwise                           = s
-    where from   = findTag w s
-
-          go     = on n (insertUp w) . on (fromJust from) (delete' w) $ s
-          curtag = tag (workspace (current s))
-          on i f = view curtag . f . view i
-