{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Keter.AppManager
(
AppManager
, Action (..)
, perform
, reloadAppList
, addApp
, terminateApp
, initialize
) where
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 qualified Data.Map as Map
import Data.Maybe (mapMaybe)
import Data.Maybe (catMaybes)
import qualified Data.Set as Set
import Keter.App (App, AppStartConfig)
import qualified Keter.App as App
import Keter.Types
import Prelude hiding (FilePath, log)
import System.Posix.Files (getFileStatus, modificationTime)
import System.Posix.Types (EpochTime)
data AppManager = AppManager
{ AppManager -> TVar (Map AppId (TVar AppState))
apps :: !(TVar (Map AppId (TVar AppState)))
, AppManager -> AppStartConfig
appStartConfig :: !AppStartConfig
, AppManager -> MVar ()
mutex :: !(MVar ())
, AppManager -> LogMessage -> IO ()
log :: !(LogMessage -> IO ())
}
data AppState = ASRunning App
| ASStarting
!(Maybe App)
!(TVar (Maybe EpochTime))
!(TVar (Maybe Action))
| ASTerminated
data Action = Reload AppInput | Terminate
initialize :: (LogMessage -> IO ())
-> AppStartConfig
-> IO AppManager
initialize :: (LogMessage -> IO ()) -> AppStartConfig -> IO AppManager
initialize LogMessage -> IO ()
log' AppStartConfig
asc = TVar (Map AppId (TVar AppState))
-> AppStartConfig -> MVar () -> (LogMessage -> IO ()) -> AppManager
AppManager
(TVar (Map AppId (TVar AppState))
-> AppStartConfig
-> MVar ()
-> (LogMessage -> IO ())
-> AppManager)
-> IO (TVar (Map AppId (TVar AppState)))
-> IO
(AppStartConfig -> MVar () -> (LogMessage -> IO ()) -> 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 () -> (LogMessage -> IO ()) -> AppManager)
-> IO AppStartConfig
-> IO (MVar () -> (LogMessage -> IO ()) -> AppManager)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AppStartConfig -> IO AppStartConfig
forall (m :: * -> *) a. Monad m => a -> m a
return AppStartConfig
asc
IO (MVar () -> (LogMessage -> IO ()) -> AppManager)
-> IO (MVar ()) -> IO ((LogMessage -> IO ()) -> AppManager)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
IO ((LogMessage -> IO ()) -> AppManager)
-> IO (LogMessage -> IO ()) -> IO AppManager
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LogMessage -> IO ()) -> IO (LogMessage -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return LogMessage -> IO ()
log'
reloadAppList :: AppManager
-> Map Appname (FilePath, EpochTime)
-> IO ()
reloadAppList :: AppManager -> Map Appname (FilePath, EpochTime) -> IO ()
reloadAppList am :: AppManager
am@AppManager {TVar (Map AppId (TVar AppState))
MVar ()
AppStartConfig
LogMessage -> IO ()
log :: LogMessage -> IO ()
mutex :: MVar ()
appStartConfig :: AppStartConfig
apps :: TVar (Map AppId (TVar AppState))
log :: AppManager -> LogMessage -> IO ()
mutex :: AppManager -> MVar ()
appStartConfig :: AppManager -> AppStartConfig
apps :: AppManager -> TVar (Map AppId (TVar AppState))
..} Map Appname (FilePath, EpochTime)
newApps = 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
[IO ()]
actions <- STM [IO ()] -> IO [IO ()]
forall a. STM a -> IO a
atomically (STM [IO ()] -> IO [IO ()]) -> STM [IO ()] -> IO [IO ()]
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 Appname
currentApps = [Appname] -> Set Appname
forall a. Ord a => [a] -> Set a
Set.fromList ([Appname] -> Set Appname) -> [Appname] -> Set Appname
forall a b. (a -> b) -> a -> b
$ (AppId -> Maybe Appname) -> [AppId] -> [Appname]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe AppId -> Maybe Appname
toAppName ([AppId] -> [Appname]) -> [AppId] -> [Appname]
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 :: [Appname]
allApps = Set Appname -> [Appname]
forall a. Set a -> [a]
Set.toList (Set Appname -> [Appname]) -> Set Appname -> [Appname]
forall a b. (a -> b) -> a -> b
$ Map Appname (FilePath, EpochTime) -> Set Appname
forall k a. Map k a -> Set k
Map.keysSet Map Appname (FilePath, EpochTime)
newApps Set Appname -> Set Appname -> Set Appname
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Appname
currentApps
([Maybe (IO ())] -> [IO ()]) -> STM [Maybe (IO ())] -> STM [IO ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (IO ())] -> [IO ()]
forall a. [Maybe a] -> [a]
catMaybes (STM [Maybe (IO ())] -> STM [IO ()])
-> STM [Maybe (IO ())] -> STM [IO ()]
forall a b. (a -> b) -> a -> b
$ (Appname -> STM (Maybe (IO ())))
-> [Appname] -> STM [Maybe (IO ())]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Map AppId (TVar AppState) -> Appname -> STM (Maybe (IO ()))
getAction Map AppId (TVar AppState)
m) [Appname]
allApps
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [IO ()]
actions
where
toAppName :: AppId -> Maybe Appname
toAppName AppId
AIBuiltin = Maybe Appname
forall a. Maybe a
Nothing
toAppName (AINamed Appname
x) = Appname -> Maybe Appname
forall a. a -> Maybe a
Just Appname
x
getAction :: Map AppId (TVar AppState) -> Appname -> STM (Maybe (IO ()))
getAction Map AppId (TVar AppState)
currentApps Appname
appname = do
case AppId -> Map AppId (TVar AppState) -> Maybe (TVar AppState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Appname -> AppId
AINamed Appname
appname) Map AppId (TVar AppState)
currentApps of
Maybe (TVar AppState)
Nothing -> Maybe (IO ()) -> STM (Maybe (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IO ())
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 (IO ()) -> STM (Maybe (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IO ())
freshLaunch
ASRunning App
app ->
case Appname
-> Map Appname (FilePath, EpochTime) -> Maybe (FilePath, EpochTime)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Appname
appname Map Appname (FilePath, EpochTime)
newApps of
Maybe (FilePath, EpochTime)
Nothing -> Maybe (IO ()) -> STM (Maybe (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IO ())
terminate
Just (FilePath
fp, EpochTime
newTimestamp) -> do
Maybe EpochTime
moldTimestamp <- App -> STM (Maybe EpochTime)
App.getTimestamp App
app
Maybe (IO ()) -> STM (Maybe (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IO ()) -> STM (Maybe (IO ())))
-> Maybe (IO ()) -> STM (Maybe (IO ()))
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 (IO ())
forall a. Maybe a
Nothing
else FilePath -> EpochTime -> Maybe (IO ())
reload FilePath
fp EpochTime
newTimestamp
ASStarting Maybe App
_ TVar (Maybe EpochTime)
tmoldTimestamp TVar (Maybe Action)
tmaction ->
case Appname
-> Map Appname (FilePath, EpochTime) -> Maybe (FilePath, EpochTime)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Appname
appname Map Appname (FilePath, EpochTime)
newApps of
Maybe (FilePath, 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 (IO ()) -> STM (Maybe (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IO ())
forall a. Maybe a
Nothing
Just (FilePath
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 (IO ()) -> STM (Maybe (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IO ()) -> STM (Maybe (IO ())))
-> Maybe (IO ()) -> STM (Maybe (IO ()))
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 (IO ())
forall a. Maybe a
Nothing
else FilePath -> EpochTime -> Maybe (IO ())
reload FilePath
fp EpochTime
newTimestamp
where
freshLaunch :: Maybe (IO ())
freshLaunch =
case Appname
-> Map Appname (FilePath, EpochTime) -> Maybe (FilePath, EpochTime)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Appname
appname Map Appname (FilePath, EpochTime)
newApps of
Maybe (FilePath, EpochTime)
Nothing -> Bool -> Maybe (IO ()) -> Maybe (IO ())
forall a. (?callStack::CallStack) => Bool -> a -> a
E.assert Bool
False Maybe (IO ())
forall a. Maybe a
Nothing
Just (FilePath
fp, EpochTime
timestamp) -> FilePath -> EpochTime -> Maybe (IO ())
reload FilePath
fp EpochTime
timestamp
terminate :: Maybe (IO ())
terminate = IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ AppManager -> AppId -> Action -> IO ()
performNoLock AppManager
am (Appname -> AppId
AINamed Appname
appname) Action
Terminate
reload :: FilePath -> EpochTime -> Maybe (IO ())
reload FilePath
fp EpochTime
timestamp = IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ AppManager -> AppId -> Action -> IO ()
performNoLock AppManager
am (Appname -> AppId
AINamed Appname
appname) (AppInput -> Action
Reload (AppInput -> Action) -> AppInput -> Action
forall a b. (a -> b) -> a -> b
$ FilePath -> EpochTime -> AppInput
AIBundle FilePath
fp EpochTime
timestamp)
perform :: AppManager -> AppId -> Action -> IO ()
perform :: AppManager -> AppId -> Action -> IO ()
perform AppManager
am AppId
appid Action
action = 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
$ AppManager -> AppId -> Action -> IO ()
performNoLock AppManager
am AppId
appid Action
action
performNoLock :: AppManager -> AppId -> Action -> IO ()
performNoLock :: AppManager -> AppId -> Action -> IO ()
performNoLock am :: AppManager
am@AppManager {TVar (Map AppId (TVar AppState))
MVar ()
AppStartConfig
LogMessage -> IO ()
log :: LogMessage -> IO ()
mutex :: MVar ()
appStartConfig :: AppStartConfig
apps :: TVar (Map AppId (TVar AppState))
log :: AppManager -> LogMessage -> IO ()
mutex :: AppManager -> MVar ()
appStartConfig :: AppManager -> AppStartConfig
apps :: AppManager -> TVar (Map AppId (TVar AppState))
..} AppId
aid Action
action = IO () -> IO ()
forall a. IO a -> IO a
E.mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO ()
launchWorker' <- STM (IO ()) -> IO (IO ())
forall a. STM a -> IO a
atomically (STM (IO ()) -> IO (IO ())) -> STM (IO ()) -> IO (IO ())
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
IO () -> STM (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
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 FilePath
_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
IO () -> STM (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ AppManager
-> AppId
-> TVar AppState
-> TVar (Maybe Action)
-> Maybe App
-> Action
-> IO ()
launchWorker AppManager
am AppId
aid TVar AppState
tstate TVar (Maybe Action)
tmnext (App -> Maybe App
forall a. a -> Maybe a
Just App
runningApp) Action
action
AppState
ASTerminated -> STM (IO ())
onNotRunning
Maybe (TVar AppState)
Nothing -> STM (IO ())
onNotRunning
IO ()
launchWorker'
where
noWorker :: IO ()
noWorker = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
onNotRunning :: STM (IO ())
onNotRunning =
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 FilePath
_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
IO () -> STM (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
forall a b. (a -> b) -> a -> b
$ AppManager
-> AppId
-> TVar AppState
-> TVar (Maybe Action)
-> Maybe App
-> Action
-> IO ()
launchWorker AppManager
am AppId
aid TVar AppState
tstate TVar (Maybe Action)
tmnext Maybe App
forall a. Maybe a
Nothing Action
action
Action
Terminate -> IO () -> STM (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
noWorker
launchWorker :: AppManager
-> AppId
-> TVar AppState
-> TVar (Maybe Action)
-> Maybe App
-> Action
-> IO ()
launchWorker :: AppManager
-> AppId
-> TVar AppState
-> TVar (Maybe Action)
-> Maybe App
-> Action
-> IO ()
launchWorker AppManager {TVar (Map AppId (TVar AppState))
MVar ()
AppStartConfig
LogMessage -> IO ()
log :: LogMessage -> IO ()
mutex :: MVar ()
appStartConfig :: AppStartConfig
apps :: TVar (Map AppId (TVar AppState))
log :: AppManager -> LogMessage -> IO ()
mutex :: AppManager -> MVar ()
appStartConfig :: AppManager -> AppStartConfig
apps :: AppManager -> TVar (Map AppId (TVar AppState))
..} AppId
appid TVar AppState
tstate TVar (Maybe Action)
tmnext Maybe App
mcurrentApp0 Action
action0 = IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
Maybe App -> Action -> IO ()
loop Maybe App
mcurrentApp0 Action
action0
where
loop :: Maybe App -> Action -> IO ()
loop Maybe App
mcurrentApp Action
action = do
Maybe App
mRunningApp <- Maybe App -> Action -> IO (Maybe App)
processAction Maybe App
mcurrentApp Action
action
Maybe Action
mnext <- 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 FilePath
_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 (m :: * -> *) a. Monad m => a -> m a
return Maybe Action
mnext
case Maybe Action
mnext of
Maybe Action
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Action
next -> Maybe App -> Action -> IO ()
loop Maybe App
mRunningApp Action
next
processAction :: Maybe App -> Action -> IO (Maybe App)
processAction Maybe App
Nothing Action
Terminate = Maybe App -> IO (Maybe App)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe App
forall a. Maybe a
Nothing
processAction (Just App
app) Action
Terminate = do
LogMessage -> IO ()
log (LogMessage -> IO ()) -> LogMessage -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> LogMessage
Terminating (FilePath -> LogMessage) -> FilePath -> LogMessage
forall a b. (a -> b) -> a -> b
$ App -> FilePath
forall a. Show a => a -> FilePath
show App
app
App -> IO ()
App.terminate App
app
Maybe App -> IO (Maybe App)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe App
forall a. Maybe a
Nothing
processAction Maybe App
Nothing (Reload AppInput
input) = do
LogMessage -> IO ()
log (LogMessage -> IO ()) -> LogMessage -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> FilePath -> LogMessage
ReloadFrom Maybe FilePath
forall a. Maybe a
Nothing (FilePath -> LogMessage) -> FilePath -> LogMessage
forall a b. (a -> b) -> a -> b
$ AppInput -> FilePath
forall a. Show a => a -> FilePath
show AppInput
input
Either SomeException App
eres <- IO App -> IO (Either SomeException App)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO App -> IO (Either SomeException App))
-> IO App -> IO (Either SomeException App)
forall a b. (a -> b) -> a -> b
$ AppStartConfig -> AppId -> AppInput -> IO App
App.start AppStartConfig
appStartConfig AppId
appid AppInput
input
case Either SomeException App
eres of
Left SomeException
e -> do
LogMessage -> IO ()
log (LogMessage -> IO ()) -> LogMessage -> IO ()
forall a b. (a -> b) -> a -> b
$ Appname -> SomeException -> LogMessage
ErrorStartingBundle Appname
name SomeException
e
Maybe App -> IO (Maybe App)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe App
forall a. Maybe a
Nothing
Right App
app -> Maybe App -> IO (Maybe App)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe App -> IO (Maybe App)) -> Maybe App -> IO (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
LogMessage -> IO ()
log (LogMessage -> IO ()) -> LogMessage -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> FilePath -> LogMessage
ReloadFrom (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ App -> FilePath
forall a. Show a => a -> FilePath
show App
app) (AppInput -> FilePath
forall a. Show a => a -> FilePath
show AppInput
input)
Either SomeException ()
eres <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ App -> AppInput -> IO ()
App.reload App
app AppInput
input
case Either SomeException ()
eres of
Left SomeException
e -> do
LogMessage -> IO ()
log (LogMessage -> IO ()) -> LogMessage -> IO ()
forall a b. (a -> b) -> a -> b
$ Appname -> SomeException -> LogMessage
ErrorStartingBundle Appname
name SomeException
e
Maybe App -> IO (Maybe App)
forall (m :: * -> *) a. Monad m => a -> m a
return (App -> Maybe App
forall a. a -> Maybe a
Just App
app)
Right () -> Maybe App -> IO (Maybe App)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe App -> IO (Maybe App)) -> Maybe App -> IO (Maybe App)
forall a b. (a -> b) -> a -> b
$ App -> Maybe App
forall a. a -> Maybe a
Just App
app
name :: Appname
name =
case AppId
appid of
AppId
AIBuiltin -> Appname
"<builtin>"
AINamed Appname
x -> Appname
x
addApp :: AppManager -> FilePath -> IO ()
addApp :: AppManager -> FilePath -> IO ()
addApp AppManager
appMan FilePath
bundle = do
(AppId
input, Action
action) <- FilePath -> IO (AppId, Action)
getInputForBundle FilePath
bundle
AppManager -> AppId -> Action -> IO ()
perform AppManager
appMan AppId
input Action
action
getInputForBundle :: FilePath -> IO (AppId, Action)
getInputForBundle :: FilePath -> IO (AppId, Action)
getInputForBundle FilePath
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
<$> FilePath -> IO FileStatus
getFileStatus FilePath
bundle
(AppId, Action) -> IO (AppId, Action)
forall (m :: * -> *) a. Monad m => a -> m a
return (Appname -> AppId
AINamed (Appname -> AppId) -> Appname -> AppId
forall a b. (a -> b) -> a -> b
$ FilePath -> Appname
getAppname FilePath
bundle, AppInput -> Action
Reload (AppInput -> Action) -> AppInput -> Action
forall a b. (a -> b) -> a -> b
$ FilePath -> EpochTime -> AppInput
AIBundle FilePath
bundle EpochTime
time)
terminateApp :: AppManager -> Appname -> IO ()
terminateApp :: AppManager -> Appname -> IO ()
terminateApp AppManager
appMan Appname
appname = AppManager -> AppId -> Action -> IO ()
perform AppManager
appMan (Appname -> AppId
AINamed Appname
appname) Action
Terminate