{-# LANGUAGE DeriveFunctor #-}

-- | A module for reading configuration options from environment variables.
--
-- Applications have configuration options. [The Twelve-Factor
-- App](https://12factor.net/import) recommends applications read these from
-- environment variables. This requires us to decode environment variables,
-- which are strings, into the different types the app's configuration options
-- might have. This module helps with that.
--
-- Here's what sets this package apart from other environment parsers:
--
-- - Very small API, supporting just one way to do environment parsing.
-- - Comes with parsers for common configuration option types, such as URIs.
--   Not using type classes for these parsers means we don't have to write a
--   bunch of orphan instances.
-- - Mandatory documentation of each environment variable we want to decode.
-- - The decoders keep track of all the environment variables they depend on.
--   That way the decoder for an application can tell us all the environment
--   variables an application depends on and what they are used for.
module Environment
  ( -- * Parsers
    Parser,
    text,
    int,
    float,
    boolean,
    uri,
    filePath,
    networkURI,
    secret,
    custom,

    -- * Decoders
    Decoder,
    consumes,
    Variable (Variable, name, description, defaultValue),
    variable,
    either,
    decode,
    decodeDefaults,
    decodePairs,

    -- * Decoders for just the variables
    decodeVariables,
    decodeVariablePairs,
    DecodedVariable
      ( DecodedVariable,
        decodedVariable,
        decodedCurrent,
        decodedErrors
      ),
  )
where

import qualified Data.Text
import qualified Debug
import qualified Dict
import qualified List
import qualified Log
import qualified Maybe
import qualified Network.URI
import NriPrelude
import qualified Result
import qualified System.Environment
import Text.Read (readMaybe)
import qualified Text.URI
import qualified Tuple
import Prelude
  ( Applicative,
    Either (Left, Right),
    FilePath,
    Functor,
    IO,
    Integer,
    Integral,
    Semigroup,
    fail,
    fromIntegral,
    mempty,
    pure,
  )

-- |
-- A function that can read values of a type from text. For example, a
-- @Parser Int@ knows how to read a string like "412" and extract from that the
-- number @412@.
--
-- Parsing functions can fail when they read a text that they do not understand.
-- For example, the @Parser Int@ parser will fail if ran against the string
-- "Not a number in the slightest!".
newtype Parser a
  = Parser (Text -> Result Text a)
  deriving (a -> Parser b -> Parser a
(a -> b) -> Parser a -> Parser b
(forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Parser b -> Parser a
$c<$ :: forall a b. a -> Parser b -> Parser a
fmap :: (a -> b) -> Parser a -> Parser b
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
Functor)

-- | Parse a text from an environment variable.
text :: Parser Text
text :: Parser Text
text = (Text -> Result Text Text) -> Parser Text
forall a. (Text -> Result Text a) -> Parser a
Parser Text -> Result Text Text
forall error value. value -> Result error value
Ok

-- | Parse an integer from an environment variable.
-- Works for any integer type (@Integer@, @Int@, @Int@, ...).
int :: (Integral a) => Parser a
int :: Parser a
int =
  (Text -> Result Text a) -> Parser a
forall a. (Text -> Result Text a) -> Parser a
Parser ((Text -> Result Text a) -> Parser a)
-> (Text -> Result Text a) -> Parser a
forall a b. (a -> b) -> a -> b
<| \Text
str ->
    case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Data.Text.unpack Text
str) of
      Maybe Integer
Nothing -> Text -> Result Text a
forall error value. error -> Result error value
Err (Text
"Could not parse as integer: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
str)
      Just (Integer
n :: Integer) -> a -> Result Text a
forall error value. value -> Result error value
Ok (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)

-- | Parse a floating point number from an environment variable.
float :: Parser Float
float :: Parser Float
float =
  (Text -> Result Text Float) -> Parser Float
forall a. (Text -> Result Text a) -> Parser a
Parser ((Text -> Result Text Float) -> Parser Float)
-> (Text -> Result Text Float) -> Parser Float
forall a b. (a -> b) -> a -> b
<| \Text
str ->
    case String -> Maybe Float
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Data.Text.unpack Text
str) of
      Maybe Float
Nothing -> Text -> Result Text Float
forall error value. error -> Result error value
Err (Text
"Could not parse as float: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
str)
      Just Float
n -> Float -> Result Text Float
forall error value. value -> Result error value
Ok Float
n

-- | Parse a boolean from an environment variable.
boolean :: Parser Bool
boolean :: Parser Bool
boolean =
  (Text -> Result Text Bool) -> Parser Bool
forall a. (Text -> Result Text a) -> Parser a
Parser ((Text -> Result Text Bool) -> Parser Bool)
-> (Text -> Result Text Bool) -> Parser Bool
forall a b. (a -> b) -> a -> b
<| \Text
str ->
    case String -> Maybe Bool
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Data.Text.unpack Text
str) of
      Maybe Bool
Nothing -> Text -> Result Text Bool
forall error value. error -> Result error value
Err (Text
"Could not parse as boolean: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
str)
      Just Bool
x -> Bool -> Result Text Bool
forall error value. value -> Result error value
Ok Bool
x

-- | Parse a URI from an environment variable.
uri :: Parser Text.URI.URI
uri :: Parser URI
uri =
  (Text -> Result Text URI) -> Parser URI
forall a. (Text -> Result Text a) -> Parser a
Parser ((Text -> Result Text URI) -> Parser URI)
-> (Text -> Result Text URI) -> Parser URI
forall a b. (a -> b) -> a -> b
<| \Text
str ->
    case Text -> Either SomeException URI
forall (m :: * -> *). MonadThrow m => Text -> m URI
Text.URI.mkURI Text
str of
      Left SomeException
err ->
        [Text
"Unexpected exception parsing uri:", Text
str, Text
". Error reads:", SomeException -> Text
forall a. Show a => a -> Text
Debug.toString SomeException
err]
          [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> [Text] -> Text
Data.Text.unwords
          Text -> (Text -> Result Text URI) -> Result Text URI
forall a b. a -> (a -> b) -> b
|> Text -> Result Text URI
forall error value. error -> Result error value
Err
      Right URI
x -> URI -> Result Text URI
forall error value. value -> Result error value
Ok URI
x

-- | Parse a file path from an environment variable.
filePath :: Parser FilePath
filePath :: Parser String
filePath = (Text -> Result Text String) -> Parser String
forall a. (Text -> Result Text a) -> Parser a
Parser (String -> Result Text String
forall error value. value -> Result error value
Ok (String -> Result Text String)
-> (Text -> String) -> Text -> Result Text String
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Text -> String
Data.Text.unpack)

-- | Parse a secret value from an environment variable.
--
-- Check the documentation for the @Log@ module of @nri-prelude@ to learn more
-- about secrets.
secret :: Parser a -> Parser (Log.Secret a)
secret :: Parser a -> Parser (Secret a)
secret = (a -> Secret a) -> Parser a -> Parser (Secret a)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map a -> Secret a
forall a. a -> Secret a
Log.mkSecret

-- | There's two @URI@ types that are in vogue in the Haskell ecosystem. We would
-- like to standardized on the @Text.URI@ package, since it's the more modern
-- @Text@ based version (no @Strings@ for us!), but most libraries require the
-- other type. This function helps convert.
networkURI :: Parser Network.URI.URI
networkURI :: Parser URI
networkURI =
  (Text -> Result Text URI) -> Parser URI
forall a. (Text -> Result Text a) -> Parser a
Parser ((Text -> Result Text URI) -> Parser URI)
-> (Text -> Result Text URI) -> Parser URI
forall a b. (a -> b) -> a -> b
<| \Text
str ->
    case String -> Maybe URI
Network.URI.parseURI (Text -> String
Data.Text.unpack Text
str) of
      Maybe URI
Nothing -> Text -> Result Text URI
forall error value. error -> Result error value
Err Text
"Oh no! We have a valid Network.URI.URI but can't seem to parse it as a Network.URI.URI."
      Just URI
uri' -> URI -> Result Text URI
forall error value. value -> Result error value
Ok URI
uri' {uriPath :: String
Network.URI.uriPath = String
""}

-- | Create a parser for custom types. Build on the back of one of the primitve
-- parsers from this module.
--
-- > data Environment = Development | Production
-- >
-- > environment :: Parser Environment
-- > environment =
-- >     custom text <| \str ->
-- >         case str of
-- >             "development" -> Ok Development
-- >             "production" -> Ok Production
-- >             _ -> Err ("Unknown environment: " ++ str)
custom :: Parser a -> (a -> Result Text b) -> Parser b
custom :: Parser a -> (a -> Result Text b) -> Parser b
custom (Parser Text -> Result Text a
base) a -> Result Text b
fn = (Text -> Result Text b) -> Parser b
forall a. (Text -> Result Text a) -> Parser a
Parser (\Text
val -> Text -> Result Text a
base Text
val Result Text a -> (Result Text a -> Result Text b) -> Result Text b
forall a b. a -> (a -> b) -> b
|> (a -> Result Text b) -> Result Text a -> Result Text b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
andThen a -> Result Text b
fn)

-- | An environment decoder knows how to read an app's configuration from
-- environment variables. Check out the @variable@ function to see how you can
-- begin building decoders.
data Decoder config
  = Decoder
      { -- | The list of @Variable@s that this decoder will read when ran.
        Decoder config -> [Variable]
consumes :: [Variable],
        Decoder config -> Dict Text Text -> Result [ParseError] config
readFromEnvironment :: Dict.Dict Text Text -> Result [ParseError] config
      }
  deriving (a -> Decoder b -> Decoder a
(a -> b) -> Decoder a -> Decoder b
(forall a b. (a -> b) -> Decoder a -> Decoder b)
-> (forall a b. a -> Decoder b -> Decoder a) -> Functor Decoder
forall a b. a -> Decoder b -> Decoder a
forall a b. (a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Decoder b -> Decoder a
$c<$ :: forall a b. a -> Decoder b -> Decoder a
fmap :: (a -> b) -> Decoder a -> Decoder b
$cfmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
Functor)

instance Applicative Decoder where
  pure :: a -> Decoder a
pure a
x = [Variable]
-> (Dict Text Text -> Result [ParseError] a) -> Decoder a
forall config.
[Variable]
-> (Dict Text Text -> Result [ParseError] config) -> Decoder config
Decoder [] (\Dict Text Text
_ -> a -> Result [ParseError] a
forall error value. value -> Result error value
Ok a
x)

  (Decoder [Variable]
consumes1 Dict Text Text -> Result [ParseError] (a -> b)
f) <*> :: Decoder (a -> b) -> Decoder a -> Decoder b
<*> (Decoder [Variable]
consumes2 Dict Text Text -> Result [ParseError] a
x) =
    Decoder :: forall config.
[Variable]
-> (Dict Text Text -> Result [ParseError] config) -> Decoder config
Decoder
      { consumes :: [Variable]
consumes = [Variable]
consumes1 [Variable] -> [Variable] -> [Variable]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [Variable]
consumes2,
        readFromEnvironment :: Dict Text Text -> Result [ParseError] b
readFromEnvironment = (Dict Text Text -> Result [ParseError] (a -> b))
-> (Dict Text Text -> Result [ParseError] a)
-> Dict Text Text
-> Result [ParseError] b
forall err env a config.
Semigroup err =>
(env -> Result err (a -> config))
-> (env -> Result err a) -> env -> Result err config
readFromEnvironment' Dict Text Text -> Result [ParseError] (a -> b)
f Dict Text Text -> Result [ParseError] a
x
      }
    where
      readFromEnvironment' ::
        Semigroup err =>
        (env -> Result err (a -> config)) ->
        (env -> Result err a) ->
        env ->
        Result err config
      readFromEnvironment' :: (env -> Result err (a -> config))
-> (env -> Result err a) -> env -> Result err config
readFromEnvironment' env -> Result err (a -> config)
f' env -> Result err a
x' env
env =
        -- This is the same as <*> except that when both sides are errors we
        -- want to capture both, not just the first.
        case (env -> Result err (a -> config)
f' env
env, env -> Result err a
x' env
env) of
          (Err err
fe, Err err
xe) ->
            err -> Result err config
forall error value. error -> Result error value
Err (err
fe err -> err -> err
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ err
xe)
          (Result err (a -> config)
fr, Result err a
xr) ->
            Result err (a -> config)
fr Result err (a -> config) -> Result err a -> Result err config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Result err a
xr

-- | An environment variable with a description of what it is used for.
data Variable
  = Variable
      { Variable -> Text
name :: Text,
        Variable -> Text
description :: Text,
        Variable -> Text
defaultValue :: Text
      }
  deriving (Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> String
(Int -> Variable -> ShowS)
-> (Variable -> String) -> ([Variable] -> ShowS) -> Show Variable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Variable] -> ShowS
$cshowList :: [Variable] -> ShowS
show :: Variable -> String
$cshow :: Variable -> String
showsPrec :: Int -> Variable -> ShowS
$cshowsPrec :: Int -> Variable -> ShowS
Show)

data ParseError
  = ParseError
      { ParseError -> Variable
failingVariable :: Variable,
        ParseError -> Text
failingReason :: Text
      }
  deriving (Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show)

-- | Describe a decoded variable for informational purposes.
data DecodedVariable
  = DecodedVariable
      { DecodedVariable -> Variable
decodedVariable :: Variable,
        DecodedVariable -> Maybe Text
decodedCurrent :: Maybe Text,
        -- A single environment variable can be decoded by multiple decoders,
        -- each with their own constraints.
        DecodedVariable -> [Text]
decodedErrors :: List Text
      }
  deriving (Int -> DecodedVariable -> ShowS
[DecodedVariable] -> ShowS
DecodedVariable -> String
(Int -> DecodedVariable -> ShowS)
-> (DecodedVariable -> String)
-> ([DecodedVariable] -> ShowS)
-> Show DecodedVariable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodedVariable] -> ShowS
$cshowList :: [DecodedVariable] -> ShowS
show :: DecodedVariable -> String
$cshow :: DecodedVariable -> String
showsPrec :: Int -> DecodedVariable -> ShowS
$cshowsPrec :: Int -> DecodedVariable -> ShowS
Show)

-- | Produce a configuration from a single environment veriable. Usually you
-- will combine these with @mapN@ functions to build larger configurations.
--
-- > Data Settings = Settings
-- >    { amountOfHats :: Int
-- >    , furLined :: Bool
-- >    }
-- >
-- > map2
-- >  Settings
-- >  (variable (Variable "HATS" "Amount of hats" "2") int)
-- >  (variable (Variable "FUR_LINED" "Do hats have fur lining?" "False") boolean)
variable :: Variable -> Parser a -> Decoder a
variable :: Variable -> Parser a -> Decoder a
variable Variable
var (Parser Text -> Result Text a
parse) =
  Decoder :: forall config.
[Variable]
-> (Dict Text Text -> Result [ParseError] config) -> Decoder config
Decoder
    { consumes :: [Variable]
consumes = [Variable
var],
      readFromEnvironment :: Dict Text Text -> Result [ParseError] a
readFromEnvironment = \Dict Text Text
env ->
        let value :: Text
value =
              Text -> Dict Text Text -> Maybe Text
forall comparable v.
Ord comparable =>
comparable -> Dict comparable v -> Maybe v
Dict.get (Variable -> Text
name Variable
var) Dict Text Text
env
                Maybe Text -> (Maybe Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.withDefault (Variable -> Text
defaultValue Variable
var)
         in Text -> Result Text a
parse Text
value Result Text a
-> (Result Text a -> Result [ParseError] a)
-> Result [ParseError] a
forall a b. a -> (a -> b) -> b
|> (Text -> [ParseError]) -> Result Text a -> Result [ParseError] a
forall a b c. (a -> b) -> Result a c -> Result b c
Result.mapError (ParseError -> [ParseError]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseError -> [ParseError])
-> (Text -> ParseError) -> Text -> [ParseError]
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Variable -> Text -> ParseError
ParseError Variable
var)
    }

-- | If the first decoder fails, try the second.
either :: Decoder a -> Decoder a -> Decoder a
either :: Decoder a -> Decoder a -> Decoder a
either (Decoder [Variable]
consumes1 Dict Text Text -> Result [ParseError] a
fa) (Decoder [Variable]
consumes2 Dict Text Text -> Result [ParseError] a
fb) =
  Decoder :: forall config.
[Variable]
-> (Dict Text Text -> Result [ParseError] config) -> Decoder config
Decoder
    { consumes :: [Variable]
consumes = [Variable]
consumes1 [Variable] -> [Variable] -> [Variable]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [Variable]
consumes2,
      readFromEnvironment :: Dict Text Text -> Result [ParseError] a
readFromEnvironment = \Dict Text Text
env ->
        case Dict Text Text -> Result [ParseError] a
fa Dict Text Text
env of
          Err [ParseError]
ea -> case Dict Text Text -> Result [ParseError] a
fb Dict Text Text
env of
            Err [ParseError]
eb -> [ParseError] -> Result [ParseError] a
forall error value. error -> Result error value
Err ([ParseError]
ea [ParseError] -> [ParseError] -> [ParseError]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [ParseError]
eb)
            Ok a
r -> a -> Result [ParseError] a
forall error value. value -> Result error value
Ok a
r
          Ok a
r -> a -> Result [ParseError] a
forall error value. value -> Result error value
Ok a
r
    }

-- | Attempt to decode a configuration by reading environment variables.
-- This will fail if one or more environment variables fail to parse.
--
-- It will not fail if certain environment variables are absent. Defaults will
-- be used for those missing values.
decode :: Decoder a -> IO a
decode :: Decoder a -> IO a
decode Decoder a
configuration = do
  Dict Text Text
env <- IO (Dict Text Text)
getEnv
  case Decoder a -> Dict Text Text -> Result Text a
forall a. Decoder a -> Dict Text Text -> Result Text a
decodePairs Decoder a
configuration Dict Text Text
env of
    Err Text
err -> String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Data.Text.unpack Text
err)
    Ok a
x -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | Same as 'decode', but takes the environment to decode as a dictionary.
decodePairs :: Decoder a -> Dict.Dict Text Text -> Result Text a
decodePairs :: Decoder a -> Dict Text Text -> Result Text a
decodePairs Decoder a
configuration Dict Text Text
env =
  case Decoder a -> Dict Text Text -> Result [ParseError] a
forall config.
Decoder config -> Dict Text Text -> Result [ParseError] config
readFromEnvironment Decoder a
configuration Dict Text Text
env of
    Err [ParseError]
err -> Text -> Result Text a
forall error value. error -> Result error value
Err ([ParseError] -> Text
errorsToText [ParseError]
err)
    Ok a
x -> a -> Result Text a
forall error value. value -> Result error value
Ok a
x

-- | Run a decoder. Instead of returnin the decoded value return metadata about
-- each variable that was decoded.
--
-- This can be helpful when generating a @--help@ command, for listing all the
-- variables that the application supports and what they are currently set to.
decodeVariables :: Decoder a -> IO [DecodedVariable]
decodeVariables :: Decoder a -> IO [DecodedVariable]
decodeVariables Decoder a
configuration =
  (Dict Text Text -> [DecodedVariable])
-> IO (Dict Text Text) -> IO [DecodedVariable]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Decoder a -> Dict Text Text -> [DecodedVariable]
forall a. Decoder a -> Dict Text Text -> [DecodedVariable]
decodeVariablePairs Decoder a
configuration) IO (Dict Text Text)
getEnv

-- | Same as 'decodeVariables', but takes the environment to decode as a
-- dictionary.
decodeVariablePairs :: Decoder a -> Dict.Dict Text Text -> [DecodedVariable]
decodeVariablePairs :: Decoder a -> Dict Text Text -> [DecodedVariable]
decodeVariablePairs Decoder a
configuration Dict Text Text
env = do
  Variable
var <- Decoder a -> [Variable]
forall config. Decoder config -> [Variable]
consumes Decoder a
configuration
  DecodedVariable -> [DecodedVariable]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( DecodedVariable :: Variable -> Maybe Text -> [Text] -> DecodedVariable
DecodedVariable
        { decodedVariable :: Variable
decodedVariable = Variable
var,
          decodedCurrent :: Maybe Text
decodedCurrent = Text -> Dict Text Text -> Maybe Text
forall comparable v.
Ord comparable =>
comparable -> Dict comparable v -> Maybe v
Dict.get (Variable -> Text
name Variable
var) Dict Text Text
env,
          decodedErrors :: [Text]
decodedErrors =
            Text -> Dict Text [Text] -> Maybe [Text]
forall comparable v.
Ord comparable =>
comparable -> Dict comparable v -> Maybe v
Dict.get (Variable -> Text
name Variable
var) Dict Text [Text]
errors
              Maybe [Text] -> (Maybe [Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
|> [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
Maybe.withDefault []
        }
    )
  where
    errors :: Dict Text [Text]
errors =
      (ParseError -> (Text, [Text])) -> [ParseError] -> [(Text, [Text])]
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map ParseError -> (Text, [Text])
errorPair [ParseError]
parseErrors
        [(Text, [Text])]
-> ([(Text, [Text])] -> Dict Text [Text]) -> Dict Text [Text]
forall a b. a -> (a -> b) -> b
|> ((Text, [Text]) -> Dict Text [Text] -> Dict Text [Text])
-> Dict Text [Text] -> [(Text, [Text])] -> Dict Text [Text]
forall a b. (a -> b -> b) -> b -> List a -> b
List.foldl (Text, [Text]) -> Dict Text [Text] -> Dict Text [Text]
forall comparable a.
(Ord comparable, Semigroup a) =>
(comparable, a) -> Dict comparable a -> Dict comparable a
insert Dict Text [Text]
forall k v. Dict k v
Dict.empty
    insert :: (comparable, a) -> Dict comparable a -> Dict comparable a
insert (comparable
k, a
v) Dict comparable a
dict =
      comparable
-> (Maybe a -> Maybe a) -> Dict comparable a -> Dict comparable a
forall comparable v.
Ord comparable =>
comparable
-> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v
Dict.update
        comparable
k
        ( \Maybe a
prev ->
            case Maybe a
prev of
              Maybe a
Nothing -> a -> Maybe a
forall a. a -> Maybe a
Just a
v
              Just a
v' -> a -> Maybe a
forall a. a -> Maybe a
Just (a
v' a -> a -> a
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ a
v)
        )
        Dict comparable a
dict
    errorPair :: ParseError -> (Text, [Text])
errorPair ParseError
err =
      ((ParseError -> Variable
failingVariable (ParseError -> Variable)
-> (Variable -> Text) -> ParseError -> Text
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Variable -> Text
name) ParseError
err, [ParseError -> Text
failingReason ParseError
err])
    parseErrors :: [ParseError]
parseErrors =
      case Decoder a -> Dict Text Text -> Result [ParseError] a
forall config.
Decoder config -> Dict Text Text -> Result [ParseError] config
readFromEnvironment Decoder a
configuration Dict Text Text
env of
        Err [ParseError]
errs -> [ParseError]
errs
        Ok a
_ -> []

getEnv :: IO (Dict.Dict Text Text)
getEnv :: IO (Dict Text Text)
getEnv = do
  [(String, String)]
pairs <- IO [(String, String)]
System.Environment.getEnvironment
  Dict Text Text -> IO (Dict Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dict Text Text -> IO (Dict Text Text))
-> Dict Text Text -> IO (Dict Text Text)
forall a b. (a -> b) -> a -> b
<| List (Text, Text) -> Dict Text Text
forall comparable v.
Ord comparable =>
List (comparable, v) -> Dict comparable v
Dict.fromList (List (Text, Text) -> Dict Text Text)
-> List (Text, Text) -> Dict Text Text
forall a b. (a -> b) -> a -> b
<| ((String, String) -> (Text, Text))
-> [(String, String)] -> List (Text, Text)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map ((String -> Text)
-> (String -> Text) -> (String, String) -> (Text, Text)
forall a x b y. (a -> x) -> (b -> y) -> (a, b) -> (x, y)
Tuple.mapBoth String -> Text
Data.Text.pack String -> Text
Data.Text.pack) [(String, String)]
pairs

-- | Build a configuration using only default values of environment variables.
-- Similar to @decode@, except this version doesn't read any environment
-- variables.
--
-- This is sometimes useful for tests, where you might not care about the exact
-- values of settings.
decodeDefaults :: Decoder a -> Result Text a
decodeDefaults :: Decoder a -> Result Text a
decodeDefaults Decoder a
configuration =
  Decoder a -> Dict Text Text -> Result [ParseError] a
forall config.
Decoder config -> Dict Text Text -> Result [ParseError] config
readFromEnvironment Decoder a
configuration Dict Text Text
forall a. Monoid a => a
mempty Result [ParseError] a
-> (Result [ParseError] a -> Result Text a) -> Result Text a
forall a b. a -> (a -> b) -> b
|> ([ParseError] -> Text) -> Result [ParseError] a -> Result Text a
forall a b c. (a -> b) -> Result a c -> Result b c
Result.mapError [ParseError] -> Text
errorsToText

errorsToText :: [ParseError] -> Text
errorsToText :: [ParseError] -> Text
errorsToText [ParseError]
errors = (ParseError -> Text) -> [ParseError] -> [Text]
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map ParseError -> Text
errorToText [ParseError]
errors [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> [Text] -> Text
Data.Text.intercalate Text
"\n\n"

errorToText :: ParseError -> Text
errorToText :: ParseError -> Text
errorToText ParseError {Variable
failingVariable :: Variable
failingVariable :: ParseError -> Variable
failingVariable, Text
failingReason :: Text
failingReason :: ParseError -> Text
failingReason} =
  [Text] -> Text
Data.Text.unwords [Text
"Parsing", Variable -> Text
name Variable
failingVariable, Text
"failed:", Text
failingReason]