yesod-default: switch from cmdargs, support for PORT env variable
This commit is contained in:
parent
bd6671b264
commit
97cface838
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user