Change WML workspaces to have a Maybe name.

1 files changed, 25 insertions, 15 deletions

diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 5ce455c..af04e44 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -60,7 +60,7 @@ data Workspace =
   forall a. (Typeable a) => Workspace {
     moveLocationToWorkspaceFn :: Location -> X ()
   , gotoWorkspaceFn :: X ()
-  , workspaceName :: String
+  , workspaceName :: Maybe String
   , extraWorkspaceData :: a
   }
 
@@ -90,7 +90,7 @@ justWorkspace s =
   Workspace {
     moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
   , gotoWorkspaceFn = gotoWorkspace s
-  , workspaceName = s
+  , workspaceName = Just s
   , extraWorkspaceData = ()
   }
 
@@ -99,7 +99,7 @@ blackHoleWorkspace =
   Workspace {
     moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow
   , gotoWorkspaceFn = return () -- can't navigate to black hole
-  , workspaceName = "blackhole"
+  , workspaceName = Nothing
   , extraWorkspaceData = ()
   }
 
@@ -122,7 +122,7 @@ alternateWorkspace =
         Just win -> do
           mapM_ gotoWorkspace =<<  getAlternateWorkspace win
 
-  , workspaceName = "@"
+  , workspaceName = Nothing
   , extraWorkspaceData = ()
   }
 
@@ -203,24 +203,32 @@ locationSetForKeysT s = feedKeysT s readNextLocationSet
 locationSetForKeys :: KeyString -> X [Location]
 locationSetForKeys s = fromMaybe [] <$> runMaybeT (locationSetForKeysT s)
 
+lift1 :: (KeyFeeder m) => (a -> X b) -> (a -> MaybeT m b)
+lift1 = fmap (lift . fromX)
+
+readNextWorkspaceName :: (KeyFeeder m) => MaybeT m WorkspaceId
+readNextWorkspaceName = joinMaybe $ workspaceName <$> readNextWorkspace
+
 -- Returns the next workspaces associated with the next set of keystrokes.
 readNextWorkspace :: (KeyFeeder m) => MaybeT m Workspace
 readNextWorkspace =
   readNextKey $ \mask sym str ->
     case (mask, sym, str) of
       (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch]
-      (_, _, "[") -> mt $ 
+      (_, _, "[") ->
         justWorkspace <$>
-           (adjacentWorkspaceNotVisible prev =<< getCurrentWorkspace)
-      (_, _, "]") -> mt $
+           (lift1 (adjacentWorkspaceNotVisible prev) =<<
+              readNextWorkspaceName)
+      (_, _, "]") ->
         justWorkspace <$>
-          (adjacentWorkspaceNotVisible next =<< getCurrentWorkspace)
-      (_, _, "(") -> mt $ 
+           (lift1 (adjacentWorkspaceNotVisible next) =<<
+              readNextWorkspaceName)
+      (_, _, "(") ->
         justWorkspace <$>
-          (adjacentWorkspace prev =<< getCurrentWorkspace)
-      (_, _, ")") -> mt $
+          (lift1 (adjacentWorkspace prev) =<< readNextWorkspaceName)
+      (_, _, ")") ->
         justWorkspace <$>
-          (adjacentWorkspace next =<< getCurrentWorkspace)
+          (lift1 (adjacentWorkspace next) =<< readNextWorkspaceName)
       (_, _, "^") -> mapMaybeT fromX $ MaybeT $
         withWindowSet $ \ws -> return $
           (fmap (justWorkspace . W.tag . W.workspace . snd) . head)
@@ -239,7 +247,7 @@ readNextWorkspace =
             map (W.tag . W.workspace . snd)
               <$> withWindowSet (return . getHorizontallyOrderedScreens)
 
-        let (_, rest) = break (==workspaceName ws) (screens ++ screens)
+        let (_, rest) = break ((==workspaceName ws) . Just) (screens ++ screens)
 
         justWorkspace <$> MaybeT (return $ head $ tail rest)
 
@@ -250,7 +258,7 @@ readNextWorkspace =
             map (W.tag . W.workspace . snd)
               <$> withWindowSet (return . getHorizontallyOrderedScreens)
 
-        let (front, _) = break (==workspaceName ws) (screens ++ screens)
+        let (front, _) = break ((==workspaceName ws) . Just) (screens ++ screens)
 
         justWorkspace <$> MaybeT (return $ last front)
 
@@ -261,6 +269,8 @@ readNextWorkspace =
         loc <- readNextLocationSet
         MaybeT (return $ justWorkspace . locationWorkspace <$> head loc)
 
+      (_, _, "~") ->
+        justWorkspace . accompaningWorkspace <$> readNextWorkspaceName
       (_, _, " ") -> mt $
         justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
       (_, _, "_") -> return blackHoleWorkspace
@@ -300,7 +310,7 @@ readNextLocationSet =
         lift $ logs Info "allWindows %s" (intercalate "\n"  (map show ret))
         return ret
       (_, _, s) | s == "\t" || s == "@" || s == "\n" ->
-        (mt . windowsInWorkspace . workspaceName) =<< readNextWorkspace
+        (mt . windowsInWorkspace) =<< readNextWorkspaceName
       (_, _, "!") -> (:[]) <$> joinMaybe (head <$> readNextLocationSet)
       (_, _, ",") -> tail <$> readNextLocationSet
       (_, _, "~") -> reverse <$> readNextLocationSet