yesod-default: switch from cmdargs, support for PORT env variable

This commit is contained in:
Michael Snoyman 2012-01-12 10:12:30 +02:00
parent bd6671b264
commit 97cface838
4 changed files with 35 additions and 37 deletions

View File

@ -4,7 +4,6 @@
module Yesod.Default.Config module Yesod.Default.Config
( DefaultEnv (..) ( DefaultEnv (..)
, fromArgs , fromArgs
, fromArgsExtra
, loadDevelopmentConfig , loadDevelopmentConfig
-- reexport -- reexport
@ -16,12 +15,13 @@ module Yesod.Default.Config
) where ) where
import Data.Char (toUpper, toLower) import Data.Char (toUpper, toLower)
import System.Console.CmdArgs hiding (args)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Yaml import Data.Yaml
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import qualified Data.HashMap.Strict as M import qualified Data.HashMap.Strict as M
import System.Environment (getArgs, getProgName, getEnvironment)
import System.Exit (exitFailure)
-- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and -- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and
-- Production environments -- Production environments
@ -34,37 +34,36 @@ data DefaultEnv = Development
data ArgConfig = ArgConfig data ArgConfig = ArgConfig
{ environment :: String { environment :: String
, port :: Int , port :: Int
} deriving (Show, Data, Typeable) } deriving Show
-- | A default @'ArgConfig'@ if using the provided @'DefaultEnv'@ type. parseArgConfig :: IO ArgConfig
defaultArgConfig :: ArgConfig parseArgConfig = do
defaultArgConfig = args <- getArgs
ArgConfig (portS, args') <- getPort id args
{ environment = def port <-
&= argPos 0 case reads portS of
&= typ "ENVIRONMENT" (i, _):_ -> return i
, port = def [] -> error $ "Invalid port value: " ++ show portS
&= help "the port to listen on" case args of
&= typ "PORT" [e] -> return $ ArgConfig e port
} _ -> do
pn <- getProgName
putStrLn $ "Usage: " ++ pn ++ " <environment> [--port <port>]"
exitFailure
where
getPort front [] = do
env <- getEnvironment
return (fromMaybe "0" $ lookup "PORT" env, front [])
getPort front ("--port":p:rest) = return (p, front rest)
getPort front ("-p":p:rest) = return (p, front rest)
getPort front (arg:rest) = getPort (front . (arg:)) rest
-- | Load an @'AppConfig'@ using the @'DefaultEnv'@ environments from -- | Load the app config from command line parameters
-- commandline arguments. fromArgs :: (Read env, Show env)
fromArgs :: IO (AppConfig DefaultEnv ()) => (env -> Object -> Parser extra)
fromArgs = fromArgsExtra (const $ const $ return ()) -> IO (AppConfig env extra)
fromArgs getExtra = do
-- | Same as 'fromArgs', but allows you to specify how to parse the 'appExtra' args <- parseArgConfig
-- record.
fromArgsExtra :: (DefaultEnv -> Object -> Parser extra)
-> IO (AppConfig DefaultEnv extra)
fromArgsExtra = fromArgsWith defaultArgConfig
fromArgsWith :: (Read env, Show env)
=> ArgConfig
-> (env -> Object -> Parser extra)
-> IO (AppConfig env extra)
fromArgsWith argConfig getExtra = do
args <- cmdArgs argConfig
env <- env <-
case reads $ capitalize $ environment args of case reads $ capitalize $ environment args of

View File

@ -19,7 +19,6 @@ library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.10 && < 0.11 , yesod-core >= 0.10 && < 0.11
, cmdargs >= 0.8
, warp >= 1.0 && < 1.1 , warp >= 1.0 && < 1.1
, wai >= 1.0 && < 1.1 , wai >= 1.0 && < 1.1
, wai-extra >= 1.0 && < 1.1 , wai-extra >= 1.0 && < 1.1

View File

@ -1,8 +1,8 @@
import Prelude (IO) import Prelude (IO)
import Yesod.Default.Config (fromArgsExtra) import Yesod.Default.Config (fromArgs)
import Yesod.Default.Main (defaultMain) import Yesod.Default.Main (defaultMain)
import Settings (parseExtra) import Settings (parseExtra)
import Application (getApplication) import Application (getApplication)
main :: IO () main :: IO ()
main = defaultMain (fromArgsExtra parseExtra) getApplication main = defaultMain (fromArgs parseExtra) getApplication

View File

@ -4,13 +4,13 @@ runghc main.hs init
( (
cd foobar cd foobar
cabal configure || cabal install cabal configure --disable-optimization || cabal install
cabal build cabal build
cabal clean cabal clean
cabal configure -fdev cabal configure -fdev --disable-optimization
cabal build cabal build
cabal clean cabal clean
cabal configure -flibrary-only cabal configure -flibrary-only --disable-optimization
cabal build cabal build
cabal clean cabal clean
cabal configure cabal configure