Merge pull request #766 from LSLeary/repeatable

Factor X.A.Cycle* modules; Write Alt+Tab style window switching

CHANGES.md

@@ -11,6 +11,11 @@
     - Deprecated the module in favour of the (new) exclusive scratchpad
       functionality of `XMonad.Util.NamedScratchpad`.
 
+  * `XMonad.Actions.CycleWorkspaceByScreen`
+
+    - The type of `repeatableAction` has changed, and it's deprecated in
+      favour of `X.A.Repeatable.repeatable`.
+
   * `XMonad.Hooks.DynamicProperty`
 
     - Deprecated the module in favour of the more aptly named
@@ -72,6 +77,22 @@
 
 ### New Modules
 
+  * `XMonad.Actions.MostRecentlyUsed`
+
+    - Tab through windows by recency of use. Based on the Alt+Tab behaviour
+      common outside of xmonad.
+
+  * `XMonad.Util.History`
+
+    - Track history in *O(log n)* time. Provides `History`, a variation on a
+      LIFO stack with a uniqueness property. In order to achieve the desired
+      asymptotics, the data type is implemented as an ordered Map.
+
+  * `XMonad.Actions.Repeatable`
+
+    - Actions you'd like to repeat. Factors out the shared logic of
+      `X.A.CycleRecentWS`, `X.A.CycleWorkspaceByScreen` and `X.A.CycleWindows`.
+
   * `XMonad.Hooks.OnPropertyChange`:
 
     - A new module replicating the functionality of

XMonad/Actions/CycleRecentWS.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE MultiWayIf #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.CycleRecentWS
@@ -35,11 +36,15 @@ module XMonad.Actions.CycleRecentWS (
 #endif
 ) where
 
+import XMonad.Actions.Repeatable (repeatableSt)
+
 import XMonad hiding (workspaces)
-import XMonad.StackSet hiding (filter)
+import XMonad.StackSet hiding (filter, modify)
 
 import Control.Arrow ((&&&))
 import Data.Function (on)
+import Data.Functor (void)
+import Control.Monad.State (lift, when)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
@@ -111,25 +116,15 @@ cycleWindowSets :: (WindowSet -> [WorkspaceId]) -- ^ A function used to create a
                 -> X ()
 cycleWindowSets genOptions mods keyNext keyPrev = do
   (options, unView') <- gets $ (genOptions &&& unView) . windowset
-  XConf {theRoot = root, display = d} <- ask
+  let
-  let event = allocaXEvent $ \p -> do
+    preview = do
-                maskEvent d (keyPressMask .|. keyReleaseMask) p
+      i <- get
-                KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
+      lift $ windows (view (options !! (i `mod` n)) . unView')
-                s <- keycodeToKeysym d c 0
+      where n = length options
-                return (t, s)
+  void . repeatableSt (-1) mods keyNext $ \t s -> when (t == keyPress) $ if
-  let setOption n = do windows $ view (options `cycref` n) . unView'
+    | s == keyNext -> modify succ >> preview
-                       (t, s) <- io event
+    | s == keyPrev -> modify pred >> preview
-                       case () of
+    | otherwise    -> pure ()
-                         () | t == keyPress   && s == keyNext  -> setOption (n+1)
-                            | t == keyPress   && s == keyPrev  -> setOption (n-1)
-                            | t == keyRelease && s `elem` mods -> return ()
-                            | otherwise                        -> setOption n
-  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
-  setOption 0
-  io $ ungrabKeyboard d currentTime
- where
-  cycref :: [a] -> Int -> a
-  cycref l i = l !! (i `mod` length l)
 
 -- | Given an old and a new 'WindowSet', which is __exactly__ one
 -- 'view' away from the old one, restore the workspace order of the

XMonad/Actions/CycleWindows.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ViewPatterns, MultiWayIf #-}
 
 --------------------------------------------------------------------------------
 -- |
@@ -59,8 +59,10 @@ import XMonad.Prelude
 import qualified XMonad.StackSet as W
 import qualified Data.List.NonEmpty as NE
 import XMonad.Actions.RotSlaves
+import XMonad.Actions.Repeatable (repeatableSt)
 
 import Control.Arrow (second)
+import Control.Monad.Trans (lift)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
@@ -139,27 +141,19 @@ cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite
                                     -> KeySym    -- ^ Key used to select a \"previous\" stack.
                                     -> X ()
 cycleStacks' filteredPerms mods keyNext keyPrev = do
-    XConf {theRoot = root, display = d} <- ask
+  stacks <- gets $ maybe [] filteredPerms
-    stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset
+                 . W.stack . W.workspace . W.current . windowset
-
+  let
-    let evt = allocaXEvent $
+    preview = do
-                  \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p
+      i <- get
-                           KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
+      lift . windows . W.modify' . const $ stacks !! (i `mod` n)
-                           s <- keycodeToKeysym d c 0
+      where n = length stacks
-                           return (t, s)
+  void $ repeatableSt 0 mods keyNext $ \t s -> if
-        choose n (t, s)
+    | t == keyPress && s == keyNext          -> modify succ
-              | t == keyPress   && s == keyNext  = io evt >>= choose (n+1)
+    | t == keyPress && s == keyPrev          -> modify pred
-              | t == keyPress   && s == keyPrev  = io evt >>= choose (n-1)
+    | t == keyPress && s `elem` [xK_0..xK_9] -> put (numKeyToN s)
-              | t == keyPress   && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s)
+    | otherwise                              -> preview
-              | t == keyRelease && s `elem` mods = return ()
+  where numKeyToN = subtract 48 . read . show
-              | otherwise                        = doStack n >> io evt >>= choose n
-        doStack n = windows . W.modify' . const $ stacks `cycref` n
-
-    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
-    io evt >>= choose 1
-    io $ ungrabKeyboard d currentTime
-  where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite
-        numKeyToN = subtract 48 . read . show
 
 -- | Given a stack element and a stack, shift or insert the element (window)
 --   at the currently focused position.

XMonad/Actions/CycleWorkspaceByScreen.hs

@@ -25,11 +25,10 @@ module XMonad.Actions.CycleWorkspaceByScreen (
 
 import           Data.IORef
 
-import           Graphics.X11.Xlib.Extras
-
 import           XMonad
 import           XMonad.Prelude
 import           XMonad.Hooks.WorkspaceHistory
+import           XMonad.Actions.Repeatable (repeatable)
 import qualified XMonad.StackSet as W
 
 -- $usage
@@ -53,22 +52,9 @@ import qualified XMonad.StackSet as W
 --
 -- > , ((mod4Mask, xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p)
 
-repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X ()
+{-# DEPRECATED repeatableAction "Use XMonad.Actions.Repeatable.repeatable" #-}
-repeatableAction mods pressHandler = do
+repeatableAction :: [KeySym] -> KeySym -> (EventType -> KeySym -> X ()) -> X ()
-  XConf {theRoot = root, display = d} <- ask
+repeatableAction = repeatable
-  let getNextEvent = io $ allocaXEvent $ \p ->
-                 do
-                   maskEvent d (keyPressMask .|. keyReleaseMask) p
-                   KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
-                   s <- io $ keycodeToKeysym d c 0
-                   return (t, s)
-      handleEvent (t, s)
-        | t == keyRelease && s `elem` mods = return ()
-        | otherwise = pressHandler t s >> getNextEvent >>= handleEvent
-
-  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
-  getNextEvent >>= handleEvent
-  io $ ungrabKeyboard d currentTime
 
 handleKeyEvent :: EventType
                -> KeySym
@@ -109,8 +95,7 @@ cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransacti
         return $ cycleWorkspaces !! current
       focusIncrement i = io (getAndIncrementWS i) >>= (windows . W.greedyView)
 
-  focusIncrement 1 -- Do the first workspace cycle
+  repeatable mods nextKey $
-  repeatableAction mods $
     runFirst
       [ handleKeyEvent keyPress nextKey $ focusIncrement 1
       , handleKeyEvent keyPress prevKey $ focusIncrement (-1)

XMonad/Actions/MostRecentlyUsed.hs

@@ -0,0 +1,227 @@
+{-# LANGUAGE NamedFieldPuns, GeneralizedNewtypeDeriving #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.MostRecentlyUsed
+-- Description :  Tab through windows by recency of use.
+-- Copyright   :  (c) 2022 L. S. Leary
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  @LSLeary (on github)
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Based on the Alt+Tab behaviour common outside of xmonad.
+--
+-----------------------------------------------------------------------------
+
+-- --< Imports & Exports >-- {{{
+
+module XMonad.Actions.MostRecentlyUsed (
+
+  -- * Usage
+  -- $usage
+
+  -- * Interface
+  configureMRU,
+  mostRecentlyUsed,
+  withMostRecentlyUsed,
+  Location(..),
+
+  ) where
+
+-- base
+import Data.Maybe (fromMaybe)
+import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
+import Data.Monoid (All(..), Any)
+import Data.Foldable (for_)
+import Data.Functor (($>))
+import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef)
+import Control.Applicative (liftA2)
+import Control.Monad (when, unless, join)
+import Control.Monad.IO.Class (MonadIO)
+
+-- mtl
+import Control.Monad.Trans (lift)
+import Control.Monad.State (get, put, gets)
+
+-- containers
+import qualified Data.Map.Strict as M
+
+-- xmonad
+import XMonad
+  ( Window, KeySym, keyPress, io
+  , Event (DestroyWindowEvent, UnmapEvent, ev_send_event, ev_window)
+  )
+import XMonad.Core
+  ( X, XConfig(..), windowset, WorkspaceId, ScreenId
+  , ExtensionClass(..), StateExtension(..)
+  , waitingUnmap
+  )
+import XMonad.Operations (screenWorkspace)
+import qualified XMonad.StackSet as W
+
+-- xmonad-contrib
+import qualified XMonad.Util.ExtensibleConf  as XC
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Util.PureX
+  (handlingRefresh, curScreenId, curTag, greedyView, view, peek, focusWindow)
+import XMonad.Util.History (History, origin, event, erase, ledger)
+import XMonad.Actions.Repeatable (repeatableSt)
+
+-- }}}
+
+-- --< Core Data Types: WindowHistory & Location >-- {{{
+
+data WindowHistory = WinHist
+  { busy :: !Bool
+  , hist :: !(History Window Location)
+  } deriving (Show, Read)
+
+instance ExtensionClass WindowHistory where
+  initialValue = WinHist
+    { busy = False
+    , hist = origin
+    }
+  extensionType = PersistentExtension
+
+data Location = Location
+  { workspace :: !WorkspaceId
+  , screen    :: !ScreenId
+  } deriving (Show, Read, Eq, Ord)
+
+-- }}}
+
+-- --< Interface >-- {{{
+
+-- $usage
+--
+-- 'configureMRU' must be applied to your config in order for 'mostRecentlyUsed'
+-- to work.
+--
+-- > main :: IO ()
+-- > main = xmonad . configureMRU . ... $ def
+-- >   { ...
+-- >   }
+--
+-- Once that's done, it can be used normally in keybinds:
+--
+-- > , ((mod1Mask, xK_Tab), mostRecentlyUsed [xK_Alt_L, xK_Alt_R] xK_Tab)
+--
+-- N.B.: This example assumes that 'mod1Mask' corresponds to alt, which is not
+-- always the case, depending on how your system is configured.
+
+-- | Configure xmonad to support 'mostRecentlyUsed'.
+configureMRU :: XConfig l -> XConfig l
+configureMRU = XC.once f (MRU ()) where
+  f cnf = cnf
+    { logHook         = logHook         cnf <> logWinHist
+    , handleEventHook = handleEventHook cnf <> winHistEH
+    }
+newtype MRU = MRU () deriving Semigroup
+
+-- | An action to browse through the history of focused windows, taking
+--   another step back with each tap of the key.
+mostRecentlyUsed
+  :: [KeySym] -- ^ The 'KeySym's corresponding to the modifier to which the
+              --   action is bound.
+  -> KeySym   -- ^ The 'KeySym' corresponding to the key to which the action
+              --   is bound.
+  -> X ()
+mostRecentlyUsed mods key = do
+  (toUndo, undo) <- undoer
+  let undoably curThing withThing thing = curThing >>= \cur ->
+        when (cur /= thing) $ withThing thing >> toUndo (withThing cur)
+  withMostRecentlyUsed mods key $ \win Location{workspace,screen} ->
+    handlingRefresh $ do
+      undo
+      undoably curScreenId viewScreen screen
+      undoably curTag      greedyView workspace
+      mi <- gets (W.findTag win . windowset)
+      for_ mi $ \i -> do
+        undoably curTag greedyView i
+        mfw <- peek
+        for_ mfw $ \fw -> do
+          undoably (pure fw) focusWindow win
+  where
+    undoer :: (MonadIO m, Monoid a) => m (m a -> m (), m a)
+    undoer = do
+      ref <- io . newIORef $ pure mempty
+      let toUndo = io . modifyIORef ref . liftA2 (<>)
+          undo   = join (io $ readIORef ref)
+                <* io (writeIORef ref $ pure mempty)
+      pure (toUndo, undo)
+    viewScreen :: ScreenId -> X Any
+    viewScreen scr = screenWorkspace scr >>= foldMap view
+
+-- | A version of 'mostRecentlyUsed' that allows you to customise exactly what
+--   is done with each window you tab through (the default being to visit its
+--   previous 'Location' and give it focus).
+withMostRecentlyUsed
+  :: [KeySym]                     -- ^ The 'KeySym's corresponding to the
+                                  --   modifier to which the action is bound.
+  -> KeySym                       -- ^ The 'KeySym' corresponding to the key to
+                                  --   which the action is bound.
+  -> (Window -> Location -> X ()) -- ^ The function applied to each window.
+  -> X ()
+withMostRecentlyUsed mods tab preview = do
+  wh@WinHist{busy,hist} <- XS.get
+  unless busy $ do
+    XS.put wh{ busy = True }
+
+    for_ (nonEmpty $ ledger hist) $ \ne -> do
+      mfw <- gets (W.peek . windowset)
+      let iSt = case cycleS ne of
+            (w, _) :~ s | mfw == Just w -> s
+            s                           -> s
+      repeatableSt iSt mods tab $ \t s ->
+        when (t == keyPress && s == tab) (pop >>= lift . uncurry preview)
+
+    XS.modify $ \ws@WinHist{} -> ws{ busy = False }
+    logWinHist
+  where
+    pop = do
+      h :~ t <- get
+      put t $> h
+
+-- }}}
+
+-- --< Raw Config >-- {{{
+
+logWinHist :: X ()
+logWinHist = do
+  wh@WinHist{busy,hist} <- XS.get
+  unless busy $ do
+    cs <- gets (W.current . windowset)
+    let cws = W.workspace cs
+    for_ (W.stack cws) $ \st -> do
+      let location = Location{ workspace = W.tag cws, screen = W.screen cs }
+      XS.put wh{ hist = event (W.focus st) location hist }
+
+winHistEH :: Event -> X All
+winHistEH ev = All True <$ case ev of
+  UnmapEvent{ ev_send_event = synth, ev_window = w } -> do
+    e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
+    when (synth || e == 0) (collect w)
+  DestroyWindowEvent{                ev_window = w } -> collect w
+  _                                                  -> pure ()
+  where collect w = XS.modify $ \wh@WinHist{hist} -> wh{ hist = erase w hist }
+
+-- }}}
+
+-- --< Auxiliary Data Type: Stream >-- {{{
+
+-- To satisfy the almighty exhaustivity checker.
+
+data Stream a = !a :~ Stream a
+infixr 5 :~
+
+(+~) :: [a] -> Stream a -> Stream a
+xs +~ s = foldr (:~) s xs
+infixr 5 +~
+
+cycleS :: NonEmpty a -> Stream a
+cycleS (x :| xs) = s where s = x :~ xs +~ s
+
+-- }}}
+

XMonad/Actions/Repeatable.hs

@@ -0,0 +1,89 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 = repeatableM 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 iSt = repeatableM $ \m -> runStateT m 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 run mods key pressHandler = do
+  XConf{ theRoot = root, display = d } <- ask
+  run (repeatableRaw d root mods key pressHandler)
+
+repeatableRaw
+  :: (MonadIO m, Monoid a)
+  => Display -> Window
+  -> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> m a
+repeatableRaw d root mods key pressHandler = do
+  io (grabKeyboard d root False grabModeAsync grabModeAsync currentTime)
+  handleEvent (keyPress, key) <* io (ungrabKeyboard d currentTime)
+  where
+    getNextEvent = io $ allocaXEvent $ \p -> do
+      maskEvent d (keyPressMask .|. keyReleaseMask) p
+      KeyEvent{ ev_event_type = t, ev_keycode = c } <- getEvent p
+      s <- keycodeToKeysym d c 0
+      return (t, s)
+    handleEvent (t, s)
+      | t == keyRelease && s `elem` mods = pure mempty
+      | otherwise = (<>) <$> pressHandler t s <*> (getNextEvent >>= handleEvent)

XMonad/Util/History.hs

@@ -0,0 +1,128 @@
+{-# LANGUAGE NamedFieldPuns, DeriveTraversable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.History
+-- Description :  Track history in /O(log n)/ time.
+-- Copyright   :  (c) 2022 L. S. Leary
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  @LSLeary (on github)
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides 'History', a variation on a LIFO stack with a uniqueness property.
+-- In order to achieve the desired asymptotics, the data type is implemented as
+-- an ordered Map.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.History (
+  History,
+  origin,
+  event,
+  erase,
+  recall,
+  ledger,
+  transcribe,
+  ) where
+
+-- base
+import Data.Function (on)
+import Text.Read
+  ( Read(readPrec, readListPrec), Lexeme(Ident)
+  , parens, prec, lexP, step, readListPrecDefault
+  )
+
+-- containers
+import Data.IntMap (IntMap)
+import qualified Data.IntMap.Strict as I
+import Data.Map (Map)
+import qualified Data.Map.Strict as M
+
+
+-- | A history of unique @k@-events with @a@-annotations.
+--
+--   @History k a@ can be considered a (LIFO) stack of @(k, a)@ values with the
+--   property that each @k@ is unique. From this point of view, 'event' pushes
+--   and 'ledger' pops/peeks all.
+--
+--   The naive implementation has /O(n)/ 'event' and 'erase' due to the
+--   uniqueness condition, but we can still use it as a denotation:
+--
+-- > mu :: History k a -> [(k, a)]
+--
+--   As an opaque data type with strict operations, @History k a@ values are all
+--   finite expressions in the core interface: 'origin', 'erase' and 'event'.
+--   Hence we define @mu@ by structural induction on these three cases.
+--
+data History k a = History
+  { annals   :: !(IntMap (k, a))
+  , recorded :: !(Map k Int)
+  } deriving (Functor, Foldable, Traversable)
+
+instance (Eq  k, Eq  a) => Eq  (History k a) where (==)    = (==)    `on` ledger
+instance (Ord k, Ord a) => Ord (History k a) where compare = compare `on` ledger
+
+instance (Show k, Show a) => Show (History k a) where
+  showsPrec d h
+    = showParen (d > app_prec)
+    $ showString "transcribe "
+    . showsPrec (app_prec+1) (ledger h)
+    where app_prec = 10
+
+instance (Read k, Read a, Ord k) => Read (History k a) where
+  readPrec = parens . prec app_prec $ do
+    Ident "transcribe" <- lexP
+    l <- step readPrec
+    pure (transcribe l)
+    where app_prec = 10
+  readListPrec = readListPrecDefault
+
+
+-- | /O(1)/. A history of nothing.
+--
+-- > mu origin := []
+--
+origin :: History k a
+origin = History I.empty M.empty
+
+-- | /O(log n)/. A new event makes history; its predecessor forgotten.
+--
+-- > mu (event k a h) := (k, a) : mu (erase k h)
+--
+event :: Ord k => k -> a -> History k a -> History k a
+event k a History{annals,recorded} = History
+  { annals   = I.insert ik (k, a) . maybe id I.delete mseen $ annals
+  , recorded = recorded'
+  }
+  where
+    ik = maybe 0 (\((i, _), _) -> pred i) (I.minViewWithKey annals)
+    (mseen, recorded') = M.insertLookupWithKey (\_ x _ -> x) k ik recorded
+
+-- | /O(log n)/. Erase an event from history.
+--
+-- > mu (erase k h) := filter ((k /=) . fst) (mu h)
+--
+erase :: Ord k => k -> History k a -> History k a
+erase k History{annals,recorded} = History
+  { annals   = maybe id I.delete mseen annals
+  , recorded = recorded'
+  }
+  where (mseen, recorded') = M.updateLookupWithKey (\_ _ -> Nothing) k recorded
+
+
+-- | /O(log n)/. Recall an event.
+recall :: Ord k => k -> History k a -> Maybe a
+recall k History{annals,recorded} = do
+  ik     <- M.lookup k recorded
+  (_, a) <- I.lookup ik annals
+  pure a
+
+-- | /O(n)/. Read history, starting with the modern day. @ledger@ is @mu@.
+ledger :: History k a -> [(k, a)]
+ledger = I.elems . annals
+
+-- | /O(n * log n)/. Transcribe a ledger.
+transcribe :: Ord k => [(k, a)] -> History k a
+transcribe = foldr (uncurry event) origin

xmonad-contrib.cabal

@@ -118,6 +118,7 @@ library
                         XMonad.Actions.LinkWorkspaces
                         XMonad.Actions.MessageFeedback
                         XMonad.Actions.Minimize
+                        XMonad.Actions.MostRecentlyUsed
                         XMonad.Actions.MouseGestures
                         XMonad.Actions.MouseResize
                         XMonad.Actions.Navigation2D
@@ -132,6 +133,7 @@ library
                         XMonad.Actions.Promote
                         XMonad.Actions.RandomBackground
                         XMonad.Actions.RepeatAction
+                        XMonad.Actions.Repeatable
                         XMonad.Actions.RotSlaves
                         XMonad.Actions.RotateSome
                         XMonad.Actions.Search
@@ -360,6 +362,7 @@ library
                         XMonad.Util.Font
                         XMonad.Util.Grab
                         XMonad.Util.Hacks
+                        XMonad.Util.History
                         XMonad.Util.Image
                         XMonad.Util.Invisible
                         XMonad.Util.Loggers
@@ -415,6 +418,7 @@ test-suite tests
                   XMonad.Actions.FocusNth
                   XMonad.Actions.GridSelect
                   XMonad.Actions.PhysicalScreens
+                  XMonad.Actions.Repeatable
                   XMonad.Actions.RotateSome
                   XMonad.Actions.Submap
                   XMonad.Actions.SwapWorkspaces