    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Util.Loggers.NamedScratchpad
    -- Description :  A collection of Loggers for "XMonad.Util.NamedScratchpad".
    -- Copyright   :  (c) Brandon S Allbery <allbery.b@gmail.com>
    -- License     :  BSD-style (see LICENSE)
    --
    -- Maintainer  :  Brandon S Allbery <allbery.b@gmail.com>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- "XMonad.Util.Loggers" for "XMonad.Util.NamedScratchpad"
    --
    -----------------------------------------------------------------------------

    module XMonad.Util.Loggers.NamedScratchpad (-- * Usage
                                                -- $usage
                                                nspTrackStartup
                                               ,nspTrackHook
                                               ,nspActiveIcon
                                               ,nspActive
                                               ,nspActive') where

    import XMonad.Core
    import Graphics.X11.Xlib (Window)
    import Graphics.X11.Xlib.Extras (Event(..))
    import XMonad.Util.Loggers (Logger)
    import XMonad.Util.NamedScratchpad (NamedScratchpad(..))
    import qualified XMonad.Util.ExtensibleState as XS
    import XMonad.Prelude (All (..), chr, foldM, forM)
    import qualified Data.IntMap as M
    import qualified XMonad.StackSet as W (allWindows)

    -- $usage
    -- This is a set of 'Logger's for 'NamedScratchpad's.
    -- It provides a 'startupHook' and 'handleEventHook' to keep track of
    -- 'NamedScratchpad's, and several possible 'Logger's for use in
    -- 'XMonad.Hooks.StatusBar.PP.ppExtras'.
    --
    -- You must add 'nspTrackStartup' to your 'startupHook' to initialize
    -- 'NamedScratchpad' tracking and to detect any currently running
    -- 'NamedScratchpad's on restart, and 'nspTrackHook' to your 'handleEventHook'
    -- to track the coming and going of 'NamedScratchpad's.
    --
    -- Why would you want to do this? If you aren't using 'EwmhDesktops', this
    -- gives you a way to see what 'NamedScratchpad's are running. If you are
    -- using 'EwmhDesktops' then you can get that from a taskbar... but you may
    -- have noticed that selecting the window from the taskbar moves you to
    -- the 'NSP' workspace instead of moving the window to the current workspace.
    -- (This is difficult to change; "minimizing" by moving it back to 'NSP'
    -- is even harder.)
    -- I hide the 'NamedScratchpad's from the taskbar and use this to track
    -- them instead (see "XMonad.Util.NoTaskbar").

    -- The extension data for tracking NSP windows
    newtype NSPTrack = NSPTrack [Maybe Window]
    instance ExtensionClass NSPTrack where
      initialValue :: NSPTrack
    initialValue = [Maybe Window] -> NSPTrack
    NSPTrack []

    -- | 'startupHook' to initialize scratchpad activation tracking
    --
    -- > , startupHook = ... <> nspTrackStartup scratchpads
    --
    -- If you kickstart the 'logHook', do it /after/ 'nspTrackStartup'!
    nspTrackStartup :: [NamedScratchpad] -> X ()
    nspTrackStartup :: [NamedScratchpad] -> X ()
    nspTrackStartup [NamedScratchpad]
    ns = do
      let ns'i :: IntMap (Maybe a)
    ns'i = [(Int, Maybe a)] -> IntMap (Maybe a)
    forall a. [(Int, a)] -> IntMap a
    M.fromList ([(Int, Maybe a)] -> IntMap (Maybe a))
    -> [(Int, Maybe a)] -> IntMap (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [Maybe a] -> [(Int, Maybe a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] ([Maybe a] -> [(Int, Maybe a)]) -> [Maybe a] -> [(Int, Maybe a)]
    forall a b. (a -> b) -> a -> b
    $ (NamedScratchpad -> Maybe a) -> [NamedScratchpad] -> [Maybe a]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe a -> NamedScratchpad -> Maybe a
    forall a b. a -> b -> a
    const Maybe a
    forall a. Maybe a
    Nothing) [NamedScratchpad]
    ns
      IntMap (Maybe Window)
    ns' <- (WindowSet -> X (IntMap (Maybe Window)))
    -> X (IntMap (Maybe Window))
    forall a. (WindowSet -> X a) -> X a
    withWindowSet ((WindowSet -> X (IntMap (Maybe Window)))
     -> X (IntMap (Maybe Window)))
    -> (WindowSet -> X (IntMap (Maybe Window)))
    -> X (IntMap (Maybe Window))
    forall a b. (a -> b) -> a -> b
    $ (IntMap (Maybe Window) -> Window -> X (IntMap (Maybe Window)))
    -> IntMap (Maybe Window) -> [Window] -> X (IntMap (Maybe Window))
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ([NamedScratchpad]
    -> IntMap (Maybe Window) -> Window -> X (IntMap (Maybe Window))
    isSp [NamedScratchpad]
    ns) IntMap (Maybe Window)
    forall {a}. IntMap (Maybe a)
    ns'i ([Window] -> X (IntMap (Maybe Window)))
    -> (WindowSet -> [Window])
    -> WindowSet
    -> X (IntMap (Maybe Window))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet -> [Window]
    forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
    W.allWindows
      NSPTrack -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put ([Maybe Window] -> NSPTrack
    NSPTrack (((Int, Maybe Window) -> Maybe Window)
    -> [(Int, Maybe Window)] -> [Maybe Window]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, Maybe Window) -> Maybe Window
    forall a b. (a, b) -> b
    snd ([(Int, Maybe Window)] -> [Maybe Window])
    -> [(Int, Maybe Window)] -> [Maybe Window]
    forall a b. (a -> b) -> a -> b
    $ IntMap (Maybe Window) -> [(Int, Maybe Window)]
    forall a. IntMap a -> [(Int, a)]
    M.toAscList IntMap (Maybe Window)
    ns'))

    isSp :: [NamedScratchpad] -> M.IntMap (Maybe Window) -> Window -> X (M.IntMap (Maybe Window))
    isSp :: [NamedScratchpad]
    -> IntMap (Maybe Window) -> Window -> X (IntMap (Maybe Window))
    isSp [NamedScratchpad]
    ns IntMap (Maybe Window)
    ws Window
    w = do
      Maybe Int
    n <- Query (Maybe Int) -> Window -> X (Maybe Int)
    forall a. Query a -> Window -> X a
    runQuery ([NamedScratchpad] -> Query (Maybe Int)
    scratchpadWindow [NamedScratchpad]
    ns) Window
    w
      IntMap (Maybe Window) -> X (IntMap (Maybe Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IntMap (Maybe Window) -> X (IntMap (Maybe Window)))
    -> IntMap (Maybe Window) -> X (IntMap (Maybe Window))
    forall a b. (a -> b) -> a -> b
    $ case Maybe Int
    n of
                Maybe Int
    Nothing -> IntMap (Maybe Window)
    ws
                Just Int
    n' -> Int
    -> Maybe Window -> IntMap (Maybe Window) -> IntMap (Maybe Window)
    forall a. Int -> a -> IntMap a -> IntMap a
    M.insert Int
    n' (Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w) IntMap (Maybe Window)
    ws

    scratchpadWindow :: [NamedScratchpad] -> Query (Maybe Int)
    scratchpadWindow :: [NamedScratchpad] -> Query (Maybe Int)
    scratchpadWindow [NamedScratchpad]
    ns = (Maybe Int -> (Int, NamedScratchpad) -> Query (Maybe Int))
    -> Maybe Int -> [(Int, NamedScratchpad)] -> Query (Maybe Int)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Maybe Int -> (Int, NamedScratchpad) -> Query (Maybe Int)
    sp' Maybe Int
    forall a. Maybe a
    Nothing ([Int] -> [NamedScratchpad] -> [(Int, NamedScratchpad)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [NamedScratchpad]
    ns)
      where sp' :: Maybe Int -> (Int,NamedScratchpad) -> Query (Maybe Int)
            sp' :: Maybe Int -> (Int, NamedScratchpad) -> Query (Maybe Int)
    sp' r :: Maybe Int
    r@(Just Int
    _) (Int, NamedScratchpad)
    _              = Maybe Int -> Query (Maybe Int)
    forall a. a -> Query a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Int
    r
            sp' Maybe Int
    Nothing    (Int
    n,NS String
    _ String
    _ Query Bool
    q ManageHook
    _) = Query Bool
    q Query Bool -> (Bool -> Query (Maybe Int)) -> Query (Maybe Int)
    forall a b. Query a -> (a -> Query b) -> Query b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Bool
    p -> Maybe Int -> Query (Maybe Int)
    forall a. a -> Query a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Int -> Query (Maybe Int)) -> Maybe Int -> Query (Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ if Bool
    p then Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n else Maybe Int
    forall a. Maybe a
    Nothing

    -- | 'handleEventHook' to track scratchpad activation/deactivation
    --
    -- > , handleEventHook = ... <> nspTrackHook scratchpads
    nspTrackHook :: [NamedScratchpad] -> Event -> X All
    nspTrackHook :: [NamedScratchpad] -> Event -> X All
    nspTrackHook [NamedScratchpad]
    _ DestroyWindowEvent{ev_window :: Event -> Window
    ev_window = Window
    w} = do
      (NSPTrack -> NSPTrack) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify ((NSPTrack -> NSPTrack) -> X ()) -> (NSPTrack -> NSPTrack) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \(NSPTrack [Maybe Window]
    ws) -> [Maybe Window] -> NSPTrack
    NSPTrack ([Maybe Window] -> NSPTrack) -> [Maybe Window] -> NSPTrack
    forall a b. (a -> b) -> a -> b
    $ (Maybe Window -> Maybe Window) -> [Maybe Window] -> [Maybe Window]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Maybe Window
    sw -> if Maybe Window
    sw Maybe Window -> Maybe Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w then Maybe Window
    forall a. Maybe a
    Nothing else Maybe Window
    sw) [Maybe Window]
    ws
      All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    nspTrackHook [NamedScratchpad]
    ns ConfigureRequestEvent{ev_window :: Event -> Window
    ev_window = Window
    w} = do
      NSPTrack [Maybe Window]
    ws <- X NSPTrack
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
      [Maybe Window]
    ws' <- [(Integer, Maybe Window, NamedScratchpad)]
    -> ((Integer, Maybe Window, NamedScratchpad) -> X (Maybe Window))
    -> X [Maybe Window]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM ([Integer]
    -> [Maybe Window]
    -> [NamedScratchpad]
    -> [(Integer, Maybe Window, NamedScratchpad)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [Integer
    0 :: Integer ..] [Maybe Window]
    ws [NamedScratchpad]
    ns) (((Integer, Maybe Window, NamedScratchpad) -> X (Maybe Window))
     -> X [Maybe Window])
    -> ((Integer, Maybe Window, NamedScratchpad) -> X (Maybe Window))
    -> X [Maybe Window]
    forall a b. (a -> b) -> a -> b
    $ \(Integer
    _,Maybe Window
    w',NS String
    _ String
    _ Query Bool
    q ManageHook
    _) -> do
        Bool
    p <- Query Bool -> Window -> X Bool
    forall a. Query a -> Window -> X a
    runQuery Query Bool
    q Window
    w
        Maybe Window -> X (Maybe Window)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Window -> X (Maybe Window))
    -> Maybe Window -> X (Maybe Window)
    forall a b. (a -> b) -> a -> b
    $ if Bool
    p then Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w else Maybe Window
    w'
      NSPTrack -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put (NSPTrack -> X ()) -> NSPTrack -> X ()
    forall a b. (a -> b) -> a -> b
    $ [Maybe Window] -> NSPTrack
    NSPTrack [Maybe Window]
    ws'
      All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    nspTrackHook [NamedScratchpad]
    _ Event
    _ = All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)

    -- | 'Logger' for scratchpads' state, using Unicode characters as "icons".
    --
    -- > , ppExtras = [..., nspActive' iconChars showActive showInactive, ...]
    nspActiveIcon :: [Char] -> (String -> String) -> (String -> String) -> Logger
    nspActiveIcon :: String -> (String -> String) -> (String -> String) -> Logger
    nspActiveIcon String
    icns String -> String
    act String -> String
    inact = do
      NSPTrack [Maybe Window]
    ws <- X NSPTrack
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
      Maybe String -> Logger
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String -> Logger) -> Maybe String -> Logger
    forall a b. (a -> b) -> a -> b
    $ if [Maybe Window] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Maybe Window]
    ws
                then Maybe String
    forall a. Maybe a
    Nothing
                else let icon' :: Int -> Char
    icon' Int
    n = if Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    icns then String
    icns String -> Int -> Char
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    n else Char
    '\NUL'
                         icon :: Int -> String
    icon  Int
    n = let c :: Char
    c = Int -> Char
    icon' Int
    n
                                    in [if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\NUL' then Int -> Char
    chr (Int
    0x2460 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n) else Char
    c]
                         ckact :: Int -> Maybe a -> String
    ckact Int
    n Maybe a
    w = let icn :: String
    icn = Int -> String
    icon Int
    n
                                      in case Maybe a
    w of
                                          Maybe a
    Nothing -> String -> String
    inact String
    icn
                                          Just a
    _  -> String -> String
    act   String
    icn
                         s :: String
    s = [String] -> String
    unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Int -> Maybe Window -> String)
    -> [Int] -> [Maybe Window] -> [String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Maybe Window -> String
    forall {a}. Int -> Maybe a -> String
    ckact [Int
    0..] [Maybe Window]
    ws
                      in String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s

    -- | 'Logger' with String-s (and no defaults)
    --
    -- > , ppExtras = [..., nspActive iconStrs showActive showInactive, ...]
    nspActive :: [String] -> (String -> String) -> (String -> String) -> Logger
    nspActive :: [String] -> (String -> String) -> (String -> String) -> Logger
    nspActive [String]
    icns String -> String
    act String -> String
    inact = do
      NSPTrack [Maybe Window]
    ws <- X NSPTrack
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
      Maybe String -> Logger
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe String -> Logger) -> Maybe String -> Logger
    forall a b. (a -> b) -> a -> b
    $ if [Maybe Window] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Maybe Window]
    ws
                then Maybe String
    forall a. Maybe a
    Nothing
                else let  ckact :: Int -> Maybe a -> String
    ckact Int
    n Maybe a
    w = let icn :: String
    icn = [String]
    icns [String] -> Int -> String
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    n
                                        in case Maybe a
    w of
                                            Maybe a
    Nothing -> String -> String
    inact String
    icn
                                            Just a
    _  -> String -> String
    act   String
    icn
                          s :: String
    s = [String] -> String
    unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Int -> Maybe Window -> String)
    -> [Int] -> [Maybe Window] -> [String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Maybe Window -> String
    forall {a}. Int -> Maybe a -> String
    ckact [Int
    0..] [Maybe Window]
    ws
                      in String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s

    -- | Variant of the above getting the String-s from the 'NamedScratchpad's
    nspActive' :: [NamedScratchpad] -> (String -> String) -> (String -> String) -> Logger
    nspActive' :: [NamedScratchpad]
    -> (String -> String) -> (String -> String) -> Logger
    nspActive' [NamedScratchpad]
    ns = [String] -> (String -> String) -> (String -> String) -> Logger
    nspActive ((NamedScratchpad -> String) -> [NamedScratchpad] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map NamedScratchpad -> String
    name [NamedScratchpad]
    ns)