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 " 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