diff options
| -rw-r--r-- | Main.hs | 2 | ||||
| -rw-r--r-- | StackSet.hs | 48 | ||||
| -rw-r--r-- | tests/Properties.hs | 71 |
3 files changed, 63 insertions, 58 deletions
@@ -52,7 +52,7 @@ main = do let winset | ("--resume" : s : _) <- args , [(x, "")] <- reads s = x - | otherwise = new (fromIntegral workspaces) (fromIntegral $ length xinesc) + | otherwise = new [0..fromIntegral workspaces-1] (fromIntegral $ length xinesc) safeLayouts = case defaultLayouts of [] -> (full, []); (x:xs) -> (x,xs) cf = XConf diff --git a/StackSet.hs b/StackSet.hs index c37640d..8f5311a 100644 --- a/StackSet.hs +++ b/StackSet.hs @@ -23,7 +23,7 @@ module StackSet ( -- $stackOperations peek, index, integrate, integrate', differentiate, focusUp, focusDown, - focusWindow, member, findIndex, + focusWindow, tagMember, member, findIndex, -- * Modifying the stackset -- $modifyStackset insertUp, delete, filter, @@ -104,6 +104,13 @@ import qualified Data.Map as M (Map,insert,delete,empty) -- needs to be well defined. Particular in relation to 'insert' and -- 'delete'. -- + +import Prelude hiding (filter) +import Data.Maybe (listToMaybe) +import qualified Data.List as L (delete,find,genericSplitAt,filter) +import qualified Data.Map as M (Map,insert,delete,empty) + +-- | -- API changes from xmonad 0.1: -- StackSet constructor arguments changed. StackSet workspace window screen -- @@ -145,8 +152,7 @@ import qualified Data.Map as M (Map,insert,delete,empty) -- Xinerama screens, and those workspaces not visible anywhere. data StackSet i a sid = - StackSet { size :: !i -- ^ number of workspaces - , current :: !(Screen i a sid) -- ^ currently focused workspace + StackSet { current :: !(Screen i a sid) -- ^ currently focused workspace , visible :: [Screen i a sid] -- ^ non-focused workspaces, visible in xinerama , hidden :: [Workspace i a] -- ^ workspaces not visible anywhere , floating :: M.Map a RationalRect -- ^ floating windows @@ -198,19 +204,20 @@ abort x = error $ "xmonad: StackSet: " ++ x -- --------------------------------------------------------------------- -- $construction --- | /O(n)/. Create a new stackset, of empty stacks, of size 'n', with --- 'm' physical screens. 'm' should be less than or equal to 'n'. --- The workspace with index '0' will be current. +-- | /O(n)/. Create a new stackset, of empty stacks, with given tags, with +-- 'm' physical screens. '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 i, Integral s) => i -> s -> StackSet i a s -new n m | n > 0 && m > 0 = StackSet n cur visi unseen M.empty - | otherwise = abort "non-positive arguments to StackSet.new" - - where (seen,unseen) = L.genericSplitAt m $ Workspace 0 Nothing : [ Workspace i Nothing | i <- [1 ..n-1]] +new :: Integral s => [i] -> s -> StackSet i a s +new (wid:wids) m | m > 0 = StackSet cur visi unseen M.empty + where (seen,unseen) = L.genericSplitAt m $ Workspace wid Nothing : [ Workspace i Nothing | i <- wids] (cur:visi) = [ Screen i s | (i,s) <- zip seen [0..] ] -- 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\'. @@ -220,9 +227,10 @@ new n m | n > 0 && m > 0 = StackSet n cur visi unseen M.empty -- becomes the current screen. If it is in the visible list, it becomes -- current. -view :: (Eq a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s +view :: (Eq a, Eq s, Eq i) => i -> StackSet i a s -> StackSet i a s view i s - | i < 0 && i >= size s || i == tag (workspace (current s)) = s -- out of bounds or current + | not (elem i $ map tag $ workspaces 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 @@ -356,6 +364,16 @@ focusWindow w s | Just w == peek s = s n <- findIndex w s return $ until ((Just w ==) . peek) focusUp (view n s) + + +-- | Get a list of all workspaces in the StackSet. +workspaces :: StackSet i a s -> [Workspace i a] +workspaces s = workspace (current s) : map workspace (visible s) ++ hidden s + +-- | Is the given tag present in the StackSet? +tagMember :: Eq i => i -> StackSet i a s -> Bool +tagMember t = elem t . map tag . workspaces + -- | -- Finding if a window is in the stackset is a little tedious. We could -- keep a cache :: Map a i, but with more bookkeeping. @@ -370,7 +388,7 @@ member a s = maybe False (const True) (findIndex a s) -- if the window is not in the StackSet. findIndex :: Eq a => a -> StackSet i a s -> Maybe i findIndex a s = listToMaybe - [ tag w | w <- workspace (current s) : map workspace (visible s) ++ hidden s, has a (stack w) ] + [ 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) @@ -464,7 +482,7 @@ swapMaster = modify' $ \c -> case c of -- element on the current stack, the original stackSet is returned. -- shift :: (Ord a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s -shift n s = if and [n >= 0,n < size s,n /= tag (workspace (current s))] +shift n s = if and [n >= 0,n `tagMember` s, n /= tag (workspace (current s))] then maybe s go (peek s) else s where go w = foldr ($) s [view (tag (workspace (current s))),insertUp w,view n,delete w] -- ^^ poor man's state monad :-) diff --git a/tests/Properties.hs b/tests/Properties.hs index d9381d8..638f7ec 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -71,7 +71,7 @@ fromList (o,m,fs,xs) = let s = view o $ foldr (\(i,ys) s -> foldr insertUp (view i s) ys) - (new (genericLength xs) m) (zip [0..] xs) + (new [0..genericLength xs-1] m) (zip [0..] xs) in foldr (\f t -> case f of Nothing -> t Just i -> foldr (const focusUp) t [0..i] ) s fs @@ -81,7 +81,7 @@ fromList (o,m,fs,xs) = -- -- Just generate StackSets with Char elements. -- -type T = StackSet Int Char Int +type T = StackSet (NonNegative Int) Char Int -- Useful operation, the non-local workspaces hidden_spaces x = map workspace (visible x) ++ hidden x @@ -103,7 +103,6 @@ hidden_spaces x = map workspace (visible x) ++ hidden x invariant (s :: T) = and -- no duplicates [ noDuplicates - , accurateSize -- all this xinerama stuff says we don't have the right structure -- , validScreens @@ -116,8 +115,6 @@ invariant (s :: T) = and | w <- workspace (current s) : map workspace (visible s) ++ hidden s , t <- maybeToList (stack w)] :: [Char] noDuplicates = nub ws == ws - calculatedSize = length (visible s) + length (hidden s) + 1 -- +1 is for current - accurateSize = calculatedSize == size s -- validScreens = monotonic . sort . M. . (W.current s : W.visible : W$ s @@ -135,10 +132,10 @@ prop_invariant = invariant -- and check other ops preserve invariants prop_empty_I (n :: Positive Int) = forAll (choose (1,fromIntegral n)) $ \m -> - invariant $ new (fromIntegral n) m + invariant $ new [0..fromIntegral n-1] m prop_view_I (n :: NonNegative Int) (x :: T) = - fromIntegral n < size x ==> invariant $ view (fromIntegral n) x + n `tagMember` x ==> invariant $ view (fromIntegral n) x prop_focusUp_I (n :: NonNegative Int) (x :: T) = invariant $ foldr (const focusUp) x [1..n] @@ -166,41 +163,39 @@ prop_swap_right_I (n :: NonNegative Int) (x :: T) = invariant $ foldr (const swapDown) x [1..n] prop_shift_I (n :: NonNegative Int) (x :: T) = - fromIntegral n < size x ==> invariant $ shift (fromIntegral n) x + n `tagMember` x ==> invariant $ shift (fromIntegral n) x -- --------------------------------------------------------------------- -- 'new' -- empty StackSets have no windows in them -prop_empty (n :: Positive Int) - (m :: Positive Int) = +prop_empty (NonEmptyNubList ns) (m :: Positive Int) = all (== Nothing) [ stack w | w <- workspace (current x) : map workspace (visible x) ++ hidden x ] - where x = new (fromIntegral n) (fromIntegral m) :: T + where x = new ns (fromIntegral m) :: T --- empty StackSets always have focus on workspace 0 -prop_empty_current (n :: Positive Int) - (m :: Positive Int) = tag (workspace $ current x) == 0 - where x = new (fromIntegral n) (fromIntegral m) :: T +-- empty StackSets always have focus on first workspace +prop_empty_current (NonEmptyNubList ns) (m :: Positive Int) = tag (workspace $ current x) == head ns + where x = new ns (fromIntegral m) :: T -- no windows will be a member of an empty workspace -prop_member_empty i (n :: Positive Int) (m :: Positive Int) - = member i (new (fromIntegral n) (fromIntegral m) :: T) == False +prop_member_empty i (NonEmptyNubList ns) (m :: Positive Int) + = member i (new ns (fromIntegral m) :: T) == False -- --------------------------------------------------------------------- -- viewing workspaces -- view sets the current workspace to 'n' -prop_view_current (x :: T) (n :: NonNegative Int) = i < size x ==> +prop_view_current (x :: T) (n :: NonNegative Int) = i `tagMember` x ==> tag (workspace $ current (view i x)) == i where i = fromIntegral n -- view *only* sets the current workspace, and touches Xinerama. -- no workspace contents will be changed. -prop_view_local (x :: T) (n :: NonNegative Int) = i < size x ==> +prop_view_local (x :: T) (n :: NonNegative Int) = i `tagMember` x ==> workspaces x == workspaces (view i x) where workspaces a = sortBy (\s t -> tag s `compare` tag t) $ @@ -209,22 +204,18 @@ prop_view_local (x :: T) (n :: NonNegative Int) = i < size x ==> i = fromIntegral n -- view should result in a visible xinerama screen --- prop_view_xinerama (x :: T) (n :: NonNegative Int) = i < size x ==> +-- prop_view_xinerama (x :: T) (n :: NonNegative Int) = i `tagMember` x ==> -- M.member i (screens (view i x)) -- where -- i = fromIntegral n -- view is idempotent -prop_view_idem (x :: T) r = - let i = fromIntegral $ r `mod` sz - sz = size x - in view i (view i x) == (view i x) +prop_view_idem (x :: T) (i :: NonNegative Int) = i `tagMember` x ==> view i (view i x) == (view i x) -- view is reversible, though shuffles the order of hidden/visible -prop_view_reversible r (x :: T) = normal (view n (view i x)) == normal x +prop_view_reversible (i :: NonNegative Int) (x :: T) = + i `tagMember` x ==> normal (view n (view i x)) == normal x where n = tag (workspace $ current x) - sz = size x - i = fromIntegral $ r `mod` sz -- normalise workspace list normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) } @@ -329,8 +320,8 @@ prop_findIndex (x :: T) = -- 'insert' -- inserting a item into an empty stackset means that item is now a member -prop_insert_empty i (n :: Positive Int) (m :: Positive Int) = member i (insertUp i x) - where x = new (fromIntegral n) (fromIntegral m) :: T +prop_insert_empty i (NonEmptyNubList ns) (m :: Positive Int) = member i (insertUp i x) + where x = new ns (fromIntegral m) :: T -- insert should be idempotent prop_insert_idem i (x :: T) = insertUp i x == insertUp i (insertUp i x) @@ -343,10 +334,9 @@ prop_insert_local (x :: T) i = not (member i x) ==> hidden_spaces x == hidden_sp -- Inserting a (unique) list of items into an empty stackset should -- result in the last inserted element having focus. -prop_insert_peek (n :: Positive Int) (m :: Positive Int) (NonEmptyNubList is) = +prop_insert_peek (NonEmptyNubList ns) (m :: Positive Int) (NonEmptyNubList is) = peek (foldr insertUp x is) == Just (head is) - where - x = new (fromIntegral n) (fromIntegral m) :: T + where x = new ns (fromIntegral m) :: T -- insert >> delete is the identity, when i `notElem` . -- Except for the 'master', which is reset on insert and delete. @@ -357,11 +347,11 @@ prop_insert_delete n x = not (member n x) ==> delete n (insertUp n y) == (y :: T -- otherwise, we don't have a rule for where master goes. -- inserting n elements increases current stack size by n -prop_size_insert is (n :: Positive Int) (m :: Positive Int) = +prop_size_insert is (NonEmptyNubList ns) (m :: Positive Int) = size (foldr insertUp x ws ) == (length ws) where ws = nub is - x = new (fromIntegral n) (fromIntegral m) :: T + x = new ns (fromIntegral m) :: T size = length . index @@ -438,15 +428,13 @@ prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x -- shift is fully reversible on current window, when focus and master -- are the same. otherwise, master may move. -prop_shift_reversible (r :: Int) (x :: T) = - let i = fromIntegral $ r `mod` sz - sz = size y - n = tag (workspace $ current y) - in case peek y of - Nothing -> True - Just _ -> normal ((view n . shift n . view i . shift i) y) == normal y +prop_shift_reversible i (x :: T) = + i `tagMember` x ==> case peek y of + Nothing -> True + Just _ -> normal ((view n . shift n . view i . shift i) y) == normal y where y = swapMaster x + n = tag (workspace $ current y) ------------------------------------------------------------------------ -- some properties for layouts: @@ -700,7 +688,6 @@ instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where arbitrary = NonEmptyNubList `fmap` ((liftM nub arbitrary) `suchThat` (not . null)) coarbitrary = undefined - type Positive a = NonZero (NonNegative a) newtype NonZero a = NonZero a |