DynamicPerScreenWorkspaces mostly working

lib/DynamicPerScreenWorkspaces.hs

@@ -3,6 +3,8 @@
 module DynamicPerScreenWorkspaces ( WorkspaceScreens
                                   , DynamicWorkspaceConfig(..)
                                   , dynamicRescreenHook
+                                  , create
+                                  , cleanup
                                   , view
                                   , viewOn
                                   , viewOnCurrent
@@ -19,8 +21,6 @@ import Data.Maybe
 
 import Storage
 
-import System.IO
-
 
 data DynamicWorkspaceStoreData = DWSD (M.Map Int ScreenId)
                                  deriving (Typeable, Show, Read)
@@ -44,7 +44,7 @@ defaultScreenWorkspaces conf n s = filter ((== s) . defaultWorkspaceScreen conf
 dynamicRescreenHook :: DynamicWorkspaceConfig -> [ScreenDetail] -> X ()
 dynamicRescreenHook conf sds = do
   layout <- asks $ layoutHook . config
-  windows $ cleanup . \wset -> let (as,bs) = splitAt (length sds) $ map W.workspace (W.current wset:W.visible wset)
+  windows $ cleanup' . \wset -> let (as,bs) = splitAt (length sds) $ map W.workspace (W.current wset:W.visible wset)
                          
                                     mkWS i = let tag = workspaceTag conf i
                                              in W.Workspace tag layout Nothing
@@ -74,20 +74,13 @@ hide conf i wset = gets (W.screens . windowset) >>= foldM (flip hideOn) wset
     hideOn s | (workspaceTag conf i) == (W.tag $ W.workspace s) = viewNextEmpty conf (W.screen s)
     hideOn _ = return
 
-cleanup :: WindowSet -> WindowSet
+cleanup' :: WindowSet -> WindowSet
-cleanup wset = wset { W.hidden = hidden' }
+cleanup' wset = wset { W.hidden = hidden' }
   where
     hidden' = filter (isJust . W.stack) $ W.hidden wset
 
 viewOn' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
 viewOn' conf sid i wset = do
-  io $ do
-    file <- openFile "/tmp/log" AppendMode
-    hPrint file "viewOn'"
-    hPrint file wset
-    hPrint file i
-    hClose file
-  
   let tag = workspaceTag conf i
   case W.tagMember tag wset of
     False -> viewEmpty conf sid i wset
@@ -95,26 +88,20 @@ viewOn' conf sid i wset = do
       wset' <- hide conf i wset
       let mws = W.lookupWorkspace sid wset'
       
-      io $ do
-        file <- openFile "/tmp/log" AppendMode
-        hPrint file "viewOn'+"
-        hPrint file wset
-        hPrint file mws
-        hPrint file tag
-        hClose file
-
       return $ case mws of
         Just ws -> W.view tag . W.view ws $ wset'
         Nothing -> wset'
 
-viewEmpty :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
+create' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
-viewEmpty conf sid i wset = do
+create' conf sid i wset = do
   layout <- asks $ layoutHook . config
-  
   let tag = workspaceTag conf i
       workspace = W.Workspace tag layout Nothing
   
-  if W.tagMember tag wset then return wset else viewOn' conf sid i wset { W.hidden = workspace:(W.hidden wset) }
+  return $ if W.tagMember tag wset then wset else wset { W.hidden = workspace:(W.hidden wset) }
+
+viewEmpty :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
+viewEmpty conf sid i = create' conf sid i >=> viewOn' conf sid i
 
 nextEmpty' ::DynamicWorkspaceConfig -> Int -> ScreenId -> WindowSet -> Int
 nextEmpty' conf n sid wset = fst $ head $ dropWhile ((`W.tagMember` wset) . snd) $ map (id &&& workspaceTag conf) $ defaultScreenWorkspaces conf n sid
@@ -129,17 +116,25 @@ windows' :: (WindowSet -> X WindowSet) -> X ()
 windows' f = do
   wset <- gets windowset
   wset' <- f wset
-  windows . const . cleanup $ wset'
+  windows . const $ wset'
+
+create :: DynamicWorkspaceConfig -> Int -> X ()
+create conf i = do
+  sid <- workspaceScreen conf i
+  windows' $ create' conf sid i
+
+cleanup :: X ()
+cleanup = windows cleanup'
 
 view :: DynamicWorkspaceConfig -> Int -> X ()
 view conf i = do
   sid <- workspaceScreen conf i
-  windows' $ viewOn' conf sid i
+  windows' $ liftM cleanup' . viewOn' conf sid i
 
 viewOn :: DynamicWorkspaceConfig -> ScreenId -> Int -> X ()
 viewOn conf sid i = do
   updateStoreData $ \(DWSD m) -> DWSD $ M.insert i sid m
-  windows' $ viewOn' conf sid i
+  windows' $ liftM cleanup' . viewOn' conf sid i
 
 viewOnCurrent :: DynamicWorkspaceConfig -> Int -> X ()
 viewOnCurrent conf i = do

xmonad.hs

@@ -60,11 +60,10 @@ main = xmonad $ ewmh $ defaultConfig
        , ("<XF86AudioRaiseVolume>", spawn "amixer -q sset Master 5%+ unmute")
        , ("M1-<F4>", kill)
        ]
-       -- ++ [ (("M-C-" ++ show n, windows $ W.greedyView ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])]
+       ++ [ ("M-" ++ show n, view dwConfig ws) | (ws, n) <- zip [0..] ([1..9]++[0])]
-       ++ [ (("M-S-" ++ show n, shiftGroup ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])]
+       ++ [ ("M-C-" ++ show n, viewOnCurrent dwConfig ws) | (ws, n) <- zip [0..] ([1..9]++[0])]
-       -- ++ [ (("M-C-" ++ show n, shiftIgnoreGroup ws)) | (ws, n) <- zip myWorkspaces ([1..9]++[0])]
+       ++ [ ("M-S-" ++ show n, create dwConfig ws >> shiftGroup (workspaceTag dwConfig ws) >> cleanup) | (ws, n) <- zip [0..] ([1..9]++[0])]
-       ++ [ (("M-" ++ show n, view dwConfig ws)) | (ws, n) <- zip [0..] ([1..9]++[0])]
+       ++ [ ("M-S-C-" ++ show n, create dwConfig ws >> shiftIgnoreGroup  (workspaceTag dwConfig ws) >> cleanup) | (ws, n) <- zip [0..] ([1..9]++[0])]
-       ++ [ (("M-C-" ++ show n, viewOnCurrent dwConfig ws)) | (ws, n) <- zip [0..] ([1..9]++[0])]
        )
        `additionalMouseBindings`
        [ ((modm, button4), \_ -> sendMessage Shrink)
@@ -74,8 +73,6 @@ main = xmonad $ ewmh $ defaultConfig
        ]
 
 
-myWorkspaces = map show [1..10]
-
 dwConfig :: DynamicWorkspaceConfig
 dwConfig = DynamicWorkspaceConfig { defaultWorkspaceScreen = defWSScreen
                                   , workspaceTag = show . (+1)
@@ -87,7 +84,7 @@ defWSScreen 1 _ = S 0
 defWSScreen _ i | i `elem` [0..7] = S 0
 defWSScreen _ i | i `elem` [8,9] = S 1
 
-defWSScreen n i = S (i `mod` n)
+defWSScreen n i = S ((i-10) `mod` n)
 
 
 viewOrWarp :: Int -> X ()