diff options
| -rw-r--r-- | Operations.hs | 6 | ||||
| -rw-r--r-- | StackSet.hs | 88 | ||||
| -rw-r--r-- | XMonad.hs | 15 | ||||
| -rw-r--r-- | tests/Properties.hs | 6 |
4 files changed, 59 insertions, 56 deletions
diff --git a/Operations.hs b/Operations.hs index 0effd8d..48ba9db 100644 --- a/Operations.hs +++ b/Operations.hs @@ -240,7 +240,7 @@ kill = withDisplay $ \d -> do else io (killClient d w) >> return () -- | tag. Move a window to a new workspace, 0 indexed. -tag :: W.WorkspaceId -> X () +tag :: WorkspaceId -> X () tag n = do ws <- gets workspace let m = W.current ws -- :: WorkspaceId @@ -250,7 +250,7 @@ tag n = do windows $ W.shift n -- | view. Change the current workspace to workspace at offset n (0 indexed). -view :: W.WorkspaceId -> X () +view :: WorkspaceId -> X () view n = do ws <- gets workspace let m = W.current ws @@ -263,7 +263,7 @@ view n = do setTopFocus -- | 'screenWorkspace sc' returns the workspace number viewed by 'sc'. -screenWorkspace :: W.ScreenId -> X W.WorkspaceId +screenWorkspace :: ScreenId -> X WorkspaceId screenWorkspace sc = fmap (fromMaybe 0 . W.workspace sc) (gets workspace) -- | True if window is under management by us diff --git a/StackSet.hs b/StackSet.hs index f0168d1..a212049 100644 --- a/StackSet.hs +++ b/StackSet.hs @@ -21,7 +21,13 @@ -- given time. -- -module StackSet where +module StackSet ( + StackSet(..), -- abstract + + screen, peekStack, index, empty, peek, push, delete, member, + raiseFocus, rotate, promote, shift, view, workspace, fromList, + toList, size, visibleWorkspaces + ) where import Data.Maybe import qualified Data.List as L (delete,genericLength,elemIndex) @@ -29,28 +35,21 @@ import qualified Data.Map as M ------------------------------------------------------------------------ --- | The StackSet data structure. A table of stacks, with a current pointer -data StackSet a = +-- | The StackSet data structure. Multiple screens containing tables of +-- stacks, with a current pointer +data StackSet i j a = StackSet - { current :: !WorkspaceId -- ^ the currently visible stack - , screen2ws:: !(M.Map ScreenId WorkspaceId) -- ^ screen -> workspace - , ws2screen:: !(M.Map WorkspaceId ScreenId) -- ^ workspace -> screen map - , stacks :: !(M.Map WorkspaceId [a]) -- ^ the separate stacks - , focus :: !(M.Map WorkspaceId a) -- ^ the window focused in each stack - , cache :: !(M.Map a WorkspaceId) -- ^ a cache of windows back to their stacks + { current :: !i -- ^ the currently visible stack + , screen2ws:: !(M.Map j i) -- ^ screen -> workspace + , ws2screen:: !(M.Map i j) -- ^ workspace -> screen map + , stacks :: !(M.Map i [a]) -- ^ the separate stacks + , focus :: !(M.Map i a) -- ^ the window focused in each stack + , cache :: !(M.Map a i) -- ^ a cache of windows back to their stacks } deriving Eq --- | Physical screen indicies -newtype ScreenId = S Int deriving (Eq,Ord,Show,Enum,Num,Integral,Real) - --- | Virtual workspace indicies -newtype WorkspaceId = W Int deriving (Eq,Ord,Show,Enum,Num,Integral,Real) - -instance Show a => Show (StackSet a) where +instance (Show i, Show a) => Show (StackSet i j a) where showsPrec p s r = showsPrec p (show . toList $ s) r --- Ord a constraint on 'a' as we use it as a key. --- -- The cache is used to check on insertion that we don't already have -- this window managed on another stack @@ -58,29 +57,28 @@ instance Show a => Show (StackSet a) where -- | /O(n)/. Create a new empty stacks of size 'n', indexed from 0, with 'm' -- screens. (also indexed from 0) The 0-indexed stack will be current. -empty :: Int -> Int -> StackSet a +empty :: (Integral i, Integral j) => Int -> Int -> StackSet i j a empty n m = StackSet { current = 0 , screen2ws = wsScrs2Works - , ws2screen = wsWorks2Scrs - , stacks = M.fromList (zip [0..W n-1] (repeat [])) + , stacks = M.fromList (zip [0..fromIntegral n-1] (repeat [])) , focus = M.empty , cache = M.empty } - where (scrs,wrks) = unzip $ map (\x -> (S x, W x)) [0..m-1] + where (scrs,wrks) = unzip $ map (\x -> (fromIntegral x, fromIntegral x)) [0..m-1] wsScrs2Works = M.fromList (zip scrs wrks) wsWorks2Scrs = M.fromList (zip wrks scrs) -- | /O(log w)/. True if x is somewhere in the StackSet -member :: Ord a => a -> StackSet a -> Bool +member :: Ord a => a -> StackSet i j a -> Bool member a w = M.member a (cache w) -- | /O(log n)/. Looks up the workspace that x is in, if it is in the StackSet -lookup :: (Monad m, Ord a) => a -> StackSet a -> m WorkspaceId -lookup x w = M.lookup x (cache w) +-- lookup :: (Monad m, Ord a) => a -> StackSet i j a -> m i +-- lookup x w = M.lookup x (cache w) -- | /O(n)/. Number of stacks -size :: StackSet a -> Int +size :: StackSet i j a -> Int size = M.size . stacks ------------------------------------------------------------------------ @@ -89,7 +87,7 @@ size = M.size . stacks -- keeping track of the currently focused workspace, and the total -- number of workspaces. If there are duplicates in the list, the last -- occurence wins. -fromList :: Ord a => (WorkspaceId, Int,[[a]]) -> StackSet a +fromList :: (Integral i, Integral j, Ord a) => (i, Int,[[a]]) -> StackSet i j a fromList (_,_,[]) = error "Cannot build a StackSet from an empty list" fromList (n,m,xs) | n < 0 || n >= L.genericLength xs @@ -103,36 +101,36 @@ fromList (o,m,xs) = view o $ foldr (\(i,ys) s -> -- | toList. Flatten a stackset to a list of lists -toList :: StackSet a -> (WorkspaceId,Int,[[a]]) +toList :: StackSet i j a -> (i,Int,[[a]]) toList x = (current x, M.size $ screen2ws x, map snd $ M.toList (stacks x)) -- | Push. Insert an element onto the top of the current stack. -- If the element is already in the current stack, it is moved to the top. -- If the element is managed on another stack, it is removed from that -- stack first. -push :: Ord a => a -> StackSet a -> StackSet a +push :: (Integral i, Ord a) => a -> StackSet i j a -> StackSet i j a push k w = insert k (current w) w -- | /O(log s)/. Extract the element on the top of the current stack. If no such -- element exists, Nothing is returned. -peek :: StackSet a -> Maybe a +peek :: Integral i => StackSet i j a -> Maybe a peek w = peekStack (current w) w -- | /O(log s)/. Extract the element on the top of the given stack. If no such -- element exists, Nothing is returned. -peekStack :: WorkspaceId -> StackSet a -> Maybe a -peekStack n w = M.lookup n (focus w) +peekStack :: Integral i => i -> StackSet i j a -> Maybe a +peekStack i w = M.lookup i (focus w) --- | /O(log s)/. Index. Extract the stack at index 'n'. +-- | /O(log s)/. Index. Extract the stack at workspace 'n'. -- If the index is invalid, an exception is thrown. -index :: WorkspaceId -> StackSet a -> [a] +index :: Integral i => i -> StackSet i j a -> [a] index k w = fromJust (M.lookup k (stacks w)) -- | view. Set the stack specified by the argument as being visible and the -- current StackSet. If the stack wasn't previously visible, it will become -- visible on the current screen. If the index is out of range an exception is -- thrown. -view :: WorkspaceId -> StackSet a -> StackSet a +view :: (Integral i, Integral j) => i -> StackSet i j a -> StackSet i j a -- view n w | n >= 0 && n < fromIntegral (M.size (stacks w)) -- coerce view n w | M.member n (stacks w) @@ -146,15 +144,15 @@ view n w | M.member n (stacks w) } -- | That screen that workspace 'n' is visible on, if any. -screen :: WorkspaceId -> StackSet a -> Maybe ScreenId +screen :: Integral i => i -> StackSet i j a -> Maybe j screen n w = M.lookup n (ws2screen w) -- | The workspace visible on screen 'sc'. Nothing if screen is out of bounds. -workspace :: ScreenId -> StackSet a -> Maybe WorkspaceId +workspace :: Integral j => j -> StackSet i j a -> Maybe i workspace sc w = M.lookup sc (screen2ws w) -- | A list of the currently visible workspaces. -visibleWorkspaces :: StackSet a -> [WorkspaceId] +visibleWorkspaces :: StackSet i j a -> [i] visibleWorkspaces = M.keys . ws2screen -- @@ -168,7 +166,7 @@ visibleWorkspaces = M.keys . ws2screen -- -- where xs = [5..8] ++ [1..4] -- -rotate :: Eq a => Ordering -> StackSet a -> StackSet a +rotate :: (Integral i, Eq a) => Ordering -> StackSet i j a -> StackSet i j a rotate o w = maybe w id $ do f <- M.lookup (current w) (focus w) s <- M.lookup (current w) (stacks w) @@ -182,7 +180,7 @@ rotate o w = maybe w id $ do -- the top of stack 'n'. If the stack to move to is not valid, and -- exception is thrown. -- -shift :: Ord a => WorkspaceId -> StackSet a -> StackSet a +shift :: (Integral i, Ord a) => i -> StackSet i j a -> StackSet i j a shift n w = maybe w (\k -> insert k n (delete k w)) (peek w) -- | /O(log n)/. Insert an element onto the top of stack 'n'. @@ -190,7 +188,7 @@ shift n w = maybe w (\k -> insert k n (delete k w)) (peek w) -- If the element exists on another stack, it is removed from that stack. -- If the index is wrong an exception is thrown. -- -insert :: Ord a => a -> WorkspaceId -> StackSet a -> StackSet a +insert :: (Integral i, Ord a) => a -> i -> StackSet i j a -> StackSet i j a insert k n old = new { cache = M.insert k n (cache new) , stacks = M.adjust (k:) n (stacks new) , focus = M.insert n k (focus new) } @@ -199,7 +197,7 @@ insert k n old = new { cache = M.insert k n (cache new) -- | /O(log n)/. Delete an element entirely from from the StackSet. -- This can be used to ensure that a given element is not managed elsewhere. -- If the element doesn't exist, the original StackSet is returned unmodified. -delete :: Ord a => a -> StackSet a -> StackSet a +delete :: (Integral i, Ord a) => a -> StackSet i j a -> StackSet i j a delete k w = maybe w tweak (M.lookup k (cache w)) where tweak i = w { cache = M.delete k (cache w) @@ -211,14 +209,14 @@ delete k w = maybe w tweak (M.lookup k (cache w)) -- | /O(log n)/. If the given window is contained in a workspace, make it the -- focused window of that workspace, and make that workspace the current one. -raiseFocus :: Ord a => a -> StackSet a -> StackSet a +raiseFocus :: (Integral i, Integral j, Ord a) => a -> StackSet i j a -> StackSet i j a raiseFocus k w = case M.lookup k (cache w) of Nothing -> w Just i -> (view i w) { focus = M.insert i k (focus w) } -- | Swap the currently focused window with the master window (the -- window on top of the stack). Focus moves to the master. -promote :: Ord a => StackSet a -> StackSet a +promote :: (Integral i, Ord a) => StackSet i j a -> StackSet i j a promote w = maybe w id $ do a <- peek w -- fail if null let w' = w { stacks = M.adjust (\s -> swap a (head s) s) (current w) (stacks w) } @@ -246,6 +244,6 @@ swap _ _ xs = xs -- do nothing -- next xs = last xs : init xs -- --- | +-- | Find the element in the (circular) list after given element. elemAfter :: Eq a => a -> [a] -> Maybe a elemAfter w ws = listToMaybe . filter (/= w) . dropWhile (/= w) $ ws ++ ws @@ -15,12 +15,11 @@ -- module XMonad ( - X, WorkSpace, XState(..), Layout(..), LayoutDesc(..), - runX, io, withDisplay, isRoot, - spawn, trace, whenJust, rotateLayout + X, WorkSpace, WorkspaceId(..), ScreenId(..), XState(..), Layout(..), LayoutDesc(..), + runX, io, withDisplay, isRoot, spawn, trace, whenJust, rotateLayout ) where -import StackSet (StackSet,WorkspaceId) +import StackSet (StackSet) import Control.Monad.State import System.IO @@ -48,7 +47,13 @@ data XState = XState -- to descriptions of their layouts } -type WorkSpace = StackSet Window +type WorkSpace = StackSet WorkspaceId ScreenId Window + +-- | Virtual workspace indicies +newtype WorkspaceId = W Int deriving (Eq,Ord,Show,Enum,Num,Integral,Real) + +-- | Physical screen indicies +newtype ScreenId = S Int deriving (Eq,Ord,Show,Enum,Num,Integral,Real) ------------------------------------------------------------------------ diff --git a/tests/Properties.hs b/tests/Properties.hs index e69c7f9..7eefe67 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -17,11 +17,11 @@ import Data.Map (keys,elems) -- QuickCheck properties for the StackSet -- | Height of stack 'n' -height :: WorkspaceId -> StackSet a -> Int +height :: Int -> T -> Int height i w = length (index i w) -- build (non-empty) StackSets with between 1 and 100 stacks -instance (Ord a, Arbitrary a) => Arbitrary (StackSet a) where +instance (Integral i, Integral j, Ord a, Arbitrary a) => Arbitrary (StackSet i j a) where arbitrary = do sz <- choose (1,20) n <- choose (0,sz-1) @@ -58,7 +58,7 @@ prop_peekmember x = case peek x of Nothing -> True {- then we don't know anything -} where _ = x :: T -type T = StackSet Int +type T = StackSet Int Int Int prop_delete_uniq i x = not (member i x) ==> delete i x == x where _ = x :: T |