Working parsing and command-line

app/Main.hs

@@ -19,8 +19,7 @@ module Main
 where
 
 import KPrelude
-import KMonad.Testing
+import KMonad.Runner (kmonad)
 
 main :: IO ()
-main = do
- runTest
+main = kmonad

doc/example.kbd

@@ -16,12 +16,13 @@
 
 ;; Define layer toggling shortcuts
 (defalias
- symb (layer-toggle symb)
- hask (layer-toggle hask)
- ffun (layer-toggle ffun)
- medi (layer-toggle media)
+ smb (layer-toggle symbols)
+ hsk (layer-toggle haskell)
+ fun (layer-toggle funckeys)
+ ;; ffun (layer-toggle ffun)
+ ;; medi (layer-toggle media)
  alt/ (tap-hold 200 / lalt)
- espG (tap-hold 200 g (layer-toggle spanish))
+ ;; espG (tap-hold 200 g (layer-toggle spanish))
  xcp (tap-next esc lctl)
  )
 
@@ -33,8 +34,8 @@
  <*> #(< * >)
  <$> #(< $ >)
  => #(= >)
- ;; sml #(: - \))
- ;; wnk #(; - \))
+ sml #(: - \))
+ wnk #(; - \))
  :p #(: p)
 )
 
@@ -48,18 +49,18 @@
 
 ;; The colemak base layer
 (deflayer colemak
- q w f p @gsp j l u y ;
+ q w f p g  j l u y ;
  a r s t d h n e i o
- @dbz x c v b k m , . @as
- tab lalt @r lsft lctl @l  @xcp spc lmet - bspc ret
+ z x c v b k m , . @alt/
+ tab lalt XX lsft lctl @smb @xcp spc lmet - bspc ret
 )
 
 ;; Various symbols and a numpad
 (deflayer symbols
  X ` ~ [ ] XX 7 8 9 /
- @ll  " \_ \( \) XX 4 5 6 *
+ @hsk " \_ \( \) XX 4 5 6 *
  lctl ' | { } = 1 2 3 -
- _ _ \\ < > _ @lr  spc 0 _ _ +
+ _ _ \\ < > _ @fun spc 0 _ _ +
 )
 
 ;; Haskell macros: to be completed when I implement macros

kmonad.cabal

@@ -18,8 +18,10 @@ library
  KPrelude
  Data.LayerStack
  Data.MultiMap
+ KLisp
+ KLisp.Joiner
  KLisp.Parser
- KLisp.Token
+ KLisp.Types
  KMonad
  KMonad.Action
  KMonad.Button
@@ -37,6 +39,8 @@ library
  KMonad.Keyboard.IO.Linux.UinputSink
  KMonad.Keyboard.Keycode
  KMonad.Runner
+ KMonad.Runner.GetCmd
+ KMonad.Runner.Types
  KMonad.Testing
  KMonad.Util
 
@@ -113,6 +117,7 @@ library
  , megaparsec
  , mtl
  , network
+ , optparse-applicative
  , resourcet
  , rio
  , time

src/KLisp.hs

@@ -0,0 +1,42 @@
+{-|
+Module : KLisp
+Description : The module responsible for parsing the configuration file
+Copyright : (c) David Janssen, 2019
+License : MIT
+
+Maintainer : [email protected]
+Stability : experimental
+Portability : non-portable (MPTC with FD, FFI to Linux-only c-code)
+
+-}
+module KLisp
+ ( loadConfig )
+where
+
+import KPrelude
+
+import KMonad.Daemon
+
+import KLisp.Parser
+import KLisp.Joiner
+import KLisp.Types
+
+-- | Parse a configuration file into a 'DaemonCfg' record
+loadConfig :: HasLogFunc e => FilePath -> RIO e DaemonCfg
+loadConfig pth = do
+ lf <- view logFuncL
+ tks <- loadTokens pth -- This can throw a parse-error
+ cfg <- joinConfigIO tks -- This can throw a JoinError
+
+ -- Try loading the sink and src
+ snk <- liftIO . _snk cfg $ lf
+ src <- liftIO . _src cfg $ lf
+
+ -- Assemble the DaemonCfg record
+ pure $ DaemonCfg
+ { _keySinkDev = snk
+ , _keySourceDev = src
+ , _keymapCfg = _km cfg
+ , _firstLayer = _fstL cfg
+ , _port = _prt cfg
+ }

src/KLisp/Joiner.hs

@@ -9,22 +9,25 @@ Stability : experimental
 Portability : non-portable (MPTC with FD, FFI to Linux-only c-code)
 
 -}
-module KList.Joiner
-
+module KLisp.Joiner
+ ( joinConfigIO
+ , joinConfig
+ )
 where
 
 import KPrelude hiding (uncons)
 
-import KLisp.Parser
 import KLisp.Types
 
-import KMonad
+import KMonad.Button
 import KMonad.Daemon
+import KMonad.Keyboard
 import KMonad.Keyboard.IO
 import KMonad.Keyboard.IO.Linux.DeviceSource
 import KMonad.Keyboard.IO.Linux.UinputSink
 
-import RIO.List (uncons)
+import RIO.List (uncons, headMaybe)
+import RIO.Partial (fromJust)
 import qualified Data.LayerStack as L
 import qualified RIO.HashMap as M
 import qualified RIO.Text as T
@@ -50,6 +53,11 @@ type J a = Either JoinError a
 --------------------------------------------------------------------------------
 -- $full
 
+joinConfigIO :: HasLogFunc e => [KExpr] -> RIO e DefCfg
+joinConfigIO es = case joinConfig es of
+ Left e -> throwM e
+ Right c -> pure c
+
 -- | Extract anything matching a particular prism from a list
 extract :: Prism' a b -> [a] -> [b]
 extract p = catMaybes . map (preview p)
@@ -79,7 +87,7 @@ joinConfig es = do
  , _src = i
  , _km = km
  , _fstL = fl
- , _port = ()
+ , _prt  = ()
  }
 
 --------------------------------------------------------------------------------
@@ -162,20 +170,19 @@ joinButton ns als =
 --------------------------------------------------------------------------------
 -- $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 (Keymap Button, LayerTag)
 joinKeymap _ _ [] = Left $ MissingBlock "deflayer"
 joinKeymap src als lys = do
-
- let nms = map _layerName lys
- amp <- joinAliases nms als
-
- -- Generate [(tag, [(Keycode Button)])] lists
- -- let g ls DefLayer{_layerName=n, _buttons=bs} = if
- -- | length bs /= nsrc -> Left $ LengthMismatch n (length bs) nsrc
- -- | True -> Right $ ls <> [(n, zip src bs)]
- undefined
-
-
+ let f acc x = if x `elem` acc then Left $ 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
+ -- 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
@@ -195,14 +202,11 @@ joinLayer als ns src DefLayer{_layerName=n, _buttons=bs} = do
  (n,) <$> foldM f [] (zip src bs)
 
 
-
-
-
 --------------------------------------------------------------------------------
 -- $test
 
-fname :: String
-fname = "/home/david/prj/hask/kmonad/doc/example.kbd"
+-- fname :: String
+-- fname = "/home/david/prj/hask/kmonad/doc/example.kbd"
 
-test :: IO (J DefCfg)
-test = runRIO () . fmap joinConfig $ loadTokens fname
+-- test :: IO (J DefCfg)
+-- test = runRIO () . fmap joinConfig $ loadTokens fname

src/KLisp/Parser.hs

@@ -31,15 +31,14 @@ where
 
 import KPrelude hiding (try)
 
-import KMonad
+import KMonad.Keyboard
 import KLisp.Types
 
 import Data.Char
 import RIO.List (sortBy)
 
 
 import qualified Data.MultiMap as Q
-import qualified RIO.HashMap as M
 import qualified RIO.Text as T
 import qualified Text.Megaparsec.Char.Lexer as L
 

src/KLisp/Types.hs

@@ -1,3 +1,14 @@
+{-|
+Module : KLisp.Types
+Description : The basic types of configuration parsing.
+Copyright : (c) David Janssen, 2019
+License : MIT
+
+Maintainer : [email protected]
+Stability : experimental
+Portability : non-portable (MPTC with FD, FFI to Linux-only c-code)
+
+-}
 module KLisp.Types
  ( -- * $bsc
  Parser
@@ -39,8 +50,6 @@ import KMonad.Daemon.KeyHandler (Keymap)
 import Text.Megaparsec
 import Text.Megaparsec.Char
 
-import qualified RIO.HashMap as M
-
 --------------------------------------------------------------------------------
 -- $bsc
 --
@@ -85,7 +94,7 @@ data DefCfg = DefCfg
  , _snk :: LogFunc -> IO (Acquire KeySink)
  , _km :: Keymap Button
  , _fstL :: Text
- , _port :: ()
+ , _prt  :: ()
  }
 
 

src/KMonad/Daemon.hs

@@ -15,7 +15,7 @@ import KMonad.Event
 import KMonad.Keyboard
 import KMonad.Keyboard.IO
 import KMonad.Util
-import KMonad.Runner
+import KMonad.Runner.Types
 
 
 import qualified KMonad.Daemon.Dispatch as Di