From 3a26f3eb4f02052fdb97dcdd884f408d52b383a9 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Sun, 17 Apr 2022 23:15:55 -0600
Subject: Starting to implement window management language

---
 src/Main.hs                            |   1 +
 src/Rahm/Desktop/Common.hs             |  86 ++++++++++++++++++++++
 src/Rahm/Desktop/History.hs            |  37 ++++++----
 src/Rahm/Desktop/Hooks/WindowChange.hs |  16 ++---
 src/Rahm/Desktop/Keys.hs               |  70 ++++++------------
 src/Rahm/Desktop/Lib.hs                |  63 ----------------
 src/Rahm/Desktop/Marking.hs            | 127 +++++++++++++++++++++++----------
 src/Rahm/Desktop/Workspaces.hs         |  38 +++++++---
 8 files changed, 260 insertions(+), 178 deletions(-)
 create mode 100644 src/Rahm/Desktop/Common.hs
 delete mode 100644 src/Rahm/Desktop/Lib.hs

diff --git a/src/Main.hs b/src/Main.hs
index edce3fb..5c1a4e0 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -14,6 +14,7 @@ import qualified Data.Map as Map
 import Text.Printf
 
 import Rahm.Desktop.Swallow
+import Rahm.Desktop.Common
 import Rahm.Desktop.Windows
 import Rahm.Desktop.XMobarLog
 import Rahm.Desktop.Keys
diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
new file mode 100644
index 0000000..926d5ff
--- /dev/null
+++ b/src/Rahm/Desktop/Common.hs
@@ -0,0 +1,86 @@
+module Rahm.Desktop.Common where
+
+import Prelude hiding ((!!))
+
+import Control.Monad.Trans.Maybe
+import XMonad.Actions.DynamicWorkspaces
+import XMonad.Util.Run
+import XMonad.Prompt
+import XMonad.Prompt.Input
+import XMonad.Prompt.Shell
+
+import Rahm.Desktop.PromptConfig
+
+import Data.Char
+import Data.List hiding ((!!))
+import Data.List.Safe ((!!))
+import Data.Maybe
+import Text.Printf
+import XMonad hiding (workspaces, Screen)
+import XMonad.StackSet hiding (filter, focus)
+import qualified Data.Map as Map
+import Rahm.Desktop.DMenu
+import Data.Ord (comparing)
+
+import qualified XMonad.StackSet as S
+import Rahm.Desktop.Windows
+
+-- A location is a workspace and maybe a window with that workspace.
+data Location = Location {
+    locationWorkspace :: WorkspaceId,
+    locationWindow :: Maybe Window
+  } deriving (Read, Show, Eq, Ord)
+
+focusLocation :: Location -> X ()
+focusLocation (Location ws Nothing) = windows $ S.greedyView ws
+focusLocation (Location _ (Just win)) = windows $ S.focusWindow win
+
+masterWindow :: MaybeT X Window
+masterWindow = MaybeT $ withWindowSet $ \ss ->
+  let windows = (S.integrate' . S.stack . S.workspace . S.current) ss
+    in case windows of
+      (a:_) -> return $ Just a
+      _ -> return Nothing
+
+data WinPrompt = WinPrompt
+
+instance XPrompt WinPrompt where
+    showXPrompt _ = "[Window] "
+    commandToComplete _ = id
+
+fuzzyCompletion :: String -> String -> Bool
+fuzzyCompletion str0 str1 =
+  all (`isInfixOf`l0) ws
+  where
+    ws = filter (not . all isSpace) $ words (map toLower str0)
+    l0 = map toLower str1
+
+getString :: Window -> X String
+getString = runQuery $ do
+  t <- title
+  a <- appName
+  return $
+    if map toLower a `isInfixOf` map toLower t
+      then t
+      else printf "%s - %s" t a
+
+askWindowId :: X (Maybe Window)
+askWindowId = do
+  windowTitlesToWinId <- withWindowSet $ \ss ->
+    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
+
+  runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
+
+windowJump :: X ()
+windowJump = mapM_ focus =<< askWindowId
+
+gotoWorkspace :: WorkspaceId -> X ()
+gotoWorkspace wid = do
+  addHiddenWorkspace wid
+  windows $ S.greedyView wid
+
+getCurrentWorkspace :: X WorkspaceId
+getCurrentWorkspace = withWindowSet $
+  \(S.StackSet (S.Screen (S.Workspace t _ _) _ _) _ _ _) -> do
+    return t
+
diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
index 5e15fe6..9195a92 100644
--- a/src/Rahm/Desktop/History.hs
+++ b/src/Rahm/Desktop/History.hs
@@ -9,10 +9,9 @@ import Data.Default
 import qualified XMonad.Util.ExtensibleState as XS
 
 import Data.Foldable (toList)
-import Rahm.Desktop.Workspaces (gotoWorkspace)
 import Rahm.Desktop.Hooks.WindowChange
+import Rahm.Desktop.Common
 import Rahm.Desktop.Logger
-import Rahm.Desktop.Marking
 import Data.Sequence (Seq(..))
 import qualified Data.Sequence as Seq
 
@@ -60,6 +59,20 @@ instance ExtensionClass History where
   initialValue = def
   -- extensionType = PersistentExtension
 
+pastHistory :: Int -> X (Maybe Location)
+pastHistory i = do
+  History (BoundedSeqZipper _ _ t) <- XS.get
+  return $ t Seq.!? i
+
+getMostRecentLocationInHistory :: X (Maybe Location)
+getMostRecentLocationInHistory = do
+  History z <- XS.get
+  case z of
+    (BoundedSeqZipper _ (_ :|> h) _) -> return $ Just h
+    (BoundedSeqZipper _ _ (t :<| _)) -> return $ Just t
+    _ -> return Nothing
+
+
 historyBack :: X ()
 historyBack = do
   History z <- XS.get
@@ -74,19 +87,19 @@ historyForward = do
   mapM_ focusLocation (getZipper z')
   XS.put (History z')
 
-lastWindow :: X (Maybe Location)
-lastWindow = getZipper . zipperBack . currentZipper <$> XS.get
+lastLocation :: X (Maybe Location)
+lastLocation = getZipper . zipperBack . currentZipper <$> XS.get
 
-jumpToLastLocation :: X ()
-jumpToLastLocation = mapM_ focusLocation =<< lastWindow
+nextLocation :: X (Maybe Location)
+nextLocation = getZipper . zipperForward . currentZipper <$> XS.get
 
+jumpToLastLocation :: X ()
+jumpToLastLocation = mapM_ focusLocation =<< lastLocation
 
-historyHook :: Location -> Location -> X ()
-historyHook (Location ws _) l@(Location ws' _) | ws /= ws' = do
+historyHook :: Maybe Location -> Location -> X ()
+historyHook Nothing loc =
+  XS.modify $ \(History z) -> History (pushZipper loc z)
+historyHook (Just (Location ws _)) l@(Location ws' _) | ws /= ws' = do
   XS.modify $ \(History z) -> History (pushZipper l z)
 
 historyHook _ _ = return ()
-
-focusLocation :: Location -> X ()
-focusLocation (Location ws Nothing) = gotoWorkspace ws
-focusLocation (Location _ (Just win)) = windows $ W.focusWindow win
diff --git a/src/Rahm/Desktop/Hooks/WindowChange.hs b/src/Rahm/Desktop/Hooks/WindowChange.hs
index 0038f47..ec8e445 100644
--- a/src/Rahm/Desktop/Hooks/WindowChange.hs
+++ b/src/Rahm/Desktop/Hooks/WindowChange.hs
@@ -4,13 +4,10 @@ import XMonad
 import Control.Monad
 import qualified XMonad.Util.ExtensibleState as XS
 import Data.Default
-import Rahm.Desktop.Workspaces
+import Rahm.Desktop.Common
 
 import qualified XMonad.StackSet as W
 
-data Location = Location WorkspaceId (Maybe Window)
-  deriving (Read, Show, Eq)
-
 newtype LastLocation = LastLocation (Maybe Location)
   deriving (Read, Show)
 
@@ -20,12 +17,14 @@ instance Default LastLocation where
 instance ExtensionClass LastLocation where
   initialValue = def
   extensionType = PersistentExtension
-
+  
 -- Creates a log hook from the function provided.
 --
 -- The first argument to the function is the old window, the second argument in
 -- the new window.
-withLocationChangeHook :: (Location -> Location -> X ()) -> XConfig l -> XConfig l
+--
+-- If the first window is Nothing, this is the first time XMonad started.
+withLocationChangeHook :: (Maybe Location -> Location -> X ()) -> XConfig l -> XConfig l
 withLocationChangeHook fn config =
   config {
     logHook = do
@@ -36,9 +35,8 @@ withLocationChangeHook fn config =
 
       LastLocation last <- XS.get
 
-      whenJust last $ \lastLocation ->
-        when (lastLocation /= currentLocation) $
-          fn lastLocation currentLocation
+      when (last /= Just currentLocation) $
+        fn last currentLocation
 
       XS.put $ LastLocation $ Just currentLocation
       return ()
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 74960df..1369a17 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -6,7 +6,6 @@ import Control.Monad.Fix (fix)
 import Control.Monad.Loops (iterateWhile)
 import Control.Monad.Reader
 import Control.Monad.Trans.Class
-import Control.Monad.Trans.Maybe
 import Control.Monad.Writer
 import Data.Char
 import Data.List hiding ((!!))
@@ -49,7 +48,7 @@ import Rahm.Desktop.Layout.Hole (toggleHole)
 import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout)
 import Rahm.Desktop.Layout.Pop (togglePop)
 import Rahm.Desktop.Layout.Rotate (rotateLayout)
-import Rahm.Desktop.Lib
+import Rahm.Desktop.Common
 import Rahm.Desktop.Logger
 import Rahm.Desktop.Marking
 import Rahm.Desktop.MouseMotion
@@ -142,30 +141,13 @@ keymap = runKeys $ do
   bind xK_apostrophe $ do
     justMod $
       doc "Jumps between marks." $
-      mapNextString $ \_ str ->
-        case str of
-          ['\''] -> jumpToLastLocation
-          [ch] | isAlphaNum ch -> jumpToMark ch
-          "[" -> historyBack
-          "]" -> historyForward
-          _ -> return ()
+      mapNextString $ const (mapM_ focusLocation <=< markToLocation)
 
     shiftMod $
-      doc "Move the marked windo to the current workspace." $
-      mapNextString $ \_ str ->
-        case str of
-          [ch] | isAlphaNum ch -> do
-            ws <- getCurrentWorkspace
-            maybe (return ()) (windows . W.shiftWin ws) =<< markToWindow ch
-          _ -> return ()
-
-    controlMod $
-      doc "Swap the current window with a mark." $
-      mapNextString $ \_ str ->
-        case str of
-          -- ['\''] ->  swapWithLastMark
-          [ch] | isAlphaNum ch -> swapWithMark ch
-          _ -> return ()
+      doc "Move the marked window to the current workspace." $
+      mapNextString $ \_ str -> do
+        mapM_ (\loc -> moveLocationToWorkspace loc <$> getCurrentWorkspace)
+          =<< markToLocation str
 
   bind xK_BackSpace $ do
     -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if
@@ -275,23 +257,6 @@ keymap = runKeys $ do
       sendMessage flipHorizontally
 
   bind xK_g $ do
-    let selectWorkspace :: (KeySym, 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 lastWorkspaceId
-          (_, "/") -> Just $ fromMaybe <$> getCurrentWorkspace <*> runMaybeT (
-              (MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
-          (_, " ") -> Just $ accompaningWorkspace <$> getCurrentWorkspace
-          _ -> Nothing
 
     justMod $
       doc "Goto/Send/Etc To a workspace\n\n\t\
@@ -315,7 +280,7 @@ keymap = runKeys $ do
       \Other keybindings starting with H-g\n\t\t\
          \F1: display this help.\n\n\t" $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace (keysym, str)) of
+        case ((keysym, str), selectWorkspace str) of
           (_, Just w) -> gotoWorkspace =<< w
           -- Test binding. Tests that I can still submap keysyms alone (keys
           -- where XLookupString won't return anything helpful.)
@@ -328,7 +293,7 @@ keymap = runKeys $ do
     shiftMod $
       doc "Move the currently focused window to another workspace" $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace (keysym, str)) of
+        case ((keysym, str), selectWorkspace str) of
           (_, Just w) -> shiftToWorkspace =<< w
           ((_, "_"), _) -> CopyWindow.kill1
           _ -> return ()
@@ -336,7 +301,7 @@ keymap = runKeys $ do
     controlMod $
       doc "Move the current focused window to another workspace and view that workspace" $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace (keysym, str)) of
+        case ((keysym, str), selectWorkspace str) of
           (_, Just w) -> do
             ws <- w
             shiftToWorkspace ws
@@ -346,14 +311,14 @@ keymap = runKeys $ do
     altMod $
       doc "Copy a window to the given workspace" $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace (keysym, str)) of
+        case ((keysym, str), selectWorkspace str) of
           (_, Just ws) -> windows . CopyWindow.copy =<< ws
           _ -> return ()
 
     shiftAltMod $
       doc "Swap this workspace with another workspace (rename)." $
       mapNextStringWithKeysym $ \_ keysym str ->
-        case ((keysym, str), selectWorkspace (keysym, str)) of
+        case ((keysym, str), selectWorkspace str) of
           (_, Just ws) -> swapWorkspace =<< ws
           ((_, "_"), _) ->
             mapM_ (\w -> focus w >> CopyWindow.kill1) =<< windowsInCurrentWorkspace
@@ -419,7 +384,7 @@ keymap = runKeys $ do
       doc "Mark the current window with the next typed character." $
       mapNextString $ \_ str ->
         case str of
-          [ch] | isAlphaNum ch -> markCurrentWindow ch
+          [ch] | isAlpha ch -> markCurrentWindow str
           _ -> return ()
 
   bind xK_plus $ do
@@ -452,6 +417,17 @@ keymap = runKeys $ do
       sendMessage rotateLayout
 
   bind xK_s $ do
+    justMod $
+      mapNextString $ \_ mark -> do
+        loc' <- markToLocation mark
+        case loc' of
+          Nothing -> return ()
+          Just loc -> do
+            mapM_ setAlternateWindow (locationWindow loc)
+            mapNextString $ \_ ws -> do
+              mapM_ (moveLocationToWorkspace loc=<<) (selectWorkspace ws)
+
+
     altMod $ spawnX "sudo -A systemctl suspend && xsecurelock"
 
   bind xK_space $ do
diff --git a/src/Rahm/Desktop/Lib.hs b/src/Rahm/Desktop/Lib.hs
deleted file mode 100644
index c7cfca4..0000000
--- a/src/Rahm/Desktop/Lib.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-module Rahm.Desktop.Lib where
-
-import Prelude hiding ((!!))
-
-import XMonad.Actions.DynamicWorkspaces
-import XMonad.Util.Run
-import XMonad.Prompt
-import XMonad.Prompt.Input
-import XMonad.Prompt.Shell
-
-import Rahm.Desktop.PromptConfig
-
-import Data.Char
-import Data.List hiding ((!!))
-import Data.List.Safe ((!!))
-import Data.Maybe
-import Rahm.Desktop.Marking
-import Text.Printf
-import XMonad hiding (workspaces, Screen)
-import XMonad.StackSet hiding (filter, focus)
-import qualified Data.Map as Map
-import Rahm.Desktop.DMenu
-import Data.Ord (comparing)
-
-import qualified XMonad.StackSet as S
-import Rahm.Desktop.Windows
-
-data WinPrompt = WinPrompt
-
-instance XPrompt WinPrompt where
-    showXPrompt _ = "[Window] "
-    commandToComplete _ = id
-
-fuzzyCompletion :: String -> String -> Bool
-fuzzyCompletion str0 str1 =
-  all (`isInfixOf`l0) ws
-  where
-    ws = filter (not . all isSpace) $ words (map toLower str0)
-    l0 = map toLower str1
-
-getString :: Window -> X String
-getString = runQuery $ do
-  t <- title
-  a <- appName
-  return $
-    if map toLower a `isInfixOf` map toLower t
-      then t
-      else printf "%s - %s" t a
-
-askWindowId :: X (Maybe Window)
-askWindowId = do
-  windowTitlesToWinId <- withWindowSet $ \ss ->
-    Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
-
-  runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
-
-windowJump :: X ()
-windowJump = do
-  windowId <- askWindowId
-
-  case windowId of
-    Nothing -> return ()
-    Just wid -> focus wid
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index b1783cc..5caaa3b 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -1,44 +1,50 @@
 module Rahm.Desktop.Marking (
   markCurrentWindow,
   jumpToMark,
-  swapWithMark, markToWindow
+  markToLocation,
+  moveLocationToWorkspace,
+  setAlternateWindow,
+  getAlternateWindow
   ) where
-
-import Rahm.Desktop.Windows (mapWindows, findWindow, getLocationWorkspace)
-import XMonad
-import XMonad.StackSet hiding (focus)
+import Data.Ord (Down(..))
+import Control.Exception
+import Control.Monad (when)
+import Control.Monad.Trans.Maybe
+import Data.Char (isAlpha, isDigit, ord)
 import Data.IORef
+import Data.List (sortOn, sort, sortBy, find)
 import Data.Map (Map)
-import Control.Monad (when)
-
+import Data.Maybe (catMaybes)
+import Data.Sequence (Seq(..))
+import Rahm.Desktop.Common
+import Rahm.Desktop.History
+import Rahm.Desktop.Hooks.WindowChange
+import Rahm.Desktop.Windows (mapWindows, findWindow, getLocationWorkspace)
+import Rahm.Desktop.Workspaces
+import System.Environment
 import System.FilePath
 import System.IO
-import Control.Exception
-import System.Environment
+import XMonad
+import XMonad.StackSet hiding (focus)
+import qualified Data.Map as Map
 import qualified Data.Sequence as Seq
-import Data.Sequence (Seq(..))
-
 import qualified XMonad.Util.ExtensibleState as XS
 
-import qualified Data.Map as Map
-
 {- Submodule that handles marking windows so they can be jumped back to. -}
 
-type Mark = Char
+type Mark = String
 
 data MarkState =
   MarkState {
-    markStateMap :: Map Mark Window
+    markStateMap :: Map Mark Location
+  , alternateWindow :: Maybe Window
   } deriving (Read, Show)
 
 
 instance ExtensionClass MarkState where
-  initialValue = MarkState Map.empty
+  initialValue = MarkState Map.empty Nothing
   extensionType = PersistentExtension
 
-withMaybeFocused :: (Maybe Window -> X a) -> X a
-withMaybeFocused f = withWindowSet $ f . peek
-
 -- greedyFocus :: Window -> X ()
 -- greedyFocus win = do
 --     ws <- withWindowSet $ \ss ->
@@ -47,20 +53,34 @@ withMaybeFocused f = withWindowSet $ f . peek
 --     mapM_ (windows . greedyView . tag) ws
 --     focus win
 
+setAlternateWindow :: Window -> X ()
+setAlternateWindow win = XS.modify (\m -> m { alternateWindow = Just win }) 
+
+getAlternateWindow :: MaybeT X Window
+getAlternateWindow = MaybeT $ alternateWindow <$> XS.get
+
+withMaybeFocused :: (Maybe Window -> X a) -> X a
+withMaybeFocused f = withWindowSet $ f . peek
+
+getCurrentLocation :: X Location
+getCurrentLocation =
+  (\ws -> withMaybeFocused (return . Location ws)) =<< getCurrentWorkspace
+
+
 markCurrentWindow :: Mark -> X ()
 markCurrentWindow mark = do
+  ws <- getCurrentWorkspace
+  
   withFocused $ \win ->
     XS.modify $ \state@MarkState {markStateMap = ms} ->
         state {
-          markStateMap = Map.insert mark win ms
+          markStateMap = Map.insert mark (Location ws $ Just win) ms
         }
 
 jumpToMark :: Mark -> X ()
 jumpToMark mark = do
   MarkState {markStateMap = m} <- XS.get
-  case Map.lookup mark m of
-    Nothing -> return ()
-    Just w ->  windows $ focusWindow w
+  mapM_ focusLocation $ Map.lookup mark m
 
 setFocusedWindow :: a -> StackSet i l a s sd -> StackSet i l a s sd
 setFocusedWindow
@@ -81,16 +101,51 @@ swapWithFocused winToSwap stackSet =
           mapWindows (
             \w -> if w == winToSwap then focused else w) stackSet
 
-markToWindow :: Mark -> X (Maybe Window)
-markToWindow m = do
-  MarkState { markStateMap = mp } <- XS.get
-  return $ Map.lookup m mp
-
-swapWithMark :: Mark -> X ()
-swapWithMark mark = do
-  MarkState {markStateMap = m} <- XS.get
-
-  case Map.lookup mark m of
-    Nothing -> return ()
-    Just winToSwap -> do
-      windows $ swapWithFocused winToSwap
+moveLocationToWorkspace :: Location -> WorkspaceId ->  X ()
+moveLocationToWorkspace (Location _ (Just win)) wid =
+  windows $ shiftWin wid win
+moveLocationToWorkspace _ _ = return ()
+
+windowRect :: Window -> X (Maybe Rectangle)
+windowRect win = withDisplay $ \dpy -> (do
+  (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
+  return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw))
+    `catchX` return Nothing
+
+getWindowsAndRects :: X [(Window, Rectangle)]
+getWindowsAndRects =
+  catMaybes <$> (mapM (\w -> fmap (w,) <$> windowRect w)
+    =<< withWindowSet (return . allWindows))
+
+windowLocation :: Window -> MaybeT X Location
+windowLocation win = do
+  tag <- MaybeT $ withWindowSet $ return . findTag win
+  return (Location tag (Just win))
+
+markToLocation :: Mark -> X (Maybe Location)
+markToLocation mark =
+  case mark of
+    [ch] | isAlpha ch -> Map.lookup mark . markStateMap <$> XS.get
+    "0" -> getMostRecentLocationInHistory
+    [ch] | isDigit ch -> pastHistory (ord ch - 0x30)
+    "." -> Just <$> getCurrentLocation
+    "\"" -> nextLocation
+    "'" -> lastLocation
+    "/" -> runMaybeT $ windowLocation =<< MaybeT askWindowId
+    "^" -> do
+          rects <- sortOn (\(_, Rectangle x _ _ _) -> x) <$> getWindowsAndRects
+          case rects of
+            ((w, _) : _) -> runMaybeT (windowLocation w)
+            _ -> return Nothing
+    "$" -> do
+          rects <- sortOn (Down . \(_, Rectangle x _ _ _) -> x)
+                     <$> getWindowsAndRects
+          case rects of
+            ((w, _) : _) -> runMaybeT (windowLocation w)
+            _ -> return Nothing
+
+    "*" -> runMaybeT (windowLocation =<< masterWindow)
+
+    "@" -> runMaybeT (windowLocation =<< getAlternateWindow)
+
+    _ -> return Nothing
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
-- 
cgit