From 86271c7d79e96aaa0be58a05eeac6cf023b487c3 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Thu, 1 Nov 2007 19:08:46 +0100 Subject: Hierarchify darcs-hash:20071101180846-a5988-25ba1c9ce37a35c1533e4075cc9494c6f7dd5ade.gz --- StackSet.hs | 565 ------------------------------------------------------------ 1 file changed, 565 deletions(-) delete mode 100644 StackSet.hs (limited to 'StackSet.hs') 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 - -- cgit v1.2.3