aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Main.hs2
-rw-r--r--StackSet.hs70
-rw-r--r--XMonad.hs2
-rw-r--r--tests/Properties.hs30
4 files changed, 53 insertions, 51 deletions
diff --git a/Main.hs b/Main.hs
index 0435675..a6ebae6 100644
--- a/Main.hs
+++ b/Main.hs
@@ -52,7 +52,7 @@ main = do
let winset | ("--resume" : s : _) <- args
, [(x, "")] <- reads s = x
- | otherwise = new workspaces $ zipWith SD xinesc gaps
+ | otherwise = new (fst safeLayouts) workspaces $ zipWith SD xinesc gaps
gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0)
safeLayouts = case defaultLayouts of [] -> (SomeLayout Full, []); (x:xs) -> (x,xs)
diff --git a/StackSet.hs b/StackSet.hs
index e6c2433..611c7f2 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -147,23 +147,23 @@ import qualified Data.Map as M (Map,insert,delete,empty)
-- that are produced are used to track those workspaces visible as
-- Xinerama screens, and those workspaces not visible anywhere.
-data StackSet i a sid sd =
- StackSet { current :: !(Screen i a sid sd) -- ^ currently focused workspace
- , visible :: [Screen i a sid sd] -- ^ non-focused workspaces, visible in xinerama
- , hidden :: [Workspace i a] -- ^ 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 a sid sd = Screen { workspace :: !(Workspace i a)
- , screen :: !sid
- , screenDetail :: !sd }
+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 a = Workspace { tag :: !i, stack :: StackOrNot a }
+data Workspace i l a = Workspace { tag :: !i, layout :: l, stack :: StackOrNot a }
deriving (Show, Read, Eq)
data RationalRect = RationalRect Rational Rational Rational Rational
@@ -208,12 +208,12 @@ abort x = error $ "xmonad: StackSet: " ++ x
--
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
--
-new :: (Integral s) => [i] -> [sd] -> StackSet i a s sd
-new wids m | not (null wids) && length m <= length wids = StackSet cur visi unseen M.empty
- where (seen,unseen) = L.splitAt (length m) $ map (flip Workspace Nothing) wids
+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"
+new _ _ _ = abort "non-positive argument to StackSet.new"
@@ -225,7 +225,7 @@ new _ _ = abort "non-positive argument to StackSet.new"
-- becomes the current screen. If it is in the visible list, it becomes
-- current.
-view :: (Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd
+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
@@ -254,7 +254,7 @@ view i s
-- screen, the workspaces of the current screen and the other screen are
-- swapped.
-greedyView :: (Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd
+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)
@@ -270,7 +270,7 @@ greedyView w ws
-- | Find the tag of the workspace visible on Xinerama screen 'sc'.
-- Nothing if screen is out of bounds.
-lookupWorkspace :: Eq s => s -> StackSet i a s sd -> Maybe i
+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 ]
-- ---------------------------------------------------------------------
@@ -282,13 +282,13 @@ lookupWorkspace sc w = listToMaybe [ tag i | Screen i s _ <- current w : visible
-- 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 a s sd -> b
+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 :: StackOrNot a -> (Stack a -> StackOrNot a) -> StackSet i a s sd -> StackSet i a s sd
+modify :: StackOrNot a -> (Stack a -> StackOrNot 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 }}}
@@ -296,14 +296,14 @@ modify d f s = s { current = (current 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 a s sd -> StackSet i a s sd
+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 a s sd -> Maybe a
+peek :: StackSet i l a s sd -> Maybe a
peek = with Nothing (return . focus)
-- |
@@ -341,7 +341,7 @@ filter p (Stack f ls rs) = case L.filter p (f:rs) of
-- 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 a s sd -> [a]
+index :: StackSet i l a s sd -> [a]
index = with [] integrate
-- let is = t : r ++ reverse l in take (length is) (dropWhile (/= m) (cycle is))
@@ -358,7 +358,7 @@ index = with [] integrate
-- if we reach the end. Again the wrapping model should 'cycle' on
-- the current stack.
--
-focusUp, focusDown, swapUp, swapDown :: StackSet i a s sd -> StackSet i a s sd
+focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd
focusUp = modify' focusUp'
focusDown = modify' (reverseStack . focusUp' . reverseStack)
@@ -380,7 +380,7 @@ 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 a s sd -> StackSet i a s sd
+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 <- findIndex w s
@@ -393,11 +393,11 @@ screens :: StackSet i a s sd -> [Screen i a s sd]
screens s = current s : visible s
-- | Get a list of all workspaces in the StackSet.
-workspaces :: StackSet i a s sd -> [Workspace i a]
+workspaces :: StackSet i l a s sd -> [Workspace i l 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 sd -> Bool
+tagMember :: Eq i => i -> StackSet i l a s sd -> Bool
tagMember t = elem t . map tag . workspaces
-- |
@@ -406,13 +406,13 @@ tagMember t = elem t . map tag . workspaces
--
-- | /O(n)/. Is a window in the StackSet.
-member :: Eq a => a -> StackSet i a s sd -> Bool
+member :: Eq a => a -> StackSet i l a s sd -> Bool
member a s = maybe False (const True) (findIndex a s)
-- | /O(1) on current window, O(n) in general/.
-- Return Just the workspace index of the given window, or Nothing
-- if the window is not in the StackSet.
-findIndex :: Eq a => a -> StackSet i a s sd -> Maybe i
+findIndex :: Eq a => a -> StackSet i l a s sd -> Maybe i
findIndex a s = listToMaybe
[ tag w | w <- workspaces s, has a (stack w) ]
where has _ Nothing = False
@@ -435,11 +435,11 @@ findIndex a s = listToMaybe
-- 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 a s sd -> StackSet i a s sd
+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 a s sd -> StackSet i a s sd
+-- 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 }
@@ -458,12 +458,12 @@ insertUp a s = if member a s then s else insert
-- * 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 a s sd -> StackSet i a s sd
+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 a s sd -> StackSet i a s sd
+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) }
@@ -474,11 +474,11 @@ delete' w s = s { current = removeFromScreen (current s)
-- | 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 a s sd -> StackSet i a s sd
+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 a s sd -> StackSet i a s sd
+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) }
------------------------------------------------------------------------
@@ -487,7 +487,7 @@ sink w s = s { floating = M.delete w (floating s) }
-- | /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 a s sd -> StackSet i a s sd
+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
@@ -510,7 +510,7 @@ focusMaster = modify' $ \c -> case c of
-- 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 a s sd -> StackSet i a s sd
+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
@@ -523,7 +523,7 @@ shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s)
-- 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 a s sd -> StackSet i a s sd
+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
| n `tagMember` s && (Just n) /= from = go
| otherwise = s
diff --git a/XMonad.hs b/XMonad.hs
index 103639e..102ddcd 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -52,7 +52,7 @@ data XConf = XConf
, normalBorder :: !Pixel -- ^ border color of unfocused windows
, focusedBorder :: !Pixel } -- ^ border color of the focused window
-type WindowSet = StackSet WorkspaceId Window ScreenId ScreenDetail
+type WindowSet = StackSet WorkspaceId (SomeLayout Window) Window ScreenId ScreenDetail
-- | Virtual workspace indicies
type WorkspaceId = String
diff --git a/tests/Properties.hs b/tests/Properties.hs
index 0f4b733..8256c45 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -34,12 +34,13 @@ import qualified Data.Map as M
--
-- The all important Arbitrary instance for StackSet.
--
-instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary sd)
- => Arbitrary (StackSet i a s sd) where
+instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary l, Arbitrary sd)
+ => Arbitrary (StackSet i l a s sd) where
arbitrary = do
sz <- choose (1,10) -- number of workspaces
n <- choose (0,sz-1) -- pick one to be in focus
sc <- choose (1,sz) -- a number of physical screens
+ lay <- arbitrary -- pick any layout
sds <- replicateM sc arbitrary
ls <- vector sz -- a vector of sz workspaces
@@ -48,7 +49,7 @@ instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary sd)
else liftM Just (choose ((-1),length s-1))
| s <- ls ]
- return $ fromList (fromIntegral n, sds,fs,ls)
+ return $ fromList (fromIntegral n, sds,fs,ls,lay)
coarbitrary = error "no coarbitrary for StackSet"
@@ -62,14 +63,14 @@ instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary sd)
-- 'fs' random focused window on each workspace
-- 'xs' list of list of windows
--
-fromList :: (Integral i, Integral s, Eq a) => (i, [sd], [Maybe Int], [[a]]) -> StackSet i a s sd
-fromList (_,_,_,[]) = error "Cannot build a StackSet from an empty list"
+fromList :: (Integral i, Integral s, Eq a) => (i, [sd], [Maybe Int], [[a]], l) -> StackSet i l a s sd
+fromList (_,_,_,[],_) = error "Cannot build a StackSet from an empty list"
-fromList (o,m,fs,xs) =
+fromList (o,m,fs,xs,l) =
let s = view o $
foldr (\(i,ys) s ->
foldr insertUp (view i s) ys)
- (new [0..genericLength xs-1] m) (zip [0..] xs)
+ (new l [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
@@ -79,7 +80,7 @@ fromList (o,m,fs,xs) =
--
-- Just generate StackSets with Char elements.
--
-type T = StackSet (NonNegative Int) Char Int Int
+type T = StackSet (NonNegative Int) Int Char Int Int
-- Useful operation, the non-local workspaces
hidden_spaces x = map workspace (visible x) ++ hidden x
@@ -129,9 +130,9 @@ monotonic (x:y:zs) | x == y-1 = monotonic (y:zs)
prop_invariant = invariant
-- and check other ops preserve invariants
-prop_empty_I (n :: Positive Int) = forAll (choose (1,fromIntegral n)) $ \m ->
- forAll (vector m) $ \ms ->
- invariant $ new [0..fromIntegral n-1] ms
+prop_empty_I (n :: Positive Int) l = forAll (choose (1,fromIntegral n)) $ \m ->
+ forAll (vector m) $ \ms ->
+ invariant $ new l [0..fromIntegral n-1] ms
prop_view_I (n :: NonNegative Int) (x :: T) =
n `tagMember` x ==> invariant $ view (fromIntegral n) x
@@ -182,11 +183,11 @@ prop_empty (EmptyStackSet x) =
: map workspace (visible x) ++ hidden x ]
-- empty StackSets always have focus on first workspace
-prop_empty_current (NonEmptyNubList ns) (NonEmptyNubList sds) =
+prop_empty_current (NonEmptyNubList ns) (NonEmptyNubList sds) l =
-- TODO, this is ugly
length sds <= length ns ==>
tag (workspace $ current x) == head ns
- where x = new ns sds :: T
+ where x = new l ns sds :: T
-- no windows will be a member of an empty workspace
prop_member_empty i (EmptyStackSet x)
@@ -844,8 +845,9 @@ instance Arbitrary EmptyStackSet where
arbitrary = do
(NonEmptyNubList ns) <- arbitrary
(NonEmptyNubList sds) <- arbitrary
+ l <- arbitrary
-- there cannot be more screens than workspaces:
- return . EmptyStackSet . new ns $ take (min (length ns) (length sds)) sds
+ return . EmptyStackSet . new l ns $ take (min (length ns) (length sds)) sds
-- | Generates a value that satisfies a predicate.
suchThat :: Gen a -> (a -> Bool) -> Gen a