{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.RepeatAction -- Description : Repeat the last performed action. -- Copyright : (c) 2022 Martin Kozlovsky -- License : BSD3-style (see LICENSE) -- -- Maintainer : <kozlovsky.m7@gmail.com> -- Stability : unstable -- Portability : not portable -- -- Ability to repeat the last action. -- ----------------------------------------------------------------------------- module XMonad.Actions.RepeatAction ( -- * Usage -- $usage rememberAction, rememberActions, repeatLast, ) where import XMonad import qualified XMonad.Util.ExtensibleState as XS -- $usage -- -- You can use this module with the following in your @xmonad.hs@: -- -- > import XMonad.Actions.RepeatAction -- -- Then join a dedicated key to run the last action with the rest of your -- key bindings using the 'rememberActions': -- -- > rememberActions (modm, xK_period) [((modm, xK_c), kill), …] -- -- It can be also used in the same way for "XMonad.Util.EZConfig": -- -- > rememberActions "M-." [("M-c", kill), …] -- -- For example, if you use 'XMonad.Util.EZConfig.additionalKeysP', -- -- > main = xmonad $ … $ def -- > { -- > … -- > } -- > `additionalKeysP` myKeys -- -- you would adjust the call to 'XMonad.Util.EZConfig.additionalKeysP' -- like so: -- -- > `additionalKeysP` (rememberActions "M-." myKeys) -- -- For more detailed instructions on editing your key bindings, see -- <https://xmonad.org/TUTORIAL.html the tutorial>. newtype LastAction = LastAction { LastAction -> X () runLastAction :: X () } instance ExtensionClass LastAction where initialValue :: LastAction initialValue = X () -> LastAction LastAction forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a. Applicative f => a -> f a pure () -- | Transforms an action into an action that can be remembered and repeated. rememberAction :: X () -> X () rememberAction :: X () -> X () rememberAction X () x = forall a. X a -> X (Maybe a) userCode X () x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe () Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a pure () Just () -> forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m () XS.put (X () -> LastAction LastAction X () x) -- Only remember action if nothing went wrong. -- | Maps 'rememberAction' over a list of key bindings. rememberActions' :: [(a, X ())] -> [(a, X ())] rememberActions' :: forall a. [(a, X ())] -> [(a, X ())] rememberActions' = forall a b. (a -> b) -> [a] -> [b] map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap X () -> X () rememberAction) infixl 4 `rememberActions` -- | Maps 'rememberAction' over a list of key bindings and adds a dedicated -- key to repeat the last action. rememberActions :: a -> [(a, X ())] -> [(a, X ())] rememberActions :: forall a. a -> [(a, X ())] -> [(a, X ())] rememberActions a key [(a, X ())] keyList = (a key, X () repeatLast) forall a. a -> [a] -> [a] : forall a. [(a, X ())] -> [(a, X ())] rememberActions' [(a, X ())] keyList -- | Runs the last remembered action. -- / Be careful not to include this action in the remembered actions! / repeatLast :: X () repeatLast :: X () repeatLast = forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a XS.get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= LastAction -> X () runLastAction