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

import Keter.Common
import Keter.Context
import           Data.Set                   (Set)
import           Data.Text                  (Text)
import           System.FilePath            (FilePath)
import           Data.Map                   (Map)
import           Control.Exception          (SomeException)
import           Control.Applicative
import           Control.Concurrent         (forkIO)
import           Control.Concurrent.MVar    (MVar, newMVar, withMVar)
import           Control.Concurrent.STM
import qualified Control.Exception          as E
import           Control.Monad              (void)
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 qualified Data.Map                   as Map
import           Data.Maybe                 (catMaybes, mapMaybe)
import qualified Data.Set                   as Set
import           Data.Text                  (pack, unpack)
import qualified Data.Text.Lazy             as LT
import qualified Data.Text.Lazy.Builder     as Builder
import           Data.Traversable.WithIndex (itraverse)
import           Keter.App                  (App, AppStartConfig, showApp)
import qualified Keter.App                  as App
import           Keter.Config
import           Prelude                    hiding (FilePath, log)
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(" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> 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   <- forall a. TVar a -> STM a
readTVar TVar (Maybe EpochTime)
tmtime
  Maybe Action
maction <- forall a. TVar a -> STM a
readTVar TVar (Maybe Action)
tmaction
  Maybe Text
mtext <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse App -> STM Text
showApp Maybe App
mapp
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"starting app %s, time %s, action %s \n" (Text -> String
unpack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
mtext) (forall a. Show a => a -> String
show Maybe EpochTime
mtime) (forall a. Show a => a -> String
show Maybe Action
maction)
showAppState AppState
ASTerminated = 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 <- forall a. TVar a -> STM a
readTVar forall a b. (a -> b) -> a -> b
$ AppManager -> TVar (Map AppId (TVar AppState))
apps AppManager
mngr
  Map AppId Builder
x <- forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\AppId
appId TVar AppState
tappState -> do
                AppState
state <- forall a. TVar a -> STM a
readTVar TVar AppState
tappState
                Text
res <- AppState -> STM Text
showAppState AppState
state
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Builder
Builder.fromText forall a b. (a -> b) -> a -> b
$ Text
res forall a. Semigroup a => a -> a -> a
<> Text
" \n"
               ) Map AppId (TVar AppState)
appMap
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.toStrict forall a b. (a -> b) -> a -> b
$ Builder -> Text
Builder.toLazyText forall a b. (a -> b) -> a -> b
$ 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
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Action] -> String -> String
$cshowList :: [Action] -> String -> String
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> String -> String
$cshowsPrec :: Int -> Action -> String -> String
Show

initialize :: KeterM AppStartConfig AppManager
initialize :: KeterM AppStartConfig AppManager
initialize = do
  AppStartConfig
asc <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ TVar (Map AppId (TVar AppState))
-> AppStartConfig -> MVar () -> AppManager
AppManager
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (TVar a)
newTVarIO forall k a. Map k a
Map.empty
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return AppStartConfig
asc
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
  am :: AppManager
am@AppManager{TVar (Map AppId (TVar AppState))
MVar ()
AppStartConfig
mutex :: MVar ()
appStartConfig :: AppStartConfig
apps :: TVar (Map AppId (TVar AppState))
mutex :: AppManager -> MVar ()
appStartConfig :: AppManager -> AppStartConfig
apps :: AppManager -> TVar (Map AppId (TVar AppState))
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. KeterM AppManager a -> IO a
rio -> 
    forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
mutex forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ do
      [KeterM AppManager ()]
actions <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
          Map AppId (TVar AppState)
m <- forall a. TVar a -> STM a
readTVar TVar (Map AppId (TVar AppState))
apps
          let currentApps :: Set Text
currentApps = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AppId -> Maybe Text
toAppName forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys Map AppId (TVar AppState)
m
              allApps :: [Text]
allApps = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Set k
Map.keysSet Map Text (String, EpochTime)
newApps forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Text
currentApps
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Map AppId (TVar AppState)
-> Text -> STM (Maybe (KeterM AppManager ()))
getAction Map AppId (TVar AppState)
m) [Text]
allApps
      forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall a b. (a -> b) -> a -> b
$ forall a. KeterM AppManager a -> IO a
rio forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeterM AppManager ()]
actions
  where
    toAppName :: AppId -> Maybe Text
toAppName AppId
AIBuiltin   = forall a. Maybe a
Nothing
    toAppName (AINamed Text
x) = 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 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (KeterM AppManager ())
freshLaunch
            Just TVar AppState
tstate -> do
                AppState
state <- forall a. TVar a -> STM a
readTVar TVar AppState
tstate
                case AppState
state of
                    AppState
ASTerminated -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (KeterM AppManager ())
freshLaunch
                    ASRunning App
app ->
                        case 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 -> 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
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Maybe EpochTime
moldTimestamp forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just EpochTime
newTimestamp
                                    then 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 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
                                forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Action)
tmaction forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Action
Terminate
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                            Just (String
fp, EpochTime
newTimestamp) -> do
                                Maybe EpochTime
moldTimestamp <- forall a. TVar a -> STM a
readTVar TVar (Maybe EpochTime)
tmoldTimestamp
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Maybe EpochTime
moldTimestamp forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just EpochTime
newTimestamp
                                    then forall a. Maybe a
Nothing
                                    else String -> EpochTime -> Maybe (KeterM AppManager ())
reload String
fp EpochTime
newTimestamp
      where
        freshLaunch :: Maybe (KeterM AppManager ())
freshLaunch =
            case 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              -> forall a. (?callStack::CallStack) => Bool -> a -> a
E.assert Bool
False 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 = forall a. a -> Maybe a
Just 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 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AppId -> Action -> KeterM AppManager ()
performNoLock (Text -> AppId
AINamed Text
appname) (AppInput -> Action
Reload 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 <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. KeterM AppManager a -> IO a
rio -> 
      forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (AppManager -> MVar ()
mutex AppManager
am) forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. KeterM AppManager a -> IO a
rio 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
    am :: AppManager
am@AppManager{TVar (Map AppId (TVar AppState))
MVar ()
AppStartConfig
mutex :: MVar ()
appStartConfig :: AppStartConfig
apps :: TVar (Map AppId (TVar AppState))
mutex :: AppManager -> MVar ()
appStartConfig :: AppManager -> AppStartConfig
apps :: AppManager -> TVar (Map AppId (TVar AppState))
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. KeterM AppManager a -> IO a
rio -> forall a. IO a -> IO a
E.mask_ forall a b. (a -> b) -> a -> b
$ do
        KeterM AppManager ()
launchWorker' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
            Map AppId (TVar AppState)
m <- forall a. TVar a -> STM a
readTVar TVar (Map AppId (TVar AppState))
apps
            case 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 <- 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
                            forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Action)
tmnext forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Action
action
                            -- use the previous worker, so nothing to do
                            forall (m :: * -> *) a. Monad m => a -> m a
return KeterM AppManager ()
noWorker
                        ASRunning App
runningApp -> do
                            TVar (Maybe Action)
tmnext <- forall a. a -> STM (TVar a)
newTVar forall a. Maybe a
Nothing
                            TVar (Maybe EpochTime)
tmtimestamp <- forall a. a -> STM (TVar a)
newTVar forall a b. (a -> b) -> a -> b
$
                                case Action
action of
                                    Reload (AIBundle String
_fp EpochTime
timestamp) -> forall a. a -> Maybe a
Just EpochTime
timestamp
                                    Reload (AIData BundleConfig
_) -> forall a. Maybe a
Nothing
                                    Action
Terminate -> forall a. Maybe a
Nothing
                            forall a. TVar a -> a -> STM ()
writeTVar TVar AppState
tstate forall a b. (a -> b) -> a -> b
$ Maybe App
-> TVar (Maybe EpochTime) -> TVar (Maybe Action) -> AppState
ASStarting (forall a. a -> Maybe a
Just App
runningApp) TVar (Maybe EpochTime)
tmtimestamp TVar (Maybe Action)
tmnext
                            forall (m :: * -> *) a. Monad m => a -> m a
return 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 (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
        forall a. KeterM AppManager a -> IO a
rio KeterM AppManager ()
launchWorker'
  where
    noWorker :: KeterM AppManager ()
noWorker = 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 <- forall a. a -> STM (TVar a)
newTVar forall a. Maybe a
Nothing
                TVar (Maybe EpochTime)
tmtimestamp <- forall a. a -> STM (TVar a)
newTVar forall a b. (a -> b) -> a -> b
$
                    case AppInput
input of
                        AIBundle String
_fp EpochTime
timestamp -> forall a. a -> Maybe a
Just EpochTime
timestamp
                        AIData BundleConfig
_               -> forall a. Maybe a
Nothing
                TVar AppState
tstate <- forall a. a -> STM (TVar a)
newTVar forall a b. (a -> b) -> a -> b
$ Maybe App
-> TVar (Maybe EpochTime) -> TVar (Maybe Action) -> AppState
ASStarting forall a. Maybe a
Nothing TVar (Maybe EpochTime)
tmtimestamp TVar (Maybe Action)
tmnext
                forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Map AppId (TVar AppState))
apps forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AppId
aid TVar AppState
tstate
                forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Maybe a
Nothing Action
action
            Action
Terminate -> 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
mcurrentApp0 Action
action0 = 
  Maybe App -> Action -> KeterM AppManager ()
loop Maybe App
mcurrentApp0 Action
action0
  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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
            Maybe Action
mnext <- forall a. TVar a -> STM a
readTVar TVar (Maybe Action)
tmnext
            forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe Action)
tmnext forall a. Maybe a
Nothing
            case Maybe Action
mnext of
                Maybe Action
Nothing ->
                    case Maybe App
mRunningApp of
                        Maybe App
Nothing -> forall a. TVar a -> a -> STM ()
writeTVar TVar AppState
tstate AppState
ASTerminated
                        Just App
runningApp -> forall a. TVar a -> a -> STM ()
writeTVar TVar AppState
tstate forall a b. (a -> b) -> a -> b
$ App -> AppState
ASRunning App
runningApp
                Just Action
_next -> do
                    TVar (Maybe EpochTime)
tmtimestamp <- forall a. a -> STM (TVar a)
newTVar forall a b. (a -> b) -> a -> b
$
                        case Action
action of
                            Reload (AIBundle String
_fp EpochTime
timestamp) -> forall a. a -> Maybe a
Just EpochTime
timestamp
                            Reload (AIData BundleConfig
_)               -> forall a. Maybe a
Nothing
                            Action
Terminate                       -> forall a. Maybe a
Nothing
                    forall a. TVar a -> a -> STM ()
writeTVar TVar AppState
tstate 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
            forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Action
mnext
        case Maybe Action
mnext of
            Maybe Action
Nothing   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just Action
next -> Maybe App -> Action -> KeterM AppManager ()
loop Maybe App
mRunningApp Action
next

    reloadMsg :: String -> String -> Text
    reloadMsg :: String -> String -> Text
reloadMsg String
app String
input =
        String -> Text
pack forall a b. (a -> b) -> a -> b
$ String
"Reloading from: " forall a. Semigroup a => a -> a -> a
<> String
app forall a. Semigroup a => a -> a -> a
<> String
input
    
    errorStartingBundleMsg :: String -> String -> Text
    errorStartingBundleMsg :: String -> String -> Text
errorStartingBundleMsg String
name String
e = 
        String -> Text
pack forall a b. (a -> b) -> a -> b
$ String
"Error occured when launching bundle " forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    processAction (Just App
app) Action
Terminate = do
        $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> KeterM AppManager ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: String -> Text
logInfo forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String
"Terminating" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show App
app)
        forall cfg cfg' a. (cfg -> cfg') -> KeterM cfg' a -> KeterM cfg a
withMappedConfig (forall a b. a -> b -> a
const App
app) KeterM App ()
App.terminate
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> KeterM AppManager ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: String -> Text
logInfo (String -> String -> Text
reloadMsg String
"Nothing" (forall a. Show a => a -> String
show AppInput
input))
        AppManager{TVar (Map AppId (TVar AppState))
MVar ()
AppStartConfig
mutex :: MVar ()
appStartConfig :: AppStartConfig
apps :: TVar (Map AppId (TVar AppState))
mutex :: AppManager -> MVar ()
appStartConfig :: AppManager -> AppStartConfig
apps :: AppManager -> TVar (Map AppId (TVar AppState))
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
        Either SomeException App
eres <- forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO 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 forall a b. (a -> b) -> a -> b
$ 
            forall a. KeterM AppManager a -> IO a
rio forall a b. (a -> b) -> a -> b
$ forall cfg cfg' a. (cfg -> cfg') -> KeterM cfg' a -> KeterM cfg a
withMappedConfig (forall a b. a -> b -> a
const AppStartConfig
appStartConfig) 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 -> KeterM AppManager ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: String -> Text
logError (String -> String -> Text
errorStartingBundleMsg (forall a. Show a => a -> String
show Text
name) (forall a. Show a => a -> String
show SomeException
e))
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            Right App
app -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> KeterM AppManager ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: String -> Text
logInfo (String -> String -> Text
reloadMsg (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just App
app) (forall a. Show a => a -> String
show AppInput
input))
        Either SomeException ()
eres <- forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO 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 forall a b. (a -> b) -> a -> b
$ 
            forall a. KeterM AppManager a -> IO a
rio forall a b. (a -> b) -> a -> b
$ forall cfg cfg' a. (cfg -> cfg') -> KeterM cfg' a -> KeterM cfg a
withMappedConfig (forall a b. a -> b -> a
const App
app) 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 -> KeterM AppManager ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: String -> Text
logError (String -> String -> Text
errorStartingBundleMsg (forall a. Show a => a -> String
show Text
name) (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.
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just App
app)
            Right () -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO FileStatus
getFileStatus String
bundle
    forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> AppId
AINamed forall a b. (a -> b) -> a -> b
$ String -> Text
getAppname String
bundle, AppInput -> Action
Reload 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