{-# 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 (X () -> LastAction) -> X () -> LastAction
forall a b. (a -> b) -> a -> b
$ () -> X ()
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 = X () -> X (Maybe ())
forall a. X a -> X (Maybe a)
userCode X ()
x X (Maybe ()) -> (Maybe () -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Maybe ()
Nothing -> () -> X ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Just () -> LastAction -> X ()
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' = ((a, X ()) -> (a, X ())) -> [(a, X ())] -> [(a, X ())]
forall a b. (a -> b) -> [a] -> [b]
map ((X () -> X ()) -> (a, X ()) -> (a, X ())
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) (a, X ()) -> [(a, X ())] -> [(a, X ())]
forall a. a -> [a] -> [a]
: [(a, X ())] -> [(a, X ())]
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 = X LastAction
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get X LastAction -> (LastAction -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LastAction -> X ()
runLastAction