    {-# LANGUAGE RecordWildCards #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Hooks.DynamicIcons
    -- Description :  Dynamically update workspace names based on its contents\/windows on it.
    -- Copyright   :  (c) Will Pierlot <willp@outlook.com.au>
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  Will Pierlot <willp@outlook.com.au>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- Dynamically augment workspace names logged to a status bar
    -- based on the contents (windows) of the workspace.
    -----------------------------------------------------------------------------

    module XMonad.Hooks.DynamicIcons (
        -- * Usage
        -- $usage

        -- * Creating Dynamic Icons
        iconsPP, dynamicLogIconsWithPP, appIcon,

        -- * Customization
        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, (<&>), (<=<), (>=>))

    -- $usage
    -- Dynamically augment Workspace's 'WorkspaceId' as shown on a status bar
    -- based on the 'Window's inside the Workspace.
    --
    -- Icons are specified by a @Query [String]@, which is something like a
    -- 'ManageHook' (and uses the same syntax) that returns a list of 'String's
    -- (icons). This 'Query' is evaluated for each window and the results are
    -- joined together. 'appIcon' is a useful shortcut here.
    --
    -- For example:
    --
    -- > myIcons :: Query [String]
    -- > myIcons = composeAll
    -- >   [ className =? "discord" --> appIcon "\xfb6e"
    -- >   , className =? "Discord" --> appIcon "\xf268"
    -- >   , className =? "Firefox" --> appIcon "\63288"
    -- >   , className =? "Spotify" <||> className =? "spotify" --> appIcon "阮"
    -- >   ]
    --
    -- then you can add it to your "XMonad.Hooks.StatusBar" config:
    --
    -- > myBar = statusBarProp "xmobar" (iconsPP myIcons myPP)
    -- > main = xmonad . withSB myBar $ … $ def
    --
    -- Here is an example of this
    --
    -- <<https://user-images.githubusercontent.com/300342/111010930-36a54300-8398-11eb-8aec-b3059b04fa31.png>>
    --
    -- Note: You can use any string you want here.
    -- The example shown here uses NerdFont Icons to represent open applications.
    --
    -- If you want to customize formatting and/or combine this with other
    -- 'PP' extensions like "XMonad.Util.ClickableWorkspaces", here's a more
    -- advanced example how to do that:
    --
    -- > myIconConfig = def{ iconConfigIcons = myIcons, iconConfigFmt = iconsFmtAppend concat }
    -- > myBar = statusBarProp "xmobar" (clickablePP =<< dynamicIconsPP myIconConfig myPP)
    -- > main = xmonad . withSB myBar . … $ def
    --
    -- This can be also used with "XMonad.Hooks.DynamicLog":
    --
    -- > main = xmonad $ … $ def
    -- >   { logHook = dynamicLogIconsWithPP myIcons xmobarPP
    -- >   , … }
    --
    -- or with more customziation:
    --
    -- > myIconConfig = def{ iconConfigIcons = myIcons, iconConfigFmt = iconsFmtAppend concat }
    -- > main = xmonad $ … $ def
    -- >   { logHook = xmonadPropLog =<< dynamicLogString =<< clickablePP =<<
    -- >               dynamicIconsPP myIconConfig xmobarPP
    -- >   , … }

    -- | Shortcut for configuring single icons.
    appIcon :: String -> Query [String]
    appIcon :: String -> Query [String]
    appIcon = [String] -> Query [String]
    forall a. a -> Query a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([String] -> Query [String])
    -> (String -> [String]) -> String -> Query [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    -- | Adjusts the 'PP' and then runs 'dynamicLogWithPP'
    dynamicLogIconsWithPP :: Query [String] -- ^ The 'IconSet' to use
                          -> PP -- ^ The 'PP' to alter
                          -> X () -- ^ The resulting 'X' action
    dynamicLogIconsWithPP :: Query [String] -> PP -> X ()
    dynamicLogIconsWithPP Query [String]
    q = PP -> X ()
    dynamicLogWithPP (PP -> X ()) -> (PP -> X PP) -> PP -> X ()
    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

    -- | Adjusts the 'PP' with the given 'IconSet'
    iconsPP :: Query [String] -- ^ The 'IconSet' to use
            -> PP -- ^ The 'PP' to alter
            -> X PP -- ^ The resulting 'X PP'
    iconsPP :: Query [String] -> PP -> X PP
    iconsPP Query [String]
    q = IconConfig -> PP -> X PP
    dynamicIconsPP IconConfig
    forall a. Default a => a
    def{ iconConfigIcons = q }

    -- | Modify a pretty-printer, 'PP', to augment
    -- workspace names with icons based on the contents (windows) of the workspace.
    dynamicIconsPP :: IconConfig -> PP -> X PP
    dynamicIconsPP :: IconConfig -> PP -> X PP
    dynamicIconsPP IconConfig
    ic PP
    pp = IconConfig -> X (String -> WindowSpace -> String)
    getWorkspaceIcons IconConfig
    ic X (String -> WindowSpace -> String)
    -> ((String -> WindowSpace -> String) -> PP) -> X PP
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> \String -> WindowSpace -> String
    ren -> PP
    pp{ ppRename = ppRename pp >=> ren }

    -- | Returns a function for 'ppRename' that augments workspaces with icons
    -- according to the provided 'IconConfig'.
    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]
    iconConfigIcons :: IconConfig -> Query [String]
    iconConfigIcons :: Query [String]
    iconConfigFmt :: String -> [String] -> String
    iconConfigFilter :: Maybe (Stack Window) -> X [Window]
    iconConfigFmt :: IconConfig -> String -> [String] -> String
    iconConfigFilter :: IconConfig -> Maybe (Stack Window) -> X [Window]
    ..} = Map String [String] -> String -> WindowSpace -> String
    forall {k} {l} {a}.
    Ord k =>
    Map k [String] -> String -> Workspace k l a -> String
    fmt (Map String [String] -> String -> WindowSpace -> String)
    -> X (Map String [String]) -> X (String -> WindowSpace -> String)
    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 ([String] -> k -> Map k [String] -> [String]
    forall k a. Ord k => a -> k -> Map k a -> a
    M.findWithDefault [] (Workspace k l a -> k
    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]
    iconConfigIcons :: IconConfig -> Query [String]
    iconConfigFmt :: IconConfig -> String -> [String] -> String
    iconConfigFilter :: IconConfig -> Maybe (Stack Window) -> X [Window]
    iconConfigIcons :: Query [String]
    iconConfigFmt :: String -> [String] -> String
    iconConfigFilter :: Maybe (Stack Window) -> X [Window]
    ..} = do
        [WindowSpace]
    ws <- (XState -> [WindowSpace]) -> X [WindowSpace]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> [WindowSpace]
    forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
    S.workspaces (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> [WindowSpace])
    -> (XState
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> [WindowSpace]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset)
        [[String]]
    is <- [WindowSpace] -> (WindowSpace -> X [String]) -> X [[String]]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for [WindowSpace]
    ws ((WindowSpace -> X [String]) -> X [[String]])
    -> (WindowSpace -> X [String]) -> X [[String]]
    forall a b. (a -> b) -> a -> b
    $ (Window -> X [String]) -> [Window] -> X [String]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (Query [String] -> Window -> X [String]
    forall a. Query a -> Window -> X a
    runQuery Query [String]
    iconConfigIcons) ([Window] -> X [String])
    -> (WindowSpace -> X [Window]) -> WindowSpace -> X [String]
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Maybe (Stack Window) -> X [Window]
    iconConfigFilter (Maybe (Stack Window) -> X [Window])
    -> (WindowSpace -> Maybe (Stack Window))
    -> WindowSpace
    -> X [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSpace -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    S.stack
        Map String [String] -> X (Map String [String])
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map String [String] -> X (Map String [String]))
    -> Map String [String] -> X (Map String [String])
    forall a b. (a -> b) -> a -> b
    $ [(String, [String])] -> Map String [String]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([String] -> [[String]] -> [(String, [String])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ((WindowSpace -> String) -> [WindowSpace] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map WindowSpace -> String
    forall i l a. Workspace i l a -> i
    S.tag [WindowSpace]
    ws) [[String]]
    is)

    -- | Datatype for expanded 'Icon' configurations
    data IconConfig = IconConfig
        { IconConfig -> Query [String]
    iconConfigIcons :: Query [String]
          -- ^ What icons to use for each window.
        , IconConfig -> String -> [String] -> String
    iconConfigFmt :: WorkspaceId -> [String] -> String
          -- ^ How to format the result, see 'iconsFmtReplace', 'iconsFmtAppend'.
        , IconConfig -> Maybe (Stack Window) -> X [Window]
    iconConfigFilter :: Maybe (S.Stack Window) -> X [Window]
          -- ^ Which windows (icons) to show.
        }

    instance Default IconConfig where
        def :: IconConfig
    def = IconConfig
            { iconConfigIcons :: Query [String]
    iconConfigIcons = Query [String]
    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
            }

    -- | 'iconConfigFmt' that replaces the workspace name with icons, if any.
    --
    -- First parameter specifies how to concatenate multiple icons. Useful values
    -- include: 'concat', 'unwords', 'wrapUnwords'.
    --
    -- ==== __Examples__
    --
    -- >>> iconsFmtReplace concat "1" []
    -- "1"
    --
    -- >>> iconsFmtReplace concat "1" ["A", "B"]
    -- "AB"
    --
    -- >>> iconsFmtReplace (wrapUnwords "{" "}") "1" ["A", "B"]
    -- "{A B}"
    iconsFmtReplace :: ([String] -> String) -> WorkspaceId -> [String] -> String
    iconsFmtReplace :: ([String] -> String) -> String -> [String] -> String
    iconsFmtReplace [String] -> String
    cat String
    ws [String]
    is | [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    is   = String
    ws
                              | Bool
    otherwise = [String] -> String
    cat [String]
    is

    -- | 'iconConfigFmt' that appends icons to the workspace name.
    --
    -- First parameter specifies how to concatenate multiple icons. Useful values
    -- include: 'concat', 'unwords', 'wrapUnwords'.
    --
    -- ==== __Examples__
    --
    -- >>> iconsFmtAppend concat "1" []
    -- "1"
    --
    -- >>> iconsFmtAppend concat "1" ["A", "B"]
    -- "1:AB"
    iconsFmtAppend :: ([String] -> String) -> WorkspaceId -> [String] -> String
    iconsFmtAppend :: ([String] -> String) -> String -> [String] -> String
    iconsFmtAppend [String] -> String
    cat String
    ws [String]
    is | [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    is   = String
    ws
                             | Bool
    otherwise = String
    ws String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char
    ':' Char -> String -> String
    forall a. a -> [a] -> [a]
    : [String] -> String
    cat [String]
    is

    -- | Join words with spaces, and wrap the result in delimiters unless there
    -- was exactly one element.
    --
    -- ==== __Examples__
    --
    -- >>> wrapUnwords "{" "}" ["A", "B"]
    -- "{A B}"
    --
    -- >>> wrapUnwords "{" "}" ["A"]
    -- "A"
    --
    -- >>> wrapUnwords "{" "}" []
    -- ""
    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)

    -- | 'iconConfigFilter' that shows all windows of every workspace.
    iconsGetAll :: Maybe (S.Stack Window) -> X [Window]
    iconsGetAll :: Maybe (Stack Window) -> X [Window]
    iconsGetAll = [Window] -> X [Window]
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Window] -> X [Window])
    -> (Maybe (Stack Window) -> [Window])
    -> Maybe (Stack Window)
    -> X [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe (Stack Window) -> [Window]
    forall a. Maybe (Stack a) -> [a]
    S.integrate'

    -- | 'iconConfigFilter' that shows only the focused window for each workspace.
    iconsGetFocus :: Maybe (S.Stack Window) -> X [Window]
    iconsGetFocus :: Maybe (Stack Window) -> X [Window]
    iconsGetFocus = [Window] -> X [Window]
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Window] -> X [Window])
    -> (Maybe (Stack Window) -> [Window])
    -> Maybe (Stack Window)
    -> X [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Window -> [Window]
    forall a. Maybe a -> [a]
    maybeToList (Maybe Window -> [Window])
    -> (Maybe (Stack Window) -> Maybe Window)
    -> Maybe (Stack Window)
    -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Stack Window -> Window) -> Maybe (Stack Window) -> Maybe Window
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Stack Window -> Window
    forall a. Stack a -> a
    S.focus