a webapp to manage expenses between a group of friends. NOTE: this is really out of date and may not work. see housetab-snap — http://housetab.org
module Main where
import Control.Concurrent (MVar, forkIO, killThread)
import Happstack.Util.Cron (cron)
import Happstack.State (waitForTermination)
import Happstack.Server
( Conf(port)
, simpleHTTP
, nullConf
, validator
, wdgHTMLValidator
)
import Happstack.State
( Component
, Proxy(..)
, Methods
, TxControl
, Saver(Queue, FileSaver)
, runTxSystem
, shutdownSystem
, createCheckpoint
)
import System.Environment (getArgs)
import System.Log.Logger (Priority(..), logM)
import System.Exit (exitFailure)
import System.Console.GetOpt
import HouseTab.App.Logger (setupLogger)
import HouseTab.App.State (AppState(..))
import HouseTab.App.Control (appHandler)
stateProxy :: Proxy AppState
stateProxy = Proxy
main = do
-- progname effects where state is stored and what the logfile is named
let progName = "housetab"
args <- getArgs
setupLogger
appConf <- case parseConfig args of
(Left e) -> do logM progName ERROR (unlines e)
exitFailure
(Right f) -> return (f $ defaultConf progName)
-- start the state system
control <- startSystemState' (store appConf) stateProxy
-- start the http server
httpTid <- forkIO $ simpleHTTP (httpConf appConf) appHandler
-- checkpoint the state once a day
cronTid <- forkIO $ cron (60*60*24) (createCheckpoint control)
-- wait for termination signal
waitForTermination
-- cleanup
killThread httpTid
killThread cronTid
createCheckpoint control
shutdownSystem control
runInteractive = startSystemState' (store (defaultConf "housetab")) stateProxy
stopInteractive control = do createCheckpoint control
shutdownSystem control
data AppConf
= AppConf { httpConf :: Conf
, store :: FilePath
, static :: FilePath
}
defaultConf :: String -> AppConf
defaultConf progName
= AppConf { httpConf = nullConf
, store = "_local/" ++ progName ++ "_state"
, static = "public"
}
opts :: [OptDescr (AppConf -> AppConf)]
opts = [ Option [] ["http-port"] (ReqArg (\h c -> c { httpConf = (httpConf c) {port = read h} }) "port") "port to bind http server"
, Option [] ["no-validate"] (NoArg (\ c -> c { httpConf = (httpConf c) { validator = Nothing } })) "Turn off HTML validation"
, Option [] ["validate"] (NoArg (\ c -> c { httpConf = (httpConf c) { validator = Just wdgHTMLValidator } })) "Turn on HTML validation"
, Option [] ["store"] (ReqArg (\h c -> c {store = h}) "PATH") "The directory used for database storage."
, Option [] ["static"] (ReqArg (\h c -> c {static = h}) "PATH") "The directory searched for static files"
]
parseConfig :: [String] -> Either [String] (AppConf -> AppConf)
parseConfig args
= case getOpt Permute opts args of
(flags,_,[]) -> Right $ \appConf -> foldr ($) appConf flags
(_,_,errs) -> Left errs
startSystemState' :: (Component st, Methods st) => String -> Proxy st -> IO (MVar TxControl)
startSystemState' = runTxSystem . Queue . FileSaver |