module KMonad.Args
( getCmd, loadConfig, Cmd, HasCmd(..))
where
import KMonad.Prelude
import KMonad.App.Types
import KMonad.Args.Cmd
import KMonad.Args.Joiner
import KMonad.Args.Parser
import KMonad.Args.Types
loadConfig :: HasLogFunc e => Cmd -> RIO e AppCfg
loadConfig :: forall e. HasLogFunc e => Cmd -> RIO e AppCfg
loadConfig Cmd
cmd = do
[KExpr]
tks <- FilePath -> RIO e [KExpr]
forall e. FilePath -> RIO e [KExpr]
loadTokens (Cmd
cmdCmd -> Getting FilePath Cmd FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^.Getting FilePath Cmd FilePath
forall c. HasCmd c => Lens' c FilePath
Lens' Cmd FilePath
cfgFile)
CfgToken
cgt <- [KExpr] -> RIO e CfgToken
forall e. HasLogFunc e => [KExpr] -> RIO e CfgToken
joinConfigIO (Cmd -> [KExpr] -> [KExpr]
joinCLI Cmd
cmd [KExpr]
tks)
LogFunc
lf <- Getting LogFunc e LogFunc -> RIO e LogFunc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LogFunc e LogFunc
forall env. HasLogFunc env => Lens' env LogFunc
Lens' e LogFunc
logFuncL
Acquire KeySink
snk <- IO (Acquire KeySink) -> RIO e (Acquire KeySink)
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Acquire KeySink) -> RIO e (Acquire KeySink))
-> (LogFunc -> IO (Acquire KeySink))
-> LogFunc
-> RIO e (Acquire KeySink)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CfgToken -> LogFunc -> IO (Acquire KeySink)
_snk CfgToken
cgt (LogFunc -> RIO e (Acquire KeySink))
-> LogFunc -> RIO e (Acquire KeySink)
forall a b. (a -> b) -> a -> b
$ LogFunc
lf
Acquire KeySource
src <- IO (Acquire KeySource) -> RIO e (Acquire KeySource)
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Acquire KeySource) -> RIO e (Acquire KeySource))
-> (LogFunc -> IO (Acquire KeySource))
-> LogFunc
-> RIO e (Acquire KeySource)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CfgToken -> LogFunc -> IO (Acquire KeySource)
_src CfgToken
cgt (LogFunc -> RIO e (Acquire KeySource))
-> LogFunc -> RIO e (Acquire KeySource)
forall a b. (a -> b) -> a -> b
$ LogFunc
lf
AppCfg -> RIO e AppCfg
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppCfg -> RIO e AppCfg) -> AppCfg -> RIO e AppCfg
forall a b. (a -> b) -> a -> b
$ AppCfg
{ _keySinkDev :: Acquire KeySink
_keySinkDev = Acquire KeySink
snk
, _keySourceDev :: Acquire KeySource
_keySourceDev = Acquire KeySource
src
, _keymapCfg :: LMap Button
_keymapCfg = CfgToken -> LMap Button
_km CfgToken
cgt
, _firstLayer :: LayerTag
_firstLayer = CfgToken -> LayerTag
_fstL CfgToken
cgt
, _fallThrough :: Bool
_fallThrough = CfgToken -> Bool
_flt CfgToken
cgt
, _allowCmd :: Bool
_allowCmd = CfgToken -> Bool
_allow CfgToken
cgt
, _startDelay :: Milliseconds
_startDelay = Cmd -> Milliseconds
_strtDel Cmd
cmd
}
joinCLI :: Cmd -> [KExpr] -> [KExpr]
joinCLI :: Cmd -> [KExpr] -> [KExpr]
joinCLI Cmd
cmd = (KExpr -> Identity KExpr) -> [KExpr] -> Identity [KExpr]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse((KExpr -> Identity KExpr) -> [KExpr] -> Identity [KExpr])
-> ((DefSettings -> Identity DefSettings)
-> KExpr -> Identity KExpr)
-> (DefSettings -> Identity DefSettings)
-> [KExpr]
-> Identity [KExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(DefSettings -> Identity DefSettings) -> KExpr -> Identity KExpr
forall r. AsKExpr r => Prism' r DefSettings
Prism' KExpr DefSettings
_KDefCfg ((DefSettings -> Identity DefSettings)
-> [KExpr] -> Identity [KExpr])
-> (DefSettings -> DefSettings) -> [KExpr] -> [KExpr]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ DefSettings -> DefSettings -> DefSettings
insertCliOption DefSettings
cliList
where
cliList :: DefSettings
cliList :: DefSettings
cliList = [Maybe DefSetting] -> DefSettings
forall a. [Maybe a] -> [a]
catMaybes ([Maybe DefSetting] -> DefSettings)
-> [Maybe DefSetting] -> DefSettings
forall a b. (a -> b) -> a -> b
$
(DefSetting -> Maybe DefSetting)
-> DefSettings -> [Maybe DefSetting]
forall a b. (a -> b) -> [a] -> [b]
map DefSetting -> Maybe DefSetting
flagToMaybe [Cmd
cmdCmd -> Getting DefSetting Cmd DefSetting -> DefSetting
forall s a. s -> Getting a s a -> a
^.Getting DefSetting Cmd DefSetting
forall c. HasCmd c => Lens' c DefSetting
Lens' Cmd DefSetting
cmdAllow, Cmd
cmdCmd -> Getting DefSetting Cmd DefSetting -> DefSetting
forall s a. s -> Getting a s a -> a
^.Getting DefSetting Cmd DefSetting
forall c. HasCmd c => Lens' c DefSetting
Lens' Cmd DefSetting
fallThrgh]
[Maybe DefSetting] -> [Maybe DefSetting] -> [Maybe DefSetting]
forall a. Semigroup a => a -> a -> a
<> [Cmd
cmdCmd
-> Getting (Maybe DefSetting) Cmd (Maybe DefSetting)
-> Maybe DefSetting
forall s a. s -> Getting a s a -> a
^.Getting (Maybe DefSetting) Cmd (Maybe DefSetting)
forall c. HasCmd c => Lens' c (Maybe DefSetting)
Lens' Cmd (Maybe DefSetting)
iToken, Cmd
cmdCmd
-> Getting (Maybe DefSetting) Cmd (Maybe DefSetting)
-> Maybe DefSetting
forall s a. s -> Getting a s a -> a
^.Getting (Maybe DefSetting) Cmd (Maybe DefSetting)
forall c. HasCmd c => Lens' c (Maybe DefSetting)
Lens' Cmd (Maybe DefSetting)
oToken, Cmd
cmdCmd
-> Getting (Maybe DefSetting) Cmd (Maybe DefSetting)
-> Maybe DefSetting
forall s a. s -> Getting a s a -> a
^.Getting (Maybe DefSetting) Cmd (Maybe DefSetting)
forall c. HasCmd c => Lens' c (Maybe DefSetting)
Lens' Cmd (Maybe DefSetting)
cmpSeq, Cmd
cmdCmd
-> Getting (Maybe DefSetting) Cmd (Maybe DefSetting)
-> Maybe DefSetting
forall s a. s -> Getting a s a -> a
^.Getting (Maybe DefSetting) Cmd (Maybe DefSetting)
forall c. HasCmd c => Lens' c (Maybe DefSetting)
Lens' Cmd (Maybe DefSetting)
initStr]
flagToMaybe :: DefSetting -> Maybe DefSetting
flagToMaybe :: DefSetting -> Maybe DefSetting
flagToMaybe = \case
SAllowCmd Bool
b -> if Bool
b then DefSetting -> Maybe DefSetting
forall a. a -> Maybe a
Just (Bool -> DefSetting
SAllowCmd Bool
b) else Maybe DefSetting
forall a. Maybe a
Nothing
SFallThrough Bool
b -> if Bool
b then DefSetting -> Maybe DefSetting
forall a. a -> Maybe a
Just (Bool -> DefSetting
SFallThrough Bool
b) else Maybe DefSetting
forall a. Maybe a
Nothing
DefSetting
_ -> Maybe DefSetting
forall a. Maybe a
Nothing
insertCliOption :: DefSettings -> DefSettings -> DefSettings
insertCliOption :: DefSettings -> DefSettings -> DefSettings
insertCliOption DefSettings
cliSettings DefSettings
cfgSettings =
(DefSetting -> DefSettings -> DefSettings)
-> DefSettings -> DefSettings -> DefSettings
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\DefSetting
s DefSettings
cfgs ->
if DefSetting
s DefSetting -> DefSettings -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DefSettings
cfgs
then (DefSetting -> DefSetting) -> DefSettings -> DefSettings
forall a b. (a -> b) -> [a] -> [b]
map (\DefSetting
x -> if DefSetting
s DefSetting -> DefSetting -> Bool
forall a. Eq a => a -> a -> Bool
== DefSetting
x then DefSetting
s else DefSetting
x) DefSettings
cfgs
else DefSetting
s DefSetting -> DefSettings -> DefSettings
forall a. a -> [a] -> [a]
: DefSettings
cfgs)
DefSettings
cfgSettings
DefSettings
cliSettings