hascat-0.2: Main.hs

module Main where

import Control.Concurrent.MVar
import Control.OldException as Exception
import Control.Monad
import Hascat.App
import Hascat.Config
import Hascat.System.App
import Hascat.System.Controller
import Prelude hiding ( log )
import System.Environment
import System.Posix.Process
import System.Posix.Types

import ConfigReader
import HttpImpl
import Logger


main :: IO ()
main = do
  configFile <- parseArgs
  config <- readConfig configFile
  stateVar <- createState config
  startServer stateVar


parseArgs :: IO FilePath
parseArgs = do
  args <- getArgs
  case args of
    [configFile] -> return configFile
    _            -> error "hascat <config-file>"


createState :: Config -> IO StateVar
createState (Config _ general (AppController appConfigs)) = do
  processID <- getProcessID
  let state = (State processID general [])
  stateVar <- newEmptyMVar
  putMVar stateVar state
  --foldM  :: Monad m => (a -> b -> m a) -> a -> [b] -> m a
  --foldr  ::            (a -> b -> b) -> b -> [a] -> b
  foldM_ loadApp' stateVar appConfigs
  state' <- readMVar stateVar
  foldM startApp' stateVar (map appConfig (stApps state'))
  --return stateVar
  where
    loadApp' :: StateVar -> AppConfig -> IO StateVar
    loadApp' stateVar config = do
      Exception.catch
        (do log ("Installing \"" ++ getAppName config ++ "\""
                 ++ " at " ++ (show $ getAppContextPath config))
            loadApp stateVar config >> return stateVar)
        (\e -> log (show e) >> return stateVar)

    startApp' :: StateVar -> AppConfig -> IO StateVar
    startApp' stateVar config =
        if (getAppAutoStart config == AppConfig_autoStart_yes
              || getAppType config == AppConfig_type_system) then
          do
            --state <- takeMVar stateVar
            Exception.catch
              (do 
                log ("Starting \"" ++ getAppName config ++ "\""
                  ++ " at " ++ (show $ getAppContextPath config))
                startApp stateVar (getAppContextPath config)
--                putMVar stateVar state'
                return stateVar)
              (\e -> log (show e)  >> return stateVar)
        else
          return stateVar