    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternGuards #-}
    module Yesod.Default.Config
        ( DefaultEnv (..)
        , fromArgs
        , fromArgsSettings
        , loadDevelopmentConfig

        -- reexport
        , AppConfig (..)
        , ConfigSettings (..)
        , configSettings
        , loadConfig
        , withYamlEnvironment
        ) where

    import Data.Char (toUpper)
    import Data.Text (Text)
    import qualified Data.Text as T
    import Data.Yaml
    import Data.Maybe (fromMaybe)
    import System.Environment (getArgs, getProgName, getEnvironment)
    import System.Exit (exitFailure)
    import Data.Streaming.Network (HostPreference)
    import Data.String (fromString)

    #if MIN_VERSION_aeson(2, 0, 0)
    import qualified Data.Aeson.KeyMap as M
    #else
    import qualified Data.HashMap.Strict as M
    #endif

    -- | A yesod-provided @'AppEnv'@, allows for Development, Testing, and
    --   Production environments
    data DefaultEnv = Development
                    | Testing
                    | Staging
                    | Production deriving (ReadPrec [DefaultEnv]
    ReadPrec DefaultEnv
    Int -> ReadS DefaultEnv
    ReadS [DefaultEnv]
    (Int -> ReadS DefaultEnv)
    -> ReadS [DefaultEnv]
    -> ReadPrec DefaultEnv
    -> ReadPrec [DefaultEnv]
    -> Read DefaultEnv
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS DefaultEnv
    readsPrec :: Int -> ReadS DefaultEnv
    $creadList :: ReadS [DefaultEnv]
    readList :: ReadS [DefaultEnv]
    $creadPrec :: ReadPrec DefaultEnv
    readPrec :: ReadPrec DefaultEnv
    $creadListPrec :: ReadPrec [DefaultEnv]
    readListPrec :: ReadPrec [DefaultEnv]
    Read, Int -> DefaultEnv -> ShowS
    [DefaultEnv] -> ShowS
    DefaultEnv -> String
    (Int -> DefaultEnv -> ShowS)
    -> (DefaultEnv -> String)
    -> ([DefaultEnv] -> ShowS)
    -> Show DefaultEnv
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DefaultEnv -> ShowS
    showsPrec :: Int -> DefaultEnv -> ShowS
    $cshow :: DefaultEnv -> String
    show :: DefaultEnv -> String
    $cshowList :: [DefaultEnv] -> ShowS
    showList :: [DefaultEnv] -> ShowS
    Show, Int -> DefaultEnv
    DefaultEnv -> Int
    DefaultEnv -> [DefaultEnv]
    DefaultEnv -> DefaultEnv
    DefaultEnv -> DefaultEnv -> [DefaultEnv]
    DefaultEnv -> DefaultEnv -> DefaultEnv -> [DefaultEnv]
    (DefaultEnv -> DefaultEnv)
    -> (DefaultEnv -> DefaultEnv)
    -> (Int -> DefaultEnv)
    -> (DefaultEnv -> Int)
    -> (DefaultEnv -> [DefaultEnv])
    -> (DefaultEnv -> DefaultEnv -> [DefaultEnv])
    -> (DefaultEnv -> DefaultEnv -> [DefaultEnv])
    -> (DefaultEnv -> DefaultEnv -> DefaultEnv -> [DefaultEnv])
    -> Enum DefaultEnv
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: DefaultEnv -> DefaultEnv
    succ :: DefaultEnv -> DefaultEnv
    $cpred :: DefaultEnv -> DefaultEnv
    pred :: DefaultEnv -> DefaultEnv
    $ctoEnum :: Int -> DefaultEnv
    toEnum :: Int -> DefaultEnv
    $cfromEnum :: DefaultEnv -> Int
    fromEnum :: DefaultEnv -> Int
    $cenumFrom :: DefaultEnv -> [DefaultEnv]
    enumFrom :: DefaultEnv -> [DefaultEnv]
    $cenumFromThen :: DefaultEnv -> DefaultEnv -> [DefaultEnv]
    enumFromThen :: DefaultEnv -> DefaultEnv -> [DefaultEnv]
    $cenumFromTo :: DefaultEnv -> DefaultEnv -> [DefaultEnv]
    enumFromTo :: DefaultEnv -> DefaultEnv -> [DefaultEnv]
    $cenumFromThenTo :: DefaultEnv -> DefaultEnv -> DefaultEnv -> [DefaultEnv]
    enumFromThenTo :: DefaultEnv -> DefaultEnv -> DefaultEnv -> [DefaultEnv]
    Enum, DefaultEnv
    DefaultEnv -> DefaultEnv -> Bounded DefaultEnv
    forall a. a -> a -> Bounded a
    $cminBound :: DefaultEnv
    minBound :: DefaultEnv
    $cmaxBound :: DefaultEnv
    maxBound :: DefaultEnv
    Bounded)

    -- | Setup commandline arguments for environment and port
    data ArgConfig env = ArgConfig
        { forall env. ArgConfig env -> env
    environment :: env
        , forall env. ArgConfig env -> Int
    port        :: Int
        } deriving Int -> ArgConfig env -> ShowS
    [ArgConfig env] -> ShowS
    ArgConfig env -> String
    (Int -> ArgConfig env -> ShowS)
    -> (ArgConfig env -> String)
    -> ([ArgConfig env] -> ShowS)
    -> Show (ArgConfig env)
    forall env. Show env => Int -> ArgConfig env -> ShowS
    forall env. Show env => [ArgConfig env] -> ShowS
    forall env. Show env => ArgConfig env -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall env. Show env => Int -> ArgConfig env -> ShowS
    showsPrec :: Int -> ArgConfig env -> ShowS
    $cshow :: forall env. Show env => ArgConfig env -> String
    show :: ArgConfig env -> String
    $cshowList :: forall env. Show env => [ArgConfig env] -> ShowS
    showList :: [ArgConfig env] -> ShowS
    Show

    parseArgConfig :: (Show env, Read env, Enum env, Bounded env) => IO (ArgConfig env)
    parseArgConfig :: forall env.
    (Show env, Read env, Enum env, Bounded env) =>
    IO (ArgConfig env)
    parseArgConfig = do
        let envs :: [env]
    envs = [env
    forall a. Bounded a => a
    minBound..env
    forall a. Bounded a => a
    maxBound]
        [String]
    args <- IO [String]
    getArgs
        (String
    portS, [String]
    args') <- ([String] -> [String]) -> [String] -> IO (String, [String])
    forall {c}. ([String] -> c) -> [String] -> IO (String, c)
    getPort [String] -> [String]
    forall a. a -> a
    id [String]
    args
        Int
    portI <-
            case ReadS Int
    forall a. Read a => ReadS a
    reads String
    portS of
                (Int
    i, String
    _):[(Int, String)]
    _ -> Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    i
                [] -> String -> IO Int
    forall a. HasCallStack => String -> a
    error (String -> IO Int) -> String -> IO Int
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid port value: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    portS
        case [String]
    args' of
            [String
    e] -> do
                case ReadS env
    forall a. Read a => ReadS a
    reads ReadS env -> ReadS env
    forall a b. (a -> b) -> a -> b
    $ ShowS
    capitalize String
    e of
                    (env
    e', String
    _):[(env, String)]
    _ -> ArgConfig env -> IO (ArgConfig env)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ArgConfig env -> IO (ArgConfig env))
    -> ArgConfig env -> IO (ArgConfig env)
    forall a b. (a -> b) -> a -> b
    $ env -> Int -> ArgConfig env
    forall env. env -> Int -> ArgConfig env
    ArgConfig env
    e' Int
    portI
                    [] -> do
                        () <- String -> IO ()
    forall a. HasCallStack => String -> a
    error (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid environment, valid entries are: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [env] -> String
    forall a. Show a => a -> String
    show [env]
    envs
                        -- next line just provided to force the type of envs
                        ArgConfig env -> IO (ArgConfig env)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ArgConfig env -> IO (ArgConfig env))
    -> ArgConfig env -> IO (ArgConfig env)
    forall a b. (a -> b) -> a -> b
    $ env -> Int -> ArgConfig env
    forall env. env -> Int -> ArgConfig env
    ArgConfig ([env] -> env
    forall a. HasCallStack => [a] -> a
    head [env]
    envs) Int
    0
            [String]
    _ -> do
                String
    pn <- IO String
    getProgName
                String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Usage: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    pn String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " <environment> [--port <port>]"
                String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Valid environments: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [env] -> String
    forall a. Show a => a -> String
    show [env]
    envs
                IO (ArgConfig env)
    forall a. IO a
    exitFailure
      where
        getPort :: ([String] -> c) -> [String] -> IO (String, c)
    getPort [String] -> c
    front [] = do
            [(String, String)]
    env <- IO [(String, String)]
    getEnvironment
            (String, c) -> IO (String, c)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "0" (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "PORT" [(String, String)]
    env, [String] -> c
    front [])
        getPort [String] -> c
    front (String
    "--port":String
    p:[String]
    rest) = (String, c) -> IO (String, c)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    p, [String] -> c
    front [String]
    rest)
        getPort [String] -> c
    front (String
    "-p":String
    p:[String]
    rest) = (String, c) -> IO (String, c)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    p, [String] -> c
    front [String]
    rest)
        getPort [String] -> c
    front (String
    arg:[String]
    rest) = ([String] -> c) -> [String] -> IO (String, c)
    getPort ([String] -> c
    front ([String] -> c) -> ([String] -> [String]) -> [String] -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    argString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :)) [String]
    rest

        capitalize :: ShowS
    capitalize [] = []
        capitalize (Char
    x:String
    xs) = Char -> Char
    toUpper Char
    x Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    xs

    -- | Load the app config from command line parameters, using the given
    -- @ConfigSettings.
    --
    -- Since 1.2.2
    fromArgsSettings :: (Read env, Show env, Enum env, Bounded env)
                     => (env -> IO (ConfigSettings env extra))
                     -> IO (AppConfig env extra)
    fromArgsSettings :: forall env extra.
    (Read env, Show env, Enum env, Bounded env) =>
    (env -> IO (ConfigSettings env extra)) -> IO (AppConfig env extra)
    fromArgsSettings env -> IO (ConfigSettings env extra)
    cs = do
        ArgConfig env
    args <- IO (ArgConfig env)
    forall env.
    (Show env, Read env, Enum env, Bounded env) =>
    IO (ArgConfig env)
    parseArgConfig

        let env :: env
    env = ArgConfig env -> env
    forall env. ArgConfig env -> env
    environment ArgConfig env
    args

        AppConfig env extra
    config <- env -> IO (ConfigSettings env extra)
    cs env
    env IO (ConfigSettings env extra)
    -> (ConfigSettings env extra -> IO (AppConfig env extra))
    -> IO (AppConfig env extra)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ConfigSettings env extra -> IO (AppConfig env extra)
    forall environment extra.
    ConfigSettings environment extra
    -> IO (AppConfig environment extra)
    loadConfig

        [(String, String)]
    env' <- IO [(String, String)]
    getEnvironment
        let config' :: AppConfig env extra
    config' =
                case String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "APPROOT" [(String, String)]
    env' of
                    Maybe String
    Nothing -> AppConfig env extra
    config
                    Just String
    ar -> AppConfig env extra
    config { appRoot = T.pack ar }

        AppConfig env extra -> IO (AppConfig env extra)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AppConfig env extra -> IO (AppConfig env extra))
    -> AppConfig env extra -> IO (AppConfig env extra)
    forall a b. (a -> b) -> a -> b
    $ if ArgConfig env -> Int
    forall env. ArgConfig env -> Int
    port ArgConfig env
    args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0
                    then AppConfig env extra
    config' { appPort = port args }
                    else AppConfig env extra
    config'

    -- | Load the app config from command line parameters
    fromArgs :: (Read env, Show env, Enum env, Bounded env)
             => (env -> Object -> Parser extra)
             -> IO (AppConfig env extra)
    fromArgs :: forall env extra.
    (Read env, Show env, Enum env, Bounded env) =>
    (env -> Object -> Parser extra) -> IO (AppConfig env extra)
    fromArgs env -> Object -> Parser extra
    getExtra = (env -> IO (ConfigSettings env extra)) -> IO (AppConfig env extra)
    forall env extra.
    (Read env, Show env, Enum env, Bounded env) =>
    (env -> IO (ConfigSettings env extra)) -> IO (AppConfig env extra)
    fromArgsSettings ((env -> IO (ConfigSettings env extra))
     -> IO (AppConfig env extra))
    -> (env -> IO (ConfigSettings env extra))
    -> IO (AppConfig env extra)
    forall a b. (a -> b) -> a -> b
    $ \env
    env -> ConfigSettings env extra -> IO (ConfigSettings env extra)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (env -> ConfigSettings env ()
    forall env. Show env => env -> ConfigSettings env ()
    configSettings env
    env)
        { csParseExtra = getExtra
        }

    -- | Load your development config (when using @'DefaultEnv'@)
    loadDevelopmentConfig :: IO (AppConfig DefaultEnv ())
    loadDevelopmentConfig :: IO (AppConfig DefaultEnv ())
    loadDevelopmentConfig = ConfigSettings DefaultEnv () -> IO (AppConfig DefaultEnv ())
    forall environment extra.
    ConfigSettings environment extra
    -> IO (AppConfig environment extra)
    loadConfig (ConfigSettings DefaultEnv () -> IO (AppConfig DefaultEnv ()))
    -> ConfigSettings DefaultEnv () -> IO (AppConfig DefaultEnv ())
    forall a b. (a -> b) -> a -> b
    $ DefaultEnv -> ConfigSettings DefaultEnv ()
    forall env. Show env => env -> ConfigSettings env ()
    configSettings DefaultEnv
    Development

    -- | Dynamic per-environment configuration which can be loaded at
    --   run-time negating the need to recompile between environments.
    data AppConfig environment extra = AppConfig
        { forall environment extra.
    AppConfig environment extra -> environment
    appEnv   :: environment
        , forall environment extra. AppConfig environment extra -> Int
    appPort  :: Int
        , forall environment extra. AppConfig environment extra -> Text
    appRoot  :: Text
        , forall environment extra.
    AppConfig environment extra -> HostPreference
    appHost  :: HostPreference
        , forall environment extra. AppConfig environment extra -> extra
    appExtra :: extra
        } deriving (Int -> AppConfig environment extra -> ShowS
    [AppConfig environment extra] -> ShowS
    AppConfig environment extra -> String
    (Int -> AppConfig environment extra -> ShowS)
    -> (AppConfig environment extra -> String)
    -> ([AppConfig environment extra] -> ShowS)
    -> Show (AppConfig environment extra)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall environment extra.
    (Show environment, Show extra) =>
    Int -> AppConfig environment extra -> ShowS
    forall environment extra.
    (Show environment, Show extra) =>
    [AppConfig environment extra] -> ShowS
    forall environment extra.
    (Show environment, Show extra) =>
    AppConfig environment extra -> String
    $cshowsPrec :: forall environment extra.
    (Show environment, Show extra) =>
    Int -> AppConfig environment extra -> ShowS
    showsPrec :: Int -> AppConfig environment extra -> ShowS
    $cshow :: forall environment extra.
    (Show environment, Show extra) =>
    AppConfig environment extra -> String
    show :: AppConfig environment extra -> String
    $cshowList :: forall environment extra.
    (Show environment, Show extra) =>
    [AppConfig environment extra] -> ShowS
    showList :: [AppConfig environment extra] -> ShowS
    Show)

    data ConfigSettings environment extra = ConfigSettings
        {
        -- | An arbitrary value, used below, to indicate the current running
        -- environment. Usually, you will use 'DefaultEnv' for this type.
           forall environment extra.
    ConfigSettings environment extra -> environment
    csEnv :: environment
        -- | Load any extra data, to be used by the application.
        , forall environment extra.
    ConfigSettings environment extra
    -> environment -> Object -> Parser extra
    csParseExtra :: environment -> Object -> Parser extra
        -- | Return the path to the YAML config file.
        , forall environment extra.
    ConfigSettings environment extra -> environment -> IO String
    csFile :: environment -> IO FilePath
        -- | Get the sub-object (if relevant) from the given YAML source which
        -- contains the specific settings for the current environment.
        , forall environment extra.
    ConfigSettings environment extra
    -> environment -> Value -> IO Value
    csGetObject :: environment -> Value -> IO Value
        }

    -- | Default config settings.
    configSettings :: Show env => env -> ConfigSettings env ()
    configSettings :: forall env. Show env => env -> ConfigSettings env ()
    configSettings env
    env0 = ConfigSettings
        { csEnv :: env
    csEnv = env
    env0
        , csParseExtra :: env -> Object -> Parser ()
    csParseExtra = \env
    _ Object
    _ -> () -> Parser ()
    forall a. a -> Parser a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        , csFile :: env -> IO String
    csFile = \env
    _ -> String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "config/settings.yml"
        , csGetObject :: env -> Value -> IO Value
    csGetObject = \env
    env Value
    v -> do
            Object
    envs <-
                case Value
    v of
                    Object Object
    obj -> Object -> IO Object
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Object
    obj
                    Value
    _ -> String -> IO Object
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Expected Object"
            let senv :: String
    senv = env -> String
    forall a. Show a => a -> String
    show env
    env
                tenv :: Key
    tenv = String -> Key
    forall a. IsString a => String -> a
    fromString String
    senv
            IO Value -> (Value -> IO Value) -> Maybe Value -> IO Value
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
                (String -> IO Value
    forall a. HasCallStack => String -> a
    error (String -> IO Value) -> String -> IO Value
    forall a b. (a -> b) -> a -> b
    $ String
    "Could not find environment: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    senv)
                Value -> IO Value
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                (Key -> Object -> Maybe Value
    forall v. Key -> KeyMap v -> Maybe v
    M.lookup Key
    tenv Object
    envs)
        }

    -- | Load an @'AppConfig'@.
    --
    --   Some examples:
    --
    --   > -- typical local development
    --   > Development:
    --   >   host: localhost
    --   >   port: 3000
    --   >
    --   >   -- approot: will default to ""
    --
    --   > -- typical outward-facing production box
    --   > Production:
    --   >   host: www.example.com
    --   >
    --   >   -- port: will default 80
    --   >   -- host: will default to "*"
    --   >   -- approot: will default "http://www.example.com"
    --
    --   > -- maybe you're reverse proxying connections to the running app
    --   > -- on some other port
    --   > Production:
    --   >   port: 8080
    --   >   approot: "http://example.com"
    --   >   host: "localhost"
    loadConfig :: ConfigSettings environment extra
               -> IO (AppConfig environment extra)
    loadConfig :: forall environment extra.
    ConfigSettings environment extra
    -> IO (AppConfig environment extra)
    loadConfig (ConfigSettings environment
    env environment -> Object -> Parser extra
    parseExtra environment -> IO String
    getFile environment -> Value -> IO Value
    getObject) = do
        String
    fp <- environment -> IO String
    getFile environment
    env
        Either ParseException Value
    etopObj <- String -> IO (Either ParseException Value)
    forall a. FromJSON a => String -> IO (Either ParseException a)
    decodeFileEither String
    fp
        Value
    topObj <- (ParseException -> IO Value)
    -> (Value -> IO Value) -> Either ParseException Value -> IO Value
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (IO Value -> ParseException -> IO Value
    forall a b. a -> b -> a
    const (IO Value -> ParseException -> IO Value)
    -> IO Value -> ParseException -> IO Value
    forall a b. (a -> b) -> a -> b
    $ String -> IO Value
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Invalid YAML file") Value -> IO Value
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either ParseException Value
    etopObj
        Value
    obj <- environment -> Value -> IO Value
    getObject environment
    env Value
    topObj
        Object
    m <-
            case Value
    obj of
                Object Object
    m -> Object -> IO Object
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Object
    m
                Value
    _ -> String -> IO Object
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Expected map"

        let host :: HostPreference
    host    = String -> HostPreference
    forall a. IsString a => String -> a
    fromString (String -> HostPreference) -> String -> HostPreference
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "*" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Key -> Object -> Maybe Text
    forall {m :: * -> *}. MonadFail m => Key -> Object -> m Text
    lookupScalar Key
    "host"    Object
    m
        Maybe Int
    mport <- (Object -> Parser (Maybe Int)) -> Object -> IO (Maybe Int)
    forall (m :: * -> *) a b.
    MonadFail m =>
    (a -> Parser b) -> a -> m b
    parseMonad (\Object
    x -> Object
    x Object -> Key -> Parser (Maybe Int)
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "port") Object
    m
        let approot' :: Text
    approot' = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "" (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Key -> Object -> Maybe Text
    forall {m :: * -> *}. MonadFail m => Key -> Object -> m Text
    lookupScalar Key
    "approot" Object
    m

        -- Handle the DISPLAY_PORT environment variable for yesod devel
        Text
    approot <-
            case Text -> Text -> Maybe Text
    T.stripSuffix Text
    ":3000" Text
    approot' of
                Maybe Text
    Nothing -> Text -> IO Text
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    approot'
                Just Text
    prefix -> do
                    [(String, String)]
    envVars <- IO [(String, String)]
    getEnvironment
                    case String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "DISPLAY_PORT" [(String, String)]
    envVars of
                        Maybe String
    Nothing -> Text -> IO Text
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    approot'
                        Just String
    p -> Text -> IO Text
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> IO Text) -> Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ Text
    prefix Text -> Text -> Text
    `T.append` String -> Text
    T.pack (Char
    ':' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    p)

        extra
    extra <- (Object -> Parser extra) -> Object -> IO extra
    forall (m :: * -> *) a b.
    MonadFail m =>
    (a -> Parser b) -> a -> m b
    parseMonad (environment -> Object -> Parser extra
    parseExtra environment
    env) Object
    m

        -- set some default arguments
        let port' :: Int
    port' = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    80 Maybe Int
    mport

        AppConfig environment extra -> IO (AppConfig environment extra)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AppConfig environment extra -> IO (AppConfig environment extra))
    -> AppConfig environment extra -> IO (AppConfig environment extra)
    forall a b. (a -> b) -> a -> b
    $ AppConfig
            { appEnv :: environment
    appEnv   = environment
    env
            , appPort :: Int
    appPort  = Int
    port'
            , appRoot :: Text
    appRoot  = Text
    approot
            , appHost :: HostPreference
    appHost  = HostPreference
    host
            , appExtra :: extra
    appExtra = extra
    extra
            }

        where
            lookupScalar :: Key -> Object -> m Text
    lookupScalar Key
    k Object
    m =
                case Key -> Object -> Maybe Value
    forall v. Key -> KeyMap v -> Maybe v
    M.lookup Key
    k Object
    m of
                    Just (String Text
    t) -> Text -> m Text
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    t
                    Just Value
    _ -> String -> m Text
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m Text) -> String -> m Text
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid value for: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Key -> String
    forall a. Show a => a -> String
    show Key
    k
                    Maybe Value
    Nothing -> String -> m Text
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m Text) -> String -> m Text
    forall a b. (a -> b) -> a -> b
    $ String
    "Not found: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Key -> String
    forall a. Show a => a -> String
    show Key
    k

    -- | Loads the configuration block in the passed file named by the
    --   passed environment, yields to the passed function as a mapping.
    --
    --   Errors in the case of a bad load or if your function returns
    --   @Nothing@.
    withYamlEnvironment :: Show e
                        => FilePath -- ^ the yaml file
                        -> e        -- ^ the environment you want to load
                        -> (Value -> Parser a) -- ^ what to do with the mapping
                        -> IO a
    withYamlEnvironment :: forall e a. Show e => String -> e -> (Value -> Parser a) -> IO a
    withYamlEnvironment String
    fp e
    env Value -> Parser a
    f = do
        Either ParseException Value
    mval <- String -> IO (Either ParseException Value)
    forall a. FromJSON a => String -> IO (Either ParseException a)
    decodeFileEither String
    fp
        case Either ParseException Value
    mval of
            Left ParseException
    err ->
              String -> IO a
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> IO a) -> String -> IO a
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid YAML file: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    fp String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ParseException -> String
    prettyPrintParseException ParseException
    err
            Right (Object Object
    obj)
                | Just Value
    v <- Key -> Object -> Maybe Value
    forall v. Key -> KeyMap v -> Maybe v
    M.lookup (String -> Key
    forall a. IsString a => String -> a
    fromString (String -> Key) -> String -> Key
    forall a b. (a -> b) -> a -> b
    $ e -> String
    forall a. Show a => a -> String
    show e
    env) Object
    obj -> (Value -> Parser a) -> Value -> IO a
    forall (m :: * -> *) a b.
    MonadFail m =>
    (a -> Parser b) -> a -> m b
    parseMonad Value -> Parser a
    f Value
    v
            Either ParseException Value
    _ -> String -> IO a
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> IO a) -> String -> IO a
    forall a b. (a -> b) -> a -> b
    $ String
    "Could not find environment: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ e -> String
    forall a. Show a => a -> String
    show e
    env