From 45708cf4c2bf0f766114f30a934e30f63fd80834 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 30 Mar 2022 17:12:52 -0600
Subject: Starting new branch to experimentally add documentation to
 KeyBindings.

The hope is to get to a point where documentation can be automatically
generated for key bindings, while keeping as much of the existing
DSL unchanged as possible.

The goal is to have something like:

bind xK_h $ do

  doc "Set focus to the next window in the stack"
  justMod nextWindow

  doc "Swap this window with the next window in the stack."
  shiftMod shiftNextWindow

Then "theoretically" a markdown/latex/text file can be generated with
documentation for each of those bindings and have the documentation
automatically update if the keys change.
---
 src/Internal/KeysM.hs | 179 ++++++++++++++++++++++++++++----------------------
 1 file changed, 101 insertions(+), 78 deletions(-)

(limited to 'src/Internal/KeysM.hs')

diff --git a/src/Internal/KeysM.hs b/src/Internal/KeysM.hs
index f834796..b394552 100644
--- a/src/Internal/KeysM.hs
+++ b/src/Internal/KeysM.hs
@@ -9,11 +9,17 @@ import XMonad
 import Data.Map (Map)
 import qualified Data.Map as Map
 
+data KeyBinding =  Action (X ()) | Submap KeyBindings
+type KeyBindings = Map (KeyMask, KeySym) KeyBinding
+
+type ButtonBinding = Window -> X ()
+type ButtonBindings = Map (KeyMask, Button) ButtonBinding
+
 {- Module that defines a DSL for binding keys. -}
-newtype KeysM l a = KeysM (State (XConfig l, Map (KeyMask, KeySym) (X ())) a)
+newtype KeysM l a = KeysM (State (XConfig l, KeyBindings) a)
   deriving (Functor, Applicative, Monad)
 
-newtype ButtonsM l a = ButtonsM (State (XConfig l, Map (KeyMask, Button) (Window -> X ())) a)
+newtype ButtonsM l a = ButtonsM (State (XConfig l, ButtonBindings) a)
   deriving (Functor, Applicative, Monad)
 
 newtype BindingBuilder b a = BindingBuilder (State (KeyMask, [(KeyMask, b)]) a)
@@ -28,11 +34,30 @@ class Bindable k where
 
   bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l ()
 
-runKeys :: KeysM l a -> XConfig l -> Map (KeyMask, KeySym) (X ())
+class Binding k b where
+  rawMask :: KeyMask -> k -> BindingBuilder b ()
+
+instance Binding (X ()) KeyBinding where
+  rawMask m x = BindingBuilder $ modify' (second ((m, Action x):))
+
+instance Binding KeyBindings KeyBinding where
+  rawMask m x = BindingBuilder $ modify' (second ((m, Submap x):))
+
+instance Binding a a where
+  rawMask m x = BindingBuilder $ modify' (second ((m, x):))
+
+instance Semigroup (KeysM l ()) where
+  (<>) = mappend
+
+instance Monoid (KeysM l ()) where
+  mempty = return ()
+  mappend = (>>)
+
+runKeys :: KeysM l a -> XConfig l -> KeyBindings
 runKeys (KeysM stateM) config =
   snd $ execState stateM (config, Map.empty)
 
-runButtons :: ButtonsM l a -> XConfig l -> Map (KeyMask, Button) (Window -> X ())
+runButtons :: ButtonsM l a -> XConfig l -> ButtonBindings
 runButtons (ButtonsM stateM) config =
   snd $ execState stateM (config, Map.empty)
 
@@ -43,13 +68,10 @@ instance HasConfig ButtonsM where
   getConfig = fst <$> ButtonsM get
 
 {- Generally it is assumed that the mod key shoud be pressed, but not always. -}
-noMod :: f -> BindingBuilder f ()
+noMod :: (Binding k b) => k -> BindingBuilder b ()
 noMod = rawMask 0
 
-rawMask :: KeyMask -> f -> BindingBuilder f ()
-rawMask m x = BindingBuilder $ modify' (second ((m, x):))
-
-maskMod :: KeyMask -> f -> BindingBuilder f ()
+maskMod :: (Binding k b) => KeyMask -> k -> BindingBuilder b ()
 maskMod mask action = do
   modMask <- fst <$> BindingBuilder get
   rawMask (modMask .|. mask) action
@@ -66,11 +88,11 @@ altgrMask = mod2Mask
 superMask :: KeyMask
 superMask = mod4Mask
 
-justMod :: f -> BindingBuilder f ()
+justMod :: (Binding k b) => k -> BindingBuilder b ()
 justMod = maskMod 0
 
 instance Bindable KeySym where
-  type BindableValue KeySym = X ()
+  type BindableValue KeySym = KeyBinding
   type BindableMonad KeySym = KeysM
 
   -- bind :: KeySym -> BindingBuilder (X x) a -> KeysM l ()
@@ -82,7 +104,7 @@ instance Bindable KeySym where
       flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values))
 
 instance Bindable Button where
-  type BindableValue Button = Window -> X ()
+  type BindableValue Button = ButtonBinding
   type BindableMonad Button = ButtonsM
 
   -- bind :: KeySym -> BindingBuilder (Window -> X ()) a -> ButtonsM l ()
@@ -93,257 +115,258 @@ instance Bindable Button where
     ButtonsM $ modify' $ second $
       flip (<>) (Map.fromList (map (\(m, v) -> ((m, button), v)) values))
 
-shiftControlAltSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltSuperHyperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
 
-shiftControlAltSuperHyperMod :: f -> BindingBuilder f ()
+shiftControlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltSuperHyperMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. hyperMask)
 
-shiftControlAltSuperAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltSuperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. superMask .|. altgrMask)
 
-shiftControlAltSuperMod :: f -> BindingBuilder f ()
+shiftControlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltSuperMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. superMask)
 
-shiftControlAltHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltHyperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask .|. altgrMask)
 
-shiftControlAltHyperMod :: f -> BindingBuilder f ()
+shiftControlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltHyperMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. hyperMask)
 
-shiftControlAltAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltAltgrMod =
   maskMod (shiftMask .|. controlMask .|. altMask .|. altgrMask)
 
-shiftControlAltMod :: f -> BindingBuilder f ()
+shiftControlAltMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltMod =
   maskMod (shiftMask .|. controlMask .|. altMask)
 
-shiftControlSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlSuperHyperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask .|. altgrMask)
 
-shiftControlSuperHyperMod :: f -> BindingBuilder f ()
+shiftControlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlSuperHyperMod =
   maskMod (shiftMask .|. controlMask .|. superMask .|. hyperMask)
 
-shiftControlSuperAltgrMod :: f -> BindingBuilder f ()
+shiftControlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlSuperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. superMask .|. altgrMask)
 
-shiftControlSuperMod :: f -> BindingBuilder f ()
+shiftControlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlSuperMod =
   maskMod (shiftMask .|. controlMask .|. superMask)
 
-shiftControlHyperAltgrMod :: f -> BindingBuilder f ()
+shiftControlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlHyperAltgrMod =
   maskMod (shiftMask .|. controlMask .|. hyperMask .|. altgrMask)
 
-shiftControlHyperMod :: f -> BindingBuilder f ()
+shiftControlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlHyperMod =
   maskMod (shiftMask .|. controlMask .|. hyperMask)
 
-shiftControlAltgrMod :: f -> BindingBuilder f ()
+shiftControlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlAltgrMod =
   maskMod (shiftMask .|. controlMask .|. altgrMask)
 
-shiftControlMod :: f -> BindingBuilder f ()
+shiftControlMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftControlMod =
   maskMod (shiftMask .|. controlMask)
 
-shiftAltSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltSuperHyperAltgrMod =
   maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
 
-shiftAltSuperHyperMod :: f -> BindingBuilder f ()
+shiftAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltSuperHyperMod =
   maskMod (shiftMask .|. altMask .|. superMask .|. hyperMask)
 
-shiftAltSuperAltgrMod :: f -> BindingBuilder f ()
+shiftAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltSuperAltgrMod =
   maskMod (shiftMask .|. altMask .|. superMask .|. altgrMask)
 
-shiftAltSuperMod :: f -> BindingBuilder f ()
+shiftAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltSuperMod =
   maskMod (shiftMask .|. altMask .|. superMask)
 
-shiftAltHyperAltgrMod :: f -> BindingBuilder f ()
+shiftAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltHyperAltgrMod =
   maskMod (shiftMask .|. altMask .|. hyperMask .|. altgrMask)
 
-shiftAltHyperMod :: f -> BindingBuilder f ()
+shiftAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltHyperMod =
   maskMod (shiftMask .|. altMask .|. hyperMask)
 
-shiftAltAltgrMod :: f -> BindingBuilder f ()
+shiftAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltAltgrMod =
   maskMod (shiftMask .|. altMask .|. altgrMask)
 
-shiftAltMod :: f -> BindingBuilder f ()
+shiftAltMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltMod =
   maskMod (shiftMask .|. altMask)
 
-shiftSuperHyperAltgrMod :: f -> BindingBuilder f ()
+shiftSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftSuperHyperAltgrMod =
   maskMod (shiftMask .|. superMask .|. hyperMask .|. altgrMask)
 
-shiftSuperHyperMod :: f -> BindingBuilder f ()
+shiftSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftSuperHyperMod =
   maskMod (shiftMask .|. superMask .|. hyperMask)
 
-shiftSuperAltgrMod :: f -> BindingBuilder f ()
+shiftSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftSuperAltgrMod =
   maskMod (shiftMask .|. superMask .|. altgrMask)
 
-shiftSuperMod :: f -> BindingBuilder f ()
+shiftSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftSuperMod =
   maskMod (shiftMask .|. superMask)
 
-shiftHyperAltgrMod :: f -> BindingBuilder f ()
+shiftHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftHyperAltgrMod =
   maskMod (shiftMask .|. hyperMask .|. altgrMask)
 
-shiftHyperMod :: f -> BindingBuilder f ()
+shiftHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftHyperMod =
   maskMod (shiftMask .|. hyperMask)
 
-shiftAltgrMod :: f -> BindingBuilder f ()
+shiftAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftAltgrMod =
   maskMod (shiftMask .|. altgrMask)
 
-shiftMod :: f -> BindingBuilder f ()
+shiftMod :: (Binding k b) => k -> BindingBuilder b ()
 shiftMod = maskMod shiftMask
 
-controlAltSuperHyperAltgrMod :: f -> BindingBuilder f ()
+controlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltSuperHyperAltgrMod =
   maskMod (controlMask .|. altMask .|. superMask .|. hyperMask .|. altgrMask)
 
-controlAltSuperHyperMod :: f -> BindingBuilder f ()
+controlAltSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltSuperHyperMod =
   maskMod (controlMask .|. altMask .|. superMask .|. hyperMask)
 
-controlAltSuperAltgrMod :: f -> BindingBuilder f ()
+controlAltSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltSuperAltgrMod =
   maskMod (controlMask .|. altMask .|. superMask .|. altgrMask)
 
-controlAltSuperMod :: f -> BindingBuilder f ()
+controlAltSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltSuperMod =
   maskMod (controlMask .|. altMask .|. superMask)
 
-controlAltHyperAltgrMod :: f -> BindingBuilder f ()
+controlAltHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltHyperAltgrMod =
   maskMod (controlMask .|. altMask .|. hyperMask .|. altgrMask)
 
-controlAltHyperMod :: f -> BindingBuilder f ()
+controlAltHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltHyperMod =
   maskMod (controlMask .|. altMask .|. hyperMask)
 
-controlAltAltgrMod :: f -> BindingBuilder f ()
+controlAltAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltAltgrMod =
   maskMod (controlMask .|. altMask .|. altgrMask)
 
-controlAltMod :: f -> BindingBuilder f ()
+controlAltMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltMod =
   maskMod (controlMask .|. altMask)
 
-controlSuperHyperAltgrMod :: f -> BindingBuilder f ()
+controlSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlSuperHyperAltgrMod =
   maskMod (controlMask .|. superMask .|. hyperMask .|. altgrMask)
 
-controlSuperHyperMod :: f -> BindingBuilder f ()
+controlSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlSuperHyperMod =
   maskMod (controlMask .|. superMask .|. hyperMask)
 
-controlSuperAltgrMod :: f -> BindingBuilder f ()
+controlSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlSuperAltgrMod =
   maskMod (controlMask .|. superMask .|. altgrMask)
 
-controlSuperMod :: f -> BindingBuilder f ()
+controlSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlSuperMod =
   maskMod (controlMask .|. superMask)
 
-controlHyperAltgrMod :: f -> BindingBuilder f ()
+controlHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlHyperAltgrMod =
   maskMod (controlMask .|. hyperMask .|. altgrMask)
 
-controlHyperMod :: f -> BindingBuilder f ()
+controlHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 controlHyperMod =
   maskMod (controlMask .|. hyperMask)
 
-controlAltgrMod :: f -> BindingBuilder f ()
+controlAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 controlAltgrMod =
   maskMod (controlMask .|. altgrMask)
 
-controlMod :: f -> BindingBuilder f ()
+controlMod :: (Binding k b) => k -> BindingBuilder b ()
 controlMod = maskMod controlMask
 
-altSuperHyperAltgrMod :: f -> BindingBuilder f ()
+altSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 altSuperHyperAltgrMod =
   maskMod (altMask .|. superMask .|. hyperMask .|. altgrMask)
 
-altSuperHyperMod :: f -> BindingBuilder f ()
+altSuperHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 altSuperHyperMod =
   maskMod (altMask .|. superMask .|. hyperMask)
 
-altSuperAltgrMod :: f -> BindingBuilder f ()
+altSuperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 altSuperAltgrMod =
   maskMod (altMask .|. superMask .|. altgrMask)
 
-altSuperMod :: f -> BindingBuilder f ()
+altSuperMod :: (Binding k b) => k -> BindingBuilder b ()
 altSuperMod =
   maskMod (altMask .|. superMask)
 
-altHyperAltgrMod :: f -> BindingBuilder f ()
+altHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 altHyperAltgrMod =
   maskMod (altMask .|. hyperMask .|. altgrMask)
 
-altHyperMod :: f -> BindingBuilder f ()
+altHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 altHyperMod =
   maskMod (altMask .|. hyperMask)
 
-altAltgrMod :: f -> BindingBuilder f ()
+altAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 altAltgrMod =
   maskMod (altMask .|. altgrMask)
 
-altMod :: f -> BindingBuilder f ()
+altMod :: (Binding k b) => k -> BindingBuilder b ()
 altMod = maskMod altMask
 
-superHyperAltgrMod :: f -> BindingBuilder f ()
+superHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 superHyperAltgrMod =
   maskMod (superMask .|. hyperMask .|. altgrMask)
 
-superHyperMod :: f -> BindingBuilder f ()
+superHyperMod :: (Binding k b) => k -> BindingBuilder b ()
 superHyperMod =
   maskMod (superMask .|. hyperMask)
 
-superAltgrMod :: f -> BindingBuilder f ()
+superAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 superAltgrMod =
   maskMod (superMask .|. altgrMask)
 
-superMod :: f -> BindingBuilder f ()
+superMod :: (Binding k b) => k -> BindingBuilder b ()
 superMod = maskMod superMask
 
-hyperAltgrMod :: f -> BindingBuilder f ()
+hyperAltgrMod :: (Binding k b) => k -> BindingBuilder b ()
 hyperAltgrMod =
   maskMod (hyperMask .|. altgrMask)
 
-hyperMod :: f -> BindingBuilder f ()
+hyperMod :: (Binding k b) => k -> BindingBuilder b ()
 hyperMod = maskMod hyperMask
 
-altgrMod :: f -> BindingBuilder f ()
+altgrMod :: (Binding k b) => k -> BindingBuilder b ()
 altgrMod = maskMod altgrMask
 
 {- Can combine two or more of the functions above to apply the same action to
  - multiple masks. -}
-(-|-) :: (f -> BindingBuilder f ()) ->
-          (f -> BindingBuilder f ()) ->
-          f -> BindingBuilder f ()
+(-|-) :: (Binding k b) => 
+          (k -> BindingBuilder b ()) ->
+          (k -> BindingBuilder b ()) ->
+          k -> BindingBuilder b ()
 (-|-) fn1 fn2 f = fn1 f >> fn2 f
 
 {- Meant for submapping, binds all alphanumeric charactes to (fn c). -}
-- 
cgit