home/xmonad: add project state

home/ui/xmonad/config.hs

@@ -10,7 +10,8 @@
 import qualified Codec.Binary.UTF8.String as UTF8
 import qualified DBus as D
 import qualified DBus.Client as D
-import qualified Data.Map as M
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 import Data.Monoid
 import System.Exit
 import XMonad
@@ -41,6 +42,7 @@ import XMonad.Layout.ThreeColumns (ThreeCol (..))
 import XMonad.Prompt (XPConfig, XPType (..), XPrompt (..), mkComplFunFromList', mkXPromptWithModes)
 import qualified XMonad.StackSet as W
 import XMonad.Util.EZConfig
+import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Util.Run
 
 -- The preferred terminal program, which is used in a binding below and by
@@ -102,7 +104,7 @@ main = mkDbusClient >>= main'
 
 main' :: D.Client -> IO ()
 main' dbus =
-  xmonad . docks . ewmhFullscreen . ewmh $
+  xmonad . docks . ewmhFullscreen . ewmh . dynProjects $
     def
       { -- simple stuff
         terminal = myTerminal,
@@ -123,6 +125,8 @@ main' dbus =
         logHook = myPolybarLogHook dbus,
         startupHook = myStartupHook
       }
+  where
+    dynProjects = dynamicProjects myProjects
 
 ------------------------------------------------------------------------
 -- Polybar settings (needs DBus client).
@@ -343,7 +347,7 @@ myKeys conf =
 -- Mouse bindings: default actions bound to mouse events
 --
 myMouseBindings (XConfig {XMonad.modMask = modm}) =
-  M.fromList
+  Map.fromList
     -- mod-button1, Set the window to floating mode and move by dragging
     [ ((modm, button1), \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster),
       -- mod-button2, Raise the window to the top of the stack
@@ -353,6 +357,20 @@ myMouseBindings (XConfig {XMonad.modMask = modm}) =
       -- you may also bind events to the mouse scroll wheel (button4 and button5)
     ]
 
+myProjects :: [Project]
+myProjects =
+  [ Project
+      { projectName = "foo",
+        projectStartHook = Just $ do
+          spawn "alacritty --working-directory ~/repos/myconfig"
+          spawn "alacritty --working-directory ~/repos/tas"
+      },
+    Project
+      { projectName = "bar",
+        projectStartHook = Nothing
+      }
+  ]
+
 ------------------------------------------------------------------------
 -- Project
 type ProjectName = String
@@ -362,18 +380,55 @@ data Project = Project
     projectStartHook :: !(Maybe (X ()))
   }
 
+type ProjectTable = Map ProjectName Project
+
+data ProjectState = ProjectState {projects :: !ProjectTable}
+
+instance ExtensionClass ProjectState where
+  initialValue = ProjectState Map.empty
+
 data ProjectPrompt = ProjectPrompt XPConfig [ProjectName]
 
+dynamicProjects :: [Project] -> XConfig a -> XConfig a
+dynamicProjects ps c =
+  c {startupHook = dynamicProjectsStartupHook ps <> startupHook c}
+
+dynamicProjectsStartupHook :: [Project] -> X ()
+dynamicProjectsStartupHook ps = XS.modify go
+  where
+    go :: ProjectState -> ProjectState
+    go s = s {projects = update $ projects s}
+
+    update :: ProjectTable -> ProjectTable
+    update = Map.union (Map.fromList $ map entry ps)
+
+    entry :: Project -> (ProjectName, Project)
+    entry p = (projectName p, p)
+
 instance XPrompt ProjectPrompt where
   showXPrompt (ProjectPrompt _ _) = "Choose Project: "
 
   completionFunction (ProjectPrompt c ns) = mkComplFunFromList' c ns
 
-  modeAction (ProjectPrompt _ _) buf auto = xmessage buf
+  modeAction (ProjectPrompt _ _) buf auto = do
+    let name = if null auto then buf else auto
+    ps <- XS.gets projects
+
+    case Map.lookup name ps of
+      Just p -> openProject p
+      Nothing -> return ()
+
+openProject :: Project -> X ()
+openProject p =
+  case projectStartHook p of
+    Just h -> h
+    Nothing -> return ()
 
 projectPrompt :: XPConfig -> X ()
 projectPrompt c = do
-  let names = ["hello", "world"]
+  ps <- XS.gets projects
+
+  let names = Map.keys ps
       modes = [XPT $ ProjectPrompt c names]
 
   mkXPromptWithModes modes c