{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnicodeSyntax #-}

{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module: Configuration.Utils
-- Description: Utilities for Configuring Programs
-- Copyright: Copyright © 2014-2015 PivotCloud, Inc.
-- License: MIT
-- Maintainer: Lars Kuhtz <lkuhtz@pivotmail.com>
-- Stability: experimental
--
-- This module provides a collection of utilities on top of the packages
-- optparse-applicative, aeson, and yaml, for configuring libraries and
-- applications in a composable way.
--
-- The main feature is the integration of command line option parsing and
-- configuration files.
--
-- The purpose is to make management of configurations easy by providing an
-- idiomatic style of defining and deploying configurations in a modular
-- and composable way.
--
-- = Usage
--
-- The module provides operators and functions that make the implementation of
-- these entities easy for the common case that the configurations are encoded
-- mainly as nested records.
--
-- For each data type that is used as as component in a configuration type
-- the following must be provided:
--
-- 1. a /default value/,
--
-- 2. a /'FromJSON' instance/ that yields a function that takes a value and
--    updates that value with the parsed values,
--
-- 3. a /'ToJSON' instance/, and
--
-- 4. a /command line options parser/ that yields a function that takes a value
--    and updates that value with the values provided as command line options.
--
-- In addition to the above optionally a /validation function/ may be provided
-- that (recursively) validates a configuration value and returns either
-- an error or a (possibly empty) list-like structure of warnings.
--
-- The modules
--
-- * "Configuration.Utils.CommandLine",
-- * "Configuration.Utils.ConfigFile", and
-- * "Configuration.Utils.Operators"
--
-- contain tools and examples for defining above prerequisites for using a
-- type in a configuration type.
--
-- The provided functions and operators assume that lenses for the
-- configuration record types are provided.
--
-- The module "Configuration.Utils.Monoid" provides tools for the case that
-- a /simple type/ is a container with a monoid instance, such as @List@ or
-- @HashMap@.
--
-- The module "Configuration.Utils.Maybe" explains the usage of optional
-- 'Maybe' values in configuration types.
--
-- = Usage Example
--
-- Beside the examples that are provided in the haddock documentation there is
-- a complete usage example in the file
-- <https://github.com/alephcloud/hs-configuration-tools/blob/master/examples/Example.hs example/Example.hs>
-- of the cabal package.
--
module Configuration.Utils
(
-- * Program Configuration
  ProgramInfo
, programInfo
, piDescription
, piHelpHeader
, piHelpFooter
, piOptionParser
, piDefaultConfiguration
, piConfigurationFiles

-- * Program Configuration with Validation of Configuration Values
, ConfigValidation
, programInfoValidate

-- * Running a Configured Application
, runWithConfiguration
, PkgInfo
, runWithPkgInfoConfiguration
, parseConfiguration

-- * Command Line Option Parsing with Default Values
, module Configuration.Utils.CommandLine

-- * Parsing of Configuration Files with Default Values
, module Configuration.Utils.ConfigFile

-- * Miscellaneous Utilities
, module Configuration.Utils.Operators
, Lens'
, Lens

-- * Configuration of Optional Values
, module Configuration.Utils.Maybe

-- * Configuration of Monoids
, module Configuration.Utils.Monoid

-- * Low-level Configuration Validation
, ProgramInfoValidate
, piValidateConfiguration
, ConfigValidationFunction(..)
, piOptionParserAndDefaultConfiguration
) where

import Configuration.Utils.CommandLine
import Configuration.Utils.ConfigFile
import Configuration.Utils.Internal
import Configuration.Utils.Internal.JsonTools
import qualified Configuration.Utils.Internal.ConfigFileReader as CF
import Configuration.Utils.Maybe
import Configuration.Utils.Monoid
import Configuration.Utils.Operators
import Configuration.Utils.Validation

import Control.Monad (void, when)
import Control.Monad.Except (MonadError, throwError)
import Control.Monad.Writer (execWriterT, runWriterT)
import Control.Monad.IO.Class (MonadIO)

import qualified Data.ByteString.Char8 as B8
import qualified Data.CaseInsensitive as CI
import Data.Foldable
import Data.Maybe
import Data.Monoid.Unicode
import Data.String
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Yaml as Yaml

import qualified Options.Applicative.Types as O

import qualified Options.Applicative as O

import Prelude hiding (any, concatMap, mapM_)
import Prelude.Unicode hiding ((×))

import System.IO

import qualified Prettyprinter as P

#ifdef REMOTE_CONFIGS
import Control.Monad.Trans.Control
#endif

-- -------------------------------------------------------------------------- --
-- Main Configuration

-- | A newtype wrapper around a validation function. The only purpose of
-- this type is to avoid @ImpredicativeTypes@ when storing the function
-- in the 'ProgramInfoValidate' record.
--
newtype ConfigValidationFunction a f = ConfigValidationFunction
    { forall a (f :: * -> *).
ConfigValidationFunction a f -> ConfigValidation a f
runConfigValidation ∷ ConfigValidation a f
    }

type ProgramInfo a = ProgramInfoValidate a []

data ProgramInfoValidate a f = ProgramInfo
    { forall a (f :: * -> *). ProgramInfoValidate a f -> String
_piDescription ∷ !String
      -- ^ Program Description
    , forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piHelpHeader ∷ !(Maybe String)
      -- ^ Help header
    , forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piHelpFooter ∷ !(Maybe String)
      -- ^ Help footer
    , forall a (f :: * -> *). ProgramInfoValidate a f -> MParser a
_piOptionParser ∷ !(MParser a)
      -- ^ options parser for configuration
    , forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ∷ !a
      -- ^ default configuration
    , forall a (f :: * -> *).
ProgramInfoValidate a f -> ConfigValidationFunction a f
_piValidateConfiguration ∷ !(ConfigValidationFunction a f)
      -- ^ a validation function. The 'Right' result is interpreted as a 'Foldable'
      -- structure of warnings.
    , forall a (f :: * -> *). ProgramInfoValidate a f -> [ConfigFile]
_piConfigurationFiles ∷ ![ConfigFile]
      -- ^ a list of configuration files that are loaded in order
      -- before any command line argument is evaluated.
    }

-- | Program Description
--
piDescription ∷ Lens' (ProgramInfoValidate a f) String
piDescription :: forall a (f :: * -> *). Lens' (ProgramInfoValidate a f) String
piDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a (f :: * -> *). ProgramInfoValidate a f -> String
_piDescription forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate a f
s String
a → ProgramInfoValidate a f
s { _piDescription :: String
_piDescription = String
a }
{-# INLINE piDescription #-}

-- | Help header
--
piHelpHeader ∷ Lens' (ProgramInfoValidate a f) (Maybe String)
piHelpHeader :: forall a (f :: * -> *).
Lens' (ProgramInfoValidate a f) (Maybe String)
piHelpHeader = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piHelpHeader forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate a f
s Maybe String
a → ProgramInfoValidate a f
s { _piHelpHeader :: Maybe String
_piHelpHeader = Maybe String
a }
{-# INLINE piHelpHeader #-}

-- | Help footer
--
piHelpFooter ∷ Lens' (ProgramInfoValidate a f) (Maybe String)
piHelpFooter :: forall a (f :: * -> *).
Lens' (ProgramInfoValidate a f) (Maybe String)
piHelpFooter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piHelpFooter forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate a f
s Maybe String
a → ProgramInfoValidate a f
s { _piHelpFooter :: Maybe String
_piHelpFooter = Maybe String
a }
{-# INLINE piHelpFooter #-}

-- | Options parser for configuration
--
piOptionParser ∷ Lens' (ProgramInfoValidate a f) (MParser a)
piOptionParser :: forall a (f :: * -> *). Lens' (ProgramInfoValidate a f) (MParser a)
piOptionParser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a (f :: * -> *). ProgramInfoValidate a f -> MParser a
_piOptionParser forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate a f
s MParser a
a → ProgramInfoValidate a f
s { _piOptionParser :: MParser a
_piOptionParser = MParser a
a }
{-# INLINE piOptionParser #-}

-- | Default configuration
--
piDefaultConfiguration ∷ Lens' (ProgramInfoValidate a f) a
piDefaultConfiguration :: forall a (f :: * -> *). Lens' (ProgramInfoValidate a f) a
piDefaultConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate a f
s a
a → ProgramInfoValidate a f
s { _piDefaultConfiguration :: a
_piDefaultConfiguration = a
a }
{-# INLINE piDefaultConfiguration #-}

-- | Validation Function
--
-- The 'Right' result is interpreted as a 'Foldable' structure of warnings.
--
piValidateConfiguration ∷ Lens' (ProgramInfoValidate a f) (ConfigValidationFunction a f)
piValidateConfiguration :: forall a (f :: * -> *).
Lens' (ProgramInfoValidate a f) (ConfigValidationFunction a f)
piValidateConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a (f :: * -> *).
ProgramInfoValidate a f -> ConfigValidationFunction a f
_piValidateConfiguration forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate a f
s ConfigValidationFunction a f
a → ProgramInfoValidate a f
s { _piValidateConfiguration :: ConfigValidationFunction a f
_piValidateConfiguration = ConfigValidationFunction a f
a }
{-# INLINE piValidateConfiguration #-}

-- | Configuration files that are loaded in order before any command line
-- argument is evaluated.
--
piConfigurationFiles ∷ Lens' (ProgramInfoValidate a f) [ConfigFile]
piConfigurationFiles :: forall a (f :: * -> *).
Lens' (ProgramInfoValidate a f) [ConfigFile]
piConfigurationFiles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a (f :: * -> *). ProgramInfoValidate a f -> [ConfigFile]
_piConfigurationFiles forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate a f
s [ConfigFile]
a → ProgramInfoValidate a f
s { _piConfigurationFiles :: [ConfigFile]
_piConfigurationFiles = [ConfigFile]
a }
{-# INLINE piConfigurationFiles #-}

-- | 'Lens' for simultaneous query and update of 'piOptionParser' and
-- 'piDefaultConfiguration'. This supports to change the type of 'ProgramInfo'
-- with 'over' and 'set'.
--
piOptionParserAndDefaultConfiguration
    ∷ Lens
        (ProgramInfoValidate a b)
        (ProgramInfoValidate c d)
        (MParser a, a, ConfigValidationFunction a b)
        (MParser c, c, ConfigValidationFunction c d)
piOptionParserAndDefaultConfiguration :: forall a (b :: * -> *) c (d :: * -> *).
Lens
  (ProgramInfoValidate a b)
  (ProgramInfoValidate c d)
  (MParser a, a, ConfigValidationFunction a b)
  (MParser c, c, ConfigValidationFunction c d)
piOptionParserAndDefaultConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall {a} {f :: * -> *}.
ProgramInfoValidate a f
-> (MParser a, a, ConfigValidationFunction a f)
g forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate a b
s (MParser c
a,c
b,ConfigValidationFunction c d
c) → ProgramInfo
    { _piDescription :: String
_piDescription = forall a (f :: * -> *). ProgramInfoValidate a f -> String
_piDescription ProgramInfoValidate a b
s
    , _piHelpHeader :: Maybe String
_piHelpHeader = forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piHelpHeader ProgramInfoValidate a b
s
    , _piHelpFooter :: Maybe String
_piHelpFooter = forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piHelpFooter ProgramInfoValidate a b
s
    , _piOptionParser :: MParser c
_piOptionParser = MParser c
a
    , _piDefaultConfiguration :: c
_piDefaultConfiguration = c
b
    , _piValidateConfiguration :: ConfigValidationFunction c d
_piValidateConfiguration = ConfigValidationFunction c d
c
    , _piConfigurationFiles :: [ConfigFile]
_piConfigurationFiles = forall a (f :: * -> *). ProgramInfoValidate a f -> [ConfigFile]
_piConfigurationFiles ProgramInfoValidate a b
s
    }
  where
    g :: ProgramInfoValidate a f
-> (MParser a, a, ConfigValidationFunction a f)
g ProgramInfoValidate a f
s = (forall a (f :: * -> *). ProgramInfoValidate a f -> MParser a
_piOptionParser ProgramInfoValidate a f
s, forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ProgramInfoValidate a f
s, forall a (f :: * -> *).
ProgramInfoValidate a f -> ConfigValidationFunction a f
_piValidateConfiguration ProgramInfoValidate a f
s)
{-# INLINE piOptionParserAndDefaultConfiguration #-}

-- | Smart constructor for 'ProgramInfo'.
--
-- 'piHelpHeader' and 'piHelpFooter' are set to 'Nothing'.
-- The function 'piValidateConfiguration' is set to @const (return [])@
--
programInfo
    ∷ String
        -- ^ program description
    → MParser a
        -- ^ parser for updating the default configuration
    → a
        -- ^ default configuration
    → ProgramInfo a
programInfo :: forall a. String -> MParser a -> a -> ProgramInfo a
programInfo String
desc MParser a
parser a
defaultConfig =
    forall a (f :: * -> *).
String
-> MParser a
-> a
-> ConfigValidation a f
-> ProgramInfoValidate a f
programInfoValidate String
desc MParser a
parser a
defaultConfig forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Smart constructor for 'ProgramInfo'.
--
-- 'piHelpHeader' and 'piHelpFooter' are set to 'Nothing'.
--
programInfoValidate
    ∷ String
    → MParser a
    → a
    → ConfigValidation a f
    → ProgramInfoValidate a f
programInfoValidate :: forall a (f :: * -> *).
String
-> MParser a
-> a
-> ConfigValidation a f
-> ProgramInfoValidate a f
programInfoValidate String
desc MParser a
parser a
defaultConfig ConfigValidation a f
valFunc = ProgramInfo
    { _piDescription :: String
_piDescription = String
desc
    , _piHelpHeader :: Maybe String
_piHelpHeader = forall a. Maybe a
Nothing
    , _piHelpFooter :: Maybe String
_piHelpFooter = forall a. Maybe a
Nothing
    , _piOptionParser :: MParser a
_piOptionParser = MParser a
parser
    , _piDefaultConfiguration :: a
_piDefaultConfiguration = a
defaultConfig
    , _piValidateConfiguration :: ConfigValidationFunction a f
_piValidateConfiguration = forall a (f :: * -> *).
ConfigValidation a f -> ConfigValidationFunction a f
ConfigValidationFunction ConfigValidation a f
valFunc
    , _piConfigurationFiles :: [ConfigFile]
_piConfigurationFiles = []
    }

-- -------------------------------------------------------------------------- --
-- AppConfiguration

data PrintConfigMode = Full | Minimal | Diff

printConfigModeToText ∷ PrintConfigMode → T.Text
printConfigModeToText :: PrintConfigMode -> Text
printConfigModeToText PrintConfigMode
Full = Text
"full"
printConfigModeToText PrintConfigMode
Minimal = Text
"minimal"
printConfigModeToText PrintConfigMode
Diff = Text
"diff"

printConfigModeFromText ∷ T.Text → Either String PrintConfigMode
printConfigModeFromText :: Text -> Either String PrintConfigMode
printConfigModeFromText Text
t = case forall s. FoldCase s => s -> CI s
CI.mk Text
t of
    CI Text
"full" → forall a b. b -> Either a b
Right PrintConfigMode
Full
    CI Text
"minimal" → forall a b. b -> Either a b
Right PrintConfigMode
Minimal
    CI Text
"diff" → forall a b. b -> Either a b
Right PrintConfigMode
Diff
    CI Text
x → forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"unknow print configuration mode: " forall a. Semigroup a => a -> a -> a
<> forall a s. (Show a, IsString s) => a -> s
sshow CI Text
x

instance ToJSON PrintConfigMode where
    toJSON :: PrintConfigMode -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ PrintConfigMode -> Text
printConfigModeToText
    {-# INLINE toJSON #-}

instance FromJSON PrintConfigMode where
    parseJSON :: Value -> Parser PrintConfigMode
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PrintConfigMode"
        forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> Either String PrintConfigMode
printConfigModeFromText
    {-# INLINE parseJSON #-}

-- | An /internal/ data type that is used during configuration parsing to
-- represent the overall application configuration which includes
--
-- 1. the /user/ configuration, which is actual configuration value that
--    is given to the application and
--
-- 2. the /meta/ configuration, which are all settings that determine how the
--    actual /user/ configuration is loaded and parsed.
--
-- NOTE that /meta/ configuration settings can only be provided via command
-- line options but not through configuration files.
--
data AppConfiguration a = AppConfiguration
    { forall a. AppConfiguration a -> Maybe PrintConfigMode
_printConfig ∷ !(Maybe PrintConfigMode)
    , forall a. AppConfiguration a -> ConfigFilesConfig
_configFilesConfig ∷ !ConfigFilesConfig
    , forall a. AppConfiguration a -> [ConfigFile]
_configFiles ∷ ![ConfigFile]
    , forall a. AppConfiguration a -> a
_mainConfig ∷ !a
    }

-- | A list of configuration file locations. Configuration file locations are
-- set either statically in the code or are provided dynamically on the command
-- line via @--config-file@ options.
--
configFiles ∷ Lens' (AppConfiguration a) [ConfigFile]
configFiles :: forall a. Lens' (AppConfiguration a) [ConfigFile]
configFiles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a. AppConfiguration a -> [ConfigFile]
_configFiles forall a b. (a -> b) -> a -> b
$ \AppConfiguration a
s [ConfigFile]
a → AppConfiguration a
s { _configFiles :: [ConfigFile]
_configFiles = [ConfigFile]
a }

-- | The /user/ configuration. During parsing this is represented as an update
-- function that yields a configuration value when applied to a default
-- value.
--
mainConfig ∷ Lens (AppConfiguration a) (AppConfiguration b) a b
mainConfig :: forall a b. Lens (AppConfiguration a) (AppConfiguration b) a b
mainConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a. AppConfiguration a -> a
_mainConfig forall a b. (a -> b) -> a -> b
$ \AppConfiguration a
s b
a → AppConfiguration a
s { _mainConfig :: b
_mainConfig = b
a }

-- | This function parsers /all/ command line options:
--
-- 1. 'ConfigFilesConfig' options that determine how configuration
--    files are loaded.
--
-- 2. 'ConfigFiles' options are all @--config-file@ options.
--
-- 3. Other /meta/ options, such as @--print-config@ and @--printconfig-as@.
--
-- 4. Options for the actual user /configuration/. The user configuration
--    is represented as an update function that yields a configuration
--    value when applied to an default value.
--
pAppConfiguration
    ∷ O.Parser (a → a)
    → O.Parser (AppConfiguration (a → a))
pAppConfiguration :: forall a. Parser (a -> a) -> Parser (AppConfiguration (a -> a))
pAppConfiguration Parser (a -> a)
mainParser = forall a.
Maybe PrintConfigMode
-> ConfigFilesConfig -> [ConfigFile] -> a -> AppConfiguration a
AppConfiguration
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe PrintConfigMode)
pPrintConfig
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MParser ConfigFilesConfig
pConfigFilesConfig forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigFilesConfig
defaultConfigFilesConfig)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ConfigFile
pConfigFile
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (a -> a)
mainParser
  where
    pConfigFile :: Parser ConfigFile
pConfigFile = Text -> ConfigFile
ConfigFileRequired forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"config-file"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"FILE"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
O.help String
"Configuration file in YAML or JSON format. If more than a single config file option is present files are loaded in the order in which they appear on the command line."

    pPrintConfig :: Parser (Maybe PrintConfigMode)
pPrintConfig
        = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PrintConfigMode
pPrintConfigOption
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PrintConfigMode
pPrintConfigFlag
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

    pPrintConfigFlag :: Parser PrintConfigMode
pPrintConfigFlag = forall a. a -> Mod FlagFields a -> Parser a
O.flag' PrintConfigMode
Full
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"print-config"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print the parsed configuration to standard out and exit. This is an alias for --print-config-as=full"

    pPrintConfigOption :: Parser PrintConfigMode
pPrintConfigOption = forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option (forall a. (String -> Either String a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ Text -> Either String PrintConfigMode
printConfigModeFromText forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
. String -> Text
T.pack)
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"print-config-as"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print the parsed configuration to standard out and exit"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasCompleter f => [String] -> Mod f a
O.completeWith [String
"full", String
"minimal", String
"diff", String
"Full", String
"Minimal", String
"Diff"]
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"full|minimal|diff"

-- -------------------------------------------------------------------------- --
-- Main Configuration without Package Info

-- | Run an IO action with a configuration that is obtained by updating the
-- given default configuration the values defined via command line arguments.
--
-- In addition to the options defined by the given options parser the following
-- options are recognized:
--
-- [@--config-file@]
--     Parse the given file path as a (partial) configuration in YAML or JSON
--     format.
--
-- [@--print-config@]
--     Print the final parsed configuration to standard out and exit.
--
-- [@--print-config-as (full|minimal|diff)@]
--     Configures the application and prints the configuration in YAML format to
--     standard out and exits. The printed configuration is exactly the
--     configuration that otherwise would be used to run the application.
--
--     Arguments:
--
--     *   @full@: print the complete configuration. Same as @--print-config@.
--     *   @minimal@: print a minimal configuration that contains only those
--         settings that are different from the default setting.
--     *   @diff@: print a YAML document that shows the difference between the
--         default configuration and the actual configuration.
--
-- [@--help, -h, -?@]
--     Print a help message and exit.
--
-- If the package is build with @-f+remote-configs@ the following two options
-- are available. They affect how configuration files are loaded from remote
-- URLs.
--
-- [@--config-https-insecure=true|false@]
--     Bypass certificate validation for all HTTPS
--     connections to all services.
--
-- [@--config-https-allow-cert=HOSTNAME:PORT:FINGERPRINT@]
--     Unconditionally trust the certificate for connecting
--     to the service.
--
runWithConfiguration
    ∷ (FromJSON (a → a), ToJSON a, Foldable f, Monoid (f T.Text))
    ⇒ ProgramInfoValidate a f
        -- ^ program info value; use 'programInfo' to construct a value of this
        -- type
    → (a → IO ())
        -- ^ computation that is given the configuration that is parsed from
        -- the command line.
    → IO ()
runWithConfiguration :: forall a (f :: * -> *).
(FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) =>
ProgramInfoValidate a f -> (a -> IO ()) -> IO ()
runWithConfiguration ProgramInfoValidate a f
appInfo = forall a (f :: * -> *).
(FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) =>
ProgramInfoValidate a f
-> (forall b. Maybe (MParser b)) -> (a -> IO ()) -> IO ()
runInternal ProgramInfoValidate a f
appInfo forall a. Maybe a
Nothing

-- -------------------------------------------------------------------------- --
-- Main Configuration with Package Info

pPkgInfo ∷ PkgInfo → MParser a
pPkgInfo :: forall a. PkgInfo -> MParser a
pPkgInfo (String
sinfo, String
detailedInfo, String
version, String
license) =
    forall {a}. Parser (a -> a)
infoO forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. Parser (a -> a)
detailedInfoO forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. Parser (a -> a)
versionO forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. Parser (a -> a)
licenseO
  where
    infoO :: Parser (a -> a)
infoO = forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption String
sinfo
        forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"info"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print program info message and exit"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value forall a. a -> a
id
    detailedInfoO :: Parser (a -> a)
detailedInfoO = forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption String
detailedInfo
        forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"long-info"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print detailed program info message and exit"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value forall a. a -> a
id
    versionO :: Parser (a -> a)
versionO = forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption String
version
        forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"version"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'v'
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print version string and exit"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value forall a. a -> a
id
    licenseO :: Parser (a -> a)
licenseO = forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption String
license
        forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"license"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print license of the program and exit"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value forall a. a -> a
id

-- | Information about the cabal package. The format is:
--
-- @(info message, detailed info message, version string, license text)@
--
-- See the documentation of "Configuration.Utils.Setup" for a way how to
-- generate this information automatically from the package description during
-- the build process.
--
type PkgInfo =
    ( String
      -- info message
    , String
      -- detailed info message
    , String
      -- version string
    , String
      -- license text
    )

-- | Run an IO action with a configuration that is obtained by updating the
-- given default configuration the values defined via command line arguments.
--
-- In addition to the options defined by the given options parser the following
-- options are recognized:
--
-- [@--config-file, -c@]
--     Parse the given file path as a (partial) configuration in YAML or JSON
--     format.
--
-- [@--print-config, -p@]
--     Print the final parsed configuration to standard out and exit.
--
-- [@--print-config-as (full|minimal|diff)@]
--     Configures the application and prints the configuration in YAML format to
--     standard out and exits. The printed configuration is exactly the
--     configuration that otherwise would be used to run the application.
--
--     Arguments:
--
--     *   @full@: print the complete configuration. Same as @--print-config@.
--     *   @minimal@: print a minimal configuration that contains only those
--         settings that are different from the default setting.
--     *   @diff@: print a YAML document that shows the difference between the
--         default configuration and the actual configuration.
--
-- [@--help, -h, -?@]
--     Print a help message and exit.
--
-- [@--version, -v@]
--     Print the version of the application and exit.
--
-- [@--info, -i@]
--     Print a short info message for the application and exit.
--
-- [@--long-info@]
--     Print a detailed info message for the application and exit.
--
-- [@--license@]
--     Print the text of the license of the application and exit.
--
-- If the package is build with @-f+remote-configs@ the following two options
-- are available. They affect how configuration files are loaded from remote
-- URLs.
--
-- [@--config-https-insecure=true|false@]
--     Bypass certificate validation for all HTTPS
--     connections to all services.
--
-- [@--config-https-allow-cert=HOSTNAME:PORT:FINGERPRINT@]
--     Unconditionally trust the certificate for connecting
--     to the service.
--
runWithPkgInfoConfiguration
    ∷ (FromJSON (a → a), ToJSON a, Foldable f, Monoid (f T.Text))
    ⇒ ProgramInfoValidate a f
        -- ^ program info value; use 'programInfo' to construct a value of this
        -- type
    → PkgInfo
        -- 'PkgInfo' value that contains information about the package.
        --
        -- See the documentation of "Configuration.Utils.Setup" for a way
        -- how to generate this information automatically from the package
        -- description during the build process.
    → (a → IO ())
        -- ^ computation that is given the configuration that is parsed from
        -- the command line.
    → IO ()
runWithPkgInfoConfiguration :: forall a (f :: * -> *).
(FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) =>
ProgramInfoValidate a f -> PkgInfo -> (a -> IO ()) -> IO ()
runWithPkgInfoConfiguration ProgramInfoValidate a f
appInfo PkgInfo
pkgInfo =
    forall a (f :: * -> *).
(FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) =>
ProgramInfoValidate a f
-> (forall b. Maybe (MParser b)) -> (a -> IO ()) -> IO ()
runInternal ProgramInfoValidate a f
appInfo (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PkgInfo -> MParser a
pPkgInfo PkgInfo
pkgInfo)

-- -------------------------------------------------------------------------- --
-- Internal main function

mainOptions
    ∷ ∀ a f . FromJSON (a → a)
    ⇒ ProgramInfoValidate a f
        -- ^ Program Info value which may include a validation function

    → (∀ b . Maybe (MParser b))
        -- ^ Maybe a package info parser. This parser is run only for its
        -- side effects. It is supposed to /intercept/ the parsing process
        -- and execute any implied action (showing help messages).

    → O.ParserInfo (AppConfiguration (a → a))
mainOptions :: forall a (f :: * -> *).
FromJSON (a -> a) =>
ProgramInfoValidate a f
-> (forall b. Maybe (MParser b))
-> ParserInfo (AppConfiguration (a -> a))
mainOptions ProgramInfo{a
String
[ConfigFile]
Maybe String
MParser a
ConfigValidationFunction a f
_piConfigurationFiles :: [ConfigFile]
_piValidateConfiguration :: ConfigValidationFunction a f
_piDefaultConfiguration :: a
_piOptionParser :: MParser a
_piHelpFooter :: Maybe String
_piHelpHeader :: Maybe String
_piDescription :: String
_piConfigurationFiles :: forall a (f :: * -> *). ProgramInfoValidate a f -> [ConfigFile]
_piValidateConfiguration :: forall a (f :: * -> *).
ProgramInfoValidate a f -> ConfigValidationFunction a f
_piDefaultConfiguration :: forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piOptionParser :: forall a (f :: * -> *). ProgramInfoValidate a f -> MParser a
_piHelpFooter :: forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piHelpHeader :: forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piDescription :: forall a (f :: * -> *). ProgramInfoValidate a f -> String
..} forall b. Maybe (MParser b)
pkgInfoParser = forall a. Parser a -> InfoMod a -> ParserInfo a
O.info Parser (AppConfiguration (a -> a))
optionParser
    forall a b. (a -> b) -> a -> b
$ forall a. String -> InfoMod a
O.progDesc String
_piDescription
    forall α. Monoid α => α -> α -> α
⊕ forall a. InfoMod a
O.fullDesc
    forall α. Monoid α => α -> α -> α
⊕ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. String -> InfoMod a
O.header Maybe String
_piHelpHeader
    forall α. Monoid α => α -> α -> α
⊕ forall a. Maybe Doc -> InfoMod a
O.footerDoc (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {ann}. Doc ann
defaultFooter forall α. Monoid α => α -> α -> α
⊕ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a ann. Pretty a => a -> Doc ann
P.pretty Maybe String
_piHelpFooter)
  where
    optionParser :: Parser (AppConfiguration (a -> a))
optionParser =
        -- these are identity parsers that are only applied for their side effects
        forall a. a -> Maybe a -> a
fromMaybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id) forall b. Maybe (MParser b)
pkgInfoParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. Parser (a -> a)
nonHiddenHelper
        -- this parser produces the results
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser (a -> a) -> Parser (AppConfiguration (a -> a))
pAppConfiguration MParser a
_piOptionParser

    -- the 'O.helper' option from optparse-applicative is hidden by default
    -- which seems a bit weired. This option doesn't hide the access to help.
    nonHiddenHelper :: Parser (a -> a)
nonHiddenHelper = forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption (Maybe String -> ParseError
ShowHelpText forall a. Maybe a
Nothing)
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"help"
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'h'
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'?'
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
help String
"Show this help message"

    defaultFooter :: Doc ann
defaultFooter = forall ann. [Doc ann] -> Doc ann
P.vsep
        [ forall {ann}. String -> Doc ann
par String
"Configurations are loaded in order from the following sources:"
        , forall ann. Int -> Doc ann -> Doc ann
P.indent Int
2 forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall ann. [Doc ann] -> Doc ann
P.vsep forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. (a -> b) -> a -> b
($) (forall a. [Maybe a] -> [a]
catMaybes [forall {ann}. Maybe (Int -> Doc ann)
staticFiles, forall {ann}. Maybe (Int -> Doc ann)
cmdFiles, forall {ann}. Maybe (Int -> Doc ann)
cmdOptions]) [Int
1..]
        , Doc ann
""
        , forall ann. [Doc ann] -> Doc ann
P.fillSep
            [ forall {ann}. String -> Doc ann
par String
"Configuration file locations can be either local file system paths"
            , forall {ann}. String -> Doc ann
par String
"or remote HTTP or HTTPS URLs. Remote URLs must start with"
            , forall {ann}. String -> Doc ann
par String
"either \"http://\" or \"https://\"."
            ]
        , Doc ann
""
        , forall ann. [Doc ann] -> Doc ann
P.fillSep
            [ forall {ann}. String -> Doc ann
par String
"Configuration settings that are loaded later overwrite settings"
            , forall {ann}. String -> Doc ann
par String
"that were loaded before."
            ]
        , Doc ann
""
        ]

    Doc ann
a </> :: Doc ann -> Doc ann -> Doc ann
</> Doc ann
b = Doc ann
a forall a. Semigroup a => a -> a -> a
<> forall {ann}. Doc ann
P.softline forall a. Semigroup a => a -> a -> a
<> Doc ann
b

    staticFiles :: Maybe (Int -> Doc ann)
staticFiles
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConfigFile]
_piConfigurationFiles = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \Int
n → forall ann. Int -> Doc ann -> Doc ann
P.hang Int
3 forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
P.vsep
            [ forall a ann. Pretty a => a -> Doc ann
P.pretty @Int Int
n forall α. Monoid α => α -> α -> α
⊕ Doc ann
"." forall {ann}. Doc ann -> Doc ann -> Doc ann
</> forall {ann}. String -> Doc ann
par String
"Configuration files at the following locations:"
            , forall ann. [Doc ann] -> Doc ann
P.vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ConfigFile
f → Doc ann
"* " forall α. Monoid α => α -> α -> α
⊕ forall {ann}. ConfigFile -> Doc ann
printConfigFile ConfigFile
f) [ConfigFile]
_piConfigurationFiles
            ]
    cmdFiles :: Maybe (Int -> Doc ann)
cmdFiles = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \Int
n → forall ann. Int -> Doc ann -> Doc ann
P.hang Int
3 forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
P.fillSep
        [ forall a ann. Pretty a => a -> Doc ann
P.pretty Int
n forall α. Monoid α => α -> α -> α
⊕ Doc ann
"." forall {ann}. Doc ann -> Doc ann -> Doc ann
</> forall {ann}. String -> Doc ann
par String
"Configuration files from locations provided through"
        , forall {ann}. String -> Doc ann
par String
"--config-file options in the order as they appear."
        ]
    cmdOptions :: Maybe (Int -> Doc ann)
cmdOptions = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \Int
n → forall ann. Int -> Doc ann -> Doc ann
P.hang Int
3
        forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
P.pretty Int
n forall α. Monoid α => α -> α -> α
⊕ Doc ann
"." forall {ann}. Doc ann -> Doc ann -> Doc ann
</> forall {ann}. String -> Doc ann
par String
"Command line options."

    printConfigFile :: ConfigFile -> Doc ann
printConfigFile ConfigFile
f = forall a ann. Pretty a => a -> Doc ann
P.pretty (ConfigFile -> Text
getConfigFile ConfigFile
f) forall {ann}. Doc ann -> Doc ann -> Doc ann
P.<+> case ConfigFile
f of
        ConfigFileRequired Text
_ → Doc ann
"(required)"
        ConfigFileOptional Text
_ → Doc ann
"(optional)"

    par :: String -> Doc ann
par = forall ann. [Doc ann] -> Doc ann
P.fillSep forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
P.pretty forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ String -> [String]
words

-- | Internal main function
--
runInternal
    ∷ (FromJSON (a → a), ToJSON a, Foldable f, Monoid (f T.Text))
    ⇒ ProgramInfoValidate a f
        -- ^ program info value; use 'programInfo' to construct a value of this
        -- type
    → (∀ b . Maybe (MParser b))
        -- 'PkgInfo' value that contains information about the package.
        --
        -- See the documentation of "Configuration.Utils.Setup" for a way
        -- how to generate this information automatically from the package
        -- description during the build process.
    → (a → IO ())
        -- ^ computation that is given the configuration that is parsed from
        -- the command line.
    → IO ()
runInternal :: forall a (f :: * -> *).
(FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) =>
ProgramInfoValidate a f
-> (forall b. Maybe (MParser b)) -> (a -> IO ()) -> IO ()
runInternal ProgramInfoValidate a f
appInfo forall b. Maybe (MParser b)
maybePkgInfo a -> IO ()
mainFunction = do

    -- Parse command line arguments and add static config files to resulting app config
    AppConfiguration (a -> a)
cliAppConf ← forall a. Lens' (AppConfiguration a) [ConfigFile]
configFiles forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
`over` forall α. Monoid α => α -> α -> α
(⊕) (forall a (f :: * -> *). ProgramInfoValidate a f -> [ConfigFile]
_piConfigurationFiles ProgramInfoValidate a f
appInfo) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        forall a. ParserPrefs -> ParserInfo a -> IO a
O.customExecParser ParserPrefs
parserPrefs (forall a (f :: * -> *).
FromJSON (a -> a) =>
ProgramInfoValidate a f
-> (forall b. Maybe (MParser b))
-> ParserInfo (AppConfiguration (a -> a))
mainOptions ProgramInfoValidate a f
appInfo forall b. Maybe (MParser b)
maybePkgInfo)

    -- Load and parse all configuration files
    AppConfiguration a
appConf ← AppConfiguration (a -> a)
cliAppConf forall a b. a -> (a -> b) -> b
& forall a b. Lens (AppConfiguration a) (AppConfiguration b) a b
mainConfig forall a. a -> a
`id` \a -> a
a → a -> a
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => ExceptT Text m a -> m a
errorT forall a b. (a -> b) -> a -> b
% forall (m :: * -> *) a.
(ConfigFileParser m, FromJSON (a -> a)) =>
ConfigFilesConfig -> a -> [ConfigFile] -> m a
CF.parseConfigFiles
        (forall a. AppConfiguration a -> ConfigFilesConfig
_configFilesConfig AppConfiguration (a -> a)
cliAppConf)
        (forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ProgramInfoValidate a f
appInfo)
        (forall a. AppConfiguration a -> [ConfigFile]
_configFiles AppConfiguration (a -> a)
cliAppConf)

    -- Validate final configuration
    forall (f :: * -> *) a.
(Foldable f, Monoid (f Text)) =>
ProgramInfoValidate a f -> a -> IO ()
validateConfig ProgramInfoValidate a f
appInfo forall a b. (a -> b) -> a -> b
$ forall a. AppConfiguration a -> a
_mainConfig AppConfiguration a
appConf

    case forall a. AppConfiguration a -> Maybe PrintConfigMode
_printConfig AppConfiguration a
appConf of
        Maybe PrintConfigMode
Nothing → a -> IO ()
mainFunction forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a. AppConfiguration a -> a
_mainConfig forall a b. (a -> b) -> a -> b
$ AppConfiguration a
appConf
        Just PrintConfigMode
Full → ByteString -> IO ()
B8.putStrLn forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a. ToJSON a => a -> ByteString
Yaml.encode forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a. AppConfiguration a -> a
_mainConfig forall a b. (a -> b) -> a -> b
$ AppConfiguration a
appConf
        Just PrintConfigMode
Minimal → ByteString -> IO ()
B8.putStrLn
            forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a. ToJSON a => a -> ByteString
Yaml.encode
            forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (Diff Value -> Value) -> Value -> Value
resolve Diff Value -> Value
resolveOnlyRight
            forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Value -> Value -> Value
diff (forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ProgramInfoValidate a f
appInfo)
            forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a. ToJSON a => a -> Value
toJSON
            forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a. AppConfiguration a -> a
_mainConfig
            forall a b. (a -> b) -> a -> b
$ AppConfiguration a
appConf
        Just PrintConfigMode
Diff → ByteString -> IO ()
B8.putStrLn
            forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a. ToJSON a => a -> ByteString
Yaml.encode
            forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Value -> Value -> Value
diff (forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ProgramInfoValidate a f
appInfo)
            forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a. ToJSON a => a -> Value
toJSON
            forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a. AppConfiguration a -> a
_mainConfig
            forall a b. (a -> b) -> a -> b
$ AppConfiguration a
appConf
  where
    parserPrefs :: ParserPrefs
parserPrefs = PrefsMod -> ParserPrefs
O.prefs forall a. Monoid a => a
mempty


-- | Parse the command line arguments.
--
-- Any warnings from the configuration function are discarded.
-- The options @--print-config@ and @--help@ are just ignored.
--
parseConfiguration
    ∷
        ( Applicative m
        , MonadIO m
#ifdef REMOTE_CONFIGS
        , MonadBaseControl IO m
#endif
        , MonadError T.Text m
        , FromJSON (a → a)
        , ToJSON a
        , Foldable f
        , Monoid (f T.Text)
        )
    ⇒ T.Text
        -- ^ program name (used in error messages)
    → ProgramInfoValidate a f
        -- ^ program info value; use 'programInfo' to construct a value of this
        -- type
    → [String]
        -- ^ command line arguments
    → m a
parseConfiguration :: forall (m :: * -> *) a (f :: * -> *).
(Applicative m, MonadIO m, MonadError Text m, FromJSON (a -> a),
 ToJSON a, Foldable f, Monoid (f Text)) =>
Text -> ProgramInfoValidate a f -> [String] -> m a
parseConfiguration Text
appName ProgramInfoValidate a f
appInfo [String]
args = do

    -- Parse command line arguments (add static config files to resulting app config)
    AppConfiguration (a -> a)
cliAppConf ← case forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
O.execParserPure ParserPrefs
parserPrefs (forall a (f :: * -> *).
FromJSON (a -> a) =>
ProgramInfoValidate a f
-> (forall b. Maybe (MParser b))
-> ParserInfo (AppConfiguration (a -> a))
mainOptions ProgramInfoValidate a f
appInfo forall a. Maybe a
Nothing) [String]
args of
        O.Success AppConfiguration (a -> a)
a → forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AppConfiguration (a -> a)
a forall a b. a -> (a -> b) -> b
& forall a. Lens' (AppConfiguration a) [ConfigFile]
configFiles forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
`over` forall α. Monoid α => α -> α -> α
(⊕) (forall a (f :: * -> *). ProgramInfoValidate a f -> [ConfigFile]
_piConfigurationFiles ProgramInfoValidate a f
appInfo)
        O.Failure ParserFailure ParserHelp
e → forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ String -> Text
T.pack forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ ParserFailure ParserHelp -> String -> (String, ExitCode)
renderFailure ParserFailure ParserHelp
e (Text -> String
T.unpack Text
appName)
        O.CompletionInvoked CompletionResult
_ → forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"command line parser returned completion result"

    -- Load and parse all configuration files
    AppConfiguration a
appConf ← AppConfiguration (a -> a)
cliAppConf forall a b. a -> (a -> b) -> b
& forall a b. Lens (AppConfiguration a) (AppConfiguration b) a b
mainConfig forall a. a -> a
`id` \a -> a
a → a -> a
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(ConfigFileParser m, FromJSON (a -> a)) =>
ConfigFilesConfig -> a -> [ConfigFile] -> m a
CF.parseConfigFiles
        (forall a. AppConfiguration a -> ConfigFilesConfig
_configFilesConfig AppConfiguration (a -> a)
cliAppConf)
        (forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ProgramInfoValidate a f
appInfo)
        (forall a. AppConfiguration a -> [ConfigFile]
_configFiles AppConfiguration (a -> a)
cliAppConf)

    -- Validate final configuration
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall {f :: * -> *} {m :: * -> *} {a}.
(Monoid (f Text), MonadIO m, MonadError Text m) =>
ProgramInfoValidate a f -> a -> m ((), f Text)
validate ProgramInfoValidate a f
appInfo forall a b. (a -> b) -> a -> b
$ forall a. AppConfiguration a -> a
_mainConfig AppConfiguration a
appConf

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. AppConfiguration a -> a
_mainConfig AppConfiguration a
appConf
  where
    parserPrefs :: ParserPrefs
parserPrefs = PrefsMod -> ParserPrefs
O.prefs PrefsMod
O.disambiguate
    validate :: ProgramInfoValidate a f -> a -> m ((), f Text)
validate ProgramInfoValidate a f
i a
conf = forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall a b. (a -> b) -> a -> b
$
        forall a (f :: * -> *).
ConfigValidationFunction a f -> ConfigValidation a f
runConfigValidation (forall r (m :: * -> *) a.
MonadReader r m =>
((a -> Const a a) -> r -> Const a r) -> m a
view forall a (f :: * -> *).
Lens' (ProgramInfoValidate a f) (ConfigValidationFunction a f)
piValidateConfiguration ProgramInfoValidate a f
i) a
conf

-- -------------------------------------------------------------------------- --
-- Validation

-- | Validates a configuration value. Throws an user error
-- if there is an error. If there are warnings they are
-- printed to 'stderr'.
--
validateConfig
    ∷ (Foldable f, Monoid (f T.Text))
    ⇒ ProgramInfoValidate a f
    → a
    → IO ()
validateConfig :: forall (f :: * -> *) a.
(Foldable f, Monoid (f Text)) =>
ProgramInfoValidate a f -> a -> IO ()
validateConfig ProgramInfoValidate a f
appInfo a
conf = do
    f Text
warnings ← forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ forall (m :: * -> *) e b a.
Monad m =>
(e -> m b) -> (a -> m b) -> ExceptT e m a -> m b
exceptT (forall a. HasCallStack => String -> a
error forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> String
T.unpack) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        forall a (f :: * -> *).
ConfigValidationFunction a f -> ConfigValidation a f
runConfigValidation (forall r (m :: * -> *) a.
MonadReader r m =>
((a -> Const a a) -> r -> Const a r) -> m a
view forall a (f :: * -> *).
Lens' (ProgramInfoValidate a f) (ConfigValidationFunction a f)
piValidateConfiguration ProgramInfoValidate a f
appInfo) a
conf
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. a -> b -> a
const Bool
True) f Text
warnings) forall a b. (a -> b) -> a -> b
$ do
        Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
"WARNINGS:"
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Text
w → Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ Text
"warning: " forall α. Monoid α => α -> α -> α
⊕ Text
w) f Text
warnings