Parameterise StackSet by two index types, rather than breaking abstraction

darcs-hash:20070419012705-9c5c1-3aa97e02123af08c3f4500c9e9c3bb7ab4121652.gz

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
diff --git a/XMonad.hs b/XMonad.hs
index 0de51ed..9053e69 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -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