make workspace tag not need to be a Num.

This change also removes the barely used 'size' field, and replaces
it with a tagMember predicate.  The idea is to move towards the ability
to make the workspace tag be a String, which by default might be "1".."9",
but could also be customized to be something meaningful to the user.

darcs-hash:20070614140709-72aca-dbc1ce07bf964e4cff69deef95b453a0051ef782

3 files changed, 63 insertions, 58 deletions

diff --git a/Main.hs b/Main.hs
index bf1402f..3271b2c 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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