Starting to implement window management language

1 files changed, 27 insertions, 11 deletions

diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index de481ac..3a26823 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -4,16 +4,19 @@ module Rahm.Desktop.Workspaces where
 
 import Prelude hiding ((!!))
 
+import Control.Monad.Trans.Maybe
 import Control.Arrow (second, (&&&))
 import qualified XMonad.StackSet as W
 import XMonad
 
 import Data.List.Safe ((!!))
 
+import Rahm.Desktop.Common
+import Rahm.Desktop.History
 import XMonad.Actions.DynamicWorkspaces
 import Data.List (sortOn, sort, sortBy, find)
 import Data.Maybe (mapMaybe, fromMaybe)
-import Data.Char (isUpper, toUpper, toLower)
+import Data.Char (isUpper, toUpper, toLower, isAlphaNum)
 
 newtype Selector = Selector (forall a. (a -> Bool) -> [a] -> Maybe a)
 
@@ -55,11 +58,6 @@ firstWorkspaceId :: X WorkspaceId
 firstWorkspaceId =
   W.tag . snd . head <$> withWindowSet (return . getPopulatedWorkspaces)
 
-getCurrentWorkspace :: X WorkspaceId
-getCurrentWorkspace = withWindowSet $
-  \(W.StackSet (W.Screen (W.Workspace t _ _) _ _) _ _ _) -> do
-    return t
-
 windowsInCurrentWorkspace :: X [Window]
 windowsInCurrentWorkspace = withWindowSet $
   \(W.StackSet (W.Screen (W.Workspace _ _ s) _ _) _ _ _) -> do
@@ -77,11 +75,6 @@ getHorizontallyOrderedScreens windowSet =
     where
       screens = (True, W.current windowSet) : map (False,) (W.visible windowSet)
 
-gotoWorkspace :: WorkspaceId -> X ()
-gotoWorkspace wid = do
-  addHiddenWorkspace wid
-  windows $ W.greedyView wid
-
 shiftToWorkspace :: WorkspaceId -> X ()
 shiftToWorkspace t = do
   addHiddenWorkspace t
@@ -155,3 +148,26 @@ workspaceWithWindow wid = withWindowSet $ \(W.StackSet c v h _) ->
       find (\(W.Workspace _ _ stack) -> wid `elem` W.integrate' stack)
         (map W.workspace (c : v) ++ h)
 
+selectWorkspace :: String -> Maybe (X WorkspaceId)
+selectWorkspace s = case s of
+  [ch] | isAlphaNum ch || ch == '*' -> Just $ return [ch]
+  "]" -> Just $ adjacentWorkspaceNotVisible next
+                  =<< getCurrentWorkspace
+  "[" -> Just $ adjacentWorkspaceNotVisible prev
+                  =<< getCurrentWorkspace
+  ")" -> Just $ adjacentWorkspace next =<< getCurrentWorkspace
+  "(" -> Just $ adjacentWorkspace prev =<< getCurrentWorkspace
+  "}" -> Just $ adjacentScreen next
+  "{" -> Just $ adjacentScreen prev
+  "^" -> Just firstWorkspaceId
+  "'" -> Just $ do
+           l <- lastLocation
+           case l of
+            Just (Location ws _) -> return ws
+            Nothing -> getCurrentWorkspace
+  "." -> Just getCurrentWorkspace
+  "$" -> Just lastWorkspaceId
+  "/" -> Just $ fromMaybe <$> getCurrentWorkspace <*> runMaybeT (
+      (MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
+  " " -> Just $ accompaningWorkspace <$> getCurrentWorkspace
+  _ -> Nothing