    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}
    -- | Functionality for using YAML as configuration files
    --
    -- In particular, merging environment variables with yaml values
    --
    -- 'loadYamlSettings' is a high-level API for loading YAML and merging environment variables.
    -- A yaml value of @_env:ENV_VAR:default@ will lookup the environment variable @ENV_VAR@.
    --
    -- On a historical note, this code was taken directly from the yesod web framework's configuration module.
    module Data.Yaml.Config
        ( -- * High-level
          loadYamlSettings
        , loadYamlSettingsArgs
          -- ** EnvUsage
        , EnvUsage
        , ignoreEnv
        , useEnv
        , requireEnv
        , useCustomEnv
        , requireCustomEnv
          -- * Lower level
        , applyCurrentEnv
        , getCurrentEnv
        , applyEnvValue
        ) where

    #if __GLASGOW_HASKELL__ < 710
    import Control.Applicative ((<$>))
    import Data.Monoid
    #endif
    import Data.Semigroup
    import Data.List.NonEmpty (nonEmpty)
    import Data.Aeson
    #if MIN_VERSION_aeson(2,0,0)
    import qualified Data.Aeson.Key as K
    import qualified Data.Aeson.KeyMap as H
    import Data.Aeson.KeyMap (KeyMap)
    #else
    import qualified Data.HashMap.Strict as H
    #endif
    import Data.Text (Text, pack)
    import System.Environment (getArgs, getEnvironment)
    import Control.Arrow ((***))
    import Control.Monad (forM)
    import Control.Exception (throwIO)
    import Data.Text.Encoding (encodeUtf8)
    import qualified Data.Yaml as Y
    import qualified Data.Yaml.Include as YI
    import Data.Maybe (fromMaybe)
    import qualified Data.Text as T

    #if MIN_VERSION_aeson(2,0,0)
    fromText :: T.Text -> Key
    fromText :: Text -> Key
    fromText = Text -> Key
    K.fromText
    #else
    fromText :: T.Text -> T.Text
    fromText = id

    type KeyMap a = H.HashMap T.Text a
    #endif

    newtype MergedValue = MergedValue { MergedValue -> Value
    getMergedValue :: Value }

    instance Semigroup MergedValue where
        MergedValue Value
    x <> :: MergedValue -> MergedValue -> MergedValue
    <> MergedValue Value
    y = Value -> MergedValue
    MergedValue (Value -> MergedValue) -> Value -> MergedValue
    forall a b. (a -> b) -> a -> b
    $ Value -> Value -> Value
    mergeValues Value
    x Value
    y

    -- | Left biased
    mergeValues :: Value -> Value -> Value
    mergeValues :: Value -> Value -> Value
    mergeValues (Object Object
    x) (Object Object
    y) = Object -> Value
    Object (Object -> Value) -> Object -> Value
    forall a b. (a -> b) -> a -> b
    $ (Value -> Value -> Value) -> Object -> Object -> Object
    forall v. (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v
    H.unionWith Value -> Value -> Value
    mergeValues Object
    x Object
    y
    mergeValues Value
    x Value
    _ = Value
    x

    -- | Override environment variable placeholders in the given @Value@ with
    -- values from the environment.
    --
    -- If the first argument is @True@, then all placeholders _must_ be provided by
    -- the actual environment. Otherwise, default values from the @Value@ will be
    -- used.
    --
    -- @since 0.8.16
    applyEnvValue :: Bool -- ^ require an environment variable to be present?
                  -> KeyMap Text -> Value -> Value
    applyEnvValue :: Bool -> KeyMap Text -> Value -> Value
    applyEnvValue Bool
    requireEnv' KeyMap Text
    env =
        Value -> Value
    goV
      where
        goV :: Value -> Value
    goV (Object Object
    o) = Object -> Value
    Object (Object -> Value) -> Object -> Value
    forall a b. (a -> b) -> a -> b
    $ Value -> Value
    goV (Value -> Value) -> Object -> Object
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Object
    o
        goV (Array Array
    a) = Array -> Value
    Array (Value -> Value
    goV (Value -> Value) -> Array -> Array
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Array
    a)
        goV (String Text
    t1) = Value -> Maybe Value -> Value
    forall a. a -> Maybe a -> a
    fromMaybe (Text -> Value
    String Text
    t1) (Maybe Value -> Value) -> Maybe Value -> Value
    forall a b. (a -> b) -> a -> b
    $ do
            t2 <- Text -> Text -> Maybe Text
    T.stripPrefix Text
    "_env:" Text
    t1
            let (name, t3) = T.break (== ':') t2
                mdef = (Text -> Value) -> Maybe Text -> Maybe Value
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> Value
    parseValue (Maybe Text -> Maybe Value) -> Maybe Text -> Maybe Value
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> Maybe Text
    T.stripPrefix Text
    ":" Text
    t3
            Just $ case H.lookup (fromText name) env of
                Just Text
    val ->
                    -- If the default value parses as a String, we treat the
                    -- environment variable as a raw value and do not parse it.
                    -- This means that things like numeric passwords just work.
                    -- However, for originally numerical or boolean values (e.g.,
                    -- port numbers), we still perform a normal YAML parse.
                    --
                    -- For details, see:
                    -- https://github.com/yesodweb/yesod/issues/1061
                    case Maybe Value
    mdef of
                        Just (String Text
    _) -> Text -> Value
    String Text
    val
                        Maybe Value
    _ -> Text -> Value
    parseValue Text
    val
                Maybe Text
    Nothing ->
                    case Maybe Value
    mdef of
                        Just Value
    val | Bool -> Bool
    not Bool
    requireEnv' -> Value
    val
                        Maybe Value
    _ -> Value
    Null
        goV Value
    v = Value
    v

        parseValue :: Text -> Value
    parseValue Text
    val = (SomeException -> Value)
    -> (Value -> Value) -> Either SomeException Value -> Value
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either
          (Value -> SomeException -> Value
    forall a b. a -> b -> a
    const (Text -> Value
    String Text
    val))
          Value -> Value
    forall a. a -> a
    id
          (ByteString -> Either SomeException Value
    forall (m :: * -> *) a.
    (MonadThrow m, FromJSON a) =>
    ByteString -> m a
    Y.decodeThrow (ByteString -> Either SomeException Value)
    -> ByteString -> Either SomeException Value
    forall a b. (a -> b) -> a -> b
    $ Text -> ByteString
    encodeUtf8 Text
    val)

    -- | Get the actual environment as a @HashMap@ from @Text@ to @Text@.
    --
    -- @since 0.8.16
    getCurrentEnv :: IO (KeyMap Text)
    getCurrentEnv :: IO (KeyMap Text)
    getCurrentEnv = ([(String, String)] -> KeyMap Text)
    -> IO [(String, String)] -> IO (KeyMap Text)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([(Key, Text)] -> KeyMap Text
    forall v. [(Key, v)] -> KeyMap v
    H.fromList ([(Key, Text)] -> KeyMap Text)
    -> ([(String, String)] -> [(Key, Text)])
    -> [(String, String)]
    -> KeyMap Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String, String) -> (Key, Text))
    -> [(String, String)] -> [(Key, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> Key
    fromText (Text -> Key) -> (String -> Text) -> String -> Key
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    pack (String -> Key)
    -> (String -> Text) -> (String, String) -> (Key, Text)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** String -> Text
    pack)) IO [(String, String)]
    getEnvironment

    -- | A convenience wrapper around 'applyEnvValue' and 'getCurrentEnv'
    --
    -- @since 0.8.16
    applyCurrentEnv :: Bool -- ^ require an environment variable to be present?
                    -> Value -> IO Value
    applyCurrentEnv :: Bool -> Value -> IO Value
    applyCurrentEnv Bool
    requireEnv' Value
    orig = (KeyMap Text -> Value -> Value) -> Value -> KeyMap Text -> Value
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Bool -> KeyMap Text -> Value -> Value
    applyEnvValue Bool
    requireEnv') Value
    orig (KeyMap Text -> Value) -> IO (KeyMap Text) -> IO Value
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (KeyMap Text)
    getCurrentEnv

    -- | Defines how we want to use the environment variables when loading a config
    -- file. Use the smart constructors provided by this module.
    --
    -- @since 0.8.16
    data EnvUsage = IgnoreEnv
                  | UseEnv
                  | RequireEnv
                  | UseCustomEnv (KeyMap Text)
                  | RequireCustomEnv (KeyMap Text)

    -- | Do not use any environment variables, instead relying on defaults values
    -- in the config file.
    --
    -- @since 0.8.16
    ignoreEnv :: EnvUsage
    ignoreEnv :: EnvUsage
    ignoreEnv = EnvUsage
    IgnoreEnv

    -- | Use environment variables when available, otherwise use defaults.
    --
    -- @since 0.8.16
    useEnv :: EnvUsage
    useEnv :: EnvUsage
    useEnv = EnvUsage
    UseEnv

    -- | Do not use default values from the config file, but instead take all
    -- overrides from the environment. If a value is missing, loading the file will
    -- throw an exception.
    --
    -- @since 0.8.16
    requireEnv :: EnvUsage
    requireEnv :: EnvUsage
    requireEnv = EnvUsage
    RequireEnv

    -- | Same as 'useEnv', but instead of the actual environment, use the provided
    -- @HashMap@ as the environment.
    --
    -- @since 0.8.16
    useCustomEnv :: KeyMap Text -> EnvUsage
    useCustomEnv :: KeyMap Text -> EnvUsage
    useCustomEnv = KeyMap Text -> EnvUsage
    UseCustomEnv

    -- | Same as 'requireEnv', but instead of the actual environment, use the
    -- provided @HashMap@ as the environment.
    --
    -- @since 0.8.16
    requireCustomEnv :: KeyMap Text -> EnvUsage
    requireCustomEnv :: KeyMap Text -> EnvUsage
    requireCustomEnv = KeyMap Text -> EnvUsage
    RequireCustomEnv

    -- | Load the settings from the following three sources:
    --
    -- * Run time config files
    --
    -- * Run time environment variables
    --
    -- * The default compile time config file
    --
    -- For example, to load up settings from @config/foo.yaml@ and allow overriding
    -- from the actual environment, you can use:
    --
    -- > loadYamlSettings ["config/foo.yaml"] [] useEnv
    --
    -- @since 0.8.16
    loadYamlSettings
        :: FromJSON settings
        => [FilePath] -- ^ run time config files to use, earlier files have precedence
        -> [Value] -- ^ any other values to use, usually from compile time config. overridden by files
        -> EnvUsage
        -> IO settings
    loadYamlSettings :: forall settings.
    FromJSON settings =>
    [String] -> [Value] -> EnvUsage -> IO settings
    loadYamlSettings [String]
    runTimeFiles [Value]
    compileValues EnvUsage
    envUsage = do
        runValues <- [String] -> (String -> IO Value) -> IO [Value]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [String]
    runTimeFiles ((String -> IO Value) -> IO [Value])
    -> (String -> IO Value) -> IO [Value]
    forall a b. (a -> b) -> a -> b
    $ \String
    fp -> do
            eres <- String -> IO (Either ParseException Value)
    forall a. FromJSON a => String -> IO (Either ParseException a)
    YI.decodeFileEither String
    fp
            case eres of
                Left ParseException
    e -> ParseException -> IO Value
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> ParseException -> ParseException
    Y.LoadSettingsException String
    fp ParseException
    e)
                Right Value
    value -> Value -> IO Value
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Value
    value

        value' <-
            case nonEmpty $ map MergedValue $ runValues ++ compileValues of
                Maybe (NonEmpty MergedValue)
    Nothing -> String -> IO Value
    forall a. HasCallStack => String -> a
    error String
    "loadYamlSettings: No configuration provided"
                Just NonEmpty MergedValue
    ne -> Value -> IO Value
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> IO Value) -> Value -> IO Value
    forall a b. (a -> b) -> a -> b
    $ MergedValue -> Value
    getMergedValue (MergedValue -> Value) -> MergedValue -> Value
    forall a b. (a -> b) -> a -> b
    $ NonEmpty MergedValue -> MergedValue
    forall a. Semigroup a => NonEmpty a -> a
    sconcat NonEmpty MergedValue
    ne
        value <-
            case envUsage of
                EnvUsage
    IgnoreEnv            -> Value -> IO Value
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> IO Value) -> Value -> IO Value
    forall a b. (a -> b) -> a -> b
    $ Bool -> KeyMap Text -> Value -> Value
    applyEnvValue   Bool
    False KeyMap Text
    forall a. Monoid a => a
    mempty Value
    value'
                EnvUsage
    UseEnv               ->          Bool -> Value -> IO Value
    applyCurrentEnv Bool
    False        Value
    value'
                EnvUsage
    RequireEnv           ->          Bool -> Value -> IO Value
    applyCurrentEnv Bool
    True         Value
    value'
                UseCustomEnv KeyMap Text
    env     -> Value -> IO Value
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> IO Value) -> Value -> IO Value
    forall a b. (a -> b) -> a -> b
    $ Bool -> KeyMap Text -> Value -> Value
    applyEnvValue   Bool
    False KeyMap Text
    env    Value
    value'
                RequireCustomEnv KeyMap Text
    env -> Value -> IO Value
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Value -> IO Value) -> Value -> IO Value
    forall a b. (a -> b) -> a -> b
    $ Bool -> KeyMap Text -> Value -> Value
    applyEnvValue   Bool
    True  KeyMap Text
    env    Value
    value'

        case Y.parseEither parseJSON value of
            Left String
    s -> String -> IO settings
    forall a. HasCallStack => String -> a
    error (String -> IO settings) -> String -> IO settings
    forall a b. (a -> b) -> a -> b
    $ String
    "Could not convert to expected type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s
            Right settings
    settings -> settings -> IO settings
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return settings
    settings

    -- | Same as @loadYamlSettings@, but get the list of runtime config files from
    -- the command line arguments.
    --
    -- @since 0.8.17
    loadYamlSettingsArgs
        :: FromJSON settings
        => [Value] -- ^ any other values to use, usually from compile time config. overridden by files
        -> EnvUsage -- ^ use environment variables
        -> IO settings
    loadYamlSettingsArgs :: forall settings.
    FromJSON settings =>
    [Value] -> EnvUsage -> IO settings
    loadYamlSettingsArgs [Value]
    values EnvUsage
    env = do
        args <- IO [String]
    getArgs
        loadYamlSettings args values env