{-# 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 <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  WorkspaceId
foc         <- forall a. (WindowSet -> X a) -> X a
withWindowSet (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> i
W.currentTag)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WorkspaceId
s forall a. Eq a => a -> a -> Bool
== WorkspaceId
foc) forall a b. (a -> b) -> a -> b
$ do
    SWNConfig -> X ()
flashName SWNConfig
cfg
    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 <- forall a. (WindowSet -> X a) -> X a
withWindowSet (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> i
W.currentTag)
  WindowConfig -> [WorkspaceId] -> X Window
showSimpleWindow WindowConfig
cfg' [WorkspaceId
n] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork forall a b. (a -> b) -> a -> b
$ do
    Display
dpy <- WorkspaceId -> IO Display
openDisplay WorkspaceId
""
    Int -> IO ()
threadDelay (forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ SWNConfig -> Rational
swn_fade SWNConfig
cfg forall a. Num a => a -> a -> a
* Rational
1000000) -- 1_000_000 needs GHC 8.6.x and up
    forall (f :: * -> *) a. Functor f => f a -> f ()
void 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' = forall a. Default a => a
def{ winFont :: WorkspaceId
winFont = SWNConfig -> WorkspaceId
swn_font SWNConfig
cfg, winBg :: WorkspaceId
winBg = SWNConfig -> WorkspaceId
swn_bgcolor SWNConfig
cfg, winFg :: WorkspaceId
winFg = SWNConfig -> WorkspaceId
swn_color SWNConfig
cfg }

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

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

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