{-|
Module      : KMonad.Args
Description : How to parse arguments and config files into an AppCfg
Copyright   : (c) David Janssen, 2019
License     : MIT

Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : non-portable (MPTC with FD, FFI to Linux-only c-code)

-}
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

--------------------------------------------------------------------------------
--

-- | Parse a configuration file into a 'AppCfg' record
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)      -- This can throw a ParseError
  CfgToken
cgt <- [KExpr] -> RIO e CfgToken
forall e. HasLogFunc e => [KExpr] -> RIO e CfgToken
joinConfigIO (Cmd -> [KExpr] -> [KExpr]
joinCLI Cmd
cmd [KExpr]
tks) -- This can throw a JoinError

  -- Try loading the sink and src
  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

  -- Emit the release of <Enter> if requested

  -- Assemble the AppCfg record
  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
    }


-- | Join the options given from the command line with the one read from the
-- configuration file.
-- This does not yet throw any kind of exception, as we are simply inserting the
-- given options into every 'KDefCfg' block that we see.
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
  -- | All options and flags that were given on the command line.
  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]

  -- | Convert command line flags to a 'Maybe' type, where the non-presence, as
  -- well as the default value of a flag will be interpreted as @Nothing@
  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

  -- | Insert all command line options, potentially overwriting already existing
  -- options that were given in the configuration file. This is a paramorphism
  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