module Hascat.System.App
( isRunning,
isPaused,
hasContextPath,
start,
use,
stop,
pause,
resume,
reload,
defaultInit,
loadFromModule,
reloadFromModule,
defaultDone )
where
import Data.Maybe
import qualified System.Plugins as Plugins
import System.Plugins hiding ( load, reload )
import Hascat.App
import Hascat.Config
import Hascat.Protocol
import Network.HTTP
import Data.ByteString.Lazy
import System.Timeout
isRunning :: App -> Bool
isRunning (App _ _ _ stateMB _) = isJust stateMB
isPaused :: App -> Bool
isPaused (App _ _ _ _ unpaused) = not unpaused
hasContextPath :: ContextPath -> App -> Bool
hasContextPath contextPath app =
getAppContextPath (appConfig app) == contextPath
start :: App -> IO App
start (App config m handlers@(Handlers init _ _) stateMB _) =
case stateMB of
Nothing -> do
state <- timeout' (getAppInitTimeout config)
(init config)
(fail "Timeout")
return (App config m handlers (Just state) True)
Just _ -> fail "Application is already started"
use :: App -> ServletRequest -> IO (Response ByteString)
use (App config _ (Handlers _ respond _) stateMB unpaused) request =
case stateMB of
Nothing -> fail "Application is not started"
Just state ->
if unpaused then
timeout' (getAppRespondTimeout config)
(respond config state request)
(fail "Timeout")
else
fail "Application is paused"
stop :: App -> IO App
stop (App config m handlers@(Handlers _ _ done) stateMB _) =
case stateMB of
Nothing -> fail "Application is not started"
Just state -> do
timeout' (getAppDoneTimeout config)
(done config state)
(fail "Timeout")
return (App config m handlers Nothing False)
pause :: App -> IO App
pause (App config m handlers stateMB True) =
return (App config m handlers stateMB False)
pause (App config m handlers stateMB False) =
fail "Application is already paused"
resume :: App -> IO App
resume (App config m handlers stateMB False) =
return (App config m handlers stateMB True)
resume (App config m handlers stateMB True) =
fail "Application is not paused"
reload :: App -> IO App
reload app@(App config modul _ _ _) =
if isRunning app then fail "Application is running"
else do
(modul',handlers) <- reloadFromModule modul "handlers"
return (App config modul' handlers Nothing True)
loadFromModule :: PluginLoader -> FilePath -> String -> IO (Plugins.Module, a)
loadFromModule pluginLoader file name = do
status <- Plugins.load_ file
[]--includePaths
--pkgConfFiles
name
case status of
LoadFailure _ -> error ("Could not load " ++ name
++ " from " ++ file)
LoadSuccess m h -> return (m,h)
reloadFromModule :: Plugins.Module -> String -> IO (Plugins.Module, a)
reloadFromModule modul name = do
status <- Plugins.reload modul name
case status of
LoadSuccess m h -> return (m,h)
LoadFailure _ -> error ("Could not load " ++ name)
timeout' :: Int
-> IO a
-> IO a
-> IO a
timeout' t a b = do
mb <- timeout (max 10000 (t * 1000000)) a
case mb of
Nothing -> b
Just result -> return result