{-|
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
  ( run )
where

import KMonad.Prelude
import KMonad.App
import KMonad.Args.Cmd
import KMonad.Args.Joiner
import KMonad.Args.Parser
import KMonad.Args.Types

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

-- | Run KMonad
run :: IO ()
run :: IO ()
run = IO Cmd
getCmd IO Cmd -> (Cmd -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cmd -> IO ()
runCmd

-- | Execute the provided 'Cmd'
--
-- 1. Construct the log-func
-- 2. Parse the config-file
-- 3. Maybe start KMonad
runCmd :: Cmd -> IO ()
runCmd :: Cmd -> IO ()
runCmd c :: Cmd
c = do
  LogOptions
o <- Handle -> Bool -> IO LogOptions
forall (m :: * -> *). MonadIO m => Handle -> Bool -> m LogOptions
logOptionsHandle Handle
stdout Bool
False IO LogOptions -> (LogOptions -> LogOptions) -> IO LogOptions
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> LogLevel -> LogOptions -> LogOptions
setLogMinLevel (Cmd
cCmd -> Getting LogLevel Cmd LogLevel -> LogLevel
forall s a. s -> Getting a s a -> a
^.Getting LogLevel Cmd LogLevel
forall c. HasCmd c => Lens' c LogLevel
logLvl)
  LogOptions -> (LogFunc -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
LogOptions -> (LogFunc -> m a) -> m a
withLogFunc LogOptions
o ((LogFunc -> IO ()) -> IO ()) -> (LogFunc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \f :: LogFunc
f -> LogFunc -> RIO LogFunc () -> IO ()
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO LogFunc
f (RIO LogFunc () -> IO ()) -> RIO LogFunc () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    AppCfg
cfg <- FilePath -> RIO LogFunc AppCfg
forall e. HasLogFunc e => FilePath -> RIO e AppCfg
loadConfig (FilePath -> RIO LogFunc AppCfg) -> FilePath -> RIO LogFunc AppCfg
forall a b. (a -> b) -> a -> b
$ Cmd
cCmd -> 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
cfgFile
    Bool -> RIO LogFunc () -> RIO LogFunc ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Cmd
cCmd -> Getting Bool Cmd Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Cmd Bool
forall c. HasCmd c => Lens' c Bool
dryRun) (RIO LogFunc () -> RIO LogFunc ())
-> RIO LogFunc () -> RIO LogFunc ()
forall a b. (a -> b) -> a -> b
$ AppCfg -> RIO LogFunc ()
forall e. HasLogFunc e => AppCfg -> RIO e ()
startApp AppCfg
cfg

-- | Parse a configuration file into a 'AppCfg' record
loadConfig :: HasLogFunc e => FilePath -> RIO e AppCfg
loadConfig :: FilePath -> RIO e AppCfg
loadConfig pth :: FilePath
pth = do

  [KExpr]
tks <- FilePath -> RIO e [KExpr]
forall e. FilePath -> RIO e [KExpr]
loadTokens FilePath
pth   -- This can throw a PErrors
  CfgToken
cgt <- [KExpr] -> RIO e CfgToken
forall e. HasLogFunc e => [KExpr] -> RIO e CfgToken
joinConfigIO [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
logFuncL
  Acquire KeySink
snk <- IO (Acquire KeySink) -> RIO e (Acquire KeySink)
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 (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

  -- Assemble the AppCfg record
  AppCfg -> RIO e AppCfg
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 :: Acquire KeySink
-> Acquire KeySource
-> LMap Button
-> LayerTag
-> Bool
-> Bool
-> AppCfg
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
    }