{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.ActionCycle
-- Description :  Provides a way to implement cycling actions.
-- 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 :: String -> [X ()] -> X ()
cycleAction String
_ [] = () -> X ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
cycleAction String
name (X ()
x:[X ()]
xs) = String -> NonEmpty (X ()) -> X ()
forall a. String -> NonEmpty (X a) -> X a
cycleActionWithResult String
name (X ()
x X () -> [X ()] -> NonEmpty (X ())
forall a. a -> [a] -> NonEmpty a
:| [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 :: String -> NonEmpty (X a) -> X a
cycleActionWithResult String
name NonEmpty (X a)
actions = do
  Maybe Int
cycleState <- (ActionCycleState -> Maybe Int) -> X (Maybe Int)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets (String -> ActionCycleState -> Maybe Int
getActionCycle String
name)
  Int
idx <- case Maybe Int
cycleState of
    Just Int
x -> do
      (ActionCycleState -> ActionCycleState) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (String -> Int -> ActionCycleState -> ActionCycleState
nextActionCycle String
name (NonEmpty (X a) -> Int
forall a. NonEmpty a -> Int
NonEmpty.length NonEmpty (X a)
actions))
      Int -> X Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
x
    Maybe Int
Nothing -> do
      (ActionCycleState -> ActionCycleState) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (String -> Int -> ActionCycleState -> ActionCycleState
setActionCycle String
name Int
1)
      Int -> X Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
  NonEmpty (X a)
actions NonEmpty (X a) -> Int -> X a
forall a. NonEmpty a -> Int -> a
!! Int
idx


newtype ActionCycleState = ActionCycleState (M.Map String Int)

instance ExtensionClass ActionCycleState where
  initialValue :: ActionCycleState
initialValue = Map String Int -> ActionCycleState
ActionCycleState Map String Int
forall a. Monoid a => a
mempty

getActionCycle :: String -> ActionCycleState -> Maybe Int
getActionCycle :: String -> ActionCycleState -> Maybe Int
getActionCycle String
name (ActionCycleState Map String Int
s) = String -> Map String Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name Map String Int
s

nextActionCycle :: String -> Int -> ActionCycleState -> ActionCycleState
nextActionCycle :: String -> Int -> ActionCycleState -> ActionCycleState
nextActionCycle String
name Int
maxNum (ActionCycleState Map String Int
s) = Map String Int -> ActionCycleState
ActionCycleState (Map String Int -> ActionCycleState)
-> Map String Int -> ActionCycleState
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe Int) -> String -> Map String Int -> Map String Int
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (\Int
n -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
maxNum) String
name Map String Int
s

setActionCycle :: String -> Int -> ActionCycleState -> ActionCycleState
setActionCycle :: String -> Int -> ActionCycleState -> ActionCycleState
setActionCycle String
name Int
n (ActionCycleState Map String Int
s) = Map String Int -> ActionCycleState
ActionCycleState (Map String Int -> ActionCycleState)
-> Map String Int -> ActionCycleState
forall a b. (a -> b) -> a -> b
$ String -> Int -> Map String Int -> Map String Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
name Int
n Map String Int
s