Add some documentation to Dsl2.hs

1 files changed, 99 insertions, 34 deletions

diff --git a/src/Rahm/Desktop/Keys/Dsl2.hs b/src/Rahm/Desktop/Keys/Dsl2.hs
index b59152e..bfa8b05 100644
--- a/src/Rahm/Desktop/Keys/Dsl2.hs
+++ b/src/Rahm/Desktop/Keys/Dsl2.hs
@@ -1,3 +1,23 @@
+-- | This module creates a DSL for binding keys in a succinct and expressive
+-- way. This DSL follows the pattern:
+--
+-- bind <key> $ do
+--    <mask> $ <doc string $?> binding
+--    <mask> $ <doc string $?> binding
+--    <mask> $ <doc string $?> binding
+--
+-- for example:
+--
+-- bind xK_x $ do
+--   justMod $ doc "Kill the current window" (withFocused X.kill)
+--   shiftMod $ doc "Restart xmonad" restart
+--
+-- bind xK_v $ do
+--   justMod $
+--     continuous $ do
+--       bind xK_plus $ doc "increase volume" increaseVolume
+--       bind xK_minus $ doc "decrease volume" decreaseVolume
+
 module Rahm.Desktop.Keys.Dsl2 where
 
 import Control.Monad.Fix (fix)
@@ -20,43 +40,63 @@ import Rahm.Desktop.XMobarLog (spawnXMobar)
 import Rahm.Desktop.XMobarLog.PendingBuffer (pushAddPendingBuffer, pushPendingBuffer)
 import XMonad
 
+-- | A documented "thing." It is essentially an item with a string attached to
+-- it. A glorified tuple (String, t)
 data Documented t = Documented
   { docString :: String,
     undocument :: t
   }
 
+-- | The Documented type is a functor.
+instance Functor Documented where
+  fmap fn (Documented s t) = Documented s (fn t)
+
+-- | Type family for an action associated with a type. This type family
+-- indicates what type of action a keytype can be bound to.
 type family Action t where
+-- KeySyms are bound to contextless actions with type X ()
   Action KeySym = X ()
+-- Buttons are associated with actions with type Window -> X (). In other
+-- words, actions bound to a button have windows associated with it.
   Action Button = Window -> X ()
-  Action () = ()
 
+-- | An GADT for XConfig that hides the 'l' parameter. This keeps type
+-- signatures clean by not having to carry around a superfluous type variable.
 data XConfigH where
   XConfigH :: forall l. XConfig l -> XConfigH
 
+-- | A type for binding. These are the type of bindings keys and buttons can be
+-- bound to The type 't' refers to the key-type of the binding: either `KeySym`
+-- or `Button`.
 data Binding t
-  = Action (Action t)
-  | Submap (forall l. XConfig l -> BindingsMap)
-  | Repeat (Binding t) (forall l. XConfig l -> BindingsMap)
-  | NoBinding
-
+  = -- | Just an action. When this key is pressed, just do some action.
+    -- This uses the type-family defined above to determine what type the action
+    -- should be.
+    Action (Action t)
+  | -- | Sub-bindings. These bindings require another key to resolve.
+    Submap (forall l. XConfig l -> BindingsMap)
+  | -- | Like submap, but these bindings are repeatable. This operates as a
+    -- self-loop in the keybinding graph.
+    Repeat (Binding t) (forall l. XConfig l -> BindingsMap)
+  | -- | No action bound to the key.
+    NoBinding
+
+-- | Compiled bindings map. This is the type built up by the Binder monad.
 data BindingsMap = BindingsMap
-  { key_bindings :: Map (KeyMask, KeySym) (Documented (Binding KeySym)),
+  { -- | Bindings for keys
+    key_bindings :: Map (KeyMask, KeySym) (Documented (Binding KeySym)),
+    -- | Bindings for buttons.
     button_bindings :: Map (KeyMask, Button) (Documented (Binding Button)),
+    -- | If no mapping for a key sym exists, this function is called to handle
+    -- the no match key.
     no_match_catch_key :: (KeyMask, KeySym, String) -> X (),
+    -- | If no mapping for a button exists, this function is called to handle
+    -- the unbound button.
     no_match_catch_button :: (KeyMask, Button) -> Window -> X ()
   }
 
-newtype MaskBinder k a = MaskBinder
-  { unMaskBinder :: WriterT (Map KeyMask (Documented (Binding k))) (Reader XConfigH) a
-  }
-  deriving
-    ( Functor,
-      Applicative,
-      Monad,
-      MonadWriter (Map KeyMask (Documented (Binding k))),
-      MonadReader XConfigH
-    )
-
+-- | BindingMaps are combined by combining the bindings map and combining the
+-- handling functio
 instance Semigroup BindingsMap where
   (BindingsMap mk1 mb1 fk1 fb1) <> (BindingsMap mk2 mb2 fk2 fb2) =
     BindingsMap
@@ -68,53 +108,64 @@ instance Semigroup BindingsMap where
 instance Monoid BindingsMap where
   mempty = BindingsMap mempty mempty (\_ -> return ()) (\_ _ -> return ())
 
-newtype Binder a = Binder (WriterT BindingsMap (Reader XConfigH) a)
-  deriving (Functor, Applicative, Monad, MonadWriter BindingsMap, MonadReader XConfigH)
-
-bindOtherKeys :: ((KeyMask, KeySym, String) -> X ()) -> Binder ()
-bindOtherKeys fn = Binder $ tell (mempty {no_match_catch_key = fn})
-
-bindOtherButtons :: ((KeyMask, Button) -> Window -> X ()) -> Binder ()
-bindOtherButtons fn = Binder $ tell (mempty {no_match_catch_button = fn})
-
-class Documentable a b where
-  toDocumented :: a -> b
 
-instance Documentable (Documented a) (Documented a) where
-  toDocumented = id
+-- | This type is an intermediate monad in the DSL. It binds an action to a key
+-- mask. This is all bound to a key or button in the Binder monad.
+newtype MaskBinder k a = MaskBinder
+  { unMaskBinder :: WriterT (Map KeyMask (Documented (Binding k))) (Reader XConfigH) a
+  }
+  deriving
+    ( Functor,
+      Applicative,
+      Monad,
+      MonadWriter (Map KeyMask (Documented (Binding k))),
+      MonadReader XConfigH
+    )
 
-instance Documentable a (Documented a) where
-  toDocumented = Documented ""
+-- | The ultimate monad for this DSL. This Binder monad builds up a BindingsMap
+newtype Binder a = Binder (WriterT BindingsMap (Reader XConfigH) a)
+  deriving (Functor, Applicative, Monad, MonadWriter BindingsMap, MonadReader XConfigH)
 
+-- | This typeclas esentiallly defines what types can be bound in the DSL. I.e.
+-- what types are allowed to be arguments to the xMod, rawMask, etc. functions.
 class BindingType a where
+  -- | What key this action belongs to.
   type BoundTo a :: *
-
+  -- | Convert the action into a Documented binding
   toBinding :: a -> Documented (Binding (BoundTo a))
 
+-- | Bindings are trivially a BindingType. 
 instance BindingType (Binding t) where
   type BoundTo (Binding t) = t
   toBinding = Documented ""
 
+-- | An X () can be bound to a Binding KeySym
 instance BindingType (X ()) where
   type BoundTo (X ()) = KeySym
   toBinding = Documented "" . Action
 
+-- | A Window -> X () can be bound to a Binding Button.
 instance BindingType (Window -> X ()) where
   type BoundTo (Window -> X ()) = Button
   toBinding = Documented "" . Action
 
+-- | Any Documented BindingType is also a BindingType.
 instance (BindingType a) => BindingType (Documented a) where
   type BoundTo (Documented a) = BoundTo a
   toBinding (Documented s (toBinding -> (Documented _ a))) = Documented s a
 
+-- | This typeclass is responsible for converting a compiled MaskBinder into a
+-- BindingsMap using a key type 'k'.
 class Bind k where
   doBinding :: k -> Map KeyMask (Documented (Binding k)) -> BindingsMap
   rawMaskRaw :: KeyMask -> Documented (Binding k) -> MaskBinder k ()
 
+-- | For this, it adds the bindings to the buttonMap
 instance Bind Button where
   doBinding but mp = mempty {button_bindings = Map.mapKeys (,but) mp}
   rawMaskRaw mask act = tell (Map.singleton mask act)
 
+-- | For this, it adds the bindings to the keysMap
 instance Bind KeySym where
   doBinding key mp = mempty {key_bindings = Map.mapKeys (,key) mp}
   rawMaskRaw mask act = tell (Map.singleton mask act)
@@ -127,6 +178,7 @@ withMod m act = do
   (XConfigH (modMask -> mm)) <- ask
   rawMask (mm .|. m) act
 
+-- | Mask bindings.
 noMod, justMod, shiftMod, controlMod, altMod :: (Bind (BoundTo a), BindingType a) => a -> MaskBinder (BoundTo a) ()
 justMod = withMod 0
 noMod = rawMask 0
@@ -134,6 +186,7 @@ shiftMod = withMod shiftMask
 controlMod = withMod controlMask
 altMod = withMod mod1Mask
 
+-- | allows easy assigning multiple masks to the same action.
 (-|-) ::
   (Bind (BoundTo a), BindingType a) =>
   (a -> MaskBinder (BoundTo a) ()) ->
@@ -142,19 +195,24 @@ altMod = withMod mod1Mask
   MaskBinder (BoundTo a) ()
 m1 -|- m2 = \act -> m1 act >> m2 act
 
+-- | Bind a key to a maksBinder.
 bind :: (Bind k) => k -> MaskBinder k () -> Binder ()
 bind k h =
   tell . doBinding k . runReader (execWriterT $ unMaskBinder h) =<< ask
 
+-- | Bind multiple keys to the same mask binder.
 bindL :: (Bind k) => [k] -> MaskBinder k () -> Binder ()
 bindL ks h = mapM_ (`bind` h) ks
 
+-- | Convenience function for Documented.
 doc :: String -> a -> Documented a
 doc = Documented
 
+-- | A concrete-typed version of 'const'
 noWindow :: X () -> Window -> X ()
 noWindow fn _ = fn
 
+-- | Turn a BindingsMap into two values usable values for the XMonad config.
 resolveBindings ::
   BindingsMap ->
   ( XConfig l -> Map (KeyMask, KeySym) (X ()),
@@ -223,6 +281,7 @@ resolveBindings (BindingsMap keyBindings buttonBindings _ _) =
         pushAddPendingBuffer (str ++ " ") $
           fn ev
 
+-- Create a submap in place of an action.
 subbind :: Binder () -> Binding t
 subbind (Binder b) =
   Submap $ \config ->
@@ -321,3 +380,9 @@ documentation conf binder =
       14 -> "Index Forward"
       15 -> "Index Back"
       b -> "Button " ++ show b
+
+bindOtherKeys :: ((KeyMask, KeySym, String) -> X ()) -> Binder ()
+bindOtherKeys fn = Binder $ tell (mempty {no_match_catch_key = fn})
+
+bindOtherButtons :: ((KeyMask, Button) -> Window -> X ()) -> Binder ()
+bindOtherButtons fn = Binder $ tell (mempty {no_match_catch_button = fn})