{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
-- | Used for management of applications.
module Keter.AppManager
    ( -- * Types
      AppManager
    , Action (..)
      -- * Actions
    , perform
    , reloadAppList
    , addApp
    , terminateApp
      -- * Initialize
    , initialize
      -- * Show
    , renderApps
    ) where

import Control.Applicative
import Control.Concurrent.MVar (MVar, newMVar, withMVar)
import Control.Concurrent.STM
import Control.Exception (SomeException)
import Control.Exception qualified as E
import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.IO.Unlift (withRunInIO)
import Control.Monad.Logger
import Control.Monad.Reader (ask)
import Data.Foldable (fold)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes, mapMaybe)
import Data.Set qualified as Set
import Data.Text (Text, pack, unpack)
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Builder qualified as Builder
import Data.Traversable.WithIndex (itraverse)
import Keter.App (App, AppStartConfig, showApp)
import Keter.App qualified as App
import Keter.Common
import Keter.Config
import Keter.Context
import Prelude hiding (FilePath, log)
import System.FilePath (FilePath)
import System.Posix.Files (getFileStatus, modificationTime)
import System.Posix.Types (EpochTime)
import Text.Printf (printf)

data AppManager = AppManager
    { AppManager -> TVar (Map AppId (TVar AppState))
apps           :: !(TVar (Map AppId (TVar AppState)))
    , AppManager -> AppStartConfig
appStartConfig :: !AppStartConfig
    , AppManager -> MVar ()
mutex          :: !(MVar ())
    }

data AppState = ASRunning App
              | ASStarting
                    !(Maybe App)
                    !(TVar (Maybe EpochTime))
                    !(TVar (Maybe Action)) -- ^ the next one to try
              | ASTerminated

showAppState :: AppState -> STM Text
showAppState :: AppState -> STM Text
showAppState (ASRunning App
x) = (\Text
x' -> Text
"running(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") (Text -> Text) -> STM Text -> STM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App -> STM Text
showApp App
x
showAppState (ASStarting Maybe App
mapp TVar (Maybe EpochTime)
tmtime TVar (Maybe Action)
tmaction) = do
  Maybe EpochTime
mtime   <- TVar (Maybe EpochTime) -> STM (Maybe EpochTime)
forall a. TVar a -> STM a
readTVar TVar (Maybe EpochTime)
tmtime
  Maybe Action
maction <- TVar (Maybe Action) -> STM (Maybe Action)
forall a. TVar a -> STM a
readTVar TVar (Maybe Action)
tmaction
  Maybe Text
mtext <- (App -> STM Text) -> Maybe App -> STM (Maybe Text)
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) -> Maybe a -> f (Maybe b)
traverse App -> STM Text
showApp Maybe App
mapp
  Text -> STM Text
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> STM Text) -> Text -> STM Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"starting app %s, time %s, action %s \n" (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
mtext) (Maybe EpochTime -> String
forall a. Show a => a -> String
show Maybe EpochTime
mtime) (Maybe Action -> String
forall a. Show a => a -> String
show Maybe Action
maction)
showAppState AppState
ASTerminated = Text -> STM Text
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"terminated"

renderApps :: AppManager -> STM Text
renderApps :: AppManager -> STM Text
renderApps AppManager
mngr = do
  Map AppId (TVar AppState)
appMap <- TVar (Map AppId (TVar AppState)) -> STM (Map AppId (TVar AppState))
forall a. TVar a -> STM a
readTVar (TVar (Map AppId (TVar AppState))
 -> STM (Map AppId (TVar AppState)))
-> TVar (Map AppId (TVar AppState))
-> STM (Map AppId (TVar AppState))
forall a b. (a -> b) -> a -> b
$ AppManager -> TVar (Map AppId (TVar AppState))
apps AppManager
mngr
  Map AppId Builder
x <- (AppId -> TVar AppState -> STM Builder)
-> Map AppId (TVar AppState) -> STM (Map AppId Builder)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(AppId -> a -> f b) -> Map AppId a -> f (Map AppId b)
itraverse (\AppId
_appId TVar AppState
tappState -> do
                AppState
state <- TVar AppState -> STM AppState
forall a. TVar a -> STM a
readTVar TVar AppState
tappState
                Text
res <- AppState -> STM Text
showAppState AppState
state
                Builder -> STM Builder
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> STM Builder) -> Builder -> STM Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
Builder.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text
res Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \n"
               ) Map AppId (TVar AppState)
appMap
  Text -> STM Text
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> STM Text) -> Text -> STM Text
forall a b. (a -> b) -> a -> b
$ LazyText -> Text
LT.toStrict (LazyText -> Text) -> LazyText -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> LazyText
Builder.toLazyText (Builder -> LazyText) -> Builder -> LazyText
forall a b. (a -> b) -> a -> b
$ Map AppId Builder -> Builder
forall m. Monoid m => Map AppId m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map AppId Builder
x

data Action = Reload AppInput | Terminate
 deriving Int -> Action -> String -> String
[Action] -> String -> String
Action -> String
(Int -> Action -> String -> String)
-> (Action -> String)
-> ([Action] -> String -> String)
-> Show Action
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Action -> String -> String
showsPrec :: Int -> Action -> String -> String
$cshow :: Action -> String
show :: Action -> String
$cshowList :: [Action] -> String -> String
showList :: [Action] -> String -> String
Show

initialize :: KeterM AppStartConfig AppManager
initialize :: KeterM AppStartConfig AppManager
initialize = do
  AppStartConfig
asc <- KeterM AppStartConfig AppStartConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO AppManager -> KeterM AppStartConfig AppManager
forall a. IO a -> KeterM AppStartConfig a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppManager -> KeterM AppStartConfig AppManager)
-> IO AppManager -> KeterM AppStartConfig AppManager
forall a b. (a -> b) -> a -> b
$ TVar (Map AppId (TVar AppState))
-> AppStartConfig -> MVar () -> AppManager
AppManager
      (TVar (Map AppId (TVar AppState))
 -> AppStartConfig -> MVar () -> AppManager)
-> IO (TVar (Map AppId (TVar AppState)))
-> IO (AppStartConfig -> MVar () -> AppManager)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map AppId (TVar AppState) -> IO (TVar (Map AppId (TVar AppState)))
forall a. a -> IO (TVar a)
newTVarIO Map AppId (TVar AppState)
forall k a. Map k a
Map.empty
      IO (AppStartConfig -> MVar () -> AppManager)
-> IO AppStartConfig -> IO (MVar () -> AppManager)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AppStartConfig -> IO AppStartConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AppStartConfig
asc
      IO (MVar () -> AppManager) -> IO (MVar ()) -> IO AppManager
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()

-- | Reset which apps are running.
--
-- * Any app not listed here that is currently running will be terminated.
--
-- * Any app listed here that is currently running will be reloaded.
--
-- * Any app listed here that is not currently running will be started.
reloadAppList :: Map Appname (FilePath, EpochTime)
              -> KeterM AppManager ()
reloadAppList :: Map Text (String, EpochTime) -> KeterM AppManager ()
reloadAppList Map Text (String, EpochTime)
newApps = do
  AppManager{MVar ()
TVar (Map AppId (TVar AppState))
AppStartConfig
apps :: AppManager -> TVar (Map AppId (TVar AppState))
appStartConfig :: AppManager -> AppStartConfig
mutex :: AppManager -> MVar ()
apps :: TVar (Map AppId (TVar AppState))
appStartConfig :: AppStartConfig
mutex :: MVar ()
..} <- KeterM AppManager AppManager
forall r (m :: * -> *). MonadReader r m => m r
ask
  ((forall a. KeterM AppManager a -> IO a) -> IO ())
-> KeterM AppManager ()
forall b.
((forall a. KeterM AppManager a -> IO a) -> IO b)
-> KeterM AppManager b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. KeterM AppManager a -> IO a) -> IO ())
 -> KeterM AppManager ())
-> ((forall a. KeterM AppManager a -> IO a) -> IO ())
-> KeterM AppManager ()
forall a b. (a -> b) -> a -> b
$ \forall a. KeterM AppManager a -> IO a
rio ->
    MVar () -> (() -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
mutex ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [KeterM AppManager ()]
actions <- STM [KeterM AppManager ()] -> IO [KeterM AppManager ()]
forall a. STM a -> IO a
atomically (STM [KeterM AppManager ()] -> IO [KeterM AppManager ()])
-> STM [KeterM AppManager ()] -> IO [KeterM AppManager ()]
forall a b. (a -> b) -> a -> b
$ do
          Map AppId (TVar AppState)
m <- TVar (Map AppId (TVar AppState)) -> STM (Map AppId (TVar AppState))
forall a. TVar a -> STM a
readTVar TVar (Map AppId (TVar AppState))
apps
          let currentApps :: Set Text
currentApps = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ (AppId -> Maybe Text) -> [AppId] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AppId -> Maybe Text
toAppName ([AppId] -> [Text]) -> [AppId] -> [Text]
forall a b. (a -> b) -> a -> b
$ Map AppId (TVar AppState) -> [AppId]
forall k a. Map k a -> [k]
Map.keys Map AppId (TVar AppState)
m
              allApps :: [Text]
allApps = Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Map Text (String, EpochTime) -> Set Text
forall k a. Map k a -> Set k
Map.keysSet Map Text (String, EpochTime)
newApps Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
currentApps
          [Maybe (KeterM AppManager ())] -> [KeterM AppManager ()]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (KeterM AppManager ())] -> [KeterM AppManager ()])
-> STM [Maybe (KeterM AppManager ())] -> STM [KeterM AppManager ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> STM (Maybe (KeterM AppManager ())))
-> [Text] -> STM [Maybe (KeterM AppManager ())]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Map AppId (TVar AppState)
-> Text -> STM (Maybe (KeterM AppManager ()))
getAction Map AppId (TVar AppState)
m) [Text]
allApps
      (KeterM AppManager () -> IO ()) -> [KeterM AppManager ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ KeterM AppManager () -> IO ()
forall a. KeterM AppManager a -> IO a
rio [KeterM AppManager ()]
actions
  where
    toAppName :: AppId -> Maybe Text
toAppName AppId
AIBuiltin   = Maybe Text
forall a. Maybe a
Nothing
    toAppName (AINamed Text
x) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x

    getAction :: Map AppId (TVar AppState)
-> Text -> STM (Maybe (KeterM AppManager ()))
getAction Map AppId (TVar AppState)
currentApps Text
appname = do
        case AppId -> Map AppId (TVar AppState) -> Maybe (TVar AppState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> AppId
AINamed Text
appname) Map AppId (TVar AppState)
currentApps of
            Maybe (TVar AppState)
Nothing -> Maybe (KeterM AppManager ()) -> STM (Maybe (KeterM AppManager ()))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (KeterM AppManager ())
freshLaunch
            Just TVar AppState
tstate -> do
                AppState
state <- TVar AppState -> STM AppState
forall a. TVar a -> STM a
readTVar TVar AppState
tstate
                case AppState
state of
                    AppState
ASTerminated -> Maybe (KeterM AppManager ()) -> STM (Maybe (KeterM AppManager ()))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (KeterM AppManager ())
freshLaunch
                    ASRunning App
app ->
                        case Text -> Map Text (String, EpochTime) -> Maybe (String, EpochTime)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
appname Map Text (String, EpochTime)
newApps of
                            Maybe (String, EpochTime)
Nothing -> Maybe (KeterM AppManager ()) -> STM (Maybe (KeterM AppManager ()))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (KeterM AppManager ())
terminate
                            Just (String
fp, EpochTime
newTimestamp) -> do
                                Maybe EpochTime
moldTimestamp <- App -> STM (Maybe EpochTime)
App.getTimestamp App
app
                                Maybe (KeterM AppManager ()) -> STM (Maybe (KeterM AppManager ()))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (KeterM AppManager ())
 -> STM (Maybe (KeterM AppManager ())))
-> Maybe (KeterM AppManager ())
-> STM (Maybe (KeterM AppManager ()))
forall a b. (a -> b) -> a -> b
$ if Maybe EpochTime
moldTimestamp Maybe EpochTime -> Maybe EpochTime -> Bool
forall a. Eq a => a -> a -> Bool
== EpochTime -> Maybe EpochTime
forall a. a -> Maybe a
Just EpochTime
newTimestamp
                                    then Maybe (KeterM AppManager ())
forall a. Maybe a
Nothing
                                    else String -> EpochTime -> Maybe (KeterM AppManager ())
reload String
fp EpochTime
newTimestamp
                    ASStarting Maybe App
_ TVar (Maybe EpochTime)
tmoldTimestamp TVar (Maybe Action)
tmaction ->
                        case Text -> Map Text (String, EpochTime) -> Maybe (String, EpochTime)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
appname Map Text (String, EpochTime)
newApps of
                            Maybe (String, EpochTime)
Nothing -> do
                                TVar (Maybe Action) -> Maybe Action -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Action)
tmaction (Maybe Action -> STM ()) -> Maybe Action -> STM ()
forall a b. (a -> b) -> a -> b
$ Action -> Maybe Action
forall a. a -> Maybe a
Just Action
Terminate
                                Maybe (KeterM AppManager ()) -> STM (Maybe (KeterM AppManager ()))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (KeterM AppManager ())
forall a. Maybe a
Nothing
                            Just (String
fp, EpochTime
newTimestamp) -> do
                                Maybe EpochTime
moldTimestamp <- TVar (Maybe EpochTime) -> STM (Maybe EpochTime)
forall a. TVar a -> STM a
readTVar TVar (Maybe EpochTime)
tmoldTimestamp
                                Maybe (KeterM AppManager ()) -> STM (Maybe (KeterM AppManager ()))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (KeterM AppManager ())
 -> STM (Maybe (KeterM AppManager ())))
-> Maybe (KeterM AppManager ())
-> STM (Maybe (KeterM AppManager ()))
forall a b. (a -> b) -> a -> b
$ if Maybe EpochTime
moldTimestamp Maybe EpochTime -> Maybe EpochTime -> Bool
forall a. Eq a => a -> a -> Bool
== EpochTime -> Maybe EpochTime
forall a. a -> Maybe a
Just EpochTime
newTimestamp
                                    then Maybe (KeterM AppManager ())
forall a. Maybe a
Nothing
                                    else String -> EpochTime -> Maybe (KeterM AppManager ())
reload String
fp EpochTime
newTimestamp
      where
        freshLaunch :: Maybe (KeterM AppManager ())
freshLaunch =
            case Text -> Map Text (String, EpochTime) -> Maybe (String, EpochTime)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
appname Map Text (String, EpochTime)
newApps of
                Maybe (String, EpochTime)
Nothing              -> Bool
-> Maybe (KeterM AppManager ()) -> Maybe (KeterM AppManager ())
forall a. (?callStack::CallStack) => Bool -> a -> a
E.assert Bool
False Maybe (KeterM AppManager ())
forall a. Maybe a
Nothing
                Just (String
fp, EpochTime
timestamp) -> String -> EpochTime -> Maybe (KeterM AppManager ())
reload String
fp EpochTime
timestamp
        terminate :: Maybe (KeterM AppManager ())
terminate = KeterM AppManager () -> Maybe (KeterM AppManager ())
forall a. a -> Maybe a
Just (KeterM AppManager () -> Maybe (KeterM AppManager ()))
-> KeterM AppManager () -> Maybe (KeterM AppManager ())
forall a b. (a -> b) -> a -> b
$ AppId -> Action -> KeterM AppManager ()
performNoLock (Text -> AppId
AINamed Text
appname) Action
Terminate
        reload :: String -> EpochTime -> Maybe (KeterM AppManager ())
reload String
fp EpochTime
timestamp = KeterM AppManager () -> Maybe (KeterM AppManager ())
forall a. a -> Maybe a
Just (KeterM AppManager () -> Maybe (KeterM AppManager ()))
-> KeterM AppManager () -> Maybe (KeterM AppManager ())
forall a b. (a -> b) -> a -> b
$ AppId -> Action -> KeterM AppManager ()
performNoLock (Text -> AppId
AINamed Text
appname) (AppInput -> Action
Reload (AppInput -> Action) -> AppInput -> Action
forall a b. (a -> b) -> a -> b
$ String -> EpochTime -> AppInput
AIBundle String
fp EpochTime
timestamp)
        {-
        case (Map.lookup appname currentApps, Map.lookup appname newApps) of
            (Nothing, Nothing) -> E.assert False Nothing
            (Just _, Nothing) -> Just $ perform am (AINamed appname) Terminate
            (Nothing, Just _) -> Just $ perform am (AINamed appname) (Reload AIBundle)
            -}

    {- FIXME
        actions <- do

            current <- getAllApps appMan
            let apps = Set.toList $ Set.fromList (Map.keys newMap) `Set.union` current
            fmap catMaybes $ forM apps $ \appname -> return $
                case (Set.member appname current, Map.lookup appname newMap) of
                    (False, Nothing) -> Nothing -- should never happen
                    (True, Nothing) -> Just $ terminateApp appname
                    (False, Just (bundle, _)) -> Just $ runKIO' $ addApp bundle
                    (Just (_, oldTime), Just (bundle, newTime))
                        | newTime /= oldTime -> Just $ runKIO' $ addApp bundle
                        | otherwise -> Nothing
        P.sequence_ actions

getAllApps :: AppManager -> IO (Set Appname)
getAllApps AppManager {..} = atomically $ do
    m <- readTVar apps
    return $ Set.fromList $ mapMaybe toAppName $ Map.keys m
    -}

perform :: AppId -> Action -> KeterM AppManager ()
perform :: AppId -> Action -> KeterM AppManager ()
perform AppId
appid Action
action = do
    AppManager
am <- KeterM AppManager AppManager
forall r (m :: * -> *). MonadReader r m => m r
ask
    ((forall a. KeterM AppManager a -> IO a) -> IO ())
-> KeterM AppManager ()
forall b.
((forall a. KeterM AppManager a -> IO a) -> IO b)
-> KeterM AppManager b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. KeterM AppManager a -> IO a) -> IO ())
 -> KeterM AppManager ())
-> ((forall a. KeterM AppManager a -> IO a) -> IO ())
-> KeterM AppManager ()
forall a b. (a -> b) -> a -> b
$ \forall a. KeterM AppManager a -> IO a
rio ->
      MVar () -> (() -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (AppManager -> MVar ()
mutex AppManager
am) ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ KeterM AppManager () -> IO ()
forall a. KeterM AppManager a -> IO a
rio (KeterM AppManager () -> IO ()) -> KeterM AppManager () -> IO ()
forall a b. (a -> b) -> a -> b
$  AppId -> Action -> KeterM AppManager ()
performNoLock AppId
appid Action
action

performNoLock :: AppId -> Action -> KeterM AppManager ()
performNoLock :: AppId -> Action -> KeterM AppManager ()
performNoLock AppId
aid Action
action = do
    AppManager{MVar ()
TVar (Map AppId (TVar AppState))
AppStartConfig
apps :: AppManager -> TVar (Map AppId (TVar AppState))
appStartConfig :: AppManager -> AppStartConfig
mutex :: AppManager -> MVar ()
apps :: TVar (Map AppId (TVar AppState))
appStartConfig :: AppStartConfig
mutex :: MVar ()
..} <- KeterM AppManager AppManager
forall r (m :: * -> *). MonadReader r m => m r
ask
    ((forall a. KeterM AppManager a -> IO a) -> IO ())
-> KeterM AppManager ()
forall b.
((forall a. KeterM AppManager a -> IO a) -> IO b)
-> KeterM AppManager b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. KeterM AppManager a -> IO a) -> IO ())
 -> KeterM AppManager ())
-> ((forall a. KeterM AppManager a -> IO a) -> IO ())
-> KeterM AppManager ()
forall a b. (a -> b) -> a -> b
$ \forall a. KeterM AppManager a -> IO a
rio -> IO () -> IO ()
forall a. IO a -> IO a
E.mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        KeterM AppManager ()
launchWorker' <- IO (KeterM AppManager ()) -> IO (KeterM AppManager ())
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (KeterM AppManager ()) -> IO (KeterM AppManager ()))
-> IO (KeterM AppManager ()) -> IO (KeterM AppManager ())
forall a b. (a -> b) -> a -> b
$ STM (KeterM AppManager ()) -> IO (KeterM AppManager ())
forall a. STM a -> IO a
atomically (STM (KeterM AppManager ()) -> IO (KeterM AppManager ()))
-> STM (KeterM AppManager ()) -> IO (KeterM AppManager ())
forall a b. (a -> b) -> a -> b
$ do
            Map AppId (TVar AppState)
m <- TVar (Map AppId (TVar AppState)) -> STM (Map AppId (TVar AppState))
forall a. TVar a -> STM a
readTVar TVar (Map AppId (TVar AppState))
apps
            case AppId -> Map AppId (TVar AppState) -> Maybe (TVar AppState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AppId
aid Map AppId (TVar AppState)
m of
                Just TVar AppState
tstate -> do
                    AppState
state <- TVar AppState -> STM AppState
forall a. TVar a -> STM a
readTVar TVar AppState
tstate
                    case AppState
state of
                        ASStarting Maybe App
_mcurrent TVar (Maybe EpochTime)
_tmtimestamp TVar (Maybe Action)
tmnext -> do
                            TVar (Maybe Action) -> Maybe Action -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Action)
tmnext (Maybe Action -> STM ()) -> Maybe Action -> STM ()
forall a b. (a -> b) -> a -> b
$ Action -> Maybe Action
forall a. a -> Maybe a
Just Action
action
                            -- use the previous worker, so nothing to do
                            KeterM AppManager () -> STM (KeterM AppManager ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return KeterM AppManager ()
noWorker
                        ASRunning App
runningApp -> do
                            TVar (Maybe Action)
tmnext <- Maybe Action -> STM (TVar (Maybe Action))
forall a. a -> STM (TVar a)
newTVar Maybe Action
forall a. Maybe a
Nothing
                            TVar (Maybe EpochTime)
tmtimestamp <- Maybe EpochTime -> STM (TVar (Maybe EpochTime))
forall a. a -> STM (TVar a)
newTVar (Maybe EpochTime -> STM (TVar (Maybe EpochTime)))
-> Maybe EpochTime -> STM (TVar (Maybe EpochTime))
forall a b. (a -> b) -> a -> b
$
                                case Action
action of
                                    Reload (AIBundle String
_fp EpochTime
timestamp) -> EpochTime -> Maybe EpochTime
forall a. a -> Maybe a
Just EpochTime
timestamp
                                    Reload (AIData BundleConfig
_) -> Maybe EpochTime
forall a. Maybe a
Nothing
                                    Action
Terminate -> Maybe EpochTime
forall a. Maybe a
Nothing
                            TVar AppState -> AppState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar AppState
tstate (AppState -> STM ()) -> AppState -> STM ()
forall a b. (a -> b) -> a -> b
$ Maybe App
-> TVar (Maybe EpochTime) -> TVar (Maybe Action) -> AppState
ASStarting (App -> Maybe App
forall a. a -> Maybe a
Just App
runningApp) TVar (Maybe EpochTime)
tmtimestamp TVar (Maybe Action)
tmnext
                            KeterM AppManager () -> STM (KeterM AppManager ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeterM AppManager () -> STM (KeterM AppManager ()))
-> KeterM AppManager () -> STM (KeterM AppManager ())
forall a b. (a -> b) -> a -> b
$ AppId
-> TVar AppState
-> TVar (Maybe Action)
-> Maybe App
-> Action
-> KeterM AppManager ()
launchWorker AppId
aid TVar AppState
tstate TVar (Maybe Action)
tmnext (App -> Maybe App
forall a. a -> Maybe a
Just App
runningApp) Action
action
                        AppState
ASTerminated -> TVar (Map AppId (TVar AppState)) -> STM (KeterM AppManager ())
onNotRunning TVar (Map AppId (TVar AppState))
apps
                Maybe (TVar AppState)
Nothing -> TVar (Map AppId (TVar AppState)) -> STM (KeterM AppManager ())
onNotRunning TVar (Map AppId (TVar AppState))
apps
        KeterM AppManager () -> IO ()
forall a. KeterM AppManager a -> IO a
rio KeterM AppManager ()
launchWorker'
  where
    noWorker :: KeterM AppManager ()
noWorker = () -> KeterM AppManager ()
forall a. a -> KeterM AppManager a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    onNotRunning :: TVar (Map AppId (TVar AppState)) -> STM (KeterM AppManager ())
onNotRunning TVar (Map AppId (TVar AppState))
apps =
        case Action
action of
            Reload AppInput
input -> do
                TVar (Maybe Action)
tmnext <- Maybe Action -> STM (TVar (Maybe Action))
forall a. a -> STM (TVar a)
newTVar Maybe Action
forall a. Maybe a
Nothing
                TVar (Maybe EpochTime)
tmtimestamp <- Maybe EpochTime -> STM (TVar (Maybe EpochTime))
forall a. a -> STM (TVar a)
newTVar (Maybe EpochTime -> STM (TVar (Maybe EpochTime)))
-> Maybe EpochTime -> STM (TVar (Maybe EpochTime))
forall a b. (a -> b) -> a -> b
$
                    case AppInput
input of
                        AIBundle String
_fp EpochTime
timestamp -> EpochTime -> Maybe EpochTime
forall a. a -> Maybe a
Just EpochTime
timestamp
                        AIData BundleConfig
_               -> Maybe EpochTime
forall a. Maybe a
Nothing
                TVar AppState
tstate <- AppState -> STM (TVar AppState)
forall a. a -> STM (TVar a)
newTVar (AppState -> STM (TVar AppState))
-> AppState -> STM (TVar AppState)
forall a b. (a -> b) -> a -> b
$ Maybe App
-> TVar (Maybe EpochTime) -> TVar (Maybe Action) -> AppState
ASStarting Maybe App
forall a. Maybe a
Nothing TVar (Maybe EpochTime)
tmtimestamp TVar (Maybe Action)
tmnext
                TVar (Map AppId (TVar AppState))
-> (Map AppId (TVar AppState) -> Map AppId (TVar AppState))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Map AppId (TVar AppState))
apps ((Map AppId (TVar AppState) -> Map AppId (TVar AppState))
 -> STM ())
-> (Map AppId (TVar AppState) -> Map AppId (TVar AppState))
-> STM ()
forall a b. (a -> b) -> a -> b
$ AppId
-> TVar AppState
-> Map AppId (TVar AppState)
-> Map AppId (TVar AppState)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AppId
aid TVar AppState
tstate
                KeterM AppManager () -> STM (KeterM AppManager ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeterM AppManager () -> STM (KeterM AppManager ()))
-> KeterM AppManager () -> STM (KeterM AppManager ())
forall a b. (a -> b) -> a -> b
$ AppId
-> TVar AppState
-> TVar (Maybe Action)
-> Maybe App
-> Action
-> KeterM AppManager ()
launchWorker AppId
aid TVar AppState
tstate TVar (Maybe Action)
tmnext Maybe App
forall a. Maybe a
Nothing Action
action
            Action
Terminate -> KeterM AppManager () -> STM (KeterM AppManager ())
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return KeterM AppManager ()
noWorker

launchWorker ::
     AppId
  -> TVar AppState
  -> TVar (Maybe Action)
  -> Maybe App
  -> Action
  -> KeterM AppManager ()
launchWorker :: AppId
-> TVar AppState
-> TVar (Maybe Action)
-> Maybe App
-> Action
-> KeterM AppManager ()
launchWorker AppId
appid TVar AppState
tstate TVar (Maybe Action)
tmnext = Maybe App -> Action -> KeterM AppManager ()
loop
  where
    loop :: Maybe App -> Action -> KeterM AppManager ()
    loop :: Maybe App -> Action -> KeterM AppManager ()
loop Maybe App
mcurrentApp Action
action = do
        Maybe App
mRunningApp <- Maybe App -> Action -> KeterM AppManager (Maybe App)
processAction Maybe App
mcurrentApp Action
action
        Maybe Action
mnext <- IO (Maybe Action) -> KeterM AppManager (Maybe Action)
forall a. IO a -> KeterM AppManager a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Action) -> KeterM AppManager (Maybe Action))
-> IO (Maybe Action) -> KeterM AppManager (Maybe Action)
forall a b. (a -> b) -> a -> b
$ STM (Maybe Action) -> IO (Maybe Action)
forall a. STM a -> IO a
atomically (STM (Maybe Action) -> IO (Maybe Action))
-> STM (Maybe Action) -> IO (Maybe Action)
forall a b. (a -> b) -> a -> b
$ do
            Maybe Action
mnext <- TVar (Maybe Action) -> STM (Maybe Action)
forall a. TVar a -> STM a
readTVar TVar (Maybe Action)
tmnext
            TVar (Maybe Action) -> Maybe Action -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Action)
tmnext Maybe Action
forall a. Maybe a
Nothing
            case Maybe Action
mnext of
                Maybe Action
Nothing ->
                    case Maybe App
mRunningApp of
                        Maybe App
Nothing -> TVar AppState -> AppState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar AppState
tstate AppState
ASTerminated
                        Just App
runningApp -> TVar AppState -> AppState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar AppState
tstate (AppState -> STM ()) -> AppState -> STM ()
forall a b. (a -> b) -> a -> b
$ App -> AppState
ASRunning App
runningApp
                Just Action
_next -> do
                    TVar (Maybe EpochTime)
tmtimestamp <- Maybe EpochTime -> STM (TVar (Maybe EpochTime))
forall a. a -> STM (TVar a)
newTVar (Maybe EpochTime -> STM (TVar (Maybe EpochTime)))
-> Maybe EpochTime -> STM (TVar (Maybe EpochTime))
forall a b. (a -> b) -> a -> b
$
                        case Action
action of
                            Reload (AIBundle String
_fp EpochTime
timestamp) -> EpochTime -> Maybe EpochTime
forall a. a -> Maybe a
Just EpochTime
timestamp
                            Reload (AIData BundleConfig
_)               -> Maybe EpochTime
forall a. Maybe a
Nothing
                            Action
Terminate                       -> Maybe EpochTime
forall a. Maybe a
Nothing
                    TVar AppState -> AppState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar AppState
tstate (AppState -> STM ()) -> AppState -> STM ()
forall a b. (a -> b) -> a -> b
$ Maybe App
-> TVar (Maybe EpochTime) -> TVar (Maybe Action) -> AppState
ASStarting Maybe App
mRunningApp TVar (Maybe EpochTime)
tmtimestamp TVar (Maybe Action)
tmnext
            Maybe Action -> STM (Maybe Action)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Action
mnext
        Maybe Action
-> (Action -> KeterM AppManager ()) -> KeterM AppManager ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Action
mnext (Maybe App -> Action -> KeterM AppManager ()
loop Maybe App
mRunningApp)

    reloadMsg :: String -> String -> Text
    reloadMsg :: String -> String -> Text
reloadMsg String
app String
input =
        String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Reloading from: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
app String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
input

    errorStartingBundleMsg :: String -> String -> Text
    errorStartingBundleMsg :: String -> String -> Text
errorStartingBundleMsg String
bundleName String
e =
        String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Error occured when launching bundle " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
bundleName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e

    processAction :: Maybe App -> Action -> KeterM AppManager (Maybe App)
    processAction :: Maybe App -> Action -> KeterM AppManager (Maybe App)
processAction Maybe App
Nothing Action
Terminate = Maybe App -> KeterM AppManager (Maybe App)
forall a. a -> KeterM AppManager a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe App
forall a. Maybe a
Nothing
    processAction (Just App
app) Action
Terminate = do
        $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> KeterM AppManager ()
(Text -> KeterM AppManager ())
-> (Text -> Text) -> Text -> KeterM AppManager ()
forall a. a -> a
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> KeterM AppManager ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logInfo (Text -> KeterM AppManager ()) -> Text -> KeterM AppManager ()
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String
"Terminating" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> App -> String
forall a. Show a => a -> String
show App
app)
        (AppManager -> App) -> KeterM App () -> KeterM AppManager ()
forall cfg cfg' a. (cfg -> cfg') -> KeterM cfg' a -> KeterM cfg a
withMappedConfig (App -> AppManager -> App
forall a b. a -> b -> a
const App
app) KeterM App ()
App.terminate
        Maybe App -> KeterM AppManager (Maybe App)
forall a. a -> KeterM AppManager a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe App
forall a. Maybe a
Nothing
    processAction Maybe App
Nothing (Reload AppInput
input) = do
        $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> KeterM AppManager ()
(Text -> KeterM AppManager ())
-> (Text -> Text) -> Text -> KeterM AppManager ()
forall a. a -> a
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> KeterM AppManager ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logInfo (String -> String -> Text
reloadMsg String
"Nothing" (AppInput -> String
forall a. Show a => a -> String
show AppInput
input))
        AppManager{MVar ()
TVar (Map AppId (TVar AppState))
AppStartConfig
apps :: AppManager -> TVar (Map AppId (TVar AppState))
appStartConfig :: AppManager -> AppStartConfig
mutex :: AppManager -> MVar ()
apps :: TVar (Map AppId (TVar AppState))
appStartConfig :: AppStartConfig
mutex :: MVar ()
..} <- KeterM AppManager AppManager
forall r (m :: * -> *). MonadReader r m => m r
ask
        Either SomeException App
eres <- ((forall a. KeterM AppManager a -> IO a)
 -> IO (Either SomeException App))
-> KeterM AppManager (Either SomeException App)
forall b.
((forall a. KeterM AppManager a -> IO a) -> IO b)
-> KeterM AppManager b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. KeterM AppManager a -> IO a)
  -> IO (Either SomeException App))
 -> KeterM AppManager (Either SomeException App))
-> ((forall a. KeterM AppManager a -> IO a)
    -> IO (Either SomeException App))
-> KeterM AppManager (Either SomeException App)
forall a b. (a -> b) -> a -> b
$ \forall a. KeterM AppManager a -> IO a
rio -> forall e a. Exception e => IO a -> IO (Either e a)
E.try @SomeException (IO App -> IO (Either SomeException App))
-> IO App -> IO (Either SomeException App)
forall a b. (a -> b) -> a -> b
$
            KeterM AppManager App -> IO App
forall a. KeterM AppManager a -> IO a
rio (KeterM AppManager App -> IO App)
-> KeterM AppManager App -> IO App
forall a b. (a -> b) -> a -> b
$ (AppManager -> AppStartConfig)
-> KeterM AppStartConfig App -> KeterM AppManager App
forall cfg cfg' a. (cfg -> cfg') -> KeterM cfg' a -> KeterM cfg a
withMappedConfig (AppStartConfig -> AppManager -> AppStartConfig
forall a b. a -> b -> a
const AppStartConfig
appStartConfig) (KeterM AppStartConfig App -> KeterM AppManager App)
-> KeterM AppStartConfig App -> KeterM AppManager App
forall a b. (a -> b) -> a -> b
$ AppId -> AppInput -> KeterM AppStartConfig App
App.start AppId
appid AppInput
input
        case Either SomeException App
eres of
            Left SomeException
e -> do
                $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> KeterM AppManager ()
(Text -> KeterM AppManager ())
-> (Text -> Text) -> Text -> KeterM AppManager ()
forall a. a -> a
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> KeterM AppManager ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logError (String -> String -> Text
errorStartingBundleMsg (Text -> String
forall a. Show a => a -> String
show Text
name) (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))
                Maybe App -> KeterM AppManager (Maybe App)
forall a. a -> KeterM AppManager a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe App
forall a. Maybe a
Nothing
            Right App
app -> Maybe App -> KeterM AppManager (Maybe App)
forall a. a -> KeterM AppManager a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe App -> KeterM AppManager (Maybe App))
-> Maybe App -> KeterM AppManager (Maybe App)
forall a b. (a -> b) -> a -> b
$ App -> Maybe App
forall a. a -> Maybe a
Just App
app
    processAction (Just App
app) (Reload AppInput
input) = do
        $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> KeterM AppManager ()
(Text -> KeterM AppManager ())
-> (Text -> Text) -> Text -> KeterM AppManager ()
forall a. a -> a
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> KeterM AppManager ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logInfo (String -> String -> Text
reloadMsg (Maybe App -> String
forall a. Show a => a -> String
show (Maybe App -> String) -> Maybe App -> String
forall a b. (a -> b) -> a -> b
$ App -> Maybe App
forall a. a -> Maybe a
Just App
app) (AppInput -> String
forall a. Show a => a -> String
show AppInput
input))
        Either SomeException ()
eres <- ((forall a. KeterM AppManager a -> IO a)
 -> IO (Either SomeException ()))
-> KeterM AppManager (Either SomeException ())
forall b.
((forall a. KeterM AppManager a -> IO a) -> IO b)
-> KeterM AppManager b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. KeterM AppManager a -> IO a)
  -> IO (Either SomeException ()))
 -> KeterM AppManager (Either SomeException ()))
-> ((forall a. KeterM AppManager a -> IO a)
    -> IO (Either SomeException ()))
-> KeterM AppManager (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ \forall a. KeterM AppManager a -> IO a
rio -> forall e a. Exception e => IO a -> IO (Either e a)
E.try @SomeException (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$
            KeterM AppManager () -> IO ()
forall a. KeterM AppManager a -> IO a
rio (KeterM AppManager () -> IO ()) -> KeterM AppManager () -> IO ()
forall a b. (a -> b) -> a -> b
$ (AppManager -> App) -> KeterM App () -> KeterM AppManager ()
forall cfg cfg' a. (cfg -> cfg') -> KeterM cfg' a -> KeterM cfg a
withMappedConfig (App -> AppManager -> App
forall a b. a -> b -> a
const App
app) (KeterM App () -> KeterM AppManager ())
-> KeterM App () -> KeterM AppManager ()
forall a b. (a -> b) -> a -> b
$ AppInput -> KeterM App ()
App.reload AppInput
input
        case Either SomeException ()
eres of
            Left SomeException
e -> do
                $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> KeterM AppManager ()
(Text -> KeterM AppManager ())
-> (Text -> Text) -> Text -> KeterM AppManager ()
forall a. a -> a
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> KeterM AppManager ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logError (String -> String -> Text
errorStartingBundleMsg (Text -> String
forall a. Show a => a -> String
show Text
name) (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))
                -- reloading will /always/ result in a valid app, either the old one
                -- will continue running or the new one will replace it.
                Maybe App -> KeterM AppManager (Maybe App)
forall a. a -> KeterM AppManager a
forall (m :: * -> *) a. Monad m => a -> m a
return (App -> Maybe App
forall a. a -> Maybe a
Just App
app)
            Right () -> Maybe App -> KeterM AppManager (Maybe App)
forall a. a -> KeterM AppManager a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe App -> KeterM AppManager (Maybe App))
-> Maybe App -> KeterM AppManager (Maybe App)
forall a b. (a -> b) -> a -> b
$ App -> Maybe App
forall a. a -> Maybe a
Just App
app

    name :: Text
name =
        case AppId
appid of
            AppId
AIBuiltin -> Text
"<builtin>"
            AINamed Text
x -> Text
x

addApp :: FilePath -> KeterM AppManager ()
addApp :: String -> KeterM AppManager ()
addApp String
bundle = do
    (AppId
input, Action
action) <- IO (AppId, Action) -> KeterM AppManager (AppId, Action)
forall a. IO a -> KeterM AppManager a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AppId, Action) -> KeterM AppManager (AppId, Action))
-> IO (AppId, Action) -> KeterM AppManager (AppId, Action)
forall a b. (a -> b) -> a -> b
$ String -> IO (AppId, Action)
getInputForBundle String
bundle
    AppId -> Action -> KeterM AppManager ()
perform AppId
input Action
action

getInputForBundle :: FilePath -> IO (AppId, Action)
getInputForBundle :: String -> IO (AppId, Action)
getInputForBundle String
bundle = do
    EpochTime
time <- FileStatus -> EpochTime
modificationTime (FileStatus -> EpochTime) -> IO FileStatus -> IO EpochTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO FileStatus
getFileStatus String
bundle
    (AppId, Action) -> IO (AppId, Action)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> AppId
AINamed (Text -> AppId) -> Text -> AppId
forall a b. (a -> b) -> a -> b
$ String -> Text
getAppname String
bundle, AppInput -> Action
Reload (AppInput -> Action) -> AppInput -> Action
forall a b. (a -> b) -> a -> b
$ String -> EpochTime -> AppInput
AIBundle String
bundle EpochTime
time)

terminateApp :: Appname -> KeterM AppManager ()
terminateApp :: Text -> KeterM AppManager ()
terminateApp Text
appname = AppId -> Action -> KeterM AppManager ()
perform (Text -> AppId
AINamed Text
appname) Action
Terminate