add (unused) Layout to StackSet.

darcs-hash:20070920212843-72aca-4c73a99b58ebd9d1d179c5e627cbf4823493f4ab.gz

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