{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# 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 (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 r = ConfigValidationFunction
    { forall a (f :: * -> *) r.
ConfigValidationFunction a f r -> ConfigValidation' a f r
runConfigValidation ∷ ConfigValidation' a f r
    }

type ProgramInfo a = ProgramInfoValidate a []

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

type ProgramInfoValidate a f = ProgramInfoValidate' a f a

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

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

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

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

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

-- | Validation Function
--
-- The 'Right' result is interpreted as a 'Foldable' structure of warnings.
--
piValidateConfiguration ∷ Lens' (ProgramInfoValidate' a f r) (ConfigValidationFunction a f r)
piValidateConfiguration :: forall a (f :: * -> *) r (f :: * -> *).
Functor f =>
(ConfigValidationFunction a f r
 -> f (ConfigValidationFunction a f r))
-> ProgramInfoValidate' a f r -> f (ProgramInfoValidate' a f r)
piValidateConfiguration = (ProgramInfoValidate' a f r -> ConfigValidationFunction a f r)
-> (ProgramInfoValidate' a f r
    -> ConfigValidationFunction a f r -> ProgramInfoValidate' a f r)
-> forall {f :: * -> *}.
   Functor f =>
   (ConfigValidationFunction a f r
    -> f (ConfigValidationFunction a f r))
   -> ProgramInfoValidate' a f r -> f (ProgramInfoValidate' a f r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate' a f r -> ConfigValidationFunction a f r
forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> ConfigValidationFunction a f r
_piValidateConfiguration ((ProgramInfoValidate' a f r
  -> ConfigValidationFunction a f r -> ProgramInfoValidate' a f r)
 -> forall {f :: * -> *}.
    Functor f =>
    (ConfigValidationFunction a f r
     -> f (ConfigValidationFunction a f r))
    -> ProgramInfoValidate' a f r -> f (ProgramInfoValidate' a f r))
-> (ProgramInfoValidate' a f r
    -> ConfigValidationFunction a f r -> ProgramInfoValidate' a f r)
-> forall {f :: * -> *}.
   Functor f =>
   (ConfigValidationFunction a f r
    -> f (ConfigValidationFunction a f r))
   -> ProgramInfoValidate' a f r -> f (ProgramInfoValidate' a f r)
forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate' a f r
s ConfigValidationFunction a f r
a → ProgramInfoValidate' a f r
s { _piValidateConfiguration = 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 :: * -> *) (f :: * -> *).
Functor f =>
([ConfigFile] -> f [ConfigFile])
-> ProgramInfoValidate a f -> f (ProgramInfoValidate a f)
piConfigurationFiles = (ProgramInfoValidate a f -> [ConfigFile])
-> (ProgramInfoValidate a f
    -> [ConfigFile] -> ProgramInfoValidate a f)
-> forall {f :: * -> *}.
   Functor f =>
   ([ConfigFile] -> f [ConfigFile])
   -> ProgramInfoValidate a f -> f (ProgramInfoValidate a f)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate a f -> [ConfigFile]
forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> [ConfigFile]
_piConfigurationFiles ((ProgramInfoValidate a f
  -> [ConfigFile] -> ProgramInfoValidate a f)
 -> forall {f :: * -> *}.
    Functor f =>
    ([ConfigFile] -> f [ConfigFile])
    -> ProgramInfoValidate a f -> f (ProgramInfoValidate a f))
-> (ProgramInfoValidate a f
    -> [ConfigFile] -> ProgramInfoValidate a f)
-> forall {f :: * -> *}.
   Functor f =>
   ([ConfigFile] -> f [ConfigFile])
   -> ProgramInfoValidate a f -> f (ProgramInfoValidate a f)
forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate a f
s [ConfigFile]
a → ProgramInfoValidate a f
s { _piConfigurationFiles = 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 r)
        (ProgramInfoValidate' c d r')
        (MParser a, a, ConfigValidationFunction a b r)
        (MParser c, c, ConfigValidationFunction c d r')
piOptionParserAndDefaultConfiguration :: forall a (b :: * -> *) r c (d :: * -> *) r' (f :: * -> *).
Functor f =>
((MParser a, a, ConfigValidationFunction a b r)
 -> f (MParser c, c, ConfigValidationFunction c d r'))
-> ProgramInfoValidate' a b r -> f (ProgramInfoValidate' c d r')
piOptionParserAndDefaultConfiguration = (ProgramInfoValidate' a b r
 -> (MParser a, a, ConfigValidationFunction a b r))
-> (ProgramInfoValidate' a b r
    -> (MParser c, c, ConfigValidationFunction c d r')
    -> ProgramInfoValidate' c d r')
-> forall {f :: * -> *}.
   Functor f =>
   ((MParser a, a, ConfigValidationFunction a b r)
    -> f (MParser c, c, ConfigValidationFunction c d r'))
   -> ProgramInfoValidate' a b r -> f (ProgramInfoValidate' c d r')
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramInfoValidate' a b r
-> (MParser a, a, ConfigValidationFunction a b r)
forall {a} {f :: * -> *} {r}.
ProgramInfoValidate' a f r
-> (MParser a, a, ConfigValidationFunction a f r)
g ((ProgramInfoValidate' a b r
  -> (MParser c, c, ConfigValidationFunction c d r')
  -> ProgramInfoValidate' c d r')
 -> forall {f :: * -> *}.
    Functor f =>
    ((MParser a, a, ConfigValidationFunction a b r)
     -> f (MParser c, c, ConfigValidationFunction c d r'))
    -> ProgramInfoValidate' a b r -> f (ProgramInfoValidate' c d r'))
-> (ProgramInfoValidate' a b r
    -> (MParser c, c, ConfigValidationFunction c d r')
    -> ProgramInfoValidate' c d r')
-> forall {f :: * -> *}.
   Functor f =>
   ((MParser a, a, ConfigValidationFunction a b r)
    -> f (MParser c, c, ConfigValidationFunction c d r'))
   -> ProgramInfoValidate' a b r -> f (ProgramInfoValidate' c d r')
forall a b. (a -> b) -> a -> b
$ \ProgramInfoValidate' a b r
s (MParser c
a,c
b,ConfigValidationFunction c d r'
c) → ProgramInfo
    { _piDescription :: String
_piDescription = ProgramInfoValidate' a b r -> String
forall a (f :: * -> *) r. ProgramInfoValidate' a f r -> String
_piDescription ProgramInfoValidate' a b r
s
    , _piHelpHeader :: Maybe String
_piHelpHeader = ProgramInfoValidate' a b r -> Maybe String
forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> Maybe String
_piHelpHeader ProgramInfoValidate' a b r
s
    , _piHelpFooter :: Maybe String
_piHelpFooter = ProgramInfoValidate' a b r -> Maybe String
forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> Maybe String
_piHelpFooter ProgramInfoValidate' a b r
s
    , _piOptionParser :: MParser c
_piOptionParser = MParser c
a
    , _piDefaultConfiguration :: c
_piDefaultConfiguration = c
b
    , _piValidateConfiguration :: ConfigValidationFunction c d r'
_piValidateConfiguration = ConfigValidationFunction c d r'
c
    , _piConfigurationFiles :: [ConfigFile]
_piConfigurationFiles = ProgramInfoValidate' a b r -> [ConfigFile]
forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> [ConfigFile]
_piConfigurationFiles ProgramInfoValidate' a b r
s
    }
  where
    g :: ProgramInfoValidate' a f r
-> (MParser a, a, ConfigValidationFunction a f r)
g ProgramInfoValidate' a f r
s = (ProgramInfoValidate' a f r -> MParser a
forall a (f :: * -> *) r. ProgramInfoValidate' a f r -> MParser a
_piOptionParser ProgramInfoValidate' a f r
s, ProgramInfoValidate' a f r -> a
forall a (f :: * -> *) r. ProgramInfoValidate' a f r -> a
_piDefaultConfiguration ProgramInfoValidate' a f r
s, ProgramInfoValidate' a f r -> ConfigValidationFunction a f r
forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> ConfigValidationFunction a f r
_piValidateConfiguration ProgramInfoValidate' a f r
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 =
    String
-> MParser a
-> a
-> (forall {m :: * -> *}.
    (MonadIO m, Functor m, Applicative m, MonadError Text m,
     MonadWriter [Text] m) =>
    a -> m ())
-> ProgramInfoValidate' a [] a
forall a (f :: * -> *).
String
-> MParser a
-> a
-> ConfigValidation a f
-> ProgramInfoValidate a f
programInfoValidate String
desc MParser a
parser a
defaultConfig ((forall {m :: * -> *}.
  (MonadIO m, Functor m, Applicative m, MonadError Text m,
   MonadWriter [Text] m) =>
  a -> m ())
 -> ProgramInfoValidate' a [] a)
-> (forall {m :: * -> *}.
    (MonadIO m, Functor m, Applicative m, MonadError Text m,
     MonadWriter [Text] m) =>
    a -> m ())
-> ProgramInfoValidate' a [] a
forall a b. (a -> b) -> a -> b
$ m () -> a -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall a. a -> m a
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 r
    → ProgramInfoValidate' a f r
programInfoValidate' :: forall a (f :: * -> *) r.
String
-> MParser a
-> a
-> ConfigValidation' a f r
-> ProgramInfoValidate' a f r
programInfoValidate' String
desc MParser a
parser a
defaultConfig ConfigValidation' a f r
valFunc = 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 r
_piValidateConfiguration = ConfigValidation' a f r -> ConfigValidationFunction a f r
forall a (f :: * -> *) r.
ConfigValidation' a f r -> ConfigValidationFunction a f r
ConfigValidationFunction a -> m r
ConfigValidation' a f r
valFunc
    , _piConfigurationFiles :: [ConfigFile]
_piConfigurationFiles = []
    }

-- | 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 =
    String
-> MParser a
-> a
-> (forall {m :: * -> *}.
    (MonadIO m, Functor m, Applicative m, MonadError Text m,
     MonadWriter (f Text) m) =>
    a -> m a)
-> ProgramInfoValidate' a f a
forall a (f :: * -> *) r.
String
-> MParser a
-> a
-> ConfigValidation' a f r
-> ProgramInfoValidate' a f r
programInfoValidate' String
desc MParser a
parser a
defaultConfig ((forall {m :: * -> *}.
  (MonadIO m, Functor m, Applicative m, MonadError Text m,
   MonadWriter (f Text) m) =>
  a -> m a)
 -> ProgramInfoValidate' a f a)
-> (forall {m :: * -> *}.
    (MonadIO m, Functor m, Applicative m, MonadError Text m,
     MonadWriter (f Text) m) =>
    a -> m a)
-> ProgramInfoValidate' a f a
forall a b. (a -> b) -> a -> b
$ \a
c -> a -> m ()
ConfigValidation a f
valFunc a
c m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
c

-- -------------------------------------------------------------------------- --
-- 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 a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail PrintConfigMode -> Parser PrintConfigMode
forall a. a -> Parser a
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
    { 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
    }
    deriving (forall a b. (a -> b) -> AppConfiguration a -> AppConfiguration b)
-> (forall a b. a -> AppConfiguration b -> AppConfiguration a)
-> Functor AppConfiguration
forall a b. a -> AppConfiguration b -> AppConfiguration a
forall a b. (a -> b) -> AppConfiguration a -> AppConfiguration b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AppConfiguration a -> AppConfiguration b
fmap :: forall a b. (a -> b) -> AppConfiguration a -> AppConfiguration b
$c<$ :: forall a b. a -> AppConfiguration b -> AppConfiguration a
<$ :: forall a b. a -> AppConfiguration b -> AppConfiguration a
Functor

-- | 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 (f :: * -> *).
Functor f =>
([ConfigFile] -> f [ConfigFile])
-> AppConfiguration a -> f (AppConfiguration a)
configFiles = (AppConfiguration a -> [ConfigFile])
-> (AppConfiguration a -> [ConfigFile] -> AppConfiguration a)
-> forall {f :: * -> *}.
   Functor f =>
   ([ConfigFile] -> f [ConfigFile])
   -> AppConfiguration a -> f (AppConfiguration a)
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)
 -> forall {f :: * -> *}.
    Functor f =>
    ([ConfigFile] -> f [ConfigFile])
    -> AppConfiguration a -> f (AppConfiguration a))
-> (AppConfiguration a -> [ConfigFile] -> AppConfiguration a)
-> forall {f :: * -> *}.
   Functor f =>
   ([ConfigFile] -> f [ConfigFile])
   -> AppConfiguration a -> f (AppConfiguration a)
forall a b. (a -> b) -> a -> b
$ \AppConfiguration a
s [ConfigFile]
a → AppConfiguration a
s { _configFiles = 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 (f :: * -> *).
Functor f =>
(a -> f b) -> AppConfiguration a -> f (AppConfiguration b)
mainConfig = (AppConfiguration a -> a)
-> (AppConfiguration a -> b -> AppConfiguration b)
-> forall {f :: * -> *}.
   Functor f =>
   (a -> f b) -> AppConfiguration a -> f (AppConfiguration 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)
 -> forall {f :: * -> *}.
    Functor f =>
    (a -> f b) -> AppConfiguration a -> f (AppConfiguration b))
-> (AppConfiguration a -> b -> AppConfiguration b)
-> forall {f :: * -> *}.
   Functor f =>
   (a -> f b) -> AppConfiguration a -> f (AppConfiguration b)
forall a b. (a -> b) -> a -> b
$ \AppConfiguration a
s b
a → AppConfiguration a
s { _mainConfig = 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 = 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 a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MParser ConfigFilesConfig
pConfigFilesConfig MParser ConfigFilesConfig
-> Parser ConfigFilesConfig -> Parser ConfigFilesConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConfigFilesConfig -> Parser ConfigFilesConfig
forall a. a -> Parser a
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 a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ConfigFile -> Parser [ConfigFile]
forall a. Parser a -> Parser [a]
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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a. Parser a -> Parser a -> Parser a
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 a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe PrintConfigMode -> Parser (Maybe PrintConfigMode)
forall a. a -> Parser a
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 r
        -- ^ program info value; use 'programInfo' to construct a value of this
        -- type
    → (r → IO ())
        -- ^ computation that is given the configuration that is parsed from
        -- the command line.
    → IO ()
runWithConfiguration :: forall a (f :: * -> *) r.
(FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) =>
ProgramInfoValidate' a f r -> (r -> IO ()) -> IO ()
runWithConfiguration ProgramInfoValidate' a f r
appInfo = ProgramInfoValidate' a f r
-> (forall b. Maybe (MParser b)) -> (r -> IO ()) -> IO ()
forall a (f :: * -> *) r.
(FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) =>
ProgramInfoValidate' a f r
-> (forall b. Maybe (MParser b)) -> (r -> IO ()) -> IO ()
runInternal ProgramInfoValidate' a f r
appInfo Maybe (MParser b)
forall a. Maybe a
forall b. Maybe (MParser b)
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) =
    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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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) -> Parser (a -> a) -> Parser (a -> a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (a -> 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 :: 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 =
    ProgramInfoValidate a f
-> (forall b. Maybe (MParser b)) -> (a -> IO ()) -> IO ()
forall a (f :: * -> *) r.
(FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) =>
ProgramInfoValidate' a f r
-> (forall b. Maybe (MParser b)) -> (r -> 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 r . FromJSON (a → a)
    ⇒ ProgramInfoValidate' a f r
        -- ^ 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 :: * -> *) r.
FromJSON (a -> a) =>
ProgramInfoValidate' a f r
-> (forall b. Maybe (MParser b))
-> ParserInfo (AppConfiguration (a -> a))
mainOptions ProgramInfo{a
String
[ConfigFile]
Maybe String
MParser a
ConfigValidationFunction a f r
_piDescription :: forall a (f :: * -> *) r. ProgramInfoValidate' a f r -> String
_piHelpHeader :: forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> Maybe String
_piHelpFooter :: forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> Maybe String
_piOptionParser :: forall a (f :: * -> *) r. ProgramInfoValidate' a f r -> MParser a
_piDefaultConfiguration :: forall a (f :: * -> *) r. ProgramInfoValidate' a f r -> a
_piValidateConfiguration :: forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> ConfigValidationFunction a f r
_piConfigurationFiles :: forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> [ConfigFile]
_piDescription :: String
_piHelpHeader :: Maybe String
_piHelpFooter :: Maybe String
_piOptionParser :: MParser a
_piDefaultConfiguration :: a
_piValidateConfiguration :: ConfigValidationFunction a f r
_piConfigurationFiles :: [ConfigFile]
..} 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
forall {ann}. Doc ann
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
forall ann. String -> Doc ann
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
        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 a. a -> Parser 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 a b. Parser (a -> b) -> Parser a -> Parser b
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 a b. Parser (a -> b) -> Parser a -> Parser b
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.
    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)
        (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 ann
defaultFooter = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
P.vsep
        [ String -> Doc ann
forall ann. String -> Doc ann
par String
"Configurations are loaded in order from the following sources:"
        , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
P.indent Int
2 (Doc ann -> Doc ann)
-> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
P.vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ((Int -> Doc ann) -> Int -> Doc ann)
-> [Int -> Doc ann] -> [Int] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int -> Doc ann) -> Int -> Doc ann
forall a b. (a -> b) -> a -> b
($) ([Maybe (Int -> Doc ann)] -> [Int -> Doc ann]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Int -> Doc ann)
forall {ann}. Maybe (Int -> Doc ann)
staticFiles, Maybe (Int -> Doc ann)
forall {ann}. Maybe (Int -> Doc ann)
cmdFiles, Maybe (Int -> Doc ann)
forall {ann}. Maybe (Int -> Doc ann)
cmdOptions]) [Int
1..]
        , Doc ann
""
        , [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
P.fillSep
            [ String -> Doc ann
forall ann. String -> Doc ann
par String
"Configuration file locations can be either local file system paths"
            , String -> Doc ann
forall ann. String -> Doc ann
par String
"or remote HTTP or HTTPS URLs. Remote URLs must start with"
            , String -> Doc ann
forall ann. String -> Doc ann
par String
"either \"http://\" or \"https://\"."
            ]
        , Doc ann
""
        , [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
P.fillSep
            [ String -> Doc ann
forall ann. String -> Doc ann
par String
"Configuration settings that are loaded later overwrite settings"
            , String -> Doc ann
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 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall {ann}. Doc ann
P.softline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
b

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

    printConfigFile :: ConfigFile -> Doc ann
printConfigFile ConfigFile
f = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
P.pretty (ConfigFile -> Text
getConfigFile ConfigFile
f) Doc ann -> Doc ann -> Doc ann
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 = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
P.fillSep ([Doc ann] -> Doc ann)
-> (String -> [Doc ann]) -> String -> Doc ann
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (String -> Doc ann) -> [String] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
P.pretty ([String] -> [Doc ann])
-> (String -> [String]) -> String -> [Doc ann]
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ String -> [String]
words

-- | Internal main function
--
runInternal
    ∷ (FromJSON (a → a), ToJSON a, Foldable f, Monoid (f T.Text))
    ⇒ ProgramInfoValidate' a f r
        -- ^ 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.
    → (r → IO ())
        -- ^ computation that is given the configuration that is parsed from
        -- the command line.
    → IO ()
runInternal :: forall a (f :: * -> *) r.
(FromJSON (a -> a), ToJSON a, Foldable f, Monoid (f Text)) =>
ProgramInfoValidate' a f r
-> (forall b. Maybe (MParser b)) -> (r -> IO ()) -> IO ()
runInternal ProgramInfoValidate' a f r
appInfo forall b. Maybe (MParser b)
maybePkgInfo r -> 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 (f :: * -> *).
Functor f =>
([ConfigFile] -> f [ConfigFile])
-> AppConfiguration a -> f (AppConfiguration a)
configFiles (([ConfigFile] -> Identity [ConfigFile])
 -> AppConfiguration (a -> a)
 -> Identity (AppConfiguration (a -> a)))
-> ([ConfigFile] -> [ConfigFile])
-> AppConfiguration (a -> a)
-> AppConfiguration (a -> a)
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
`over` [ConfigFile] -> [ConfigFile] -> [ConfigFile]
forall α. Monoid α => α -> α -> α
(⊕) (ProgramInfoValidate' a f r -> [ConfigFile]
forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> [ConfigFile]
_piConfigurationFiles ProgramInfoValidate' a f r
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 r
-> (forall b. Maybe (MParser b))
-> ParserInfo (AppConfiguration (a -> a))
forall a (f :: * -> *) r.
FromJSON (a -> a) =>
ProgramInfoValidate' a f r
-> (forall b. Maybe (MParser b))
-> ParserInfo (AppConfiguration (a -> a))
mainOptions ProgramInfoValidate' a f r
appInfo Maybe (MParser b)
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 (f :: * -> *).
Functor f =>
(a -> f b) -> AppConfiguration a -> f (AppConfiguration 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 r -> a
forall a (f :: * -> *) r. ProgramInfoValidate' a f r -> a
_piDefaultConfiguration ProgramInfoValidate' a f r
appInfo)
        (AppConfiguration (a -> a) -> [ConfigFile]
forall a. AppConfiguration a -> [ConfigFile]
_configFiles AppConfiguration (a -> a)
cliAppConf)

    -- Validate final configuration
    r
validatedConf ← ProgramInfoValidate' a f r -> a -> IO r
forall (f :: * -> *) a r.
(Foldable f, Monoid (f Text)) =>
ProgramInfoValidate' a f r -> a -> IO r
validateConfig ProgramInfoValidate' a f r
appInfo (a -> IO r) -> a -> IO r
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 → r -> IO ()
mainFunction (r -> IO ())
-> (AppConfiguration r -> r) -> AppConfiguration r -> IO ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ AppConfiguration r -> r
forall a. AppConfiguration a -> a
_mainConfig (AppConfiguration r -> IO ()) -> AppConfiguration r -> IO ()
forall a b. (a -> b) -> a -> b
$ r
validatedConf r -> AppConfiguration a -> AppConfiguration r
forall a b. a -> AppConfiguration b -> AppConfiguration a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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 r -> a
forall a (f :: * -> *) r. ProgramInfoValidate' a f r -> a
_piDefaultConfiguration ProgramInfoValidate' a f r
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 r -> a
forall a (f :: * -> *) r. ProgramInfoValidate' a f r -> a
_piDefaultConfiguration ProgramInfoValidate' a f r
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 r
        -- ^ program info value; use 'programInfo' to construct a value of this
        -- type
    → [String]
        -- ^ command line arguments
    → m a
parseConfiguration :: forall (m :: * -> *) a (f :: * -> *) r.
(Applicative m, MonadIO m, MonadError Text m, FromJSON (a -> a),
 ToJSON a, Foldable f, Monoid (f Text)) =>
Text -> ProgramInfoValidate' a f r -> [String] -> m a
parseConfiguration Text
appName ProgramInfoValidate' a f r
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 r
-> (forall b. Maybe (MParser b))
-> ParserInfo (AppConfiguration (a -> a))
forall a (f :: * -> *) r.
FromJSON (a -> a) =>
ProgramInfoValidate' a f r
-> (forall b. Maybe (MParser b))
-> ParserInfo (AppConfiguration (a -> a))
mainOptions ProgramInfoValidate' a f r
appInfo Maybe (MParser b)
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 a. a -> m 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 (f :: * -> *).
Functor f =>
([ConfigFile] -> f [ConfigFile])
-> AppConfiguration a -> f (AppConfiguration a)
configFiles (([ConfigFile] -> Identity [ConfigFile])
 -> AppConfiguration (a -> a)
 -> Identity (AppConfiguration (a -> a)))
-> ([ConfigFile] -> [ConfigFile])
-> AppConfiguration (a -> a)
-> AppConfiguration (a -> a)
forall s t a b. Setter s t a b -> (a -> b) -> s -> t
`over` [ConfigFile] -> [ConfigFile] -> [ConfigFile]
forall α. Monoid α => α -> α -> α
(⊕) (ProgramInfoValidate' a f r -> [ConfigFile]
forall a (f :: * -> *) r.
ProgramInfoValidate' a f r -> [ConfigFile]
_piConfigurationFiles ProgramInfoValidate' a f r
appInfo)
        O.Failure ParserFailure ParserHelp
e → Text -> m (AppConfiguration (a -> a))
forall a. Text -> m 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 a. Text -> m 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 (f :: * -> *).
Functor f =>
(a -> f b) -> AppConfiguration a -> f (AppConfiguration 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 r -> a
forall a (f :: * -> *) r. ProgramInfoValidate' a f r -> a
_piDefaultConfiguration ProgramInfoValidate' a f r
appInfo)
        (AppConfiguration (a -> a) -> [ConfigFile]
forall a. AppConfiguration a -> [ConfigFile]
_configFiles AppConfiguration (a -> a)
cliAppConf)

    -- Validate final configuration
    m (r, f Text) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (r, f Text) -> m ()) -> (a -> m (r, f Text)) -> a -> m ()
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ ProgramInfoValidate' a f r -> a -> m (r, f Text)
forall {f :: * -> *} {m :: * -> *} {a} {a}.
(Monoid (f Text), MonadIO m, MonadError Text m) =>
ProgramInfoValidate' a f a -> a -> m (a, f Text)
validate ProgramInfoValidate' a f r
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 a. 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 -> a -> m (a, f Text)
validate ProgramInfoValidate' a f a
i a
conf = WriterT (f Text) m a -> m (a, f Text)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT (f Text) m a -> m (a, f Text))
-> WriterT (f Text) m a -> m (a, f Text)
forall a b. (a -> b) -> a -> b
$
        ConfigValidationFunction a f a -> ConfigValidation' a f a
forall a (f :: * -> *) r.
ConfigValidationFunction a f r -> ConfigValidation' a f r
runConfigValidation (((ConfigValidationFunction a f a
  -> Const
       (ConfigValidationFunction a f a) (ConfigValidationFunction a f a))
 -> ProgramInfoValidate' a f a
 -> Const
      (ConfigValidationFunction a f a) (ProgramInfoValidate' a f a))
-> ProgramInfoValidate' a f a -> ConfigValidationFunction a f a
forall r (m :: * -> *) a.
MonadReader r m =>
((a -> Const a a) -> r -> Const a r) -> m a
view (ConfigValidationFunction a f a
 -> Const
      (ConfigValidationFunction a f a) (ConfigValidationFunction a f a))
-> ProgramInfoValidate' a f a
-> Const
     (ConfigValidationFunction a f a) (ProgramInfoValidate' a f a)
forall a (f :: * -> *) r (f :: * -> *).
Functor f =>
(ConfigValidationFunction a f r
 -> f (ConfigValidationFunction a f r))
-> ProgramInfoValidate' a f r -> f (ProgramInfoValidate' a f r)
piValidateConfiguration ProgramInfoValidate' a f a
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 r
    → a
    → IO r
validateConfig :: forall (f :: * -> *) a r.
(Foldable f, Monoid (f Text)) =>
ProgramInfoValidate' a f r -> a -> IO r
validateConfig ProgramInfoValidate' a f r
appInfo a
conf = do
    (r
r, f Text
warnings) ← WriterT (f Text) IO r -> IO (r, f Text)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT (f Text) IO r -> IO (r, f Text))
-> (ExceptT Text (WriterT (f Text) IO) r -> WriterT (f Text) IO r)
-> ExceptT Text (WriterT (f Text) IO) r
-> IO (r, f Text)
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ (Text -> WriterT (f Text) IO r)
-> (r -> WriterT (f Text) IO r)
-> ExceptT Text (WriterT (f Text) IO) r
-> WriterT (f Text) IO r
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 r
forall a. HasCallStack => String -> a
error (String -> WriterT (f Text) IO r)
-> (Text -> String) -> Text -> WriterT (f Text) IO r
forall β γ α. (β -> γ) -> (α -> β) -> α -> γ
∘ Text -> String
T.unpack) r -> WriterT (f Text) IO r
forall a. a -> WriterT (f Text) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExceptT Text (WriterT (f Text) IO) r -> IO (r, f Text))
-> ExceptT Text (WriterT (f Text) IO) r -> IO (r, f Text)
forall a b. (a -> b) -> a -> b
$
        ConfigValidationFunction a f r -> ConfigValidation' a f r
forall a (f :: * -> *) r.
ConfigValidationFunction a f r -> ConfigValidation' a f r
runConfigValidation (((ConfigValidationFunction a f r
  -> Const
       (ConfigValidationFunction a f r) (ConfigValidationFunction a f r))
 -> ProgramInfoValidate' a f r
 -> Const
      (ConfigValidationFunction a f r) (ProgramInfoValidate' a f r))
-> ProgramInfoValidate' a f r -> ConfigValidationFunction a f r
forall r (m :: * -> *) a.
MonadReader r m =>
((a -> Const a a) -> r -> Const a r) -> m a
view (ConfigValidationFunction a f r
 -> Const
      (ConfigValidationFunction a f r) (ConfigValidationFunction a f r))
-> ProgramInfoValidate' a f r
-> Const
     (ConfigValidationFunction a f r) (ProgramInfoValidate' a f r)
forall a (f :: * -> *) r (f :: * -> *).
Functor f =>
(ConfigValidationFunction a f r
 -> f (ConfigValidationFunction a f r))
-> ProgramInfoValidate' a f r -> f (ProgramInfoValidate' a f r)
piValidateConfiguration ProgramInfoValidate' a f r
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
    r -> IO r
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return r
r