{-# 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 forall a. Monoid a => a
mempty
newtype ActionQueueHooked = ActionQueueHooked ()
deriving newtype (NonEmpty ActionQueueHooked -> ActionQueueHooked
ActionQueueHooked -> ActionQueueHooked -> 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)
actionQueue :: XConfig l -> XConfig l
actionQueue :: forall (l :: * -> *). XConfig l -> XConfig l
actionQueue = 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 = forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
cfg forall a. Semigroup a => a -> a -> a
<> X ()
exequeue })
() -> ActionQueueHooked
ActionQueueHooked
enqueue :: X () -> X ()
enqueue :: X () -> X ()
enqueue = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify 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 forall a b. (a -> b) -> a -> b
$ Seq (X ())
as forall a. Seq a -> a -> Seq a
|> X ()
a
exequeue :: X ()
exequeue :: X ()
exequeue = do
ActionQueue Seq (X ())
aas <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
case forall a. Seq a -> ViewL a
viewl Seq (X ())
aas of
ViewL (X ())
EmptyL -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
X ()
a :< Seq (X ())
as -> do forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (Seq (X ()) -> ActionQueue
ActionQueue Seq (X ())
as)
X ()
a forall a. X a -> X a -> X a
`catchX` forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
X ()
exequeue