{-# LANGUAGE RecordWildCards #-}
module XMonad.Hooks.DynamicIcons (
iconsPP, dynamicLogIconsWithPP, appIcon,
dynamicIconsPP, getWorkspaceIcons,
IconConfig(..),
iconsFmtAppend, iconsFmtReplace, wrapUnwords,
iconsGetAll, iconsGetFocus,
) where
import XMonad
import qualified XMonad.StackSet as S
import qualified Data.Map as M
import XMonad.Hooks.StatusBar.PP
import XMonad.Prelude (for, maybeToList, (<&>), (<=<), (>=>))
appIcon :: String -> Query [String]
appIcon :: String -> Query [String]
appIcon = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
dynamicLogIconsWithPP :: Query [String]
-> PP
-> X ()
dynamicLogIconsWithPP :: Query [String] -> PP -> X ()
dynamicLogIconsWithPP Query [String]
q = PP -> X ()
dynamicLogWithPP forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Query [String] -> PP -> X PP
iconsPP Query [String]
q
iconsPP :: Query [String]
-> PP
-> X PP
iconsPP :: Query [String] -> PP -> X PP
iconsPP Query [String]
q = IconConfig -> PP -> X PP
dynamicIconsPP forall a. Default a => a
def{ iconConfigIcons :: Query [String]
iconConfigIcons = Query [String]
q }
dynamicIconsPP :: IconConfig -> PP -> X PP
dynamicIconsPP :: IconConfig -> PP -> X PP
dynamicIconsPP IconConfig
ic PP
pp = IconConfig -> X (String -> WindowSpace -> String)
getWorkspaceIcons IconConfig
ic forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String -> WindowSpace -> String
ren -> PP
pp{ ppRename :: String -> WindowSpace -> String
ppRename = PP -> String -> WindowSpace -> String
ppRename PP
pp forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> WindowSpace -> String
ren }
getWorkspaceIcons :: IconConfig -> X (String -> WindowSpace -> String)
getWorkspaceIcons :: IconConfig -> X (String -> WindowSpace -> String)
getWorkspaceIcons conf :: IconConfig
conf@IconConfig{Query [String]
String -> [String] -> String
Maybe (Stack Window) -> X [Window]
iconConfigFilter :: IconConfig -> Maybe (Stack Window) -> X [Window]
iconConfigFmt :: IconConfig -> String -> [String] -> String
iconConfigFilter :: Maybe (Stack Window) -> X [Window]
iconConfigFmt :: String -> [String] -> String
iconConfigIcons :: Query [String]
iconConfigIcons :: IconConfig -> Query [String]
..} = forall {k} {l} {a}.
Ord k =>
Map k [String] -> String -> Workspace k l a -> String
fmt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IconConfig -> X (Map String [String])
getWorkspaceIcons' IconConfig
conf
where
fmt :: Map k [String] -> String -> Workspace k l a -> String
fmt Map k [String]
icons String
s Workspace k l a
w = String -> [String] -> String
iconConfigFmt String
s (forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] (forall i l a. Workspace i l a -> i
S.tag Workspace k l a
w) Map k [String]
icons)
getWorkspaceIcons' :: IconConfig -> X (M.Map WorkspaceId [String])
getWorkspaceIcons' :: IconConfig -> X (Map String [String])
getWorkspaceIcons' IconConfig{Query [String]
String -> [String] -> String
Maybe (Stack Window) -> X [Window]
iconConfigFilter :: Maybe (Stack Window) -> X [Window]
iconConfigFmt :: String -> [String] -> String
iconConfigIcons :: Query [String]
iconConfigFilter :: IconConfig -> Maybe (Stack Window) -> X [Window]
iconConfigFmt :: IconConfig -> String -> [String] -> String
iconConfigIcons :: IconConfig -> Query [String]
..} = do
[WindowSpace]
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
S.workspaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
[[String]]
is <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [WindowSpace]
ws forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Query a -> Window -> X a
runQuery Query [String]
iconConfigIcons) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Maybe (Stack Window) -> X [Window]
iconConfigFilter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
S.tag [WindowSpace]
ws) [[String]]
is)
data IconConfig = IconConfig
{ IconConfig -> Query [String]
iconConfigIcons :: Query [String]
, IconConfig -> String -> [String] -> String
iconConfigFmt :: WorkspaceId -> [String] -> String
, IconConfig -> Maybe (Stack Window) -> X [Window]
iconConfigFilter :: Maybe (S.Stack Window) -> X [Window]
}
instance Default IconConfig where
def :: IconConfig
def = IconConfig
{ iconConfigIcons :: Query [String]
iconConfigIcons = forall a. Monoid a => a
mempty
, iconConfigFmt :: String -> [String] -> String
iconConfigFmt = ([String] -> String) -> String -> [String] -> String
iconsFmtReplace (String -> String -> [String] -> String
wrapUnwords String
"{" String
"}")
, iconConfigFilter :: Maybe (Stack Window) -> X [Window]
iconConfigFilter = Maybe (Stack Window) -> X [Window]
iconsGetAll
}
iconsFmtReplace :: ([String] -> String) -> WorkspaceId -> [String] -> String
iconsFmtReplace :: ([String] -> String) -> String -> [String] -> String
iconsFmtReplace [String] -> String
cat String
ws [String]
is | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
is = String
ws
| Bool
otherwise = [String] -> String
cat [String]
is
iconsFmtAppend :: ([String] -> String) -> WorkspaceId -> [String] -> String
iconsFmtAppend :: ([String] -> String) -> String -> [String] -> String
iconsFmtAppend [String] -> String
cat String
ws [String]
is | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
is = String
ws
| Bool
otherwise = String
ws forall a. [a] -> [a] -> [a]
++ Char
':' forall a. a -> [a] -> [a]
: [String] -> String
cat [String]
is
wrapUnwords :: String -> String -> [String] -> String
wrapUnwords :: String -> String -> [String] -> String
wrapUnwords String
_ String
_ [String
x] = String
x
wrapUnwords String
l String
r [String]
xs = String -> String -> String -> String
wrap String
l String
r ([String] -> String
unwords [String]
xs)
iconsGetAll :: Maybe (S.Stack Window) -> X [Window]
iconsGetAll :: Maybe (Stack Window) -> X [Window]
iconsGetAll = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe (Stack a) -> [a]
S.integrate'
iconsGetFocus :: Maybe (S.Stack Window) -> X [Window]
iconsGetFocus :: Maybe (Stack Window) -> X [Window]
iconsGetFocus = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Stack a -> a
S.focus