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"
--   return app {appPaused = False}
-- ghc 6.10.4 complains:
-- Record update for the non-Haskell-98 data type `App' is not (yet) supported



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
--  let includePaths = getIncludePaths pluginLoader
--      pkgConfFiles = getPkgConfFiles pluginLoader
  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   -- ^ time limit
        -> IO a  -- ^ computation to run
        -> IO a  -- ^ computation on timeout
        -> IO a
timeout' t a b = do
  mb <- timeout  (max 10000 (t * 1000000)) a
  case mb of
    Nothing -> b
    Just result -> return result