-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.Repeatable
-- Description :  Actions you'd like to repeat.
-- Copyright   :  (c) 2022 L. S. Leary
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  @LSLeary (on github)
-- 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
  , repeatableSt
  , repeatableM
  ) where

-- 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 a b. (a -> b) -> a -> b
$ \StateT s X a
m -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s X a
m 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
pressHandler = 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.
(MonadIO m, Monoid a) =>
Display
-> KeySym
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> m a)
-> m a
repeatableRaw Display
d KeySym
root [KeySym]
mods KeySym
key EventType -> KeySym -> m a
pressHandler)

repeatableRaw
  :: (MonadIO m, Monoid a)
  => Display -> Window
  -> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> m a
repeatableRaw :: forall (m :: * -> *) a.
(MonadIO m, Monoid a) =>
Display
-> KeySym
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> m a)
-> m a
repeatableRaw Display
d KeySym
root [KeySym]
mods KeySym
key EventType -> KeySym -> m a
pressHandler = 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)
  (EventType, KeySym) -> m a
handleEvent (EventType
keyPress, KeySym
key) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> KeySym -> IO ()
ungrabKeyboard Display
d KeySym
currentTime)
  where
    getNextEvent :: m (EventType, KeySym)
getNextEvent = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \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 (m :: * -> *) a. Monad m => a -> m a
return (EventType
t, KeySym
s)
    handleEvent :: (EventType, KeySym) -> m a
handleEvent (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. Monoid a => a
mempty
      | Bool
otherwise = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventType -> KeySym -> m a
pressHandler EventType
t KeySym
s forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (m (EventType, KeySym)
getNextEvent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (EventType, KeySym) -> m a
handleEvent)