From 2a98917b3e6df3145035cb8dc733f788d401ba35 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Thu, 26 Mar 2020 23:33:45 -0400
Subject: [PATCH] ENH move workspace appending to managehook for vbox and gimp

---
 bin/xmonad.hs | 73 +++++++++++++++++++++++++++++----------------------
 1 file changed, 41 insertions(+), 32 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 6a12326..e45562b 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -19,6 +19,7 @@ import           Control.Concurrent
 import           Control.Monad
     ( forM
     , forM_
+    , liftM2
     , mapM_
     , void
     , when
@@ -112,18 +113,6 @@ spawnPipe' x = io $ do
 myWorkspaces :: [String]
 myWorkspaces = map show [1..10 :: Int]
 
-myVMWorkspace :: String
-myVMWorkspace = "VM"
-
-myVMClass :: String
-myVMClass = "VirtualBoxVM"
-
-myGimpWorkspace :: String
-myGimpWorkspace = "GIMP"
-
-myGimpClass :: String
-myGimpClass = "Gimp"
-
 myLayouts = onWorkspace myVMWorkspace (noBorders Full)
   -- $ onWorkspace myGimpWorkspace gimpLayout
   $ tall ||| single ||| full
@@ -186,12 +175,16 @@ myWindowSetXinerama ws = wsString ++ sep ++ layout
         (_, Rectangle x0 _ _ _) = getScreenIdAndRectangle s0
         (_, Rectangle x1 _ _ _) = getScreenIdAndRectangle s1
 
+viewShift = doF . liftM2 (.) W.view W.shift
+
+appendViewShift tag = liftX (appendWorkspace tag) >> viewShift tag
+
 myManageHook :: ManageHook
 myManageHook = composeOne
   -- assume virtualbox is not run with the toolbar in fullscreen mode
   -- as this makes a new window that confusingly must go over the
   -- actual VM window
-  [ className =? myVMClass -?> doShift myVMWorkspace
+  [ className =? myVMClass -?> appendViewShift myVMWorkspace
   -- the seafile applet
   , className =? "Seafile Client" -?> doFloat
   -- gnucash
@@ -199,7 +192,7 @@ myManageHook = composeOne
   -- xsane
   , className =? "Xsane" -?> doFloat
   -- all of GIMP
-  , className =? myGimpClass -?> doFloat >> doShift myGimpWorkspace
+  , className =? myGimpClass -?> doFloat >> appendViewShift myGimpWorkspace
   -- , title =? "GIMP Startup" -?> doIgnore
   -- plots and graphics created by R
   , className =? "R_x11" -?> doFloat
@@ -433,12 +426,6 @@ runScreenCapture = runFlameshot "screen"
 runDesktopCapture :: X ()
 runDesktopCapture = runFlameshot "full"
 
-runVBox :: X ()
-runVBox = spawnCmd "vbox-start" ["win8raw"]
-
-runGimp :: X ()
-runGimp = spawnCmd "gimp" []
-
 runCleanup :: [ProcessID] -> Client -> X ()
 runCleanup ps client = io $ do
   mapM_ killPID ps
@@ -528,16 +515,38 @@ showKeybindings x = addName "Show Keybindings" $ do
           , "'#element.selected.normal { background-color: #a200ff; }'"
           ]
 
-appendOrSwitch :: WorkspaceId -> X () -> X ()
-appendOrSwitch tag cmd = do
-  occupied <- withWindowSet $ \ws ->
-    return $ elem tag
-      $ map W.tag
-      -- list of all workspaces with windows on them
-      $ W.workspace (W.current ws)
-        : W.hidden ws
-        ++ map W.workspace (W.visible ws)
-  if occupied then windows $ W.view tag else appendWorkspace tag >> cmd
+myVMWorkspace :: String
+myVMWorkspace = "VM"
+
+myVMClass :: String
+myVMClass = "VirtualBoxVM"
+
+myGimpWorkspace :: String
+myGimpWorkspace = "GIMP"
+
+-- TODO I don't feel like changing the version long term
+myGimpClass :: String
+myGimpClass = "Gimp-2.10"
+
+wsOccupied :: Eq a1 => a1 -> W.StackSet a1 l a2 sid sd -> Bool
+wsOccupied tag ws = elem tag
+  $ map W.tag
+  -- TODO there is likely a much better way to do this...
+  $ filter (\w -> case W.stack w of { Nothing -> False; _ -> True } )
+  -- list of all workspaces with windows on them
+  -- TODO is there not a better way to do this?
+  $ W.workspace (W.current ws) : W.hidden ws ++ map W.workspace (W.visible ws)
+
+spawnOrSwitch :: WorkspaceId -> X () -> X ()
+spawnOrSwitch tag cmd = do
+  occupied <- withWindowSet $ return . wsOccupied tag
+  if occupied then windows $ W.view tag else cmd
+
+runVBox :: X ()
+runVBox = spawnOrSwitch myVMWorkspace $ spawnCmd "vbox-start" ["win8raw"]
+
+runGimp :: X ()
+runGimp = spawnOrSwitch myGimpWorkspace $ spawnCmd "gimp-2.10" []
 
 myModMask :: KeyMask
 myModMask = mod4Mask
@@ -614,8 +623,8 @@ mkKeys hs client c =
   , ("M-C-t", "launch terminal", runTerm)
   , ("M-C-q", "launch calc", runCalc)
   , ("M-C-f", "launch file manager", runFileManager)
-  , ("M-C-v", "launch windows VM", appendOrSwitch myVMWorkspace runVBox)
-  , ("M-C-g", "launch GIMP", appendOrSwitch myGimpWorkspace runGimp)
+  , ("M-C-v", "launch windows VM", runVBox)
+  , ("M-C-g", "launch GIMP", runGimp)
   ] ++
 
   mkNamedSubmap c "Multimedia"