Added named source blocks

doc/quick-reference.md

@@ -68,7 +68,7 @@ The following are all global config options that one can set in the
 `defcfg` block.
 
 + `fallthrough` (boolean, defaults to `false`): re-emit keys that are
-  not defined in a `defsrc` block.
+  not defined in the corresponding `defsrc` block.
 
   This allows one to only specify certain parts of a layout, with all
   other keys having their "default" meaning.
@@ -317,6 +317,8 @@ just collections of keys.
   `defsrc` is very similar to a layer visually, it is not a one and will
   thus not be used as one! It only serves to define where the different
   keys are and what kind of layout kmonad is initially dealing with.
+  It also supports giving a name via `:name <my-soucre-name>` as the
+  first argument.
 
   For example, an ANSI 60% keyboard may be represented as:
 
@@ -338,6 +340,9 @@ just collections of keys.
    For example, defining a qwerty layer, as well as one for special
    symbols and numbers:
 
+   To use a named source block add `:source <my-source-name>` after
+   the layer name.
+
   ```
   (deflayer qwerty
     grv  1    2    3    4    5    6    7    8    9    0    -    =    bspc

keymap/tutorial.kbd

@@ -61,9 +61,9 @@
 
     KMonad catches input events and tries to match them to various handlers. If
     it cannot match an event to any handler (for example, if it isn't included
-    in the `defsrc` block, or if it is, but the current keymap does not map any
-    buttons to it), then the event gets quietly ignored. If `fallthrough` is set
-    to `true`, any unhandled events simply get reemitted.
+    in the corresponding `defsrc` block, or if it is, but the current keymap
+    does not map any buttons to it), then the event gets quietly ignored. If
+    `fallthrough` is set to `true`, any unhandled events simply get reemitted.
 
   - allow-cmd: `true` or `false`, defaults to `false`
 
@@ -187,7 +187,7 @@
 
 
 #| --------------------------------------------------------------------------
-                         Necessary: the `defsrc` block
+                      Necessary: at least 1 `defsrc` block
 
   It is difficult to explain the `defsrc` block without immediately going into
   `deflayer` blocks as well. Essentially, KMonad maps input-events to various
@@ -208,10 +208,8 @@
   particular case you probably want to set `fallthrough` to `true` in your
   `defcfg` block though.
 
-  In the future we would like to provide support for multiple, named `defsrc`
-  blocks, so that it becomes easier to specify various layers for just the
-  numpad, for example, but at the moment any more or less than 1 `defsrc` block
-  will result in an error.
+  There is also support for named `defsrc` blocks. They contain `:name <my-source>`
+  as the first argument in their definition.
 
   The layouting in the `defsrc` block is completely free, whitespace simply gets
   ignored. We strive to provide a name for every keycode that is no longer than
@@ -240,6 +238,14 @@
   lctl lmet lalt           spc            ralt rmet cmp  rctl
 )
 
+(defsrc :name numpad
+  nlck kp/ kp* kp-
+  kp7  kp8 kp9 kp+
+  kp4  kp5 kp6
+  kp1  kp2 kp3 kprt
+  kp0    kp.
+)
+
 
 #| --------------------------------------------------------------------------
                         Optional : `defalias` statements
@@ -282,6 +288,9 @@
   layer, followed by N 'statements-that-evaluate-to-a-button', where N is
   exactly how many entries are defined in the `defsrc` statement.
 
+  Optionally you can add a `:source <my-source>` parameter after the name to map
+  a layer using a named `defsrc` block.
+
   It is also important to mention that the 'keymap' in KMonad is modelled as a
   stack of layers (just like in QMK). When an event is registered we look in the
   top-most layer for a handler. If we don't find one we try the next layer, and
@@ -325,6 +334,14 @@
   lctl @num lalt           spc            ralt rmet @sym @tst
 )
 
+(deflayer phone :source numpad
+  nlck kp/ kp* kp-
+  kp1  kp2 kp3 kp+
+  kp4  kp5 kp6
+  kp7  kp8 kp9 kprt
+  kp0    kp.
+)
+
 
 #| --------------------------------------------------------------------------
                      Optional: as many layers as you please

src/KMonad/Args/Joiner.hs

@@ -65,8 +65,10 @@ data JoinError
   | MissingBlock     Text
   | DuplicateAlias   Text
   | DuplicateLayer   Text
+  | DuplicateSource  (Maybe Text)
   | MissingAlias     Text
   | MissingLayer     Text
+  | MissingSource    (Maybe Text)
   | MissingSetting   Text
   | DuplicateSetting Text
   | InvalidOS        Text
@@ -80,8 +82,14 @@ instance Show JoinError where
     MissingBlock      t   -> "Missing at least 1 block of type: "    <> T.unpack t
     DuplicateAlias    t   -> "Multiple aliases of the same name: "   <> T.unpack t
     DuplicateLayer    t   -> "Multiple layers of the same name: "    <> T.unpack t
+    DuplicateSource   t   -> case t of
+      Just t  -> "Multiple sources of the same name: " <> T.unpack t
+      Nothing -> "Multiple default sources"
     MissingAlias      t   -> "Reference to non-existent alias: "     <> T.unpack t
     MissingLayer      t   -> "Reference to non-existent layer: "     <> T.unpack t
+    MissingSource     t   -> case t of
+      Just t  -> "Reference to non-existent source: " <> T.unpack t
+      Nothing -> "Reference to non-existent default source"
     MissingSetting    t   -> "Missing setting in 'defcfg': "         <> T.unpack t
     DuplicateSetting  t   -> "Duplicate setting in 'defcfg': "       <> T.unpack t
     InvalidOS         t   -> "Not available under this OS: "         <> T.unpack t
@@ -168,8 +176,8 @@ joinConfig' = do
   -- Extract the other blocks and join them into a keymap
   let als = extract _KDefAlias es
   let lys = extract _KDefLayer es
-  src      <- oneBlock "defsrc" _KDefSrc
-  (km, fl) <- joinKeymap src als lys
+  let srcs = extract _KDefSrc es
+  (km, fl) <- joinKeymap srcs als lys
 
   pure $ CfgToken
     { _snk   = o
@@ -391,30 +399,48 @@ joinButton ns als =
     KBlock -> ret pass
 
 
+--------------------------------------------------------------------------------
+-- $src
+
+type Sources = M.HashMap (Maybe Text) DefSrc
+
+-- | Build up a hashmap of text to source mappings.
+joinSources :: [DefSrc] -> J Sources
+joinSources = foldM joiner mempty
+  where
+   joiner :: Sources -> DefSrc -> J Sources
+   joiner sources src@DefSrc{_srcName=n}
+     | n `M.member` sources = throwError $ DuplicateSource n
+     | otherwise            = pure $ M.insert n src sources
+
 --------------------------------------------------------------------------------
 -- $kmap
 
 -- | Join the defsrc, defalias, and deflayer layers into a Keymap of buttons and
 -- the name signifying the initial layer to load.
-joinKeymap :: DefSrc -> [DefAlias] -> [DefLayer] -> J (LMap Button, LayerTag)
-joinKeymap _   _   []  = throwError $ MissingBlock "deflayer"
-joinKeymap src als lys = do
+joinKeymap :: [DefSrc] -> [DefAlias] -> [DefLayer] -> J (LMap Button, LayerTag)
+joinKeymap []   _   _   = throwError $ MissingBlock "defsrc"
+joinKeymap _    _   []  = throwError $ MissingBlock "deflayer"
+joinKeymap srcs als lys = do
   let f acc x = if x `elem` acc then throwError $ DuplicateLayer x else pure (x:acc)
-  nms  <- foldM f [] $ map _layerName lys   -- Extract all names
-  als' <- joinAliases nms als               -- Join aliases into 1 hashmap
-  lys' <- mapM (joinLayer als' nms src) lys -- Join all layers
+  nms   <- foldM f [] $ map _layerName lys     -- Extract all names
+  als'  <- joinAliases nms als                 -- Join aliases into 1 hashmap
+  srcs' <- joinSources  srcs                   -- Join all sources into 1 hashmap
+  lys'  <- mapM (joinLayer als' nms srcs') lys -- Join all layers
   -- Return the layerstack and the name of the first layer
   pure (L.mkLayerStack lys', _layerName . fromJust . headMaybe $ lys)
 
 -- | Check and join 1 deflayer.
 joinLayer ::
      Aliases                       -- ^ Mapping of names to buttons
   -> LNames                        -- ^ List of valid layer names
-  -> DefSrc                        -- ^ Layout of the source layer
+  -> Sources                       -- ^ Mapping of names to source layer
   -> DefLayer                      -- ^ The layer token to join
   -> J (Text, [(Keycode, Button)]) -- ^ The resulting tuple
-joinLayer als ns src DefLayer{_layerName=n, _buttons=bs} = do
-
+joinLayer als ns srcs DefLayer{_layerName=n, _associatedSrcName=assocSrc, _buttons=bs} = do
+  src <- case M.lookup assocSrc srcs of
+    Just src -> pure $ src^.keycodes
+    Nothing  -> throwError $ MissingSource assocSrc
   -- Ensure length-match between src and buttons
   when (length bs /= length src) $
     throwError $ LengthMismatch n (length bs) (length src)

src/KMonad/Args/Parser.hs

@@ -368,10 +368,17 @@ defaliasP = many $ (,) <$> lexeme word <*> buttonP
 -- $defsrc
 
 defsrcP :: Parser DefSrc
-defsrcP = many $ lexeme keycodeP
-
+defsrcP =
+  DefSrc
+    <$> optional (keywordP "name" word)
+    <*> many (lexeme keycodeP)
 
 --------------------------------------------------------------------------------
 -- $deflayer
+
 deflayerP :: Parser DefLayer
-deflayerP = DefLayer <$> lexeme word <*> many (lexeme buttonP)
+deflayerP =
+  DefLayer
+    <$> lexeme word
+    <*> optional (keywordP "source" word)
+    <*> many (lexeme buttonP)

src/KMonad/Args/Types.hs

@@ -22,7 +22,7 @@ module KMonad.Args.Types
   , DefSettings
   , DefAlias
   , DefLayer(..)
-  , DefSrc
+  , DefSrc(..)
   , KExpr(..)
 
     -- * $defio
@@ -32,6 +32,7 @@ module KMonad.Args.Types
     -- * $lenses
   , AsKExpr(..)
   , AsDefSetting(..)
+  , HasDefSrc(..)
 ) where
 
 
@@ -117,16 +118,23 @@ makeClassy ''CfgToken
 -- A collection of all the different top-level statements possible in a config
 -- file.
 
--- | A list of keycodes describing the ordering of all the other layers
-type DefSrc = [Keycode]
+-- | A list of keycodes describing the ordering used by all other layers
+-- | which is associated with a name.
+data DefSrc = DefSrc
+  { _srcName  :: Maybe Text -- ^ A unique name used to refer to this layer.
+  , _keycodes :: [Keycode]  -- ^ Layer settings containing also the buttons.
+  }
+  deriving Show
+makeClassy ''DefSrc
 
 -- | A mapping from names to button tokens
 type DefAlias = [(Text, DefButton)]
 
 -- | A layer of buttons
 data DefLayer = DefLayer
-  { _layerName :: Text        -- ^ A unique name used to refer to this layer
-  , _buttons   :: [DefButton] -- ^ A list of button tokens
+  { _layerName         :: Text        -- ^ A unique name used to refer to this layer
+  , _associatedSrcName :: Maybe Text  -- ^ The source used by the layer
+  , _buttons           :: [DefButton] -- ^ A list of button tokens
   }
   deriving Show