Stylistic changes to scaffolded main

This commit is contained in:
patrick brisbin 2011-09-10 20:49:07 -04:00
parent f99a64e372
commit c569ed5f2f

View File

@ -15,44 +15,54 @@ import Yesod.Logger (makeLogger)
main :: IO ()
main = do
logger <- makeLogger
args <- cmdArgs argConfig
env <- getAppEnv args
args <- cmdArgs argConfig
env <- getAppEnv args
config <- loadConfig env
let c = if (port args) /= 0 then config {appPort = (port args) } else config
let c = if port args /= 0
then config { appPort = port args }
else config
#if PRODUCTION
with~sitearg~ c logger $ run (appPort c)
#else
logString logger $ (show env) ++ " application launched, listening on port " ++ show (appPort c)
with~sitearg~ c logger $ run (appPort c) . debugHandle (logHandle logger)
flushLogger logger
where
logHandle logger msg = logLazyText logger msg >> flushLogger logger
where
logHandle logger msg = logLazyText logger msg >> flushLogger logger
#endif
data ArgConfig = ArgConfig {environment :: String, port :: Int}
deriving (Show, Data, Typeable)
data ArgConfig = ArgConfig
{ environment :: String
, port :: Int
} deriving (Show, Data, Typeable)
argConfig :: ArgConfig
argConfig = ArgConfig{ environment = def
&= help ("application environment, one of: " ++ (foldl1 (\a b -> a ++ ", " ++ b) environments))
&= typ "ENVIRONMENT"
,port = def &= typ "PORT"
}
argConfig = ArgConfig
{ environment = def
&= help ("application environment, one of: " ++ (foldl1 (\a b -> a ++ ", " ++ b) environments))
&= typ "ENVIRONMENT"
, port = def
&= typ "PORT"
}
environments :: [String]
environments = map ((map toLower) . show) ([minBound..maxBound] :: [AppEnvironment])
-- | retrieve the -e environment option
getAppEnv :: ArgConfig -> IO AppEnvironment
getAppEnv :: ArgConfig -> IO AppEnvironment
getAppEnv cfg = do
let e = if (environment cfg) /= "" then (environment cfg)
let e = if environment cfg /= ""
then environment cfg
else
#if PRODUCTION
"production"
"production"
#else
"development"
"development"
#endif
return $ read $ capitalize e
where
capitalize [] = []
capitalize (x:xs) = toUpper x : map toLower xs
where
capitalize [] = []
capitalize (x:xs) = toUpper x : map toLower xs