basic ability teo generate config

1 files changed, 125 insertions, 58 deletions

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 467ed24..88ec8cf 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -101,24 +101,35 @@ button14 = 14
 button15 :: Button
 button15 = 15
 
-resolveSubmaps :: (XConfig l -> KeyBindings) -> KeyMap l
-resolveSubmaps bindings config = (fmap $ \binding ->
-  case binding of
-    Action x -> x
-    Submap _ -> logs "") (bindings config)
-
-keymap :: KeyMap l
-keymap = resolveSubmaps $ runKeys $ do
+keyBindingToKeymap :: (XConfig l -> KeyBindings) -> KeyMap l
+keyBindingToKeymap bindings config = fmap bindingToX (bindings config)
+
+  where
+    bindingToX b =
+      case b of
+        Documented _ (Action x) -> x
+        Documented _ (Submap mapping) ->
+          submap (fmap bindingToX mapping)
+        Documented _ (Repeat mapping) ->
+          fix $ \recur ->
+            submap (fmap (\b -> bindingToX b >> recur) mapping)
+
+keymap :: XConfig l -> KeyBindings
+keymap = runKeys $ do
   config <- getConfig
 
-  let defaultKey key = fromMaybe (return ()) $ Map.lookup key (keymap config)
-      subkeys keysM = submapDefaultWithKey defaultKey $ (resolveSubmaps (runKeys keysM)) config
+  let subkeys keysM = Submap (runKeys keysM config)
+      repeatable keysM = Repeat (runKeys keysM config)
 
   bind xK_apostrophe $ do
-    justMod $ subkeys $ do
-      bind xK_apostrophe $
-        (noMod -|- justMod) jumpToLast
-      mapAlpha 0 jumpToMark
+    justMod $
+      doc "Jumps between marks." $
+      subkeys $ do
+        bind xK_apostrophe $
+          (noMod -|- justMod) $
+            doc "Jumps to the last window." $
+            jumpToLast
+        mapAlpha 0 jumpToMark
 
     shiftMod $ subkeys $ do
       bind xK_apostrophe $
@@ -150,6 +161,12 @@ keymap = resolveSubmaps $ runKeys $ do
     justMod $
       replicateM_ 10 $ withFocused (sendKey (shiftMask, xK_a))
 
+  bind xK_F7 $
+    
+    justMod $
+      doc "Print this documentation." $
+      logs (documentation (keymap config))
+
   bind xK_F10 $ do
     justMod playPause
 
@@ -195,57 +212,105 @@ keymap = resolveSubmaps $ runKeys $ do
     shiftMod $ sendMessage HFlipLayout
 
   bind xK_g $ do
-    justMod $ mapNextString $ \_ str ->
-      case str of
-        [ch] | isAlphaNum ch -> gotoWorkspace ch
-        [' '] -> gotoAccompaningWorkspace
-        _ -> return ()
-    shiftMod $ mapNextString $ \_ str ->
-      case str of
-        [ch] | isAlphaNum ch -> shiftToWorkspace ch
-        _ -> return ()
-    shiftAltMod $ mapNextString $ \_ str ->
-      case str of
-        [ch] | isAlphaNum ch -> swapWorkspace ch
-        _ -> return ()
+    justMod $
+      doc ("Go to a workspace. The next typed character is the workspace " ++
+          "must be alpha-numeric.") $
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> gotoWorkspace ch
+          [' '] -> gotoAccompaningWorkspace
+          _ -> return ()
+    shiftMod $
+      doc "Move the currently focused window to another workspace" $
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> shiftToWorkspace ch
+          _ -> return ()
+    shiftAltMod $
+      doc "Swap this workspace with another workspace (rename)." $
+      mapNextString $ \_ str ->
+        case str of
+          [ch] | isAlphaNum ch -> swapWorkspace ch
+          _ -> return ()
 
   bind xK_h $ do
-    justMod    $ windows W.focusDown
-    shiftMod   $ windows W.swapDown
-    controlMod rotAllDown
+    justMod $
+      doc "Focus on the next window down in the stack" $
+      windows W.focusDown
+
+    shiftMod $
+      doc "Swap the current window with the next one down in the stack" $
+      windows W.swapDown
+
+    controlMod $
+      doc "Rotate all the windows down the stack"
+      rotAllDown
 
   bind xK_j $ do
-    justMod $ sendMessage ShrinkZoom
+    justMod $
+      doc "Shrink the size of the zoom region" $
+      sendMessage ShrinkZoom
 
   bind xK_k $ do
-    justMod $ sendMessage ExpandZoom
+    justMod $
+      doc "Expand the size of the zoom region" $
+      sendMessage ExpandZoom
 
   bind xK_l $ do
-    justMod    $ windows W.focusUp
-    shiftMod   $ windows W.swapUp
-    controlMod rotAllUp
-    altMod     $ spawnX "xsecurelock"
+    justMod    $
+      doc "Focus the next window in the stack" $
+      windows W.focusUp
+
+    shiftMod   $
+      doc "Swap the currently focused window with the next window in the stack." $
+      windows W.swapUp
+
+    controlMod $
+      doc "Rotate the windows up."
+      rotAllUp
+
+    altMod $
+      doc "Lock the screen" $
+      spawnX "xsecurelock"
 
   bind xK_minus $ do
-    justMod  $ sendMessage (IncMasterN (-1))
-    shiftMod $ withFocused $ sendMessage . shrinkWindowAlt
+    justMod  $
+      doc "Decrease the number of windows in the  master region." $
+      sendMessage (IncMasterN (-1))
+
+    shiftMod $
+      doc "For mosaic layout, shrink the size-share of the current window" $
+      withFocused $ sendMessage . shrinkWindowAlt
 
   bind xK_m $ do
-    justMod $ subkeys $
-      mapAlpha 0 markCurrentWindow
+    justMod $
+      doc "Mark the current window with the next typed character." $
+      subkeys $
+        mapAlpha 0 markCurrentWindow
 
   bind xK_n $ do
-    justMod $ relativeWorkspaceShift next
+    justMod $
+      doc "Shift to the next workspace." $
+      relativeWorkspaceShift next
 
   bind xK_p $ do
-    justMod $ relativeWorkspaceShift prev
+    justMod $
+      doc "Shift to the previous workspace." $
+      relativeWorkspaceShift prev
 
   bind xK_plus $ do
-    justMod  $ sendMessage (IncMasterN 1)
-    shiftMod $ withFocused $ sendMessage . expandWindowAlt
+    justMod $ 
+      doc "Increase the number of windows in the master region." $
+      sendMessage (IncMasterN 1)
+
+    shiftMod $
+      doc "For mosaic layout, increase the size-share of the current window." $
+      withFocused $ sendMessage . expandWindowAlt
 
   bind xK_q $ do
-    shiftMod $ spawnX "xmonad --recompile && xmonad --restart"
+    shiftMod $
+      doc "Recompile and restart XMonad" $
+      spawnX "xmonad --recompile && xmonad --restart"
 
     justMod $ subkeys $ do
 
@@ -279,19 +344,21 @@ keymap = resolveSubmaps $ runKeys $ do
   bind xK_v $
     -- Allows repeated strokes of M-h and M-l to reduce and increase volume
     -- respectively.
-    justMod $ fix $ \recur -> subkeys $ do
-      bind xK_h $ do
-        justMod $ do
-           decreaseVolume
-           recur
+    justMod $
+      doc "Changes the volume." $
+      repeatable $ do
+        bind xK_h $
+          justMod $
+             doc "Decrease volume." $
+             decreaseVolume
 
-      bind xK_l $ do
-        justMod $ do
-           increaseVolume
-           recur
+        bind xK_l $
+          justMod $
+             doc "Increase volume." $
+             increaseVolume
 
-      bind xK_v $ do
-        justMod recur
+        bind xK_v $
+          justMod $ (return () :: X ())
 
   bind xK_w $ do
     justMod windowJump
@@ -505,7 +572,7 @@ windowSpecificBindings config = do
 
   w <- lift ask
 
-  let configureIf b k = tell =<< lift (b --> return (resolveSubmaps (runKeys k) config))
+  let configureIf b k = tell =<< lift (b --> return (keyBindingToKeymap (runKeys k) config))
       emitKey = flip sendKey w
 
   configureIf (flip elem browsers <$> className) $ do
@@ -617,7 +684,7 @@ windowBindings xconfig =
 
 applyKeys :: XConfig l -> IO (XConfig l)
 applyKeys config =
-    return $ windowBindings $ config { keys = keymap, mouseBindings = mouseMap }
+    return $ windowBindings $ config { keys = keyBindingToKeymap keymap, mouseBindings = mouseMap }
 
 click :: X ()
 click = do