add ProgramWorkSpaces

src/XMonad/Custom/BindingUtils.hs

@@ -4,11 +4,13 @@ import GHC.Utils.Misc
 
 import XMonad
 
-addWindowsToBinding :: [(a, WindowSet -> WindowSet)] -> [(a, X ())]
+import qualified XMonad.StackSet as W
-addWindowsToBinding = mapSnd $ \action -> windows action
 
 addShiftToBinding :: [([Char], b)] -> [([Char], b)]
-addShiftToBinding        = addModifierToBinding "S"
+addShiftToBinding = addModifierToBinding "S"
+
+addControlToBinding :: [([Char], b)] -> [([Char], b)]
+addControlToBinding = addModifierToBinding "S"
 
 addMainModifierToBinding :: [([Char], b)] -> [([Char], b)]
 addMainModifierToBinding = addModifierToBinding "M"
@@ -18,3 +20,12 @@ addModifierToBinding modifier = mapFst $ \key -> modifier ++ "-" ++ key
 
 addSubMapKey :: [Char] -> [([Char], b)] -> [([Char], b)]
 addSubMapKey key = mapFst $ \subkey -> key ++ " " ++ subkey
+
+addWindowsToBinding :: [(a, WindowSet -> WindowSet)] -> [(a, X ())]
+addWindowsToBinding = mapSnd windows
+
+addWindowViewToBinding :: [(a, String)] -> [(a, X ())]
+addWindowViewToBinding = addWindowsToBinding . (mapSnd W.view)
+
+addWindowShiftToBinding :: [(a, String)] -> [(a, X ())]
+addWindowShiftToBinding = addWindowsToBinding . (mapSnd W.shift)

src/XMonad/Custom/ProgramWorkSpaces.hs

@@ -0,0 +1,96 @@
+module XMonad.Custom.ProgramWorkSpaces (myProgramWorkSpacesKeyBindings, myProgramWorkSpaces) where
+
+import Data.Tuple
+
+import XMonad
+import XMonad.Actions.WindowGo
+
+import XMonad.Custom.BindingUtils
+
+
+-- |
+myProgramWorkSpaceSuperKey :: String
+myProgramWorkSpaceSuperKey = "M1"
+
+-- | WorkSpaces (label, key, executable, className/ general )
+type ProgramWorkSpace = (String, String, String, Query Bool)
+
+myProgramWorkSpacesConfig :: [ProgramWorkSpace]
+myProgramWorkSpacesConfig = addClassNameStrCheck [
+      ("signal",    "s", "signal-desktop",   "Signal")
+    , ("element",   "e", "element-desktop",  "Element")
+    , ("discord",   "d", "discord",          "discord")
+    , ("telegram",  "t", "telegram-desktop", "TelegramDesktop")
+    , ("ownCloud",  "o", "owncloud",         "owncloud")
+    , ("firefox",   "f", "firefox",          "firefox")
+    , ("mail",      "m", "thunderbird",      "Thunderbird")
+    , ("xournal",   "x", "xournalpp",        "Xournalpp")
+    , ("qute",      "q", "qutebrowser",      "qutebrowser")
+  ]
+  where
+    addClassNameStrCheck = mapFourth4 $ \classNameStr -> className =? classNameStr
+
+
+
+-- | Mapping utilities
+
+mapFourth4 :: (d -> e) -> [(a,b,c,d)] -> [(a,b,c,e)]
+mapFourth4 f = map $ \(a, b, c, d) -> (a, b, c, f d)
+
+quadrupleToPairFront :: (a, b, c, d) -> (a, b)
+quadrupleToPairFront (a, b, _, _) = (a, b)
+
+quadrupleToPairBack :: (a, b, c, d) -> (c, d)
+quadrupleToPairBack (_, _, c, d) = (c, d)
+
+zipWithSnd :: (a -> b -> c) -> [(d,a)] -> [b] -> [(d,c)]
+zipWithSnd f = zipWith $ \(d,a) -> \b -> (d, f a b)
+
+first4 :: (a,b,c,d) -> a
+first4 (a, _, _, _) = a
+
+
+-- | workSpaces itself
+myProgramWorkSpaces :: [String]
+myProgramWorkSpaces = map first4 myProgramWorkSpacesConfig
+
+
+-- | Bindings to move/focus to program workspaces
+
+myProgramWorkSpacesBindingsRaw :: [(String, String)]
+myProgramWorkSpacesBindingsRaw = (addModifierToBinding myProgramWorkSpaceSuperKey)
+                               . (map swap)
+                               . (map quadrupleToPairFront)
+                               $ myProgramWorkSpacesConfig
+
+myProgramWorkSpacesFocusBindingsRaw :: [(String, X ())]
+myProgramWorkSpacesFocusBindingsRaw = addWindowViewToBinding myProgramWorkSpacesBindingsRaw
+
+myProgramWorkSpacesFocusBindingsNoLaunch :: [(String, X ())]
+myProgramWorkSpacesFocusBindingsNoLaunch = addControlToBinding myProgramWorkSpacesFocusBindingsRaw
+
+myProgramWorkSpacesFocusBindingsLaunch :: [(String, X ())]
+myProgramWorkSpacesFocusBindingsLaunch = zipWithSnd (<+>) myProgramWorkSpacesFocusBindingsRaw
+                                       $ map (\(a,b) -> runOrRaise a b)
+                                       $ map quadrupleToPairBack myProgramWorkSpacesConfig
+
+myProgramWorkSpacesShiftBindings :: [(String, X ())]
+myProgramWorkSpacesShiftBindings = addShiftToBinding
+                                 . addWindowShiftToBinding
+                                 $ myProgramWorkSpacesBindingsRaw
+
+
+myProgramWorkSpacesKeyBindings :: [(String, X ())]
+myProgramWorkSpacesKeyBindings = concat [
+    myProgramWorkSpacesFocusBindingsNoLaunch
+  , myProgramWorkSpacesFocusBindingsLaunch
+  , myProgramWorkSpacesShiftBindings
+  ]
+                                         
+
+
+--    , ("zoom",      "z", "zoom",
+--            (liftM2 (&&) (className =? "zoom") $ fmap (not) (title=? "Zoom Meeting")))
+--    , ("zoom-meeting", "y", "false",
+--            (liftM2 (&&) (className =? "zoom") (title=? "Zoom Meeting")))
+--    ]

xmonad-custom.cabal

@@ -12,10 +12,12 @@ library
   exposed-modules: XMonad.Custom.BindingUtils
                    XMonad.Custom.BasicKeyBindings
                    XMonad.Custom.SystemKeyBindings
+                   XMonad.Custom.ProgramWorkSpaces
                    XMonad.Custom.UniversitySetup
   hs-source-dirs:  src
   ghc-options:     -funbox-strict-fields -Wall -Wno-unused-do-bind
   build-depends:   base
                  , xmonad
+                 , xmonad-contrib
                  , ghc
   default-language: Haskell2010