{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.ActionQueue
-- Description :  Queue of XMonad actions
-- Copyright   :  (c) 2021 Xiaokui Shu
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  subbyte@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- Put XMonad actions in the queue to be executed in either the
-- @logHook@ or another hook of your choice.
-----------------------------------------------------------------------------

module XMonad.Util.ActionQueue ( -- * Usage
                                 -- $usage
                                 ActionQueue
                               , actionQueue
                               , enqueue
                               , exequeue
                               ) where

import XMonad
import qualified XMonad.Util.ExtensibleConf  as XC
import qualified XMonad.Util.ExtensibleState as XS

import Data.Sequence (Seq (..), ViewL (..), viewl, (|>))

-- $usage
--
-- This module provides a queue that, by default, gets executed every
-- time the @logHook@ runs.  To use this module
--
-- 1. Enqueue `X ()` actions at the place you need; e.g.:
--
-- > enqueue myAction
--
-- 2. Add the 'actionQueue' combinator to your configuration:
--
-- > main = xmonad $ actionQueue $ def
-- >     { ... }
--
-- This will execute all of the actions in the queue (if any) every time
-- the @logHook@ runs.  Developers of other extensions using this module
-- should re-export 'actionQueue'.
--
-- Alternatively, you can directly add 'exequeue' to a hook of your choice.
-- This is discouraged when writing user-facing modules, as (accidentally)
-- adding 'exequeue' to two different hooks might lead to undesirable
-- behaviour.  'actionQueue' uses the "XMonad.Util.ExtensibleConf" interface to
-- circumvent this.
--

newtype ActionQueue = ActionQueue (Seq (X ()))

instance ExtensionClass ActionQueue where
    initialValue :: ActionQueue
initialValue = Seq (X ()) -> ActionQueue
ActionQueue Seq (X ())
forall a. Monoid a => a
mempty

newtype ActionQueueHooked = ActionQueueHooked ()
  deriving newtype (NonEmpty ActionQueueHooked -> ActionQueueHooked
ActionQueueHooked -> ActionQueueHooked -> ActionQueueHooked
(ActionQueueHooked -> ActionQueueHooked -> ActionQueueHooked)
-> (NonEmpty ActionQueueHooked -> ActionQueueHooked)
-> (forall b.
    Integral b =>
    b -> ActionQueueHooked -> ActionQueueHooked)
-> Semigroup ActionQueueHooked
forall b. Integral b => b -> ActionQueueHooked -> ActionQueueHooked
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> ActionQueueHooked -> ActionQueueHooked
$cstimes :: forall b. Integral b => b -> ActionQueueHooked -> ActionQueueHooked
sconcat :: NonEmpty ActionQueueHooked -> ActionQueueHooked
$csconcat :: NonEmpty ActionQueueHooked -> ActionQueueHooked
<> :: ActionQueueHooked -> ActionQueueHooked -> ActionQueueHooked
$c<> :: ActionQueueHooked -> ActionQueueHooked -> ActionQueueHooked
Semigroup)

-- | Every time the @logHook@ runs, execute all actions in the queue.
actionQueue :: XConfig l -> XConfig l
actionQueue :: forall (l :: * -> *). XConfig l -> XConfig l
actionQueue = (XConfig l -> XConfig l)
-> (() -> ActionQueueHooked) -> XConfig l -> XConfig l
forall a (l :: * -> *).
(Semigroup a, Typeable a) =>
(XConfig l -> XConfig l) -> a -> XConfig l -> XConfig l
XC.once (\XConfig l
cfg -> XConfig l
cfg{ logHook :: X ()
logHook = XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
cfg X () -> X () -> X ()
forall a. Semigroup a => a -> a -> a
<> X ()
exequeue })
                      () -> ActionQueueHooked
ActionQueueHooked

-- | Enqueue an action.
enqueue :: X () -> X ()
enqueue :: X () -> X ()
enqueue = (ActionQueue -> ActionQueue) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((ActionQueue -> ActionQueue) -> X ())
-> (X () -> ActionQueue -> ActionQueue) -> X () -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X () -> ActionQueue -> ActionQueue
go
  where
    go :: X () -> ActionQueue -> ActionQueue
    go :: X () -> ActionQueue -> ActionQueue
go X ()
a (ActionQueue Seq (X ())
as) = Seq (X ()) -> ActionQueue
ActionQueue (Seq (X ()) -> ActionQueue) -> Seq (X ()) -> ActionQueue
forall a b. (a -> b) -> a -> b
$ Seq (X ())
as Seq (X ()) -> X () -> Seq (X ())
forall a. Seq a -> a -> Seq a
|> X ()
a

-- | Execute every action in the queue.
exequeue :: X ()
exequeue :: X ()
exequeue = do
    -- Note that we are executing all actions one by one.  Otherwise, we may
    -- not execute the actions in the right order.  Any of them may call
    -- 'refresh' or 'windows', which triggers the logHook, which may trigger
    -- 'exequeue' again if it is used in the logHook.
    ActionQueue Seq (X ())
aas <- X ActionQueue
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    case Seq (X ()) -> ViewL (X ())
forall a. Seq a -> ViewL a
viewl Seq (X ())
aas of
      ViewL (X ())
EmptyL  -> () -> X ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      X ()
a :< Seq (X ())
as -> do ActionQueue -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (Seq (X ()) -> ActionQueue
ActionQueue Seq (X ())
as)
                    X ()
a X () -> X () -> X ()
forall a. X a -> X a -> X a
`catchX` () -> X ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    X ()
exequeue