{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module XMonad.Util.ActionQueue (
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, (|>))
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
$c<> :: ActionQueueHooked -> ActionQueueHooked -> ActionQueueHooked
<> :: ActionQueueHooked -> ActionQueueHooked -> ActionQueueHooked
$csconcat :: NonEmpty ActionQueueHooked -> ActionQueueHooked
sconcat :: NonEmpty ActionQueueHooked -> ActionQueueHooked
$cstimes :: forall b. Integral b => b -> ActionQueueHooked -> ActionQueueHooked
stimes :: forall b. Integral b => b -> ActionQueueHooked -> ActionQueueHooked
Semigroup)
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 = logHook cfg <> exequeue })
() -> ActionQueueHooked
ActionQueueHooked
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
exequeue :: X ()
exequeue :: X ()
exequeue = do
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 a. a -> X a
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 a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
X ()
exequeue