Factor workspace sorting into a separate module

darcs-hash:20071222104114-a5988-bfd9059d0556a526c275b6d0e4a930103bd7d990.gz

4 files changed, 55 insertions, 32 deletions

diff --git a/XMonad/Actions/CycleWS.hs b/XMonad/Actions/CycleWS.hs
index f64f2fb..6e4e822 100644
--- a/XMonad/Actions/CycleWS.hs
+++ b/XMonad/Actions/CycleWS.hs
@@ -24,13 +24,12 @@ module XMonad.Actions.CycleWS (
                               toggleWS,
                              ) where
 
-import Data.List ( sortBy, findIndex )
+import Data.List ( findIndex )
 import Data.Maybe ( fromMaybe )
-import Data.Ord ( comparing )
 
 import XMonad hiding (workspaces)
-import qualified XMonad (workspaces)
 import XMonad.StackSet hiding (filter)
+import XMonad.Util.WorkspaceCompare
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
@@ -81,14 +80,11 @@ shiftBy d = wsBy d >>= windows . shift
 wsBy :: Int -> X (WorkspaceId)
 wsBy d = do
     ws <- gets windowset
-    spaces <- asks (XMonad.workspaces . config)
-    let orderedWs = sortBy (comparing (wsIndex spaces)) (workspaces ws)
+    sort' <- getSortByTag
+    let orderedWs = sort' (workspaces ws)
     let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs
     let next = orderedWs !! ((now + d) `mod` length orderedWs)
     return $ tag next
 
-wsIndex :: [WorkspaceId] -> WindowSpace -> Maybe Int
-wsIndex spaces ws = findIndex (== tag ws) spaces
-
 findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int
 findWsIndex ws wss = findIndex ((== tag ws) . tag) wss
diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs
index a4a492f..d6ab9eb 100644
--- a/XMonad/Hooks/DynamicLog.hs
+++ b/XMonad/Hooks/DynamicLog.hs
@@ -46,8 +46,8 @@ import Data.Maybe ( isJust )
 import Data.List
 import Data.Ord ( comparing )
 import qualified XMonad.StackSet as S
-import Data.Monoid
 import System.IO
+import XMonad.Util.WorkspaceCompare
 import XMonad.Util.NamedWindows
 import XMonad.Util.Run
 import XMonad.Hooks.UrgencyHook
@@ -108,11 +108,11 @@ dynamicLogWithPP :: PP -> X ()
 dynamicLogWithPP pp = do
     winset <- gets windowset
     urgents <- readUrgents
-    spaces <- asks (workspaces . config)
+    sort' <- getSortByTag
     -- layout description
     let ld = description . S.layout . S.workspace . S.current $ winset
     -- workspace list
-    let ws = pprWindowSet spaces urgents pp winset
+    let ws = pprWindowSet sort' urgents pp winset
     -- window title
     wt <- maybe (return "") (fmap show . getName) . S.peek $ winset
 
@@ -128,19 +128,10 @@ dynamicLogWithPP pp = do
 dynamicLogDzen :: X ()
 dynamicLogDzen = dynamicLogWithPP dzenPP
 
-pprWindowSet :: [String] -> [Window] -> PP -> WindowSet -> String
-pprWindowSet spaces urgents pp s =  sepBy (ppWsSep pp) $ map fmt $ sortBy cmp
-            (map S.workspace (S.current s : S.visible s) ++ S.hidden s)
-   where f Nothing Nothing   = EQ
-         f (Just _) Nothing  = LT
-         f Nothing (Just _)  = GT
-         f (Just x) (Just y) = compare x y
-
-         wsIndex = flip elemIndex spaces . S.tag
-
-         cmp a b = f (wsIndex a) (wsIndex b) `mappend` compare (S.tag a) (S.tag b)
-
-         this     = S.tag (S.workspace (S.current s))
+pprWindowSet :: ([WindowSpace] -> [WindowSpace]) -> [Window] -> PP -> WindowSet -> String
+pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
+            map S.workspace (S.current s : S.visible s) ++ S.hidden s
+   where this     = S.tag (S.workspace (S.current s))
          visibles = map (S.tag . S.workspace) (S.visible s)
 
          fmt w = printer pp (S.tag w)
diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs
index e8c6dae..34bec81 100644
--- a/XMonad/Hooks/EwmhDesktops.hs
+++ b/XMonad/Hooks/EwmhDesktops.hs
@@ -17,15 +17,15 @@ module XMonad.Hooks.EwmhDesktops (
     ewmhDesktopsLogHook
     ) where
 
-import Data.List    (elemIndex, sortBy)
-import Data.Ord     (comparing)
-import Data.Maybe   (fromMaybe)
+import Data.List
+import Data.Maybe
 
 import XMonad
 import Control.Monad
 import qualified XMonad.StackSet as W
 
 import XMonad.Hooks.SetWMName
+import XMonad.Util.WorkspaceCompare
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -48,9 +48,8 @@ import XMonad.Hooks.SetWMName
 -- of the current state of workspaces and windows.
 ewmhDesktopsLogHook :: X ()
 ewmhDesktopsLogHook = withWindowSet $ \s -> do
-    -- Bad hack because xmonad forgets the original order of things, it seems
-    -- see http://code.google.com/p/xmonad/issues/detail?id=53
-    let ws = sortBy (comparing W.tag) $ W.workspaces s
+    sort' <- getSortByTag
+    let ws = sort' $ W.workspaces s
     let wins = W.allWindows s
 
     setSupported
@@ -70,8 +69,8 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
     setClientList wins
 
     -- Per window Desktop
-    forM (zip ws [(0::Int)..]) $ \(w, wn) ->
-        forM (W.integrate' (W.stack w)) $ \win -> do
+    forM_ (zip ws [(0::Int)..]) $ \(w, wn) ->
+        forM_ (W.integrate' (W.stack w)) $ \win -> do
             setWindowDesktop win wn
 
     return ()
diff --git a/XMonad/Util/WorkspaceCompare.hs b/XMonad/Util/WorkspaceCompare.hs
new file mode 100644
index 0000000..93bd597
--- /dev/null
+++ b/XMonad/Util/WorkspaceCompare.hs
@@ -0,0 +1,37 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.WorkspaceCompare
+-- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+
+module XMonad.Util.WorkspaceCompare ( getWsIndex, getWsCompare, getSortByTag ) where
+
+import XMonad
+import qualified XMonad.StackSet as S
+import Data.List
+import Data.Monoid
+
+getWsIndex :: X (WorkspaceId -> Maybe Int)
+getWsIndex = do
+    spaces <- asks (workspaces . config)
+    return $ flip elemIndex spaces
+
+getWsCompare :: X (WorkspaceId -> WorkspaceId -> Ordering)
+getWsCompare = do
+    wsIndex <- getWsIndex
+    return $ \a b -> f (wsIndex a) (wsIndex b) `mappend` compare a b
+ where
+   f Nothing Nothing   = EQ
+   f (Just _) Nothing  = LT
+   f Nothing (Just _)  = GT
+   f (Just x) (Just y) = compare x y
+
+getSortByTag :: X ([WindowSpace] -> [WindowSpace])
+getSortByTag = do
+    cmp <- getWsCompare
+    return $ sortBy (\a b -> cmp (S.tag a) (S.tag b))