Refactor someNamedScratchpadOption to use Data.NonEmpty and to improve readability

This commit is contained in:
Leon Kowarschick
2020-06-06 14:55:31 +02:00
parent a861a8f954
commit 5f3edb110e

View File

@@ -36,7 +36,9 @@ import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)
import XMonad.Hooks.DynamicLog (PP, ppSort) import XMonad.Hooks.DynamicLog (PP, ppSort)
import XMonad.Actions.SpawnOn (spawnHere) import XMonad.Actions.SpawnOn (spawnHere)
import Control.Monad (filterM) import qualified Data.List.NonEmpty as NE
import Control.Monad (filterM, unless)
import Data.Maybe (listToMaybe) import Data.Maybe (listToMaybe)
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
@@ -112,7 +114,7 @@ type NamedScratchpads = [NamedScratchpad]
-- | Finds named scratchpad configuration by name -- | Finds named scratchpad configuration by name
findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad
findByName c s = listToMaybe $ filter ((s==) . name) c findByName c s = listToMaybe $ filter ((s ==) . name) c
-- | Runs application which should appear in specified scratchpad -- | Runs application which should appear in specified scratchpad
runApplication :: NamedScratchpad -> X () runApplication :: NamedScratchpad -> X ()
@@ -139,34 +141,40 @@ customRunNamedScratchpadAction :: (NamedScratchpad -> X ()) -- ^ Function initi
-> NamedScratchpads -- ^ Named scratchpads configuration -> NamedScratchpads -- ^ Named scratchpads configuration
-> String -- ^ Scratchpad name -> String -- ^ Scratchpad name
-> X () -> X ()
customRunNamedScratchpadAction = someNamedScratchpadAction (\f ws -> f $ head ws) customRunNamedScratchpadAction = someNamedScratchpadAction (\f ws -> f $ NE.head ws)
allNamedScratchpadAction :: NamedScratchpads allNamedScratchpadAction :: NamedScratchpads
-> String -> String
-> X () -> X ()
allNamedScratchpadAction = someNamedScratchpadAction mapM_ runApplication allNamedScratchpadAction = someNamedScratchpadAction mapM_ runApplication
someNamedScratchpadAction :: ((Window -> X ()) -> [Window] -> X ()) -- | execute some action on a named scratchpad
someNamedScratchpadAction :: ((Window -> X ()) -> NE.NonEmpty Window -> X ())
-> (NamedScratchpad -> X ()) -> (NamedScratchpad -> X ())
-> NamedScratchpads -> NamedScratchpads
-> String -> String
-> X () -> X ()
someNamedScratchpadAction f runApp confs n someNamedScratchpadAction f runApp scratchpadConfig scratchpadName =
| Just conf <- findByName confs n = withWindowSet $ \s -> do case findByName scratchpadConfig scratchpadName of
filterCurrent <- filterM (runQuery (query conf)) Just conf -> withWindowSet $ \winSet -> do
((maybe [] W.integrate . W.stack . W.workspace . W.current) s) let focusedWspWindows = maybe [] W.integrate (W.stack . W.workspace . W.current $ winSet)
filterAll <- filterM (runQuery (query conf)) (W.allWindows s) allWindows = W.allWindows winSet
case filterCurrent of matchingOnCurrent <- filterM (runQuery (query conf)) focusedWspWindows
[] -> matchingOnAll <- filterM (runQuery (query conf)) allWindows
case filterAll of
[] -> runApp conf case NE.nonEmpty matchingOnCurrent of
_ -> f (windows . W.shiftWin (W.currentTag s)) filterAll -- no matching window on the current workspace -> scratchpad not running or in background
_ -> do Nothing -> case NE.nonEmpty matchingOnAll of
if null (filter ((== scratchpadWorkspaceTag) . W.tag) (W.workspaces s)) Nothing -> runApp conf
then addHiddenWorkspace scratchpadWorkspaceTag Just wins -> f (windows . W.shiftWin (W.currentTag winSet)) wins
else return ()
f (windows . W.shiftWin scratchpadWorkspaceTag) filterAll -- matching window running on current workspace -> window should be shifted to scratchpad workspace
| otherwise = return () Just wins -> do
unless (any (\wsp -> scratchpadWorkspaceTag == W.tag wsp) (W.workspaces winSet))
(addHiddenWorkspace scratchpadWorkspaceTag)
f (windows . W.shiftWin scratchpadWorkspaceTag) wins
Nothing -> return ()
-- tag of the scratchpad workspace -- tag of the scratchpad workspace