Add new conditional description for workspaces.

This adds the "<" condition, it used as "in"

i.e. "<l₀l₁w₀w₁" reads as "if l₀ is a subset of l₁, then w₀ else w₁"

Useful for macro programming like, if Spotify is on the current
workspace, then go back to where I came from, otherwise jump to Spotify.
This can be achieved with the following (assuming Spotify is marked with
"s"):

"<H-g><s@.'@s"

"if spotify (s) is in the set of the windows on the current screen (@.), jump
back to where I came from (workspace '), otherwise goto the workspace
spotify is on (@s)."

3 files changed, 63 insertions, 17 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 81a874b..a98e568 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,5 +1,6 @@
 import XMonad
 
+import XMonad.Hooks.DynamicProperty
 import Control.Monad.Trans.Class
 import Control.Monad.Reader
 import XMonad.Hooks.ManageDocks (docks)
@@ -14,6 +15,7 @@ import qualified Data.Map as Map
 import Text.Printf
 
 import Rahm.Desktop.Swallow
+import Rahm.Desktop.Marking
 import Rahm.Desktop.Common
 import Rahm.Desktop.XMobarLog
 import Rahm.Desktop.Keys
@@ -51,6 +53,7 @@ main = do
        , startupHook = spawn fp
        , manageHook = composeAll [
            isFullscreen --> doFullFloat
+         , doLogWindow
          , className =? "Tilda" --> doFloat
          , className =? "yakuake" --> doFloat
          , className =? "MPlayer" --> doFloat
@@ -72,7 +75,10 @@ main = do
            composeAll [
              fullscreenEventHook,
              remapHook,
-             swallowHook]
+             swallowHook,
+             dynamicTitle (composeAll [
+              title =? "Spotify" --> doMarkWindow "s"
+              ])]
        , focusFollowsMouse = False
        , clickJustFocuses = False
        , logHook = xMobarLogHook xmobar
@@ -83,6 +89,19 @@ changeHook :: Location -> Location -> X ()
 changeHook l1 l2 =
   logs Info "Change %s -> %s" (show l1) (show l2)
 
+doLogWindow :: ManageHook
+doLogWindow = do
+  t <- title
+  c <- className
+  a <- appName
+  liftX $ logs Debug "New Window {title: \"%s\", class: \"%s\", appName: \"%s\"}" t c a
+  return (Endo id)
+
+doMarkWindow :: Mark -> ManageHook
+doMarkWindow m = ask >>= (\w -> liftX (do
+  ws <- getCurrentWorkspace
+  markAllLocations m [Location ws (Just w)]) >> return (Endo id))
+
 doCenterFloat :: ManageHook
 doCenterFloat =
   ask >>= \w -> doF . W.float w . centerRect . snd =<< liftX (floatLocation w)
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index adb1d9f..647234c 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -267,18 +267,15 @@ readNextWorkspace =
 
       (_, _, "@") -> do
         loc <- readNextLocationSet
-        MaybeT (return $ justWorkspace . locationWorkspace <$> head loc)
+        MaybeT $ fromX $ withWindowSet $ \ws -> return $ do
+          win <- locationWindow =<< head loc
+          winLocation <- W.findWindow ws win
+          (justWorkspace . W.tag) <$> W.getLocationWorkspace winLocation
 
       (_, _, "~") ->
         justWorkspace . accompaningWorkspace <$> readNextWorkspaceName
       (_, _, " ") -> mt $
         justWorkspace . accompaningWorkspace <$> getCurrentWorkspace
-      (_, _, "~") -> do
-          ws <- readNextWorkspace
-          case workspaceName ws of
-            Just [a] | isAlphaNum a ->
-              return (justWorkspace $ accompaningWorkspace [a])
-            _ -> MaybeT (return Nothing)
 
       (_, _, "_") -> return blackHoleWorkspace
       (_, _, "-") -> return alternateWorkspace
@@ -294,6 +291,28 @@ readNextWorkspace =
             then ws3
             else ws4
 
+      (_, _, "<") -> do
+        lift . fromX $
+          logs Trace "Doing thing"
+
+        l1 <- map locationWindow <$> readNextLocationSet
+
+        lift . fromX $
+          logs Trace "%s" (show l1)
+
+        l2 <- map locationWindow <$> readNextLocationSet
+
+        ws1 <- readNextWorkspace
+        ws2 <- readNextWorkspace
+
+        (lift . fromX) $ (logs Trace "%s < %s? %s" (show l1) (show l2) (show $ all (`elem`l2) l1) :: X ())
+        (lift . fromX) $ (logs Trace "%s %s" (show $ workspaceName ws1) (show $ workspaceName ws2))
+
+        return $
+          if all (`elem`l2) l1
+            then ws1
+            else ws2
+
       (mask, keysym, _) -> do
         macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . workspaceMacros <$> XS.get)
         fromMaybeTX $ workspaceForKeysT macro
diff --git a/src/Rahm/Desktop/Marking.hs b/src/Rahm/Desktop/Marking.hs
index 4da2a46..f239399 100644
--- a/src/Rahm/Desktop/Marking.hs
+++ b/src/Rahm/Desktop/Marking.hs
@@ -9,7 +9,9 @@ module Rahm.Desktop.Marking (
   markAllLocations,
   farLeftWindow,
   farRightWindow,
-  windowLocation
+  windowLocation,
+  markWindow,
+  Mark
   ) where
 
 import Prelude hiding (head)
@@ -27,6 +29,7 @@ import Data.List.Safe (head)
 import Data.Map (Map)
 import Data.Sequence (Seq(..))
 import Rahm.Desktop.Common
+import Rahm.Desktop.Logger
 import Rahm.Desktop.History
 import Rahm.Desktop.Hooks.WindowChange
 import Rahm.Desktop.Workspaces
@@ -83,21 +86,26 @@ withMaybeFocused :: (Maybe Window -> X a) -> X a
 withMaybeFocused f = withWindowSet $ f . peek
 
 markAllLocations :: Mark -> [Location]  -> X ()
-markAllLocations mark locs =
+markAllLocations mark locs = do
+  logs Debug "Marking locations %s as \"%s\"" (show locs) (show mark)
+
   XS.modify $ \m ->
     m {
       markStateMap = Map.insert mark locs (markStateMap m)
     }
 
-markCurrentWindow :: Mark -> X ()
-markCurrentWindow mark = do
+markWindow :: Mark -> Window -> X ()
+markWindow mark window = do
+  logs Debug "Marking window %s as \"%s\"" (show window) (show mark)
+
   ws <- getCurrentWorkspace
+  XS.modify $ \state@MarkState {markStateMap = ms} ->
+      state {
+        markStateMap = Map.insertWith (++) mark [Location ws $ Just window] ms
+      }
 
-  withFocused $ \win ->
-    XS.modify $ \state@MarkState {markStateMap = ms} ->
-        state {
-          markStateMap = Map.insertWith (++) mark [Location ws $ Just win] ms
-        }
+markCurrentWindow :: Mark -> X ()
+markCurrentWindow = withFocused . markWindow
 
 jumpToMark :: Mark -> X ()
 jumpToMark mark = do