    {-# LANGUAGE InstanceSigs #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Hooks.ShowWName
    -- Description :  Like 'XMonad.Layout.ShowWName', but as a logHook
    -- Copyright   :  (c) 2022  Tony Zorman
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  Tony Zorman <soliditsallgood@mailbox.org>
    --
    -- Flash the names of workspaces name when switching to them.  This is a
    -- reimplementation of "XMonad.Layout.ShowWName" as a logHook.
    -----------------------------------------------------------------------------

    module XMonad.Hooks.ShowWName (
      -- * Usage
      -- $usage
      showWNameLogHook,
      SWNConfig(..),
      flashName,
    ) where

    import qualified XMonad.StackSet             as W
    import qualified XMonad.Util.ExtensibleState as XS

    import XMonad
    import XMonad.Layout.ShowWName (SWNConfig (..))
    import XMonad.Prelude
    import XMonad.Util.XUtils (WindowConfig (..), showSimpleWindow)

    import Control.Concurrent (threadDelay)

    {- $usage

    You can use this module with the following in your
    @xmonad.hs@:

    > import XMonad.Hooks.ShowWName
    >
    > main :: IO ()
    > main = xmonad $ def
    >   { logHook = showWNameLogHook def
    >   }

    Whenever a workspace gains focus, the above logHook will flash its name.
    You can customise the duration of the flash, as well as colours by
    customising the 'SWNConfig' argument that 'showWNameLogHook' takes.

    Alternatively, you can also bind 'flashName' to a key and manually
    invoke it when you want to know which workspace you are on.
    -}

    -- | LogHook for flashing the name of a workspace upon entering it.
    showWNameLogHook :: SWNConfig -> X ()
    showWNameLogHook :: SWNConfig -> X ()
    showWNameLogHook SWNConfig
    cfg = do
      LastShown WorkspaceId
    s <- X LastShown
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
      WorkspaceId
    foc         <- (WindowSet -> X WorkspaceId) -> X WorkspaceId
    forall a. (WindowSet -> X a) -> X a
    withWindowSet (WorkspaceId -> X WorkspaceId
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (WorkspaceId -> X WorkspaceId)
    -> (WindowSet -> WorkspaceId) -> WindowSet -> X WorkspaceId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet -> WorkspaceId
    forall i l a s sd. StackSet i l a s sd -> i
    W.currentTag)
      Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (WorkspaceId
    s WorkspaceId -> WorkspaceId -> Bool
    forall a. Eq a => a -> a -> Bool
    == WorkspaceId
    foc) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        SWNConfig -> X ()
    flashName SWNConfig
    cfg
        LastShown -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put (WorkspaceId -> LastShown
    LastShown WorkspaceId
    foc)

    -- | Flash the name of the currently focused workspace.
    flashName :: SWNConfig -> X ()
    flashName :: SWNConfig -> X ()
    flashName SWNConfig
    cfg = do
      WorkspaceId
    n <- (WindowSet -> X WorkspaceId) -> X WorkspaceId
    forall a. (WindowSet -> X a) -> X a
    withWindowSet (WorkspaceId -> X WorkspaceId
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (WorkspaceId -> X WorkspaceId)
    -> (WindowSet -> WorkspaceId) -> WindowSet -> X WorkspaceId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet -> WorkspaceId
    forall i l a s sd. StackSet i l a s sd -> i
    W.currentTag)
      WindowConfig -> [WorkspaceId] -> X Window
    showSimpleWindow WindowConfig
    cfg' [WorkspaceId
    n] X Window -> (Window -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Window
    w -> X ProcessID -> X ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (X ProcessID -> X ()) -> (IO () -> X ProcessID) -> IO () -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> X ProcessID
    forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
    xfork (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        Display
    dpy <- WorkspaceId -> IO Display
    openDisplay WorkspaceId
    ""
        Int -> IO ()
    threadDelay (Rational -> Int
    forall a. Enum a => a -> Int
    fromEnum (Rational -> Int) -> Rational -> Int
    forall a b. (a -> b) -> a -> b
    $ SWNConfig -> Rational
    swn_fade SWNConfig
    cfg Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    1000000) -- 1_000_000 needs GHC 8.6.x and up
        IO () -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO ()
    destroyWindow Display
    dpy Window
    w
        Display -> IO ()
    closeDisplay Display
    dpy
     where
      cfg' :: WindowConfig
      cfg' :: WindowConfig
    cfg' = WindowConfig
    forall a. Default a => a
    def{ winFont = swn_font cfg, winBg = swn_bgcolor cfg, winFg = swn_color cfg }

    -- | Last shown workspace.
    newtype LastShown = LastShown WorkspaceId
      deriving (Int -> LastShown -> ShowS
    [LastShown] -> ShowS
    LastShown -> WorkspaceId
    (Int -> LastShown -> ShowS)
    -> (LastShown -> WorkspaceId)
    -> ([LastShown] -> ShowS)
    -> Show LastShown
    forall a.
    (Int -> a -> ShowS)
    -> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> LastShown -> ShowS
    showsPrec :: Int -> LastShown -> ShowS
    $cshow :: LastShown -> WorkspaceId
    show :: LastShown -> WorkspaceId
    $cshowList :: [LastShown] -> ShowS
    showList :: [LastShown] -> ShowS
    Show, ReadPrec [LastShown]
    ReadPrec LastShown
    Int -> ReadS LastShown
    ReadS [LastShown]
    (Int -> ReadS LastShown)
    -> ReadS [LastShown]
    -> ReadPrec LastShown
    -> ReadPrec [LastShown]
    -> Read LastShown
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS LastShown
    readsPrec :: Int -> ReadS LastShown
    $creadList :: ReadS [LastShown]
    readList :: ReadS [LastShown]
    $creadPrec :: ReadPrec LastShown
    readPrec :: ReadPrec LastShown
    $creadListPrec :: ReadPrec [LastShown]
    readListPrec :: ReadPrec [LastShown]
    Read)

    instance ExtensionClass LastShown where
      initialValue :: LastShown
      initialValue :: LastShown
    initialValue  = WorkspaceId -> LastShown
    LastShown WorkspaceId
    ""

      extensionType :: LastShown -> StateExtension
      extensionType :: LastShown -> StateExtension
    extensionType = LastShown -> StateExtension
    forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
    PersistentExtension