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 :: 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
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
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
CfgToken
cgt <- [KExpr] -> RIO e CfgToken
forall e. HasLogFunc e => [KExpr] -> RIO e CfgToken
joinConfigIO [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
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
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
}