{-# LANGUAGE CPP #-}
{-|
Module      : KMonad.App.Main
Description : The entry-point to KMonad
Copyright   : (c) David Janssen, 2021
License     : MIT

Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : non-portable

-}
module KMonad.App.Main
  ( -- * The entry-point to KMonad
    main
  )
where

import KMonad.Prelude

import KMonad.Args
import KMonad.App.Types
import KMonad.Keyboard
import KMonad.Util
import KMonad.Model



import qualified KMonad.Model.Dispatch as Dp
import qualified KMonad.Model.Hooks    as Hs
import qualified KMonad.Model.Sluice   as Sl
import qualified KMonad.Model.Keymap   as Km

-- FIXME: This should live somewhere else

#ifdef linux_HOST_OS
import System.Posix.Signals (Handler(Ignore), installHandler, sigCHLD)
#endif

--------------------------------------------------------------------------------
-- $start
--
-- How to start KMonad

-- | The first command in KMonad
--
-- Get the invocation from the command-line, then do something with it.
main :: IO ()
main :: IO ()
main = IO Cmd
getCmd IO Cmd -> (Cmd -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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 Cmd
c = do
  Handle -> BufferMode -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> BufferMode -> m ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
  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
Lens' Cmd 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
$ \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 <- Cmd -> RIO LogFunc AppCfg
forall e. HasLogFunc e => Cmd -> RIO e AppCfg
loadConfig Cmd
c
    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
Lens' Cmd 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

--------------------------------------------------------------------------------
-- $init
--
-- The steps required to turn a configuration into the initial KMonad env

-- | Initialize all the components of the KMonad app-loop
--
-- NOTE: This is written in 'ContT' over our normal RIO monad. This is just to
-- to simplify a bunch of nesting of calls. At no point do we make use of
-- 'callCC' or other 'ContT' functionality.
--
initAppEnv :: HasLogFunc e => AppCfg -> ContT r (RIO e) AppEnv
initAppEnv :: forall e r. HasLogFunc e => AppCfg -> ContT r (RIO e) AppEnv
initAppEnv AppCfg
cfg = do
  -- Get a reference to the logging function
  LogFunc
lgf <- Getting LogFunc e LogFunc -> ContT r (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

  -- Wait a bit for the user to release the 'Return' key with which they started KMonad
  Int -> ContT r (RIO e) ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> ContT r (RIO e) ()) -> Int -> ContT r (RIO e) ()
forall a b. (a -> b) -> a -> b
$ Milliseconds -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (AppCfg
cfgAppCfg -> Getting Milliseconds AppCfg Milliseconds -> Milliseconds
forall s a. s -> Getting a s a -> a
^.Getting Milliseconds AppCfg Milliseconds
forall c. HasAppCfg c => Lens' c Milliseconds
Lens' AppCfg Milliseconds
startDelay) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000

  -- Acquire the key source and key sink
  KeySink
snk <- Acquire KeySink -> ContT r (RIO e) KeySink
forall a r e. Acquire a -> ContT r (RIO e) a
using (Acquire KeySink -> ContT r (RIO e) KeySink)
-> Acquire KeySink -> ContT r (RIO e) KeySink
forall a b. (a -> b) -> a -> b
$ AppCfg
cfgAppCfg
-> Getting (Acquire KeySink) AppCfg (Acquire KeySink)
-> Acquire KeySink
forall s a. s -> Getting a s a -> a
^.Getting (Acquire KeySink) AppCfg (Acquire KeySink)
forall c. HasAppCfg c => Lens' c (Acquire KeySink)
Lens' AppCfg (Acquire KeySink)
keySinkDev
  KeySource
src <- Acquire KeySource -> ContT r (RIO e) KeySource
forall a r e. Acquire a -> ContT r (RIO e) a
using (Acquire KeySource -> ContT r (RIO e) KeySource)
-> Acquire KeySource -> ContT r (RIO e) KeySource
forall a b. (a -> b) -> a -> b
$ AppCfg
cfgAppCfg
-> Getting (Acquire KeySource) AppCfg (Acquire KeySource)
-> Acquire KeySource
forall s a. s -> Getting a s a -> a
^.Getting (Acquire KeySource) AppCfg (Acquire KeySource)
forall c. HasAppCfg c => Lens' c (Acquire KeySource)
Lens' AppCfg (Acquire KeySource)
keySourceDev

  -- Initialize the pull-chain components
  Dispatch
dsp <- RIO e KeyEvent -> ContT r (RIO e) Dispatch
forall (m :: * -> *) r.
MonadUnliftIO m =>
m KeyEvent -> ContT r m Dispatch
Dp.mkDispatch (RIO e KeyEvent -> ContT r (RIO e) Dispatch)
-> RIO e KeyEvent -> ContT r (RIO e) Dispatch
forall a b. (a -> b) -> a -> b
$ KeySource -> RIO e KeyEvent
forall e. HasLogFunc e => KeySource -> RIO e KeyEvent
awaitKey KeySource
src
  Hooks
ihk <- RIO e KeyEvent -> ContT r (RIO e) Hooks
forall (m :: * -> *) r.
MonadUnliftIO m =>
m KeyEvent -> ContT r m Hooks
Hs.mkHooks    (RIO e KeyEvent -> ContT r (RIO e) Hooks)
-> RIO e KeyEvent -> ContT r (RIO e) Hooks
forall a b. (a -> b) -> a -> b
$ Dispatch -> RIO e KeyEvent
forall e. HasLogFunc e => Dispatch -> RIO e KeyEvent
Dp.pull  Dispatch
dsp
  Sluice
slc <- RIO e KeyEvent -> ContT r (RIO e) Sluice
forall (m :: * -> *) r.
MonadUnliftIO m =>
m KeyEvent -> ContT r m Sluice
Sl.mkSluice   (RIO e KeyEvent -> ContT r (RIO e) Sluice)
-> RIO e KeyEvent -> ContT r (RIO e) Sluice
forall a b. (a -> b) -> a -> b
$ Hooks -> RIO e KeyEvent
forall e. HasLogFunc e => Hooks -> RIO e KeyEvent
Hs.pull  Hooks
ihk

  -- Initialize the button environments in the keymap
  Keymap
phl <- LayerTag -> LMap Button -> ContT r (RIO e) Keymap
forall (m :: * -> *) r.
MonadUnliftIO m =>
LayerTag -> LMap Button -> ContT r m Keymap
Km.mkKeymap (AppCfg
cfgAppCfg -> Getting LayerTag AppCfg LayerTag -> LayerTag
forall s a. s -> Getting a s a -> a
^.Getting LayerTag AppCfg LayerTag
forall c. HasAppCfg c => Lens' c LayerTag
Lens' AppCfg LayerTag
firstLayer) (AppCfg
cfgAppCfg -> Getting (LMap Button) AppCfg (LMap Button) -> LMap Button
forall s a. s -> Getting a s a -> a
^.Getting (LMap Button) AppCfg (LMap Button)
forall c. HasAppCfg c => Lens' c (LMap Button)
Lens' AppCfg (LMap Button)
keymapCfg)

  -- Initialize output components
  TMVar KeyEvent
otv <- RIO e (TMVar KeyEvent) -> ContT r (RIO e) (TMVar KeyEvent)
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift RIO e (TMVar KeyEvent)
forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
  Hooks
ohk <- RIO e KeyEvent -> ContT r (RIO e) Hooks
forall (m :: * -> *) r.
MonadUnliftIO m =>
m KeyEvent -> ContT r m Hooks
Hs.mkHooks (RIO e KeyEvent -> ContT r (RIO e) Hooks)
-> (TMVar KeyEvent -> RIO e KeyEvent)
-> TMVar KeyEvent
-> ContT r (RIO e) Hooks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM KeyEvent -> RIO e KeyEvent
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM KeyEvent -> RIO e KeyEvent)
-> (TMVar KeyEvent -> STM KeyEvent)
-> TMVar KeyEvent
-> RIO e KeyEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMVar KeyEvent -> STM KeyEvent
forall a. TMVar a -> STM a
takeTMVar (TMVar KeyEvent -> ContT r (RIO e) Hooks)
-> TMVar KeyEvent -> ContT r (RIO e) Hooks
forall a b. (a -> b) -> a -> b
$ TMVar KeyEvent
otv

  -- Setup thread to read from outHooks and emit to keysink
  LayerTag -> RIO e () -> ContT r (RIO e) ()
forall e a r.
HasLogFunc e =>
LayerTag -> RIO e a -> ContT r (RIO e) ()
launch_ LayerTag
"emitter_proc" (RIO e () -> ContT r (RIO e) ()) -> RIO e () -> ContT r (RIO e) ()
forall a b. (a -> b) -> a -> b
$ do
    KeyEvent
e <- STM KeyEvent -> RIO e KeyEvent
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM KeyEvent -> RIO e KeyEvent)
-> (TMVar KeyEvent -> STM KeyEvent)
-> TMVar KeyEvent
-> RIO e KeyEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMVar KeyEvent -> STM KeyEvent
forall a. TMVar a -> STM a
takeTMVar (TMVar KeyEvent -> RIO e KeyEvent)
-> TMVar KeyEvent -> RIO e KeyEvent
forall a b. (a -> b) -> a -> b
$ TMVar KeyEvent
otv
    KeySink -> KeyEvent -> RIO e ()
forall e. HasLogFunc e => KeySink -> KeyEvent -> RIO e ()
emitKey KeySink
snk KeyEvent
e
    -- If delay is specified, wait for it
    Maybe Milliseconds -> (Milliseconds -> RIO e ()) -> RIO e ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (AppCfg
cfgAppCfg
-> Getting (Maybe Milliseconds) AppCfg (Maybe Milliseconds)
-> Maybe Milliseconds
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Milliseconds) AppCfg (Maybe Milliseconds)
forall c. HasAppCfg c => Lens' c (Maybe Milliseconds)
Lens' AppCfg (Maybe Milliseconds)
keyOutDelay) ((Milliseconds -> RIO e ()) -> RIO e ())
-> (Milliseconds -> RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Int -> RIO e ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> RIO e ())
-> (Milliseconds -> Int) -> Milliseconds -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
1000) (Int -> Int) -> (Milliseconds -> Int) -> Milliseconds -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Milliseconds -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  -- emit e = view keySink >>= flip emitKey e
  AppEnv -> ContT r (RIO e) AppEnv
forall a. a -> ContT r (RIO e) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppEnv -> ContT r (RIO e) AppEnv)
-> AppEnv -> ContT r (RIO e) AppEnv
forall a b. (a -> b) -> a -> b
$ AppEnv
    { _keAppCfg :: AppCfg
_keAppCfg  = AppCfg
cfg
    , _keLogFunc :: LogFunc
_keLogFunc = LogFunc
lgf
    , _keySink :: KeySink
_keySink   = KeySink
snk
    , _keySource :: KeySource
_keySource = KeySource
src

    , _dispatch :: Dispatch
_dispatch  = Dispatch
dsp
    , _inHooks :: Hooks
_inHooks   = Hooks
ihk
    , _sluice :: Sluice
_sluice    = Sluice
slc

    , _keymap :: Keymap
_keymap    = Keymap
phl
    , _outHooks :: Hooks
_outHooks  = Hooks
ohk
    , _outVar :: TMVar KeyEvent
_outVar    = TMVar KeyEvent
otv
    }

--------------------------------------------------------------------------------
-- $emit
--
-- How to use a KMonad env to emit keys to the OS
--
-- FIXME: this needs to live somewhere else

-- | Trigger the button-action press currently registered to 'Keycode'
pressKey :: (HasAppEnv e, HasLogFunc e, HasAppCfg e) => Keycode -> RIO e ()
pressKey :: forall e.
(HasAppEnv e, HasLogFunc e, HasAppCfg e) =>
Keycode -> RIO e ()
pressKey Keycode
c =
  Getting Keymap e Keymap -> RIO e Keymap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Keymap e Keymap
forall c. HasAppEnv c => Lens' c Keymap
Lens' e Keymap
keymap RIO e Keymap
-> (Keymap -> RIO e (Maybe BEnv)) -> RIO e (Maybe BEnv)
forall a b. RIO e a -> (a -> RIO e b) -> RIO e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Keymap -> Keycode -> RIO e (Maybe BEnv))
-> Keycode -> Keymap -> RIO e (Maybe BEnv)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Keymap -> Keycode -> RIO e (Maybe BEnv)
forall (m :: * -> *).
MonadIO m =>
Keymap -> Keycode -> m (Maybe BEnv)
Km.lookupKey Keycode
c RIO e (Maybe BEnv) -> (Maybe BEnv -> RIO e ()) -> RIO e ()
forall a b. RIO e a -> (a -> RIO e b) -> RIO e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case

    -- If the keycode does not occur in our keymap
    Maybe BEnv
Nothing -> do
      Bool
ft <- Getting Bool e Bool -> RIO e Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool e Bool
forall c. HasAppCfg c => Lens' c Bool
Lens' e Bool
fallThrough
      Bool -> RIO e () -> RIO e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ft (RIO e () -> RIO e ()) -> RIO e () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
          KeyEvent -> RIO e ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
emit (KeyEvent -> RIO e ()) -> KeyEvent -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Keycode -> KeyEvent
mkPress Keycode
c
          KeyPred -> (KeyEvent -> RIO e Catch) -> RIO e ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await (Keycode -> KeyPred
isReleaseOf Keycode
c) ((KeyEvent -> RIO e Catch) -> RIO e ())
-> (KeyEvent -> RIO e Catch) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ \KeyEvent
_ -> do
            KeyEvent -> RIO e ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
emit (KeyEvent -> RIO e ()) -> KeyEvent -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Keycode -> KeyEvent
mkRelease Keycode
c
            Catch -> RIO e Catch
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch

    -- If the keycode does occur in our keymap
    Just BEnv
b  -> BEnv -> Switch -> RIO e (Maybe Action)
forall (m :: * -> *).
MonadUnliftIO m =>
BEnv -> Switch -> m (Maybe Action)
runBEnv BEnv
b Switch
Press RIO e (Maybe Action) -> (Maybe Action -> RIO e ()) -> RIO e ()
forall a b. RIO e a -> (a -> RIO e b) -> RIO e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Action
Nothing -> () -> RIO e ()
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()  -- If the previous action on this key was *not* a release
      Just Action
a  -> do
        -- Execute the press and register the release
        AppEnv
app <- Getting AppEnv e AppEnv -> RIO e AppEnv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AppEnv e AppEnv
forall c. HasAppEnv c => Lens' c AppEnv
Lens' e AppEnv
appEnv
        KEnv -> RIO KEnv () -> RIO e ()
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO (AppEnv -> BEnv -> KEnv
KEnv AppEnv
app BEnv
b) (RIO KEnv () -> RIO e ()) -> RIO KEnv () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
          Action -> AnyK ()
runAction Action
a
          Switch -> RIO KEnv Catch -> RIO KEnv ()
forall (m :: * -> *). MonadK m => Switch -> m Catch -> m ()
awaitMy Switch
Release (RIO KEnv Catch -> RIO KEnv ()) -> RIO KEnv Catch -> RIO KEnv ()
forall a b. (a -> b) -> a -> b
$ do
            BEnv -> Switch -> RIO KEnv (Maybe Action)
forall (m :: * -> *).
MonadUnliftIO m =>
BEnv -> Switch -> m (Maybe Action)
runBEnv BEnv
b Switch
Release RIO KEnv (Maybe Action)
-> (Maybe Action -> RIO KEnv ()) -> RIO KEnv ()
forall a b. RIO KEnv a -> (a -> RIO KEnv b) -> RIO KEnv b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe Action
Nothing -> () -> RIO KEnv ()
forall a. a -> RIO KEnv a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Just Action
a  -> Action -> AnyK ()
runAction Action
a
            Catch -> RIO KEnv Catch
forall a. a -> RIO KEnv a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch

--------------------------------------------------------------------------------
-- $loop
--
-- The app-loop of KMonad

-- | Perform 1 step of KMonad's app loop
--
-- We forever:
-- 1. Pull from the pull-chain until an unhandled event reaches us.
-- 2. If that event is a 'Press' we use our keymap to trigger an action.
loop :: RIO AppEnv ()
loop :: RIO AppEnv ()
loop = RIO AppEnv () -> RIO AppEnv ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (RIO AppEnv () -> RIO AppEnv ()) -> RIO AppEnv () -> RIO AppEnv ()
forall a b. (a -> b) -> a -> b
$ Getting Sluice AppEnv Sluice -> RIO AppEnv Sluice
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Sluice AppEnv Sluice
forall c. HasAppEnv c => Lens' c Sluice
Lens' AppEnv Sluice
sluice RIO AppEnv Sluice
-> (Sluice -> RIO AppEnv KeyEvent) -> RIO AppEnv KeyEvent
forall a b. RIO AppEnv a -> (a -> RIO AppEnv b) -> RIO AppEnv b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Sluice -> RIO AppEnv KeyEvent
forall e. HasLogFunc e => Sluice -> RIO e KeyEvent
Sl.pull RIO AppEnv KeyEvent -> (KeyEvent -> RIO AppEnv ()) -> RIO AppEnv ()
forall a b. RIO AppEnv a -> (a -> RIO AppEnv b) -> RIO AppEnv b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  KeyEvent
e | KeyEvent
eKeyEvent -> Getting Switch KeyEvent Switch -> Switch
forall s a. s -> Getting a s a -> a
^.Getting Switch KeyEvent Switch
forall c. HasKeyEvent c => Lens' c Switch
Lens' KeyEvent Switch
switch Switch -> Switch -> Bool
forall a. Eq a => a -> a -> Bool
== Switch
Press -> Keycode -> RIO AppEnv ()
forall e.
(HasAppEnv e, HasLogFunc e, HasAppCfg e) =>
Keycode -> RIO e ()
pressKey (Keycode -> RIO AppEnv ()) -> Keycode -> RIO AppEnv ()
forall a b. (a -> b) -> a -> b
$ KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
forall c. HasKeyEvent c => Lens' c Keycode
Lens' KeyEvent Keycode
keycode
  KeyEvent
_                      -> () -> RIO AppEnv ()
forall a. a -> RIO AppEnv a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Run KMonad using the provided configuration
startApp :: HasLogFunc e => AppCfg -> RIO e ()
startApp :: forall e. HasLogFunc e => AppCfg -> RIO e ()
startApp AppCfg
c = do
#ifdef linux_HOST_OS
  -- Ignore SIGCHLD to avoid zombie processes.
  IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ())
-> (IO Handler -> IO ()) -> IO Handler -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Handler -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Handler -> RIO e ()) -> IO Handler -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigCHLD Handler
Ignore Maybe SignalSet
forall a. Maybe a
Nothing
#endif
  ContT () (RIO e) AppEnv -> (AppEnv -> RIO e ()) -> RIO e ()
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT (AppCfg -> ContT () (RIO e) AppEnv
forall e r. HasLogFunc e => AppCfg -> ContT r (RIO e) AppEnv
initAppEnv AppCfg
c) (AppEnv -> RIO AppEnv () -> RIO e ()
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
`runRIO` RIO AppEnv ()
loop)