Merge pull request #401 from elkowar/cycle-action

Add new module XMonad.Util.ActionCycle

CHANGES.md

@@ -46,6 +46,12 @@
 
 ### New Modules
 
+  * `XMonad.Util.ActionCycle`
+
+    A module providing a simple way to implement "cycling" `X` actions,
+    useful for things like alternating toggle-style keybindings.
+
+
   * `XMonad.Actions.RotateSome`
 
     Functions for rotating some elements around the stack while keeping others

XMonad/Doc/Extending.hs

@@ -1117,6 +1117,10 @@ external utilities.
 
 A non complete list with a brief description:
 
+* "XMonad.Util.ActionCycle":
+    Provides a way to implement cycling actions. This can be used to implement
+    things like alternating, toggle-style keybindings.
+
 * "XMonad.Util.ClickableWorkspaces":
     Provides clickablePP, which when applied to the PP pretty-printer used by
     'XMonad.Hooks.DynamicLog.dynamicLogWithPP', will make the workspace tags

XMonad/Util/ActionCycle.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.ActionCycle
+-- Copyright   :  (c) 2020 Leon Kowarschick
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Leon Kowarschick. <thereal.elkowar@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This module provides a way to have "cycling" actions.
+-- This means that you can define an @X ()@ action that cycles through a list of actions,
+-- advancing every time it is executed.
+-- This may for exapmle be useful for toggle-style keybindings.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.ActionCycle
+  ( -- * Usage
+    -- $usage
+    cycleAction
+  , cycleActionWithResult
+  )
+where
+import Prelude hiding ((!!))
+import Data.Map.Strict as M
+import XMonad
+import qualified XMonad.Util.ExtensibleState as XS
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.List.NonEmpty ((!!), NonEmpty((:|)))
+
+
+-- $usage
+-- You can use this module to implement cycling key-bindings by importing 'XMonad.Util.ActionCycle'
+--
+-- > import XMonad.Util.ActionCycle
+--
+-- and then creating a keybinding as follows:
+--
+-- > ((mod1Mask, xK_t), cycleAction "cycleActions" [ spawn "commmand1", spawn "command2", spawn "command3" ])
+--
+-- Note that the name given to cycleAction must be a unique action per cycle.
+
+
+-- | Generate an @X ()@ action that cycles through a list of actions,
+-- advancing every time the action is called.
+cycleAction
+  :: String -- ^ Unique name for this action. May be any arbitrary, unique string.
+  -> [X ()] -- ^ List of actions that will be cycled through.
+  -> X ()
+cycleAction _ [] = pure ()
+cycleAction name (x:xs) = cycleActionWithResult name (x :| xs)
+
+-- | Another version of 'cycleAction' that returns the result of the actions.
+-- To allow for this, we must make sure that the list of actions is non-empty.
+cycleActionWithResult
+  :: String                   -- ^ Unique name for this action. May be any arbitrary, unique string.
+  -> NonEmpty.NonEmpty (X a)  -- ^ Non-empty List of actions that will be cycled through.
+  -> X a
+cycleActionWithResult name actions = do
+  cycleState <- XS.gets (getActionCycle name)
+  idx <- case cycleState of
+    Just x -> do
+      XS.modify (nextActionCycle name (NonEmpty.length actions))
+      pure x
+    Nothing -> do
+      XS.modify (setActionCycle name 1)
+      pure 0
+  actions !! idx
+
+
+newtype ActionCycleState = ActionCycleState (M.Map String Int) deriving (Typeable)
+
+instance ExtensionClass ActionCycleState where
+  initialValue = ActionCycleState mempty
+
+getActionCycle :: String -> ActionCycleState -> Maybe Int
+getActionCycle name (ActionCycleState s) = M.lookup name s
+
+nextActionCycle :: String -> Int -> ActionCycleState -> ActionCycleState
+nextActionCycle name maxNum (ActionCycleState s) = ActionCycleState $ M.update (\n -> Just $ (n + 1) `mod` maxNum) name s
+
+setActionCycle :: String -> Int -> ActionCycleState -> ActionCycleState
+setActionCycle name n (ActionCycleState s) = ActionCycleState $ M.insert name n s

xmonad-contrib.cabal

@@ -325,6 +325,7 @@ library
                         XMonad.Prompt.Workspace
                         XMonad.Prompt.XMonad
                         XMonad.Prompt.Zsh
+                        XMonad.Util.ActionCycle
                         XMonad.Util.ClickableWorkspaces
                         XMonad.Util.Cursor
                         XMonad.Util.CustomKeys