{-# LANGUAGE BangPatterns, BlockArguments, LambdaCase #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.Repeatable
-- Description :  Actions you'd like to repeat.
-- Copyright   :  (c) 2022,2026 L. S. Leary
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  L.S.Leary.II@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module factors out the shared logic of "XMonad.Actions.CycleRecentWS",
-- "XMonad.Actions.CycleWorkspaceByScreen", "XMonad.Actions.CycleWindows" and
-- "XMonad.Actions.MostRecentlyUsed".
--
-- See the source of these modules for usage examples.
--
-----------------------------------------------------------------------------

module XMonad.Actions.Repeatable (

  -- * Repeatable
  repeatable,
  repeatableSt,
  repeatableM,

  -- * Concludable
  NotOurEvent(..),
  Done(..),
  concludable,
  concludableSt,
  concludableM,

) where

-- base
import Data.Functor (($>))

-- mtl
import Control.Monad.State (StateT(..))

-- X11
import Graphics.X11.Xlib.Extras

-- xmonad
import XMonad


-- | An action that temporarily usurps and responds to key press/release events,
--   concluding when one of the modifier keys is released.
repeatable
  :: [KeySym]                      -- ^ The list of 'KeySym's under the
                                   --   modifiers used to invoke the action.
  -> KeySym                        -- ^ The keypress that invokes the action.
  -> (EventType -> KeySym -> X ()) -- ^ The keypress handler.
  -> X ()
repeatable :: [KeySym] -> KeySym -> (EventType -> KeySym -> X ()) -> X ()
repeatable = forall (m :: * -> *) a b.
(MonadIO m, Monoid a) =>
(m a -> X b)
-> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> X b
repeatableM forall a. a -> a
id

-- | A more general variant of 'repeatable' with a stateful handler,
--   accumulating a monoidal return value throughout the events.
repeatableSt
  :: Monoid a
  => s                                     -- ^ Initial state.
  -> [KeySym]                              -- ^ The list of 'KeySym's under the
                                           --   modifiers used to invoke the
                                           --   action.
  -> KeySym                                -- ^ The keypress that invokes the
                                           --   action.
  -> (EventType -> KeySym -> StateT s X a) -- ^ The keypress handler.
  -> X (a, s)
repeatableSt :: forall a s.
Monoid a =>
s
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> StateT s X a)
-> X (a, s)
repeatableSt s
iSt = forall (m :: * -> *) a b.
(MonadIO m, Monoid a) =>
(m a -> X b)
-> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> X b
repeatableM (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` s
iSt)

-- | A more general variant of 'repeatable' with an arbitrary monadic handler,
--   accumulating a monoidal return value throughout the events.
repeatableM
  :: (MonadIO m, Monoid a)
  => (m a -> X b)                 -- ^ How to run the monad in 'X'.
  -> [KeySym]                     -- ^ The list of 'KeySym's under the
                                  --   modifiers used to invoke the action.
  -> KeySym                       -- ^ The keypress that invokes the action.
  -> (EventType -> KeySym -> m a) -- ^ The keypress handler.
  -> X b
repeatableM :: forall (m :: * -> *) a b.
(MonadIO m, Monoid a) =>
(m a -> X b)
-> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> X b
repeatableM m a -> X b
run [KeySym]
mods KeySym
key EventType -> KeySym -> m a
handler = forall (m :: * -> *) a b e.
(MonadIO m, Monoid a) =>
(m a -> X b)
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> IO (Either NotOurEvent e))
-> (e -> m (Either Done a))
-> X b
concludableM m a -> X b
run [KeySym]
mods KeySym
key forall {f :: * -> *} {a} {b} {a}.
Applicative f =>
a -> b -> f (Either a (a, b))
press forall {a}. (EventType, KeySym) -> m (Either a a)
event
 where
  press :: a -> b -> f (Either a (a, b))
press a
t b
s = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (a
t, b
s))
  event :: (EventType, KeySym) -> m (Either a a)
event (EventType
t, KeySym
s) = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventType -> KeySym -> m a
handler EventType
t KeySym
s


data Done        = Done
data NotOurEvent = NotOurEvent

-- | A generalisation of `repeatable` which may conclude early with `NotOurEvent` or `Done`.
concludable
  :: [KeySym]
  -- ^ The list of 'KeySym's under the modifiers used to invoke the action.
  -> KeySym
  -- ^ The keypress that invokes the action.
  -> (EventType -> KeySym -> IO (Either NotOurEvent e))
  -- ^ Handle keypresses by translating them into custom events.
  --   If the function produces `NotOurEvent` then we conclude and put the
  --   X `Event` back into the queue.
  -> (e -> X (Either Done ()))
  -- ^ The custom event handler.
  -> X ()
concludable :: forall e.
[KeySym]
-> KeySym
-> (EventType -> KeySym -> IO (Either NotOurEvent e))
-> (e -> X (Either Done ()))
-> X ()
concludable = forall (m :: * -> *) a b e.
(MonadIO m, Monoid a) =>
(m a -> X b)
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> IO (Either NotOurEvent e))
-> (e -> m (Either Done a))
-> X b
concludableM forall a. a -> a
id

-- | A more general variant of 'concludable' with a stateful handler,
--   accumulating a monoidal return value throughout the events.
concludableSt
  :: Monoid a
  => s
  -- ^ Initial state.
  -> [KeySym]
  -- ^ The list of 'KeySym's under the modifiers used to invoke the action.
  -> KeySym
  -- ^ The keypress that invokes the action.
  -> (EventType -> KeySym -> IO (Either NotOurEvent e))
  -- ^ Handle keypresses by translating them into custom events.
  --   If the function produces `NotOurEvent` then we conclude and put the
  --   X `Event` back into the queue.
  -> (e -> StateT s X (Either Done a))
  -- ^ The custom event handler.
  -> X (a, s)
concludableSt :: forall a s e.
Monoid a =>
s
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> IO (Either NotOurEvent e))
-> (e -> StateT s X (Either Done a))
-> X (a, s)
concludableSt s
iSt = forall (m :: * -> *) a b e.
(MonadIO m, Monoid a) =>
(m a -> X b)
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> IO (Either NotOurEvent e))
-> (e -> m (Either Done a))
-> X b
concludableM (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` s
iSt)

-- | A more general variant of 'concludable' with an arbitrary monadic handler,
--   accumulating a monoidal return value throughout the events.
concludableM
  :: (MonadIO m, Monoid a)
  => (m a -> X b)
  -- ^ How to run the monad in 'X'.
  -> [KeySym]
  -- ^ The list of 'KeySym's under the modifiers used to invoke the action.
  -> KeySym
  -- ^ The keypress that invokes the action.
  -> (EventType -> KeySym -> IO (Either NotOurEvent e))
  -- ^ Handle keypresses by translating them into custom events.
  --   If the function produces `NotOurEvent` then we conclude and put the
  --   X `Event` back into the queue.
  -> (e -> m (Either Done a))
  -- ^ The custom event handler.
  -> X b
concludableM :: forall (m :: * -> *) a b e.
(MonadIO m, Monoid a) =>
(m a -> X b)
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> IO (Either NotOurEvent e))
-> (e -> m (Either Done a))
-> X b
concludableM m a -> X b
run [KeySym]
mods KeySym
key EventType -> KeySym -> IO (Either NotOurEvent e)
pressHandler e -> m (Either Done a)
eventHandler = do
  XConf{ theRoot :: XConf -> KeySym
theRoot = KeySym
root, display :: XConf -> Display
display = Display
d } <- forall r (m :: * -> *). MonadReader r m => m r
ask
  m a -> X b
run (forall (m :: * -> *) a e.
(MonadIO m, Monoid a) =>
Display
-> KeySym
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> IO (Either NotOurEvent e))
-> (e -> m (Either Done a))
-> m a
concludableRaw Display
d KeySym
root [KeySym]
mods KeySym
key EventType -> KeySym -> IO (Either NotOurEvent e)
pressHandler e -> m (Either Done a)
eventHandler)

concludableRaw
  :: (MonadIO m, Monoid a)
  => Display -> Window
  -> [KeySym] -> KeySym
  -> (EventType -> KeySym -> IO (Either NotOurEvent e))
  -> (e -> m (Either Done a))
  -> m a
concludableRaw :: forall (m :: * -> *) a e.
(MonadIO m, Monoid a) =>
Display
-> KeySym
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> IO (Either NotOurEvent e))
-> (e -> m (Either Done a))
-> m a
concludableRaw Display
d KeySym
root [KeySym]
mods KeySym
key EventType -> KeySym -> IO (Either NotOurEvent e)
pressHandler e -> m (Either Done a)
eventHandler = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display
-> KeySym -> Bool -> GrabMode -> GrabMode -> KeySym -> IO GrabMode
grabKeyboard Display
d KeySym
root Bool
False GrabMode
grabModeAsync GrabMode
grabModeAsync KeySym
currentTime)
  Maybe e
mev <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall {a}. IO a -> EventType -> KeySym -> IO (Maybe e)
pressHandler' (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) EventType
keyPress KeySym
key)
  a
x   <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty) (a -> e -> m a
eventHandler' forall a. Monoid a => a
mempty) Maybe e
mev
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> KeySym -> IO ()
ungrabKeyboard Display
d KeySym
currentTime)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
 where
  pressHandler' :: IO a -> EventType -> KeySym -> IO (Maybe e)
pressHandler' IO a
putBack EventType
t KeySym
s
    | EventType
t forall a. Eq a => a -> a -> Bool
== EventType
keyRelease Bool -> Bool -> Bool
&& KeySym
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeySym]
mods = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    | Bool
otherwise                        = EventType -> KeySym -> IO (Either NotOurEvent e)
pressHandler EventType
t KeySym
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left NotOurEvent
NotOurEvent -> IO a
putBack forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Maybe a
Nothing
      Right e
ev         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just e
ev)
  eventHandler' :: a -> e -> m a
eventHandler' !a
x e
ev = do
    Either Done a
c <- e -> m (Either Done a)
eventHandler e
ev
    case Either Done a
c of
      Left  Done
Done -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
      Right a
y    -> do
        Maybe e
mev <- m (Maybe e)
getNextEvent
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
xy) (a -> e -> m a
eventHandler' a
xy) Maybe e
mev
       where xy :: a
xy = a
x forall a. Semigroup a => a -> a -> a
<> a
y
  getNextEvent :: m (Maybe e)
getNextEvent = (forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent) \XEventPtr
p -> do
    Display -> KeySym -> XEventPtr -> IO ()
maskEvent Display
d (KeySym
keyPressMask forall a. Bits a => a -> a -> a
.|. KeySym
keyReleaseMask) XEventPtr
p
    KeyEvent{ ev_event_type :: Event -> EventType
ev_event_type = EventType
t, ev_keycode :: Event -> KeyCode
ev_keycode = KeyCode
c } <- XEventPtr -> IO Event
getEvent XEventPtr
p
    KeySym
s <- Display -> KeyCode -> GrabMode -> IO KeySym
keycodeToKeysym Display
d KeyCode
c GrabMode
0
    forall {a}. IO a -> EventType -> KeySym -> IO (Maybe e)
pressHandler' (Display -> XEventPtr -> IO ()
putBackEvent Display
d XEventPtr
p) EventType
t KeySym
s