{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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.Except hiding (mapM_)
import Control.Monad.Writer hiding (mapM_)

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_)
#if MIN_VERSION_base(4,13,0)
import Prelude.Unicode hiding ((×))
#else
import Prelude.Unicode
#endif

import System.IO

import qualified Text.PrettyPrint.ANSI.Leijen 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
    { ConfigValidationFunction a f
-> forall (m :: * -> *).
   (MonadIO m, Functor m, Applicative m, MonadError Text m,
    MonadWriter (f Text) m) =>
   a -> m ()
runConfigValidation ∷ ConfigValidation a f
    }

type ProgramInfo a = ProgramInfoValidate a []

data ProgramInfoValidate a f = ProgramInfo
    { ProgramInfoValidate a f -> String
_piDescription ∷ !String
      -- ^ Program Description
    , ProgramInfoValidate a f -> Maybe String
_piHelpHeader ∷ !(Maybe String)
      -- ^ Help header
    , ProgramInfoValidate a f -> Maybe String
_piHelpFooter ∷ !(Maybe String)
      -- ^ Help footer
    , ProgramInfoValidate a f -> MParser a
_piOptionParser ∷ !(MParser a)
      -- ^ options parser for configuration
    , ProgramInfoValidate a f -> a
_piDefaultConfiguration ∷ !a
      -- ^ default configuration
    , ProgramInfoValidate a f -> ConfigValidationFunction a f
_piValidateConfiguration ∷ !(ConfigValidationFunction a f)
      -- ^ a validation function. The 'Right' result is interpreted as a 'Foldable'
      -- structure of warnings.
    , 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 :: (String -> f String)
-> ProgramInfoValidate a f -> f (ProgramInfoValidate a f)
piDescription = (ProgramInfoValidate a f -> String)
-> (ProgramInfoValidate a f -> String -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f) (ProgramInfoValidate a f) String String
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate a f -> String
forall a (f :: * -> *). ProgramInfoValidate a f -> String
_piDescription ((ProgramInfoValidate a f -> String -> ProgramInfoValidate a f)
 -> Lens
      (ProgramInfoValidate a f) (ProgramInfoValidate a f) String String)
-> (ProgramInfoValidate a f -> String -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f) (ProgramInfoValidate a f) String String
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 :: (Maybe String -> f (Maybe String))
-> ProgramInfoValidate a f -> f (ProgramInfoValidate a f)
piHelpHeader = (ProgramInfoValidate a f -> Maybe String)
-> (ProgramInfoValidate a f
    -> Maybe String -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f)
     (ProgramInfoValidate a f)
     (Maybe String)
     (Maybe String)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate a f -> Maybe String
forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piHelpHeader ((ProgramInfoValidate a f
  -> Maybe String -> ProgramInfoValidate a f)
 -> Lens
      (ProgramInfoValidate a f)
      (ProgramInfoValidate a f)
      (Maybe String)
      (Maybe String))
-> (ProgramInfoValidate a f
    -> Maybe String -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f)
     (ProgramInfoValidate a f)
     (Maybe String)
     (Maybe String)
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 :: (Maybe String -> f (Maybe String))
-> ProgramInfoValidate a f -> f (ProgramInfoValidate a f)
piHelpFooter = (ProgramInfoValidate a f -> Maybe String)
-> (ProgramInfoValidate a f
    -> Maybe String -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f)
     (ProgramInfoValidate a f)
     (Maybe String)
     (Maybe String)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate a f -> Maybe String
forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piHelpFooter ((ProgramInfoValidate a f
  -> Maybe String -> ProgramInfoValidate a f)
 -> Lens
      (ProgramInfoValidate a f)
      (ProgramInfoValidate a f)
      (Maybe String)
      (Maybe String))
-> (ProgramInfoValidate a f
    -> Maybe String -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f)
     (ProgramInfoValidate a f)
     (Maybe String)
     (Maybe String)
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 :: (MParser a -> f (MParser a))
-> ProgramInfoValidate a f -> f (ProgramInfoValidate a f)
piOptionParser = (ProgramInfoValidate a f -> MParser a)
-> (ProgramInfoValidate a f
    -> MParser a -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f)
     (ProgramInfoValidate a f)
     (MParser a)
     (MParser a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate a f -> MParser a
forall a (f :: * -> *). ProgramInfoValidate a f -> MParser a
_piOptionParser ((ProgramInfoValidate a f -> MParser a -> ProgramInfoValidate a f)
 -> Lens
      (ProgramInfoValidate a f)
      (ProgramInfoValidate a f)
      (MParser a)
      (MParser a))
-> (ProgramInfoValidate a f
    -> MParser a -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f)
     (ProgramInfoValidate a f)
     (MParser a)
     (MParser a)
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 :: (a -> f a)
-> ProgramInfoValidate a f -> f (ProgramInfoValidate a f)
piDefaultConfiguration = (ProgramInfoValidate a f -> a)
-> (ProgramInfoValidate a f -> a -> ProgramInfoValidate a f)
-> Lens (ProgramInfoValidate a f) (ProgramInfoValidate a f) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate a f -> a
forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ((ProgramInfoValidate a f -> a -> ProgramInfoValidate a f)
 -> Lens (ProgramInfoValidate a f) (ProgramInfoValidate a f) a a)
-> (ProgramInfoValidate a f -> a -> ProgramInfoValidate a f)
-> Lens (ProgramInfoValidate a f) (ProgramInfoValidate a f) a a
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 :: (ConfigValidationFunction a f -> f (ConfigValidationFunction a f))
-> ProgramInfoValidate a f -> f (ProgramInfoValidate a f)
piValidateConfiguration = (ProgramInfoValidate a f -> ConfigValidationFunction a f)
-> (ProgramInfoValidate a f
    -> ConfigValidationFunction a f -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f)
     (ProgramInfoValidate a f)
     (ConfigValidationFunction a f)
     (ConfigValidationFunction a f)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate a f -> ConfigValidationFunction a f
forall a (f :: * -> *).
ProgramInfoValidate a f -> ConfigValidationFunction a f
_piValidateConfiguration ((ProgramInfoValidate a f
  -> ConfigValidationFunction a f -> ProgramInfoValidate a f)
 -> Lens
      (ProgramInfoValidate a f)
      (ProgramInfoValidate a f)
      (ConfigValidationFunction a f)
      (ConfigValidationFunction a f))
-> (ProgramInfoValidate a f
    -> ConfigValidationFunction a f -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f)
     (ProgramInfoValidate a f)
     (ConfigValidationFunction a f)
     (ConfigValidationFunction a f)
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 :: ([ConfigFile] -> f [ConfigFile])
-> ProgramInfoValidate a f -> f (ProgramInfoValidate a f)
piConfigurationFiles = (ProgramInfoValidate a f -> [ConfigFile])
-> (ProgramInfoValidate a f
    -> [ConfigFile] -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f)
     (ProgramInfoValidate a f)
     [ConfigFile]
     [ConfigFile]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate a f -> [ConfigFile]
forall a (f :: * -> *). ProgramInfoValidate a f -> [ConfigFile]
_piConfigurationFiles ((ProgramInfoValidate a f
  -> [ConfigFile] -> ProgramInfoValidate a f)
 -> Lens
      (ProgramInfoValidate a f)
      (ProgramInfoValidate a f)
      [ConfigFile]
      [ConfigFile])
-> (ProgramInfoValidate a f
    -> [ConfigFile] -> ProgramInfoValidate a f)
-> Lens
     (ProgramInfoValidate a f)
     (ProgramInfoValidate a f)
     [ConfigFile]
     [ConfigFile]
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 :: ((MParser a, a, ConfigValidationFunction a b)
 -> f (MParser c, c, ConfigValidationFunction c d))
-> ProgramInfoValidate a b -> f (ProgramInfoValidate c d)
piOptionParserAndDefaultConfiguration = (ProgramInfoValidate a b
 -> (MParser a, a, ConfigValidationFunction a b))
-> (ProgramInfoValidate a b
    -> (MParser c, c, ConfigValidationFunction c d)
    -> ProgramInfoValidate c d)
-> Lens
     (ProgramInfoValidate a b)
     (ProgramInfoValidate c d)
     (MParser a, a, ConfigValidationFunction a b)
     (MParser c, c, ConfigValidationFunction c d)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate a b
-> (MParser a, a, ConfigValidationFunction a b)
forall a (f :: * -> *).
ProgramInfoValidate a f
-> (MParser a, a, ConfigValidationFunction a f)
g ((ProgramInfoValidate a b
  -> (MParser c, c, ConfigValidationFunction c d)
  -> ProgramInfoValidate c d)
 -> Lens
      (ProgramInfoValidate a b)
      (ProgramInfoValidate c d)
      (MParser a, a, ConfigValidationFunction a b)
      (MParser c, c, ConfigValidationFunction c d))
-> (ProgramInfoValidate a b
    -> (MParser c, c, ConfigValidationFunction c d)
    -> ProgramInfoValidate c d)
-> Lens
     (ProgramInfoValidate a b)
     (ProgramInfoValidate c d)
     (MParser a, a, ConfigValidationFunction a b)
     (MParser c, c, ConfigValidationFunction c d)
forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate a b
s (MParser c
a,c
b,ConfigValidationFunction c d
c) → ProgramInfo :: forall a (f :: * -> *).
String
-> Maybe String
-> Maybe String
-> MParser a
-> a
-> ConfigValidationFunction a f
-> [ConfigFile]
-> ProgramInfoValidate a f
ProgramInfo
    { _piDescription :: String
_piDescription = ProgramInfoValidate a b -> String
forall a (f :: * -> *). ProgramInfoValidate a f -> String
_piDescription ProgramInfoValidate a b
s
    , _piHelpHeader :: Maybe String
_piHelpHeader = ProgramInfoValidate a b -> Maybe String
forall a (f :: * -> *). ProgramInfoValidate a f -> Maybe String
_piHelpHeader ProgramInfoValidate a b
s
    , _piHelpFooter :: Maybe String
_piHelpFooter = ProgramInfoValidate a b -> Maybe String
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 = ProgramInfoValidate a b -> [ConfigFile]
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 = (ProgramInfoValidate a f -> MParser a
forall a (f :: * -> *). ProgramInfoValidate a f -> MParser a
_piOptionParser ProgramInfoValidate a f
s, ProgramInfoValidate a f -> a
forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ProgramInfoValidate a f
s, ProgramInfoValidate a f -> ConfigValidationFunction a f
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 :: String -> MParser a -> a -> ProgramInfo a
programInfo String
desc MParser a
parser a
defaultConfig =
    String -> MParser a -> a -> ConfigValidation a [] -> ProgramInfo a
forall a (f :: * -> *).
String
-> MParser a
-> a
-> ConfigValidation a f
-> ProgramInfoValidate a f
programInfoValidate String
desc MParser a
parser a
defaultConfig (ConfigValidation a [] -> ProgramInfo a)
-> ConfigValidation a [] -> ProgramInfo a
forall a b. (a -> b) -> a -> b
$ m () -> a -> m ()
forall a b. a -> b -> a
const (() -> m ()
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 :: String
-> MParser a
-> a
-> ConfigValidation a f
-> ProgramInfoValidate a f
programInfoValidate String
desc MParser a
parser a
defaultConfig ConfigValidation a f
valFunc = ProgramInfo :: forall a (f :: * -> *).
String
-> Maybe String
-> Maybe String
-> MParser a
-> a
-> ConfigValidationFunction a f
-> [ConfigFile]
-> ProgramInfoValidate a f
ProgramInfo
    { _piDescription :: String
_piDescription = String
desc
    , _piHelpHeader :: Maybe String
_piHelpHeader = Maybe String
forall a. Maybe a
Nothing
    , _piHelpFooter :: Maybe String
_piHelpFooter = Maybe String
forall a. Maybe a
Nothing
    , _piOptionParser :: MParser a
_piOptionParser = MParser a
parser
    , _piDefaultConfiguration :: a
_piDefaultConfiguration = a
defaultConfig
    , _piValidateConfiguration :: ConfigValidationFunction a f
_piValidateConfiguration = ConfigValidation a f -> ConfigValidationFunction a f
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 Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk Text
t of
    CI Text
"full" → PrintConfigMode -> Either String PrintConfigMode
forall a b. b -> Either a b
Right PrintConfigMode
Full
    CI Text
"minimal" → PrintConfigMode -> Either String PrintConfigMode
forall a b. b -> Either a b
Right PrintConfigMode
Minimal
    CI Text
"diff" → PrintConfigMode -> Either String PrintConfigMode
forall a b. b -> Either a b
Right PrintConfigMode
Diff
    CI Text
x → String -> Either String PrintConfigMode
forall a b. a -> Either a b
Left (String -> Either String PrintConfigMode)
-> String -> Either String PrintConfigMode
forall a b. (a -> b) -> a -> b
$ String
"unknow print configuration mode: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CI Text -> String
forall a s. (Show a, IsString s) => a -> s
sshow CI Text
x

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

instance FromJSON PrintConfigMode where
    parseJSON :: Value -> Parser PrintConfigMode
parseJSON = String
-> (Text -> Parser PrintConfigMode)
-> Value
-> Parser PrintConfigMode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PrintConfigMode"
        ((Text -> Parser PrintConfigMode)
 -> Value -> Parser PrintConfigMode)
-> (Text -> Parser PrintConfigMode)
-> Value
-> Parser PrintConfigMode
forall a b. (a -> b) -> a -> b
$ (String -> Parser PrintConfigMode)
-> (PrintConfigMode -> Parser PrintConfigMode)
-> Either String PrintConfigMode
-> Parser PrintConfigMode
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser PrintConfigMode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail PrintConfigMode -> Parser PrintConfigMode
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String PrintConfigMode -> Parser PrintConfigMode)
-> (Text -> Either String PrintConfigMode)
-> Text
-> Parser PrintConfigMode
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
    { AppConfiguration a -> Maybe PrintConfigMode
_printConfig ∷ !(Maybe PrintConfigMode)
    , AppConfiguration a -> ConfigFilesConfig
_configFilesConfig ∷ !ConfigFilesConfig
    , AppConfiguration a -> [ConfigFile]
_configFiles ∷ ![ConfigFile]
    , 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 :: ([ConfigFile] -> f [ConfigFile])
-> AppConfiguration a -> f (AppConfiguration a)
configFiles = (AppConfiguration a -> [ConfigFile])
-> (AppConfiguration a -> [ConfigFile] -> AppConfiguration a)
-> Lens
     (AppConfiguration a) (AppConfiguration a) [ConfigFile] [ConfigFile]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AppConfiguration a -> [ConfigFile]
forall a. AppConfiguration a -> [ConfigFile]
_configFiles ((AppConfiguration a -> [ConfigFile] -> AppConfiguration a)
 -> Lens
      (AppConfiguration a)
      (AppConfiguration a)
      [ConfigFile]
      [ConfigFile])
-> (AppConfiguration a -> [ConfigFile] -> AppConfiguration a)
-> Lens
     (AppConfiguration a) (AppConfiguration a) [ConfigFile] [ConfigFile]
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 :: (a -> f b) -> AppConfiguration a -> f (AppConfiguration b)
mainConfig = (AppConfiguration a -> a)
-> (AppConfiguration a -> b -> AppConfiguration b)
-> Lens (AppConfiguration a) (AppConfiguration b) a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AppConfiguration a -> a
forall a. AppConfiguration a -> a
_mainConfig ((AppConfiguration a -> b -> AppConfiguration b)
 -> Lens (AppConfiguration a) (AppConfiguration b) a b)
-> (AppConfiguration a -> b -> AppConfiguration b)
-> Lens (AppConfiguration a) (AppConfiguration b) a b
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 :: Parser (a -> a) -> Parser (AppConfiguration (a -> a))
pAppConfiguration Parser (a -> a)
mainParser = Maybe PrintConfigMode
-> ConfigFilesConfig
-> [ConfigFile]
-> (a -> a)
-> AppConfiguration (a -> a)
forall a.
Maybe PrintConfigMode
-> ConfigFilesConfig -> [ConfigFile] -> a -> AppConfiguration a
AppConfiguration
    (Maybe PrintConfigMode
 -> ConfigFilesConfig
 -> [ConfigFile]
 -> (a -> a)
 -> AppConfiguration (a -> a))
-> Parser (Maybe PrintConfigMode)
-> Parser
     (ConfigFilesConfig
      -> [ConfigFile] -> (a -> a) -> AppConfiguration (a -> a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe PrintConfigMode)
pPrintConfig
    Parser
  (ConfigFilesConfig
   -> [ConfigFile] -> (a -> a) -> AppConfiguration (a -> a))
-> Parser ConfigFilesConfig
-> Parser ([ConfigFile] -> (a -> a) -> AppConfiguration (a -> a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MParser ConfigFilesConfig
pConfigFilesConfig MParser ConfigFilesConfig
-> Parser ConfigFilesConfig -> Parser ConfigFilesConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConfigFilesConfig -> Parser ConfigFilesConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConfigFilesConfig
defaultConfigFilesConfig)
    Parser ([ConfigFile] -> (a -> a) -> AppConfiguration (a -> a))
-> Parser [ConfigFile]
-> Parser ((a -> a) -> AppConfiguration (a -> a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfigFile -> Parser [ConfigFile]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ConfigFile
pConfigFile
    Parser ((a -> a) -> AppConfiguration (a -> a))
-> Parser (a -> a) -> Parser (AppConfiguration (a -> a))
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 (Text -> ConfigFile) -> (String -> Text) -> String -> ConfigFile
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ String -> Text
T.pack (String -> ConfigFile) -> Parser String -> Parser ConfigFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
O.strOption
        (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
% String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"config-file"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"FILE"
        Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields String
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
        = PrintConfigMode -> Maybe PrintConfigMode
forall a. a -> Maybe a
Just (PrintConfigMode -> Maybe PrintConfigMode)
-> Parser PrintConfigMode -> Parser (Maybe PrintConfigMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PrintConfigMode
pPrintConfigOption
        Parser (Maybe PrintConfigMode)
-> Parser (Maybe PrintConfigMode) -> Parser (Maybe PrintConfigMode)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PrintConfigMode -> Maybe PrintConfigMode
forall a. a -> Maybe a
Just (PrintConfigMode -> Maybe PrintConfigMode)
-> Parser PrintConfigMode -> Parser (Maybe PrintConfigMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PrintConfigMode
pPrintConfigFlag
        Parser (Maybe PrintConfigMode)
-> Parser (Maybe PrintConfigMode) -> Parser (Maybe PrintConfigMode)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe PrintConfigMode -> Parser (Maybe PrintConfigMode)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PrintConfigMode
forall a. Maybe a
Nothing

    pPrintConfigFlag :: Parser PrintConfigMode
pPrintConfigFlag = PrintConfigMode
-> Mod FlagFields PrintConfigMode -> Parser PrintConfigMode
forall a. a -> Mod FlagFields a -> Parser a
O.flag' PrintConfigMode
Full
        (Mod FlagFields PrintConfigMode -> Parser PrintConfigMode)
-> Mod FlagFields PrintConfigMode -> Parser PrintConfigMode
forall a b. (a -> b) -> a -> b
% String -> Mod FlagFields PrintConfigMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"print-config"
        Mod FlagFields PrintConfigMode
-> Mod FlagFields PrintConfigMode -> Mod FlagFields PrintConfigMode
forall α. Monoid α => α -> α -> α
⊕ String -> Mod FlagFields PrintConfigMode
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 = ReadM PrintConfigMode
-> Mod OptionFields PrintConfigMode -> Parser PrintConfigMode
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ((String -> Either String PrintConfigMode) -> ReadM PrintConfigMode
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String PrintConfigMode)
 -> ReadM PrintConfigMode)
-> (String -> Either String PrintConfigMode)
-> ReadM PrintConfigMode
forall a b. (a -> b) -> a -> b
$ Text -> Either String PrintConfigMode
printConfigModeFromText (Text -> Either String PrintConfigMode)
-> (String -> Text) -> String -> Either String PrintConfigMode
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
. String -> Text
T.pack)
        (Mod OptionFields PrintConfigMode -> Parser PrintConfigMode)
-> Mod OptionFields PrintConfigMode -> Parser PrintConfigMode
forall a b. (a -> b) -> a -> b
% String -> Mod OptionFields PrintConfigMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"print-config-as"
        Mod OptionFields PrintConfigMode
-> Mod OptionFields PrintConfigMode
-> Mod OptionFields PrintConfigMode
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields PrintConfigMode
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print the parsed configuration to standard out and exit"
        Mod OptionFields PrintConfigMode
-> Mod OptionFields PrintConfigMode
-> Mod OptionFields PrintConfigMode
forall α. Monoid α => α -> α -> α
⊕ [String] -> Mod OptionFields PrintConfigMode
forall (f :: * -> *) a. HasCompleter f => [String] -> Mod f a
O.completeWith [String
"full", String
"minimal", String
"diff", String
"Full", String
"Minimal", String
"Diff"]
        Mod OptionFields PrintConfigMode
-> Mod OptionFields PrintConfigMode
-> Mod OptionFields PrintConfigMode
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields PrintConfigMode
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 :: ProgramInfoValidate a f -> (a -> IO ()) -> IO ()
runWithConfiguration ProgramInfoValidate a f
appInfo = ProgramInfoValidate a f
-> (forall b. Maybe (MParser b)) -> (a -> IO ()) -> IO ()
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
forall b. Maybe (MParser b)
Nothing

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

pPkgInfo ∷ PkgInfo → MParser a
pPkgInfo :: PkgInfo -> MParser a
pPkgInfo (String
sinfo, String
detailedInfo, String
version, String
license) =
    Parser
  ((((a -> a) -> a -> a) -> (a -> a) -> a -> a)
   -> ((a -> a) -> a -> a) -> (a -> a) -> a -> a)
forall a. Parser (a -> a)
infoO Parser
  ((((a -> a) -> a -> a) -> (a -> a) -> a -> a)
   -> ((a -> a) -> a -> a) -> (a -> a) -> a -> a)
-> Parser (((a -> a) -> a -> a) -> (a -> a) -> a -> a)
-> Parser (((a -> a) -> a -> a) -> (a -> a) -> a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (((a -> a) -> a -> a) -> (a -> a) -> a -> a)
forall a. Parser (a -> a)
detailedInfoO Parser (((a -> a) -> a -> a) -> (a -> a) -> a -> a)
-> Parser ((a -> a) -> a -> a) -> Parser ((a -> a) -> a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ((a -> a) -> a -> a)
forall a. Parser (a -> a)
versionO Parser ((a -> a) -> a -> a) -> MParser a -> MParser a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MParser a
forall a. Parser (a -> a)
licenseO
  where
    infoO :: Parser (a -> a)
infoO = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption String
sinfo
        (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"info"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print program info message and exit"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ (a -> a) -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value a -> a
forall a. a -> a
id
    detailedInfoO :: Parser (a -> a)
detailedInfoO = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption String
detailedInfo
        (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"long-info"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print detailed program info message and exit"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ (a -> a) -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value a -> a
forall a. a -> a
id
    versionO :: Parser (a -> a)
versionO = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption String
version
        (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"version"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
O.short Char
'v'
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print version string and exit"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ (a -> a) -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value a -> a
forall a. a -> a
id
    licenseO :: Parser (a -> a)
licenseO = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption String
license
        (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"license"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Print license of the program and exit"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ (a -> a) -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
O.value a -> a
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 :: ProgramInfoValidate a f -> PkgInfo -> (a -> IO ()) -> IO ()
runWithPkgInfoConfiguration ProgramInfoValidate a f
appInfo PkgInfo
pkgInfo =
    ProgramInfoValidate a f
-> (forall b. Maybe (MParser b)) -> (a -> IO ()) -> IO ()
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 (MParser b -> Maybe (MParser b)
forall a. a -> Maybe a
Just (MParser b -> Maybe (MParser b)) -> MParser b -> Maybe (MParser b)
forall a b. (a -> b) -> a -> b
$ PkgInfo -> MParser 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 :: 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 = Parser (AppConfiguration (a -> a))
-> InfoMod (AppConfiguration (a -> a))
-> ParserInfo (AppConfiguration (a -> a))
forall a. Parser a -> InfoMod a -> ParserInfo a
O.info Parser (AppConfiguration (a -> a))
optionParser
    (InfoMod (AppConfiguration (a -> a))
 -> ParserInfo (AppConfiguration (a -> a)))
-> InfoMod (AppConfiguration (a -> a))
-> ParserInfo (AppConfiguration (a -> a))
forall a b. (a -> b) -> a -> b
$ String -> InfoMod (AppConfiguration (a -> a))
forall a. String -> InfoMod a
O.progDesc String
_piDescription
    InfoMod (AppConfiguration (a -> a))
-> InfoMod (AppConfiguration (a -> a))
-> InfoMod (AppConfiguration (a -> a))
forall α. Monoid α => α -> α -> α
⊕ InfoMod (AppConfiguration (a -> a))
forall a. InfoMod a
O.fullDesc
    InfoMod (AppConfiguration (a -> a))
-> InfoMod (AppConfiguration (a -> a))
-> InfoMod (AppConfiguration (a -> a))
forall α. Monoid α => α -> α -> α
⊕ InfoMod (AppConfiguration (a -> a))
-> (String -> InfoMod (AppConfiguration (a -> a)))
-> Maybe String
-> InfoMod (AppConfiguration (a -> a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InfoMod (AppConfiguration (a -> a))
forall a. Monoid a => a
mempty String -> InfoMod (AppConfiguration (a -> a))
forall a. String -> InfoMod a
O.header Maybe String
_piHelpHeader
    InfoMod (AppConfiguration (a -> a))
-> InfoMod (AppConfiguration (a -> a))
-> InfoMod (AppConfiguration (a -> a))
forall α. Monoid α => α -> α -> α
⊕ Maybe Doc -> InfoMod (AppConfiguration (a -> a))
forall a. Maybe Doc -> InfoMod a
O.footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ Doc
defaultFooter Doc -> Doc -> Doc
forall α. Monoid α => α -> α -> α
⊕ Doc -> (String -> Doc) -> Maybe String -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Monoid a => a
mempty String -> Doc
P.text Maybe String
_piHelpFooter)
  where
    optionParser :: Parser (AppConfiguration (a -> a))
optionParser =
        -- these are identity parsers that are only applied for their side effects
        Parser
  ((AppConfiguration (a -> a) -> AppConfiguration (a -> a))
   -> AppConfiguration (a -> a) -> AppConfiguration (a -> a))
-> Maybe
     (Parser
        ((AppConfiguration (a -> a) -> AppConfiguration (a -> a))
         -> AppConfiguration (a -> a) -> AppConfiguration (a -> a)))
-> Parser
     ((AppConfiguration (a -> a) -> AppConfiguration (a -> a))
      -> AppConfiguration (a -> a) -> AppConfiguration (a -> a))
forall a. a -> Maybe a -> a
fromMaybe (((AppConfiguration (a -> a) -> AppConfiguration (a -> a))
 -> AppConfiguration (a -> a) -> AppConfiguration (a -> a))
-> Parser
     ((AppConfiguration (a -> a) -> AppConfiguration (a -> a))
      -> AppConfiguration (a -> a) -> AppConfiguration (a -> a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppConfiguration (a -> a) -> AppConfiguration (a -> a))
-> AppConfiguration (a -> a) -> AppConfiguration (a -> a)
forall a. a -> a
id) Maybe
  (Parser
     ((AppConfiguration (a -> a) -> AppConfiguration (a -> a))
      -> AppConfiguration (a -> a) -> AppConfiguration (a -> a)))
forall b. Maybe (MParser b)
pkgInfoParser Parser
  ((AppConfiguration (a -> a) -> AppConfiguration (a -> a))
   -> AppConfiguration (a -> a) -> AppConfiguration (a -> a))
-> Parser (AppConfiguration (a -> a) -> AppConfiguration (a -> a))
-> Parser (AppConfiguration (a -> a) -> AppConfiguration (a -> a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (AppConfiguration (a -> a) -> AppConfiguration (a -> a))
forall a. Parser (a -> a)
nonHiddenHelper
        -- this parser produces the results
        Parser (AppConfiguration (a -> a) -> AppConfiguration (a -> a))
-> Parser (AppConfiguration (a -> a))
-> Parser (AppConfiguration (a -> a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MParser a -> Parser (AppConfiguration (a -> a))
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.
#if MIN_VERSION_optparse_applicative(0,16,0)
    nonHiddenHelper :: Parser (a -> a)
nonHiddenHelper = ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption (Maybe String -> ParseError
ShowHelpText Maybe String
forall a. Maybe a
Nothing)
#else
    nonHiddenHelper = abortOption ShowHelpText
#endif
        (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
% String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"help"
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'h'
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'?'
        Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall α. Monoid α => α -> α -> α
⊕ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show this help message"

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

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

    printConfigFile :: ConfigFile -> Doc
printConfigFile ConfigFile
f = String -> Doc
P.text (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ConfigFile -> Text
getConfigFile ConfigFile
f) Doc -> Doc -> Doc
P.<+> case ConfigFile
f of
        ConfigFileRequired Text
_ → String -> Doc
P.text String
"(required)"
        ConfigFileOptional Text
_ → String -> Doc
P.text String
"(optional)"

    par ∷ String → P.Doc
    par :: String -> Doc
par = [Doc] -> Doc
P.fillSep ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
P.string ([String] -> [Doc]) -> (String -> [String]) -> String -> [Doc]
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 :: 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 ← ([ConfigFile] -> Identity [ConfigFile])
-> AppConfiguration (a -> a)
-> Identity (AppConfiguration (a -> a))
forall a. Lens' (AppConfiguration a) [ConfigFile]
configFiles (([ConfigFile] -> Identity [ConfigFile])
 -> AppConfiguration (a -> a)
 -> Identity (AppConfiguration (a -> a)))
-> ([ConfigFile] -> [ConfigFile])
-> AppConfiguration (a -> a)
-> AppConfiguration (a -> a)
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
`over` [ConfigFile] -> [ConfigFile] -> [ConfigFile]
forall α. Monoid α => α -> α -> α
(⊕) (ProgramInfoValidate a f -> [ConfigFile]
forall a (f :: * -> *). ProgramInfoValidate a f -> [ConfigFile]
_piConfigurationFiles ProgramInfoValidate a f
appInfo) (AppConfiguration (a -> a) -> AppConfiguration (a -> a))
-> IO (AppConfiguration (a -> a)) -> IO (AppConfiguration (a -> a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ParserPrefs
-> ParserInfo (AppConfiguration (a -> a))
-> IO (AppConfiguration (a -> a))
forall a. ParserPrefs -> ParserInfo a -> IO a
O.customExecParser ParserPrefs
parserPrefs (ProgramInfoValidate a f
-> (forall b. Maybe (MParser b))
-> ParserInfo (AppConfiguration (a -> a))
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 AppConfiguration (a -> a)
-> (AppConfiguration (a -> a) -> IO (AppConfiguration a))
-> IO (AppConfiguration a)
forall a b. a -> (a -> b) -> b
& ((a -> a) -> IO a)
-> AppConfiguration (a -> a) -> IO (AppConfiguration a)
forall a b. Lens (AppConfiguration a) (AppConfiguration b) a b
mainConfig (((a -> a) -> IO a)
 -> AppConfiguration (a -> a) -> IO (AppConfiguration a))
-> ((a -> a) -> IO a)
-> AppConfiguration (a -> a)
-> IO (AppConfiguration a)
forall a. a -> a
`id` \a -> a
a → a -> a
a (a -> a) -> IO a -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT Text IO a -> IO a
forall (m :: * -> *) a. Monad m => ExceptT Text m a -> m a
errorT (ExceptT Text IO a -> IO a) -> ExceptT Text IO a -> IO a
forall a b. (a -> b) -> a -> b
% ConfigFilesConfig -> a -> [ConfigFile] -> ExceptT Text IO a
forall (m :: * -> *) a.
(ConfigFileParser m, FromJSON (a -> a)) =>
ConfigFilesConfig -> a -> [ConfigFile] -> m a
CF.parseConfigFiles
        (AppConfiguration (a -> a) -> ConfigFilesConfig
forall a. AppConfiguration a -> ConfigFilesConfig
_configFilesConfig AppConfiguration (a -> a)
cliAppConf)
        (ProgramInfoValidate a f -> a
forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ProgramInfoValidate a f
appInfo)
        (AppConfiguration (a -> a) -> [ConfigFile]
forall a. AppConfiguration a -> [ConfigFile]
_configFiles AppConfiguration (a -> a)
cliAppConf)

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

    case AppConfiguration a -> Maybe PrintConfigMode
forall a. AppConfiguration a -> Maybe PrintConfigMode
_printConfig AppConfiguration a
appConf of
        Maybe PrintConfigMode
Nothing → a -> IO ()
mainFunction (a -> IO ())
-> (AppConfiguration a -> a) -> AppConfiguration a -> IO ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ AppConfiguration a -> a
forall a. AppConfiguration a -> a
_mainConfig (AppConfiguration a -> IO ()) -> AppConfiguration a -> IO ()
forall a b. (a -> b) -> a -> b
$ AppConfiguration a
appConf
        Just PrintConfigMode
Full → ByteString -> IO ()
B8.putStrLn (ByteString -> IO ())
-> (AppConfiguration a -> ByteString)
-> AppConfiguration a
-> IO ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ a -> ByteString
forall a. ToJSON a => a -> ByteString
Yaml.encode (a -> ByteString)
-> (AppConfiguration a -> a) -> AppConfiguration a -> ByteString
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ AppConfiguration a -> a
forall a. AppConfiguration a -> a
_mainConfig (AppConfiguration a -> IO ()) -> AppConfiguration a -> IO ()
forall a b. (a -> b) -> a -> b
$ AppConfiguration a
appConf
        Just PrintConfigMode
Minimal → ByteString -> IO ()
B8.putStrLn
            (ByteString -> IO ())
-> (AppConfiguration a -> ByteString)
-> AppConfiguration a
-> IO ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Yaml.encode
            (Value -> ByteString)
-> (AppConfiguration a -> Value)
-> AppConfiguration a
-> ByteString
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (Diff Value -> Value) -> Value -> Value
resolve Diff Value -> Value
resolveOnlyRight
            (Value -> Value)
-> (AppConfiguration a -> Value) -> AppConfiguration a -> Value
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Value -> Value -> Value
diff (a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> a -> Value
forall a b. (a -> b) -> a -> b
$ ProgramInfoValidate a f -> a
forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ProgramInfoValidate a f
appInfo)
            (Value -> Value)
-> (AppConfiguration a -> Value) -> AppConfiguration a -> Value
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ a -> Value
forall a. ToJSON a => a -> Value
toJSON
            (a -> Value)
-> (AppConfiguration a -> a) -> AppConfiguration a -> Value
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ AppConfiguration a -> a
forall a. AppConfiguration a -> a
_mainConfig
            (AppConfiguration a -> IO ()) -> AppConfiguration a -> IO ()
forall a b. (a -> b) -> a -> b
$ AppConfiguration a
appConf
        Just PrintConfigMode
Diff → ByteString -> IO ()
B8.putStrLn
            (ByteString -> IO ())
-> (AppConfiguration a -> ByteString)
-> AppConfiguration a
-> IO ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Yaml.encode
            (Value -> ByteString)
-> (AppConfiguration a -> Value)
-> AppConfiguration a
-> ByteString
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Value -> Value -> Value
diff (a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> a -> Value
forall a b. (a -> b) -> a -> b
$ ProgramInfoValidate a f -> a
forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ProgramInfoValidate a f
appInfo)
            (Value -> Value)
-> (AppConfiguration a -> Value) -> AppConfiguration a -> Value
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ a -> Value
forall a. ToJSON a => a -> Value
toJSON
            (a -> Value)
-> (AppConfiguration a -> a) -> AppConfiguration a -> Value
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ AppConfiguration a -> a
forall a. AppConfiguration a -> a
_mainConfig
            (AppConfiguration a -> IO ()) -> AppConfiguration a -> IO ()
forall a b. (a -> b) -> a -> b
$ AppConfiguration a
appConf
  where
    parserPrefs :: ParserPrefs
parserPrefs = PrefsMod -> ParserPrefs
O.prefs PrefsMod
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 :: 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 ParserPrefs
-> ParserInfo (AppConfiguration (a -> a))
-> [String]
-> ParserResult (AppConfiguration (a -> a))
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
O.execParserPure ParserPrefs
parserPrefs (ProgramInfoValidate a f
-> (forall b. Maybe (MParser b))
-> ParserInfo (AppConfiguration (a -> a))
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
forall b. Maybe (MParser b)
Nothing) [String]
args of
        O.Success AppConfiguration (a -> a)
a → AppConfiguration (a -> a) -> m (AppConfiguration (a -> a))
forall (m :: * -> *) a. Monad m => a -> m a
return (AppConfiguration (a -> a) -> m (AppConfiguration (a -> a)))
-> AppConfiguration (a -> a) -> m (AppConfiguration (a -> a))
forall a b. (a -> b) -> a -> b
$ AppConfiguration (a -> a)
a AppConfiguration (a -> a)
-> (AppConfiguration (a -> a) -> AppConfiguration (a -> a))
-> AppConfiguration (a -> a)
forall a b. a -> (a -> b) -> b
& ([ConfigFile] -> Identity [ConfigFile])
-> AppConfiguration (a -> a)
-> Identity (AppConfiguration (a -> a))
forall a. Lens' (AppConfiguration a) [ConfigFile]
configFiles (([ConfigFile] -> Identity [ConfigFile])
 -> AppConfiguration (a -> a)
 -> Identity (AppConfiguration (a -> a)))
-> ([ConfigFile] -> [ConfigFile])
-> AppConfiguration (a -> a)
-> AppConfiguration (a -> a)
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
`over` [ConfigFile] -> [ConfigFile] -> [ConfigFile]
forall α. Monoid α => α -> α -> α
(⊕) (ProgramInfoValidate a f -> [ConfigFile]
forall a (f :: * -> *). ProgramInfoValidate a f -> [ConfigFile]
_piConfigurationFiles ProgramInfoValidate a f
appInfo)
        O.Failure ParserFailure ParserHelp
e → Text -> m (AppConfiguration (a -> a))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> m (AppConfiguration (a -> a)))
-> ((String, ExitCode) -> Text)
-> (String, ExitCode)
-> m (AppConfiguration (a -> a))
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ String -> Text
T.pack (String -> Text)
-> ((String, ExitCode) -> String) -> (String, ExitCode) -> Text
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (String, ExitCode) -> String
forall a b. (a, b) -> a
fst ((String, ExitCode) -> m (AppConfiguration (a -> a)))
-> (String, ExitCode) -> m (AppConfiguration (a -> a))
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
_ → Text -> m (AppConfiguration (a -> a))
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 AppConfiguration (a -> a)
-> (AppConfiguration (a -> a) -> m (AppConfiguration a))
-> m (AppConfiguration a)
forall a b. a -> (a -> b) -> b
& ((a -> a) -> m a)
-> AppConfiguration (a -> a) -> m (AppConfiguration a)
forall a b. Lens (AppConfiguration a) (AppConfiguration b) a b
mainConfig (((a -> a) -> m a)
 -> AppConfiguration (a -> a) -> m (AppConfiguration a))
-> ((a -> a) -> m a)
-> AppConfiguration (a -> a)
-> m (AppConfiguration a)
forall a. a -> a
`id` \a -> a
a → a -> a
a (a -> a) -> m a -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigFilesConfig -> a -> [ConfigFile] -> m a
forall (m :: * -> *) a.
(ConfigFileParser m, FromJSON (a -> a)) =>
ConfigFilesConfig -> a -> [ConfigFile] -> m a
CF.parseConfigFiles
        (AppConfiguration (a -> a) -> ConfigFilesConfig
forall a. AppConfiguration a -> ConfigFilesConfig
_configFilesConfig AppConfiguration (a -> a)
cliAppConf)
        (ProgramInfoValidate a f -> a
forall a (f :: * -> *). ProgramInfoValidate a f -> a
_piDefaultConfiguration ProgramInfoValidate a f
appInfo)
        (AppConfiguration (a -> a) -> [ConfigFile]
forall a. AppConfiguration a -> [ConfigFile]
_configFiles AppConfiguration (a -> a)
cliAppConf)

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

    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ AppConfiguration a -> a
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 = WriterT (f Text) m () -> m ((), f Text)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT (f Text) m () -> m ((), f Text))
-> WriterT (f Text) m () -> m ((), f Text)
forall a b. (a -> b) -> a -> b
$
        ConfigValidationFunction a f -> a -> WriterT (f Text) m ()
forall a (f :: * -> *).
ConfigValidationFunction a f -> ConfigValidation a f
runConfigValidation (((ConfigValidationFunction a f
  -> Const
       (ConfigValidationFunction a f) (ConfigValidationFunction a f))
 -> ProgramInfoValidate a f
 -> Const (ConfigValidationFunction a f) (ProgramInfoValidate a f))
-> ProgramInfoValidate a f -> ConfigValidationFunction a f
forall r (m :: * -> *) a.
MonadReader r m =>
((a -> Const a a) -> r -> Const a r) -> m a
view (ConfigValidationFunction a f
 -> Const
      (ConfigValidationFunction a f) (ConfigValidationFunction a f))
-> ProgramInfoValidate a f
-> Const (ConfigValidationFunction a f) (ProgramInfoValidate a f)
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 :: ProgramInfoValidate a f -> a -> IO ()
validateConfig ProgramInfoValidate a f
appInfo a
conf = do
    f Text
warnings ← WriterT (f Text) IO () -> IO (f Text)
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT (f Text) IO () -> IO (f Text))
-> (ExceptT Text (WriterT (f Text) IO) ()
    -> WriterT (f Text) IO ())
-> ExceptT Text (WriterT (f Text) IO) ()
-> IO (f Text)
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (Text -> WriterT (f Text) IO ())
-> (() -> WriterT (f Text) IO ())
-> ExceptT Text (WriterT (f Text) IO) ()
-> WriterT (f Text) IO ()
forall (m :: * -> *) e b a.
Monad m =>
(e -> m b) -> (a -> m b) -> ExceptT e m a -> m b
exceptT (String -> WriterT (f Text) IO ()
forall a. HasCallStack => String -> a
error (String -> WriterT (f Text) IO ())
-> (Text -> String) -> Text -> WriterT (f Text) IO ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> String
T.unpack) () -> WriterT (f Text) IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (ExceptT Text (WriterT (f Text) IO) () -> IO (f Text))
-> ExceptT Text (WriterT (f Text) IO) () -> IO (f Text)
forall a b. (a -> b) -> a -> b
$
        ConfigValidationFunction a f
-> a -> ExceptT Text (WriterT (f Text) IO) ()
forall a (f :: * -> *).
ConfigValidationFunction a f -> ConfigValidation a f
runConfigValidation (((ConfigValidationFunction a f
  -> Const
       (ConfigValidationFunction a f) (ConfigValidationFunction a f))
 -> ProgramInfoValidate a f
 -> Const (ConfigValidationFunction a f) (ProgramInfoValidate a f))
-> ProgramInfoValidate a f -> ConfigValidationFunction a f
forall r (m :: * -> *) a.
MonadReader r m =>
((a -> Const a a) -> r -> Const a r) -> m a
view (ConfigValidationFunction a f
 -> Const
      (ConfigValidationFunction a f) (ConfigValidationFunction a f))
-> ProgramInfoValidate a f
-> Const (ConfigValidationFunction a f) (ProgramInfoValidate a f)
forall a (f :: * -> *).
Lens' (ProgramInfoValidate a f) (ConfigValidationFunction a f)
piValidateConfiguration ProgramInfoValidate a f
appInfo) a
conf
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Text -> Bool) -> f Text -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True) f Text
warnings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr Text
"WARNINGS:"
        (Text -> IO ()) -> f Text -> IO ()
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 (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"warning: " Text -> Text -> Text
forall α. Monoid α => α -> α -> α
⊕ Text
w) f Text
warnings