    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Util.Loggers.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'
    --
    -----------------------------------------------------------------------------

    {-# LANGUAGE DeriveDataTypeable #-}

    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 Data.Monoid (All(..))
    import Data.Char (chr)
    import Control.Monad (forM, foldM)
    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.DynamicLog' '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
    data NSPTrack = NSPTrack [Maybe Window] deriving Typeable
    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 ns :: [NamedScratchpad]
    ns = do
      let ns'i :: IntMap (Maybe a)
    ns'i = [(Key, Maybe a)] -> IntMap (Maybe a)
    forall a. [(Key, a)] -> IntMap a
    M.fromList ([(Key, Maybe a)] -> IntMap (Maybe a))
    -> [(Key, Maybe a)] -> IntMap (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ [Key] -> [Maybe a] -> [(Key, Maybe a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [0..] ([Maybe a] -> [(Key, Maybe a)]) -> [Maybe a] -> [(Key, 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 (((Key, Maybe Window) -> Maybe Window)
    -> [(Key, Maybe Window)] -> [Maybe Window]
    forall a b. (a -> b) -> [a] -> [b]
    map (Key, Maybe Window) -> Maybe Window
    forall a b. (a, b) -> b
    snd ([(Key, Maybe Window)] -> [Maybe Window])
    -> [(Key, Maybe Window)] -> [Maybe Window]
    forall a b. (a -> b) -> a -> b
    $ IntMap (Maybe Window) -> [(Key, Maybe Window)]
    forall a. IntMap a -> [(Key, 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 ns :: [NamedScratchpad]
    ns ws :: IntMap (Maybe Window)
    ws w :: Window
    w = do
      Maybe Key
    n <- Query (Maybe Key) -> Window -> X (Maybe Key)
    forall a. Query a -> Window -> X a
    runQuery ([NamedScratchpad] -> Query (Maybe Key)
    scratchpadWindow [NamedScratchpad]
    ns) Window
    w
      IntMap (Maybe Window) -> X (IntMap (Maybe Window))
    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 Key
    n of
                Nothing -> IntMap (Maybe Window)
    ws
                Just n' :: Key
    n' -> Key
    -> Maybe Window -> IntMap (Maybe Window) -> IntMap (Maybe Window)
    forall a. Key -> a -> IntMap a -> IntMap a
    M.insert Key
    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 Key)
    scratchpadWindow ns :: [NamedScratchpad]
    ns = (Maybe Key -> (Key, NamedScratchpad) -> Query (Maybe Key))
    -> Maybe Key -> [(Key, NamedScratchpad)] -> Query (Maybe Key)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Maybe Key -> (Key, NamedScratchpad) -> Query (Maybe Key)
    sp' Maybe Key
    forall a. Maybe a
    Nothing ([Key] -> [NamedScratchpad] -> [(Key, NamedScratchpad)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [0..] [NamedScratchpad]
    ns)
      where sp' :: Maybe Int -> (Int,NamedScratchpad) -> Query (Maybe Int)
            sp' :: Maybe Key -> (Key, NamedScratchpad) -> Query (Maybe Key)
    sp' r :: Maybe Key
    r@(Just _) _              = Maybe Key -> Query (Maybe Key)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Key
    r
            sp' Nothing    (n :: Key
    n,NS _ _ q :: Query Bool
    q _) = Query Bool
    q Query Bool -> (Bool -> Query (Maybe Key)) -> Query (Maybe Key)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \p :: Bool
    p -> Maybe Key -> Query (Maybe Key)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Key -> Query (Maybe Key)) -> Maybe Key -> Query (Maybe Key)
    forall a b. (a -> b) -> a -> b
    $ if Bool
    p then Key -> Maybe Key
    forall a. a -> Maybe a
    Just Key
    n else Maybe Key
    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 _ (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 ws :: [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 (\sw :: 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 (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    nspTrackHook ns :: [NamedScratchpad]
    ns (ConfigureRequestEvent {ev_window :: Event -> Window
    ev_window = Window
    w}) = do
      NSPTrack ws :: [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 [0..] [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
    $ \(_,w' :: Maybe Window
    w',NS _ _ q :: Query Bool
    q _) -> 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 (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 (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    nspTrackHook _ _ = All -> X All
    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 :: [Char] -> ([Char] -> [Char]) -> ([Char] -> [Char]) -> Logger
    nspActiveIcon icns :: [Char]
    icns act :: [Char] -> [Char]
    act inact :: [Char] -> [Char]
    inact = do
      NSPTrack ws :: [Maybe Window]
    ws <- X NSPTrack
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
      Maybe [Char] -> Logger
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe [Char] -> Logger) -> Maybe [Char] -> Logger
    forall a b. (a -> b) -> a -> b
    $ if [Maybe Window] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Maybe Window]
    ws
                then Maybe [Char]
    forall a. Maybe a
    Nothing
                else let icon' :: Key -> Char
    icon' n :: Key
    n = if Key
    n Key -> Key -> Bool
    forall a. Ord a => a -> a -> Bool
    < [Char] -> Key
    forall (t :: * -> *) a. Foldable t => t a -> Key
    length [Char]
    icns then [Char]
    icns [Char] -> Key -> Char
    forall a. [a] -> Key -> a
    !! Key
    n else '\NUL'
                         icon :: Key -> [Char]
    icon  n :: Key
    n = let c :: Char
    c = Key -> Char
    icon' Key
    n
                                    in [if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\NUL' then Key -> Char
    chr (0x2460 Key -> Key -> Key
    forall a. Num a => a -> a -> a
    + Key
    n) else Char
    c]
                         ckact :: Key -> Maybe a -> [Char]
    ckact n :: Key
    n w :: Maybe a
    w = let icn :: [Char]
    icn = Key -> [Char]
    icon Key
    n
                                      in case Maybe a
    w of
                                          Nothing -> [Char] -> [Char]
    inact [Char]
    icn
                                          Just _  -> [Char] -> [Char]
    act   [Char]
    icn
                         s :: [Char]
    s = [[Char]] -> [Char]
    unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ (Key -> Maybe Window -> [Char])
    -> [Key] -> [Maybe Window] -> [[Char]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Key -> Maybe Window -> [Char]
    forall a. Key -> Maybe a -> [Char]
    ckact [0..] [Maybe Window]
    ws
                      in [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    s

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

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