    ------------------------------------------------------------------------
    -- |
    -- Module      : What4.Config
    -- Description : Declares attributes for simulator configuration settings.
    -- Copyright   : (c) Galois, Inc 2015-2020
    -- License     : BSD3
    -- Maintainer  : Rob Dockins <rdockins@galois.com>
    -- Stability   : provisional
    --
    -- This module provides access to persistent configuration settings, and
    -- is designed for access both by Haskell client code of the What4 library,
    -- and by users of the systems ultimately built using the library, for example,
    -- from within a user-facing REPL.
    --
    -- Configurations are defined dynamically by combining a collection of
    -- configuration option descriptions.  This allows disparate modules
    -- to define their own configuration options, rather than having to
    -- define the options for all modules in a central place.  Every
    -- configuration option has a name, which consists of a nonempty
    -- sequence of period-separated strings.  The intention is that option
    -- names should conform to a namespace hierarchy both for
    -- organizational purposes and to avoid namespace conflicts.  For
    -- example, the options for an \"asdf\" module might be named as:
    --
    --    * asdf.widget
    --    * asdf.frob
    --    * asdf.max_bound
    --
    -- At runtime, a configuration consists of a collection of nested
    -- finite maps corresponding to the namespace tree of the existing
    -- options.  A configuration option may be queried or set either by
    -- using a raw string representation of the name (see
    -- @getOptionSettingFromText@), or by using a `ConfigOption` value
    -- (using @getOptionSetting@), which provides a modicum of type-safety
    -- over the basic dynamically-typed configuration maps.
    --
    -- Each option is associated with an \"option style\", which describes
    -- the underlying type of the option (e.g., integer, boolean, string,
    -- etc.) as well as the allowed settings of that value.  In addition,
    -- options can take arbitrary actions when their values are changed in
    -- the @opt_onset@ callback.
    --
    -- Every configuration comes with the built-in `verbosity`
    -- configuration option pre-defined.  A `Config` value is constructed
    -- using the `initialConfig` operation, which should be given the
    -- initial verbosity value and a collection of configuration options
    -- to install.  A configuration may be later extended with additional
    -- options by using the `extendConfig` operation.
    --
    -- Example use (assuming you wanted to use the z3 solver):
    --
    -- > import What4.Solver
    -- >
    -- > setupSolverConfig :: (IsExprBuilder sym) -> sym -> IO ()
    -- > setupSolverConfig sym = do
    -- >   let cfg = getConfiguration sym
    -- >   extendConfig (solver_adapter_config_options z3Adapter) cfg
    -- >   z3PathSetter <- getOptionSetting z3Path
    -- >   res <- setOpt z3PathSetter "/usr/bin/z3"
    -- >   assert (null res) (return ())
    --
    -- Developer's note: we might want to add the following operations:
    --
    --   * a method for \"unsetting\" options to restore the default state of an option
    --   * a method for removing options from a configuration altogether
    --       (i.e., to undo extendConfig)
    --
    --
    -- Note regarding concurrency: the configuration data structures in
    -- this module are implemented using MVars, and may safely be used in
    -- a multithreaded way; configuration changes made in one thread will
    -- be visible to others in a properly synchronized way.  Of course, if
    -- one desires to isolate configuration changes in different threads
    -- from each other, separate configuration objects are required. The
    -- @splitConfig@ operation may be useful to partially isolate
    -- configuration objects.  As noted in the documentation for
    -- 'opt_onset', the validation procedures for options should not look
    -- up the value of other options, or deadlock may occur.
    ------------------------------------------------------------------------------
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FunctionalDependencies #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}
    module What4.Config
      ( -- * Names of properties
        ConfigOption
      , configOption
      , configOptionType
      , configOptionName
      , configOptionText
      , configOptionNameParts

        -- * Option settings
      , OptionSetting(..)
      , Opt(..)
      , setUnicodeOpt
      , setIntegerOpt
      , setBoolOpt

        -- * Defining option styles
      , OptionStyle(..)
      , set_opt_default
      , set_opt_onset

        -- ** OptionSetResult
      , OptionSetResult(..)
      , optOK
      , optWarn
      , optErr
      , checkOptSetResult
      , OptSetFailure(..)
      , OptGetFailure(..)
      , OptCreateFailure(..)

        -- ** Option style templates
      , Bound(..)
      , boolOptSty
      , integerOptSty
      , realOptSty
      , stringOptSty
      , realWithRangeOptSty
      , realWithMinOptSty
      , realWithMaxOptSty
      , integerWithRangeOptSty
      , integerWithMinOptSty
      , integerWithMaxOptSty
      , enumOptSty
      , listOptSty
      , executablePathOptSty

        -- * Describing configuration options
      , ConfigDesc
      , mkOpt
      , opt
      , optV
      , optU
      , optUV
      , copyOpt
      , deprecatedOpt

        -- * Building and manipulating configurations
      , Config
      , initialConfig
      , extendConfig
      , tryExtendConfig
      , splitConfig

      , getOptionSetting
      , getOptionSettingFromText

        -- * Extracting entire subtrees of the current configuration
      , ConfigValue(..)
      , getConfigValues

        -- * Printing help messages for configuration options
      , configHelp

        -- * Verbosity
      , verbosity
      , verbosityLogger
      ) where

    import           Control.Applicative ( Const(..), (<|>) )
    import           Control.Concurrent.MVar
    import qualified Control.Concurrent.ReadWriteVar as RWV
    import           Control.Lens ((&))
    import qualified Control.Lens.Combinators as LC
    import           Control.Monad (foldM, when)
    import           Control.Monad.Catch
    import           Control.Monad.IO.Class
    import           Control.Monad.Writer.Strict (MonadWriter(..), WriterT, execWriterT)
    import           Data.Foldable (toList)
    import           Data.Kind
    import           Data.List.NonEmpty (NonEmpty(..))
    import           Data.Map (Map)
    import qualified Data.Map.Strict as Map
    import           Data.Maybe
    import           Data.Parameterized.Classes
    import           Data.Parameterized.Some
    import           Data.Sequence (Seq)
    import qualified Data.Sequence as Seq
    import           Data.Set (Set)
    import qualified Data.Set as Set
    import           Data.Text (Text)
    import qualified Data.Text as Text
    import           Data.Void
    import           System.IO ( Handle, hPutStr )
    import           System.IO.Error ( ioeGetErrorString )

    import           Prettyprinter hiding (Unbounded)

    import           What4.BaseTypes
    import           What4.Concrete
    import qualified What4.Utils.Environment as Env
    import           What4.Utils.StringLiteral

    -------------------------------------------------------------------------
    -- ConfigOption

    -- | A Haskell-land wrapper around the name of a configuration option.
    --   Developers are encouraged to define and use `ConfigOption` values
    --   to avoid two classes of errors: typos in configuration option names;
    --   and dynamic type-cast failures.  Both classes of errors can be lifted
    --   to statically-checkable failures (missing symbols and type-checking,
    --   respectively) by consistently using `ConfigOption` values.
    --
    --   The following example indicates the suggested usage
    --
    -- @
    --   asdfFrob :: ConfigOption BaseRealType
    --   asdfFrob = configOption BaseRealRepr "asdf.frob"
    --
    --   asdfMaxBound :: ConfigOption BaseIntegerType
    --   asdfMaxBound = configOption BaseIntegerRepr "asdf.max_bound"
    -- @
    data ConfigOption (tp :: BaseType) where
      ConfigOption :: BaseTypeRepr tp -> NonEmpty Text -> ConfigOption tp

    instance Show (ConfigOption tp) where
      show :: ConfigOption tp -> String
    show = ConfigOption tp -> String
    forall (tp :: BaseType). ConfigOption tp -> String
    configOptionName

    -- | Construct a `ConfigOption` from a string name.  Idiomatic usage is
    --   to define a single top-level `ConfigOption` value in the module where the option
    --   is defined to consistently fix its name and type for all subsequent uses.
    configOption :: BaseTypeRepr tp -> String -> ConfigOption tp
    configOption :: forall (tp :: BaseType).
    BaseTypeRepr tp -> String -> ConfigOption tp
    configOption BaseTypeRepr tp
    tp String
    nm =
      case Text -> Maybe (NonEmpty Text)
    splitPath (String -> Text
    Text.pack String
    nm) of
        Just NonEmpty Text
    ps -> BaseTypeRepr tp -> NonEmpty Text -> ConfigOption tp
    forall (tp :: BaseType).
    BaseTypeRepr tp -> NonEmpty Text -> ConfigOption tp
    ConfigOption BaseTypeRepr tp
    tp NonEmpty Text
    ps
        Maybe (NonEmpty Text)
    Nothing -> String -> ConfigOption tp
    forall a. HasCallStack => String -> a
    error String
    "config options cannot have an empty name"

    -- | Split a text value on \' characters.  Return @Nothing@ if
    --   the whole string, or any of its segments, is the empty string.
    splitPath :: Text -> Maybe (NonEmpty Text)
    splitPath :: Text -> Maybe (NonEmpty Text)
    splitPath Text
    nm =
       let nms :: [Text]
    nms = HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    Text.splitOn Text
    "." Text
    nm in
       case [Text]
    nms of
         (Text
    x:[Text]
    xs) | (Text -> Bool) -> [Text] -> Bool
    forall (t :: Type -> Type) a.
    Foldable t =>
    (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Bool
    Text.null) (Text
    xText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    xs) -> NonEmpty Text -> Maybe (NonEmpty Text)
    forall a. a -> Maybe a
    Just (Text
    xText -> [Text] -> NonEmpty Text
    forall a. a -> [a] -> NonEmpty a
    :|[Text]
    xs)
         [Text]
    _ -> Maybe (NonEmpty Text)
    forall a. Maybe a
    Nothing

    -- | Get the individual dot-separated segments of an option's name.
    configOptionNameParts :: ConfigOption tp -> [Text]
    configOptionNameParts :: forall (tp :: BaseType). ConfigOption tp -> [Text]
    configOptionNameParts (ConfigOption BaseTypeRepr tp
    _ (Text
    x:|[Text]
    xs)) = Text
    xText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    xs

    -- | Reconstruct the original string name of this option.
    configOptionName :: ConfigOption tp -> String
    configOptionName :: forall (tp :: BaseType). ConfigOption tp -> String
    configOptionName = Text -> String
    Text.unpack (Text -> String)
    -> (ConfigOption tp -> Text) -> ConfigOption tp -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConfigOption tp -> Text
    forall (tp :: BaseType). ConfigOption tp -> Text
    configOptionText

    -- | Reconstruct the original string name of this option.
    configOptionText :: ConfigOption tp -> Text
    configOptionText :: forall (tp :: BaseType). ConfigOption tp -> Text
    configOptionText (ConfigOption BaseTypeRepr tp
    _ (Text
    x:|[Text]
    xs)) = Text -> [Text] -> Text
    Text.intercalate Text
    "." ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Text
    xText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    xs)

    -- | Retrieve the run-time type representation of @tp@.
    configOptionType :: ConfigOption tp -> BaseTypeRepr tp
    configOptionType :: forall (tp :: BaseType). ConfigOption tp -> BaseTypeRepr tp
    configOptionType (ConfigOption BaseTypeRepr tp
    tp NonEmpty Text
    _) = BaseTypeRepr tp
    tp

    ------------------------------------------------------------------------------
    -- OptionSetResult

    -- | When setting the value of an option, a validation function is called
    --   (as defined by the associated @OptionStyle@).  The result of the validation
    --   function is an @OptionSetResult@.  If the option value given is invalid
    --   for some reason, an error should be returned.  Additionally, warning messages
    --   may be returned, which will be passed through to the eventual call site
    --   attempting to alter the option setting.
    data OptionSetResult =
      OptionSetResult
      { OptionSetResult -> Maybe (Doc Void)
    optionSetError    :: !(Maybe (Doc Void))
      , OptionSetResult -> Seq (Doc Void)
    optionSetWarnings :: !(Seq (Doc Void))
      }

    instance Semigroup OptionSetResult where
      OptionSetResult
    x <> :: OptionSetResult -> OptionSetResult -> OptionSetResult
    <> OptionSetResult
    y = OptionSetResult
                { optionSetError :: Maybe (Doc Void)
    optionSetError    = OptionSetResult -> Maybe (Doc Void)
    optionSetError OptionSetResult
    x Maybe (Doc Void) -> Maybe (Doc Void) -> Maybe (Doc Void)
    forall a. Semigroup a => a -> a -> a
    <> OptionSetResult -> Maybe (Doc Void)
    optionSetError OptionSetResult
    y
                , optionSetWarnings :: Seq (Doc Void)
    optionSetWarnings = OptionSetResult -> Seq (Doc Void)
    optionSetWarnings OptionSetResult
    x Seq (Doc Void) -> Seq (Doc Void) -> Seq (Doc Void)
    forall a. Semigroup a => a -> a -> a
    <> OptionSetResult -> Seq (Doc Void)
    optionSetWarnings OptionSetResult
    y
                }

    instance Monoid OptionSetResult where
      mappend :: OptionSetResult -> OptionSetResult -> OptionSetResult
    mappend = OptionSetResult -> OptionSetResult -> OptionSetResult
    forall a. Semigroup a => a -> a -> a
    (<>)
      mempty :: OptionSetResult
    mempty  = OptionSetResult
    optOK

    -- | Accept the new option value with no errors or warnings.
    optOK :: OptionSetResult
    optOK :: OptionSetResult
    optOK = OptionSetResult{ optionSetError :: Maybe (Doc Void)
    optionSetError = Maybe (Doc Void)
    forall a. Maybe a
    Nothing, optionSetWarnings :: Seq (Doc Void)
    optionSetWarnings = Seq (Doc Void)
    forall a. Monoid a => a
    mempty }

    -- | Reject the new option value with an error message.
    optErr :: Doc Void -> OptionSetResult
    optErr :: Doc Void -> OptionSetResult
    optErr Doc Void
    x = OptionSetResult{ optionSetError :: Maybe (Doc Void)
    optionSetError = Doc Void -> Maybe (Doc Void)
    forall a. a -> Maybe a
    Just Doc Void
    x, optionSetWarnings :: Seq (Doc Void)
    optionSetWarnings = Seq (Doc Void)
    forall a. Monoid a => a
    mempty }

    -- | Accept the given option value, but report a warning message.
    optWarn :: Doc Void -> OptionSetResult
    optWarn :: Doc Void -> OptionSetResult
    optWarn Doc Void
    x = OptionSetResult{ optionSetError :: Maybe (Doc Void)
    optionSetError = Maybe (Doc Void)
    forall a. Maybe a
    Nothing, optionSetWarnings :: Seq (Doc Void)
    optionSetWarnings = Doc Void -> Seq (Doc Void)
    forall a. a -> Seq a
    Seq.singleton Doc Void
    x }

    -- | An @OptionSetting@ gives the direct ability to query or set the current value
    --   of an option.  The @getOption@ field is an action that, when executed, fetches
    --   the current value of the option, if it is set.  The @setOption@ method attempts
    --   to set the value of the option.  If the associated @opt_onset@ validation method
    --   rejects the option, it will retain its previous value; otherwise it will be set
    --   to the given value.  In either case, the generated @OptionSetResult@ will be
    --   returned.
    data OptionSetting (tp :: BaseType) =
      OptionSetting
      { forall (tp :: BaseType). OptionSetting tp -> ConfigOption tp
    optionSettingName :: ConfigOption tp
      , forall (tp :: BaseType).
    OptionSetting tp -> IO (Maybe (ConcreteVal tp))
    getOption :: IO (Maybe (ConcreteVal tp))
      , forall (tp :: BaseType).
    OptionSetting tp -> ConcreteVal tp -> IO OptionSetResult
    setOption :: ConcreteVal tp -> IO OptionSetResult
      }

    instance Show (OptionSetting tp) where
      show :: OptionSetting tp -> String
    show = (String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " option setting") ShowS -> (OptionSetting tp -> String) -> OptionSetting tp -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
             Char -> ShowS
    forall s a. Cons s s a a => a -> s -> s
    LC.cons Char
    '\'' ShowS -> (OptionSetting tp -> String) -> OptionSetting tp -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Char -> String) -> Char -> ShowS
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> Char -> String
    forall s a. Snoc s s a a => s -> a -> s
    LC.snoc Char
    '\'' ShowS -> (OptionSetting tp -> String) -> OptionSetting tp -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
             ConfigOption tp -> String
    forall a. Show a => a -> String
    show (ConfigOption tp -> String)
    -> (OptionSetting tp -> ConfigOption tp)
    -> OptionSetting tp
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OptionSetting tp -> ConfigOption tp
    forall (tp :: BaseType). OptionSetting tp -> ConfigOption tp
    optionSettingName
    instance ShowF OptionSetting

    -- | An option defines some metadata about how a configuration option behaves.
    --   It contains a base type representation, which defines the runtime type
    --   that is expected for setting and querying this option at runtime.
    data OptionStyle (tp :: BaseType) =
      OptionStyle
      { forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type :: BaseTypeRepr tp
        -- ^ base type representation of this option

      , forall (tp :: BaseType).
    OptionStyle tp
    -> Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    opt_onset :: Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
        -- ^ An operation for validating new option values.  This action may also
        -- be used to take actions whenever an option setting is changed.  NOTE!
        -- the onset action should not attempt to look up the values of other
        -- configuration settings, or deadlock may occur.
        --
        -- The first argument is the current value of the option (if any).
        -- The second argument is the new value that is being set.
        -- If the validation fails, the operation should return a result
        -- describing why validation failed. Optionally, warnings may also be returned.

      , forall (tp :: BaseType). OptionStyle tp -> Doc Void
    opt_help :: Doc Void
        -- ^ Documentation for the option to be displayed in the event a user asks for information
        --   about this option.  This message should contain information relevant to all options in this
        --   style (e.g., its type and range of expected values), not necessarily
        --   information about a specific option.

      , forall (tp :: BaseType). OptionStyle tp -> Maybe (ConcreteVal tp)
    opt_default_value :: Maybe (ConcreteVal tp)
        -- ^ This gives a default value for the option, if set.
      }

    -- | A basic option style for the given base type.
    --   This option style performs no validation, has no
    --   help information, and has no default value.
    defaultOpt :: BaseTypeRepr tp -> OptionStyle tp
    defaultOpt :: forall (tp :: BaseType). BaseTypeRepr tp -> OptionStyle tp
    defaultOpt BaseTypeRepr tp
    tp =
      OptionStyle
      { opt_type :: BaseTypeRepr tp
    opt_type = BaseTypeRepr tp
    tp
      , opt_onset :: Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    opt_onset = \Maybe (ConcreteVal tp)
    _ ConcreteVal tp
    _ -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return OptionSetResult
    forall a. Monoid a => a
    mempty
      , opt_help :: Doc Void
    opt_help = Doc Void
    forall a. Monoid a => a
    mempty
      , opt_default_value :: Maybe (ConcreteVal tp)
    opt_default_value = Maybe (ConcreteVal tp)
    forall a. Maybe a
    Nothing
      }

    -- | Update the @opt_onset@ field.
    set_opt_onset :: (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
                     -> OptionStyle tp
                     -> OptionStyle tp
    set_opt_onset :: forall (tp :: BaseType).
    (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    set_opt_onset Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    f OptionStyle tp
    s = OptionStyle tp
    s { opt_onset = f }

    -- | Update the @opt_help@ field.
    set_opt_help :: Doc Void
                 -> OptionStyle tp
                 -> OptionStyle tp
    set_opt_help :: forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    set_opt_help Doc Void
    v OptionStyle tp
    s = OptionStyle tp
    s { opt_help = v }

    -- | Update the @opt_default_value@ field.
    set_opt_default :: ConcreteVal tp
                  -> OptionStyle tp
                  -> OptionStyle tp
    set_opt_default :: forall (tp :: BaseType).
    ConcreteVal tp -> OptionStyle tp -> OptionStyle tp
    set_opt_default ConcreteVal tp
    v OptionStyle tp
    s = OptionStyle tp
    s { opt_default_value = Just v }

    -- | An inclusive or exclusive bound.
    data Bound r = Exclusive r
                 | Inclusive r
                 | Unbounded

    -- | Standard option style for boolean-valued configuration options
    boolOptSty :: OptionStyle BaseBoolType
    boolOptSty :: OptionStyle BaseBoolType
    boolOptSty = BaseTypeRepr BaseBoolType
    -> (Maybe (ConcreteVal BaseBoolType)
        -> ConcreteVal BaseBoolType -> IO OptionSetResult)
    -> Doc Void
    -> Maybe (ConcreteVal BaseBoolType)
    -> OptionStyle BaseBoolType
    forall (tp :: BaseType).
    BaseTypeRepr tp
    -> (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> Doc Void
    -> Maybe (ConcreteVal tp)
    -> OptionStyle tp
    OptionStyle BaseTypeRepr BaseBoolType
    BaseBoolRepr
                            (\Maybe (ConcreteVal BaseBoolType)
    _ ConcreteVal BaseBoolType
    _ -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return OptionSetResult
    optOK)
                            Doc Void
    "Boolean"
                            Maybe (ConcreteVal BaseBoolType)
    forall a. Maybe a
    Nothing

    -- | Standard option style for real-valued configuration options
    realOptSty :: OptionStyle BaseRealType
    realOptSty :: OptionStyle BaseRealType
    realOptSty = BaseTypeRepr BaseRealType
    -> (Maybe (ConcreteVal BaseRealType)
        -> ConcreteVal BaseRealType -> IO OptionSetResult)
    -> Doc Void
    -> Maybe (ConcreteVal BaseRealType)
    -> OptionStyle BaseRealType
    forall (tp :: BaseType).
    BaseTypeRepr tp
    -> (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> Doc Void
    -> Maybe (ConcreteVal tp)
    -> OptionStyle tp
    OptionStyle BaseTypeRepr BaseRealType
    BaseRealRepr
                      (\Maybe (ConcreteVal BaseRealType)
    _ ConcreteVal BaseRealType
    _ -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return OptionSetResult
    optOK)
                      Doc Void
    "ℝ"
                      Maybe (ConcreteVal BaseRealType)
    forall a. Maybe a
    Nothing

    -- | Standard option style for integral-valued configuration options
    integerOptSty :: OptionStyle BaseIntegerType
    integerOptSty :: OptionStyle BaseIntegerType
    integerOptSty = BaseTypeRepr BaseIntegerType
    -> (Maybe (ConcreteVal BaseIntegerType)
        -> ConcreteVal BaseIntegerType -> IO OptionSetResult)
    -> Doc Void
    -> Maybe (ConcreteVal BaseIntegerType)
    -> OptionStyle BaseIntegerType
    forall (tp :: BaseType).
    BaseTypeRepr tp
    -> (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> Doc Void
    -> Maybe (ConcreteVal tp)
    -> OptionStyle tp
    OptionStyle BaseTypeRepr BaseIntegerType
    BaseIntegerRepr
                      (\Maybe (ConcreteVal BaseIntegerType)
    _ ConcreteVal BaseIntegerType
    _ -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return OptionSetResult
    optOK)
                      Doc Void
    "ℤ"
                      Maybe (ConcreteVal BaseIntegerType)
    forall a. Maybe a
    Nothing

    stringOptSty :: OptionStyle (BaseStringType Unicode)
    stringOptSty :: OptionStyle (BaseStringType Unicode)
    stringOptSty = BaseTypeRepr (BaseStringType Unicode)
    -> (Maybe (ConcreteVal (BaseStringType Unicode))
        -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult)
    -> Doc Void
    -> Maybe (ConcreteVal (BaseStringType Unicode))
    -> OptionStyle (BaseStringType Unicode)
    forall (tp :: BaseType).
    BaseTypeRepr tp
    -> (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> Doc Void
    -> Maybe (ConcreteVal tp)
    -> OptionStyle tp
    OptionStyle (StringInfoRepr Unicode -> BaseTypeRepr (BaseStringType Unicode)
    forall (si :: StringInfo).
    StringInfoRepr si -> BaseTypeRepr ('BaseStringType si)
    BaseStringRepr StringInfoRepr Unicode
    UnicodeRepr)
                      (\Maybe (ConcreteVal (BaseStringType Unicode))
    _ ConcreteVal (BaseStringType Unicode)
    _ -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return OptionSetResult
    optOK)
                      Doc Void
    "string"
                      Maybe (ConcreteVal (BaseStringType Unicode))
    forall a. Maybe a
    Nothing

    checkBound :: Ord a => Bound a -> Bound a -> a -> Bool
    checkBound :: forall a. Ord a => Bound a -> Bound a -> a -> Bool
    checkBound Bound a
    lo Bound a
    hi a
    a = Bound a -> a -> Bool
    forall {a}. Ord a => Bound a -> a -> Bool
    checkLo Bound a
    lo a
    a Bool -> Bool -> Bool
    && a -> Bound a -> Bool
    forall {a}. Ord a => a -> Bound a -> Bool
    checkHi a
    a Bound a
    hi
     where checkLo :: Bound a -> a -> Bool
    checkLo Bound a
    Unbounded a
    _ = Bool
    True
           checkLo (Inclusive a
    x) a
    y = a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    y
           checkLo (Exclusive a
    x) a
    y = a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <  a
    y

           checkHi :: a -> Bound a -> Bool
    checkHi a
    _ Bound a
    Unbounded     = Bool
    True
           checkHi a
    x (Inclusive a
    y) = a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    y
           checkHi a
    x (Exclusive a
    y) = a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <  a
    y

    docInterval :: Show a => Bound a -> Bound a -> Doc ann
    docInterval :: forall a ann. Show a => Bound a -> Bound a -> Doc ann
    docInterval Bound a
    lo Bound a
    hi = Bound a -> Doc ann
    forall {a} {ann}. Show a => Bound a -> Doc ann
    docLo Bound a
    lo Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> Doc ann
    ", " Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> Bound a -> Doc ann
    forall {a} {ann}. Show a => Bound a -> Doc ann
    docHi Bound a
    hi
     where docLo :: Bound a -> Doc ann
    docLo Bound a
    Unbounded      = Doc ann
    "(-∞"
           docLo (Exclusive a
    r)  = Doc ann
    "(" Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> a -> Doc ann
    forall a ann. Show a => a -> Doc ann
    viaShow a
    r
           docLo (Inclusive a
    r)  = Doc ann
    "[" Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> a -> Doc ann
    forall a ann. Show a => a -> Doc ann
    viaShow a
    r

           docHi :: Bound a -> Doc ann
    docHi Bound a
    Unbounded      = Doc ann
    "+∞)"
           docHi (Exclusive a
    r)  = a -> Doc ann
    forall a ann. Show a => a -> Doc ann
    viaShow a
    r Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> Doc ann
    ")"
           docHi (Inclusive a
    r)  = a -> Doc ann
    forall a ann. Show a => a -> Doc ann
    viaShow a
    r Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> Doc ann
    "]"

    -- | Option style for real-valued options with upper and lower bounds
    realWithRangeOptSty :: Bound Rational -> Bound Rational -> OptionStyle BaseRealType
    realWithRangeOptSty :: Bound Rational -> Bound Rational -> OptionStyle BaseRealType
    realWithRangeOptSty Bound Rational
    lo Bound Rational
    hi = OptionStyle BaseRealType
    realOptSty OptionStyle BaseRealType
    -> (OptionStyle BaseRealType -> OptionStyle BaseRealType)
    -> OptionStyle BaseRealType
    forall a b. a -> (a -> b) -> b
    & (Maybe (ConcreteVal BaseRealType)
     -> ConcreteVal BaseRealType -> IO OptionSetResult)
    -> OptionStyle BaseRealType -> OptionStyle BaseRealType
    forall (tp :: BaseType).
    (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    set_opt_onset Maybe (ConcreteVal BaseRealType)
    -> ConcreteVal BaseRealType -> IO OptionSetResult
    vf
                                           OptionStyle BaseRealType
    -> (OptionStyle BaseRealType -> OptionStyle BaseRealType)
    -> OptionStyle BaseRealType
    forall a b. a -> (a -> b) -> b
    & Doc Void -> OptionStyle BaseRealType -> OptionStyle BaseRealType
    forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    set_opt_help Doc Void
    help
      where help :: Doc Void
    help = Doc Void
    "ℝ ∈" Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Bound Rational -> Bound Rational -> Doc Void
    forall a ann. Show a => Bound a -> Bound a -> Doc ann
    docInterval Bound Rational
    lo Bound Rational
    hi
            vf :: Maybe (ConcreteVal BaseRealType) -> ConcreteVal BaseRealType -> IO OptionSetResult
            vf :: Maybe (ConcreteVal BaseRealType)
    -> ConcreteVal BaseRealType -> IO OptionSetResult
    vf Maybe (ConcreteVal BaseRealType)
    _ (ConcreteReal Rational
    x)
              | Bound Rational -> Bound Rational -> Rational -> Bool
    forall a. Ord a => Bound a -> Bound a -> a -> Bool
    checkBound Bound Rational
    lo Bound Rational
    hi Rational
    x = OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return OptionSetResult
    optOK
              | Bool
    otherwise          = OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (OptionSetResult -> IO OptionSetResult)
    -> OptionSetResult -> IO OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ Doc Void -> OptionSetResult
    optErr (Doc Void -> OptionSetResult) -> Doc Void -> OptionSetResult
    forall a b. (a -> b) -> a -> b
    $
                                     Rational -> Doc Void
    forall ann. Rational -> Doc ann
    prettyRational Rational
    x Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc Void
    "out of range, expected real value in"
                                                      Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Bound Rational -> Bound Rational -> Doc Void
    forall a ann. Show a => Bound a -> Bound a -> Doc ann
    docInterval Bound Rational
    lo Bound Rational
    hi

    -- | Option style for real-valued options with a lower bound
    realWithMinOptSty :: Bound Rational -> OptionStyle BaseRealType
    realWithMinOptSty :: Bound Rational -> OptionStyle BaseRealType
    realWithMinOptSty Bound Rational
    lo = Bound Rational -> Bound Rational -> OptionStyle BaseRealType
    realWithRangeOptSty Bound Rational
    lo Bound Rational
    forall r. Bound r
    Unbounded

    -- | Option style for real-valued options with an upper bound
    realWithMaxOptSty :: Bound Rational -> OptionStyle BaseRealType
    realWithMaxOptSty :: Bound Rational -> OptionStyle BaseRealType
    realWithMaxOptSty Bound Rational
    hi = Bound Rational -> Bound Rational -> OptionStyle BaseRealType
    realWithRangeOptSty Bound Rational
    forall r. Bound r
    Unbounded Bound Rational
    hi

    -- | Option style for integer-valued options with upper and lower bounds
    integerWithRangeOptSty :: Bound Integer -> Bound Integer -> OptionStyle BaseIntegerType
    integerWithRangeOptSty :: Bound Integer -> Bound Integer -> OptionStyle BaseIntegerType
    integerWithRangeOptSty Bound Integer
    lo Bound Integer
    hi = OptionStyle BaseIntegerType
    integerOptSty OptionStyle BaseIntegerType
    -> (OptionStyle BaseIntegerType -> OptionStyle BaseIntegerType)
    -> OptionStyle BaseIntegerType
    forall a b. a -> (a -> b) -> b
    & (Maybe (ConcreteVal BaseIntegerType)
     -> ConcreteVal BaseIntegerType -> IO OptionSetResult)
    -> OptionStyle BaseIntegerType -> OptionStyle BaseIntegerType
    forall (tp :: BaseType).
    (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    set_opt_onset Maybe (ConcreteVal BaseIntegerType)
    -> ConcreteVal BaseIntegerType -> IO OptionSetResult
    vf
                                                  OptionStyle BaseIntegerType
    -> (OptionStyle BaseIntegerType -> OptionStyle BaseIntegerType)
    -> OptionStyle BaseIntegerType
    forall a b. a -> (a -> b) -> b
    & Doc Void
    -> OptionStyle BaseIntegerType -> OptionStyle BaseIntegerType
    forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    set_opt_help Doc Void
    help
      where help :: Doc Void
    help = Doc Void
    "ℤ ∈" Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Bound Integer -> Bound Integer -> Doc Void
    forall a ann. Show a => Bound a -> Bound a -> Doc ann
    docInterval Bound Integer
    lo Bound Integer
    hi
            vf :: Maybe (ConcreteVal BaseIntegerType) -> ConcreteVal BaseIntegerType -> IO OptionSetResult
            vf :: Maybe (ConcreteVal BaseIntegerType)
    -> ConcreteVal BaseIntegerType -> IO OptionSetResult
    vf Maybe (ConcreteVal BaseIntegerType)
    _ (ConcreteInteger Integer
    x)
              | Bound Integer -> Bound Integer -> Integer -> Bool
    forall a. Ord a => Bound a -> Bound a -> a -> Bool
    checkBound Bound Integer
    lo Bound Integer
    hi Integer
    x = OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return OptionSetResult
    optOK
              | Bool
    otherwise          = OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (OptionSetResult -> IO OptionSetResult)
    -> OptionSetResult -> IO OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ Doc Void -> OptionSetResult
    optErr (Doc Void -> OptionSetResult) -> Doc Void -> OptionSetResult
    forall a b. (a -> b) -> a -> b
    $
                                     Integer -> Doc Void
    forall ann. Integer -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Integer
    x Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc Void
    "out of range, expected integer value in"
                                              Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Bound Integer -> Bound Integer -> Doc Void
    forall a ann. Show a => Bound a -> Bound a -> Doc ann
    docInterval Bound Integer
    lo Bound Integer
    hi

    -- | Option style for integer-valued options with a lower bound
    integerWithMinOptSty :: Bound Integer -> OptionStyle BaseIntegerType
    integerWithMinOptSty :: Bound Integer -> OptionStyle BaseIntegerType
    integerWithMinOptSty Bound Integer
    lo = Bound Integer -> Bound Integer -> OptionStyle BaseIntegerType
    integerWithRangeOptSty Bound Integer
    lo Bound Integer
    forall r. Bound r
    Unbounded

    -- | Option style for integer-valued options with an upper bound
    integerWithMaxOptSty :: Bound Integer -> OptionStyle BaseIntegerType
    integerWithMaxOptSty :: Bound Integer -> OptionStyle BaseIntegerType
    integerWithMaxOptSty Bound Integer
    hi = Bound Integer -> Bound Integer -> OptionStyle BaseIntegerType
    integerWithRangeOptSty Bound Integer
    forall r. Bound r
    Unbounded Bound Integer
    hi

    -- | A configuration style for options that must be one of a fixed set of text values
    enumOptSty :: Set Text -> OptionStyle (BaseStringType Unicode)
    enumOptSty :: Set Text -> OptionStyle (BaseStringType Unicode)
    enumOptSty Set Text
    elts = OptionStyle (BaseStringType Unicode)
    stringOptSty OptionStyle (BaseStringType Unicode)
    -> (OptionStyle (BaseStringType Unicode)
        -> OptionStyle (BaseStringType Unicode))
    -> OptionStyle (BaseStringType Unicode)
    forall a b. a -> (a -> b) -> b
    & (Maybe (ConcreteVal (BaseStringType Unicode))
     -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult)
    -> OptionStyle (BaseStringType Unicode)
    -> OptionStyle (BaseStringType Unicode)
    forall (tp :: BaseType).
    (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    set_opt_onset Maybe (ConcreteVal (BaseStringType Unicode))
    -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult
    vf
                                   OptionStyle (BaseStringType Unicode)
    -> (OptionStyle (BaseStringType Unicode)
        -> OptionStyle (BaseStringType Unicode))
    -> OptionStyle (BaseStringType Unicode)
    forall a b. a -> (a -> b) -> b
    & Doc Void
    -> OptionStyle (BaseStringType Unicode)
    -> OptionStyle (BaseStringType Unicode)
    forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    set_opt_help Doc Void
    help
      where help :: Doc Void
    help = Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    group (Doc Void
    "one of: " Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    align ([Doc Void] -> Doc Void
    forall ann. [Doc ann] -> Doc ann
    sep ([Doc Void] -> Doc Void) -> [Doc Void] -> Doc Void
    forall a b. (a -> b) -> a -> b
    $ (Text -> Doc Void) -> [Text] -> [Doc Void]
    forall a b. (a -> b) -> [a] -> [b]
    map (Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    dquotes (Doc Void -> Doc Void) -> (Text -> Doc Void) -> Text -> Doc Void
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Doc Void
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty) ([Text] -> [Doc Void]) -> [Text] -> [Doc Void]
    forall a b. (a -> b) -> a -> b
    $ Set Text -> [Text]
    forall a. Set a -> [a]
    Set.toList Set Text
    elts))
            vf :: Maybe (ConcreteVal (BaseStringType Unicode))
               -> ConcreteVal (BaseStringType Unicode)
               -> IO OptionSetResult
            vf :: Maybe (ConcreteVal (BaseStringType Unicode))
    -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult
    vf Maybe (ConcreteVal (BaseStringType Unicode))
    _ (ConcreteString (UnicodeLiteral Text
    x))
             | Text
    x Text -> Set Text -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set Text
    elts = OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return OptionSetResult
    optOK
             | Bool
    otherwise = OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (OptionSetResult -> IO OptionSetResult)
    -> OptionSetResult -> IO OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ Doc Void -> OptionSetResult
    optErr (Doc Void -> OptionSetResult) -> Doc Void -> OptionSetResult
    forall a b. (a -> b) -> a -> b
    $
                                Doc Void
    "invalid setting" Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    dquotes (Text -> Doc Void
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Text
    x) Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                Doc Void
    ", expected one of these enums:" Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+>
                                Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    align ([Doc Void] -> Doc Void
    forall ann. [Doc ann] -> Doc ann
    sep (Doc Void -> [Doc Void] -> [Doc Void]
    forall ann. Doc ann -> [Doc ann] -> [Doc ann]
    punctuate Doc Void
    forall ann. Doc ann
    comma ((Text -> Doc Void) -> [Text] -> [Doc Void]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Doc Void
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty ([Text] -> [Doc Void]) -> [Text] -> [Doc Void]
    forall a b. (a -> b) -> a -> b
    $ Set Text -> [Text]
    forall a. Set a -> [a]
    Set.toList Set Text
    elts)))

    -- | A configuration syle for options that must be one of a fixed set of text values.
    --   Associated with each string is a validation/callback action that will be run
    --   whenever the named string option is selected.
    listOptSty
      :: Map Text (IO OptionSetResult)
      -> OptionStyle (BaseStringType Unicode)
    listOptSty :: Map Text (IO OptionSetResult)
    -> OptionStyle (BaseStringType Unicode)
    listOptSty Map Text (IO OptionSetResult)
    values =  OptionStyle (BaseStringType Unicode)
    stringOptSty OptionStyle (BaseStringType Unicode)
    -> (OptionStyle (BaseStringType Unicode)
        -> OptionStyle (BaseStringType Unicode))
    -> OptionStyle (BaseStringType Unicode)
    forall a b. a -> (a -> b) -> b
    & (Maybe (ConcreteVal (BaseStringType Unicode))
     -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult)
    -> OptionStyle (BaseStringType Unicode)
    -> OptionStyle (BaseStringType Unicode)
    forall (tp :: BaseType).
    (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    set_opt_onset Maybe (ConcreteVal (BaseStringType Unicode))
    -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult
    vf
                                      OptionStyle (BaseStringType Unicode)
    -> (OptionStyle (BaseStringType Unicode)
        -> OptionStyle (BaseStringType Unicode))
    -> OptionStyle (BaseStringType Unicode)
    forall a b. a -> (a -> b) -> b
    & Doc Void
    -> OptionStyle (BaseStringType Unicode)
    -> OptionStyle (BaseStringType Unicode)
    forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    set_opt_help Doc Void
    help
      where help :: Doc Void
    help = Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    group (Doc Void
    "one of: " Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    align ([Doc Void] -> Doc Void
    forall ann. [Doc ann] -> Doc ann
    sep ([Doc Void] -> Doc Void) -> [Doc Void] -> Doc Void
    forall a b. (a -> b) -> a -> b
    $ ((Text, IO OptionSetResult) -> Doc Void)
    -> [(Text, IO OptionSetResult)] -> [Doc Void]
    forall a b. (a -> b) -> [a] -> [b]
    map (Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    dquotes (Doc Void -> Doc Void)
    -> ((Text, IO OptionSetResult) -> Doc Void)
    -> (Text, IO OptionSetResult)
    -> Doc Void
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Doc Void
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (Text -> Doc Void)
    -> ((Text, IO OptionSetResult) -> Text)
    -> (Text, IO OptionSetResult)
    -> Doc Void
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, IO OptionSetResult) -> Text
    forall a b. (a, b) -> a
    fst) ([(Text, IO OptionSetResult)] -> [Doc Void])
    -> [(Text, IO OptionSetResult)] -> [Doc Void]
    forall a b. (a -> b) -> a -> b
    $ Map Text (IO OptionSetResult) -> [(Text, IO OptionSetResult)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map Text (IO OptionSetResult)
    values))
            vf :: Maybe (ConcreteVal (BaseStringType Unicode))
               -> ConcreteVal (BaseStringType Unicode)
               -> IO OptionSetResult
            vf :: Maybe (ConcreteVal (BaseStringType Unicode))
    -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult
    vf Maybe (ConcreteVal (BaseStringType Unicode))
    _ (ConcreteString (UnicodeLiteral Text
    x)) =
             IO OptionSetResult
    -> Maybe (IO OptionSetResult) -> IO OptionSetResult
    forall a. a -> Maybe a -> a
    fromMaybe
              (OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (OptionSetResult -> IO OptionSetResult)
    -> OptionSetResult -> IO OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ Doc Void -> OptionSetResult
    optErr (Doc Void -> OptionSetResult) -> Doc Void -> OptionSetResult
    forall a b. (a -> b) -> a -> b
    $
                Doc Void
    "invalid setting" Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    dquotes (Text -> Doc Void
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Text
    x) Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                Doc Void
    ", expected one from this list:" Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+>
                Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    align ([Doc Void] -> Doc Void
    forall ann. [Doc ann] -> Doc ann
    sep (((Text, IO OptionSetResult) -> Doc Void)
    -> [(Text, IO OptionSetResult)] -> [Doc Void]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> Doc Void
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (Text -> Doc Void)
    -> ((Text, IO OptionSetResult) -> Text)
    -> (Text, IO OptionSetResult)
    -> Doc Void
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text, IO OptionSetResult) -> Text
    forall a b. (a, b) -> a
    fst) ([(Text, IO OptionSetResult)] -> [Doc Void])
    -> [(Text, IO OptionSetResult)] -> [Doc Void]
    forall a b. (a -> b) -> a -> b
    $ Map Text (IO OptionSetResult) -> [(Text, IO OptionSetResult)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map Text (IO OptionSetResult)
    values)))
              (Text -> Map Text (IO OptionSetResult) -> Maybe (IO OptionSetResult)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Text
    x Map Text (IO OptionSetResult)
    values)

    -- | Used as a wrapper for an option that has been deprecated. If the
    -- option is actually set (as opposed to just using the default value)
    -- then this will emit an OptionSetResult warning that time, optionally
    -- mentioning the replacement option (if specified).
    --
    -- There are three cases of deprecation:
    -- 1. Removing an option that no longer applies
    -- 2. Changing the name or heirarchical position of an option.
    -- 3. #2 and also changing the type.
    -- 4. Replacing an option by multiple new options (e.g. split url option
    --    into hostname and port options)
    --
    -- In the case of #1, the option will presumably be ignored by the
    -- code and the warnings are provided to allow the user to clean the
    -- option from their configurations.
    --
    -- In the case of #2, the old option and the new option will share the
    -- same value storage: changes to one can be seen via the other and
    -- vice versa.  The code can be switched over to reference the new
    -- option entirely, and user configurations setting the old option
    -- will still work until they have been updated and the definition of
    -- the old option is removed entirely.
    --
    --   NOTE: in order to support #2, the newer option should be declared
    --   (via 'insertOption') *before* the option it deprecates.
    --
    -- In the case of #3, it is not possible to share storage space, so
    -- during the deprecation period, the code using the option config
    -- value must check both locations and decide which value to utilize.
    --
    -- Case #4 is an enhanced form of #3 and #2, and is generally treated
    -- as #3, but adds the consideration that deprecation warnings will
    -- need to advise about multiple new options.  The inverse of #4
    -- (multiple options being combined to a single newer option) is just
    -- treated as separate deprecations.
    --
    --   NOTE: in order to support #4, the newer options should all be
    --   declared (via 'insertOption') *before* the options they deprecate.
    --
    -- Nested deprecations are valid, and replacement warnings are
    -- automatically transitive to the newest options.
    --
    -- Any user-supplied value for the old option will result in warnings
    -- emitted to the OptionSetResult for all four cases.  Code should
    -- ensure that these warnings are appropriately communicated to the
    -- user to allow configuration updates to occur.
    --
    -- Note that for #1 and #2, the overhead burden of continuing to
    -- define the deprecated option is very small, so actual removal of
    -- the older config can be delayed indefinitely.

    deprecatedOpt :: [ConfigDesc] -> ConfigDesc -> ConfigDesc
    deprecatedOpt :: [ConfigDesc] -> ConfigDesc -> ConfigDesc
    deprecatedOpt [ConfigDesc]
    newerOpt (ConfigDesc ConfigOption tp
    o OptionStyle tp
    sty Maybe (Doc Void)
    desc Maybe [ConfigDesc]
    oldRepl) =
      let -- note: description and setter not modified here in case this
          -- is called again to declare additional replacements (viz. case
          -- #2 above).  These will be modified in the 'insertOption' function.
          newRepl :: Maybe [ConfigDesc]
          newRepl :: Maybe [ConfigDesc]
    newRepl = ([ConfigDesc]
    newerOpt [ConfigDesc] -> [ConfigDesc] -> [ConfigDesc]
    forall a. Semigroup a => a -> a -> a
    <>) ([ConfigDesc] -> [ConfigDesc])
    -> Maybe [ConfigDesc] -> Maybe [ConfigDesc]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Maybe [ConfigDesc]
    oldRepl Maybe [ConfigDesc] -> Maybe [ConfigDesc] -> Maybe [ConfigDesc]
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
    <|> [ConfigDesc] -> Maybe [ConfigDesc]
    forall a. a -> Maybe a
    Just [])
      in ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe [ConfigDesc]
    -> ConfigDesc
    forall (tp :: BaseType).
    ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe [ConfigDesc]
    -> ConfigDesc
    ConfigDesc ConfigOption tp
    o OptionStyle tp
    sty Maybe (Doc Void)
    desc Maybe [ConfigDesc]
    newRepl

    -- | A configuration style for options that are expected to be paths to an executable
    --   image.  Configuration options with this style generate a warning message if set to a
    --   value that cannot be resolved to an absolute path to an executable file in the
    --   current OS environment.
    executablePathOptSty :: OptionStyle (BaseStringType Unicode)
    executablePathOptSty :: OptionStyle (BaseStringType Unicode)
    executablePathOptSty = OptionStyle (BaseStringType Unicode)
    stringOptSty OptionStyle (BaseStringType Unicode)
    -> (OptionStyle (BaseStringType Unicode)
        -> OptionStyle (BaseStringType Unicode))
    -> OptionStyle (BaseStringType Unicode)
    forall a b. a -> (a -> b) -> b
    & (Maybe (ConcreteVal (BaseStringType Unicode))
     -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult)
    -> OptionStyle (BaseStringType Unicode)
    -> OptionStyle (BaseStringType Unicode)
    forall (tp :: BaseType).
    (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    set_opt_onset Maybe (ConcreteVal (BaseStringType Unicode))
    -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult
    vf
                                        OptionStyle (BaseStringType Unicode)
    -> (OptionStyle (BaseStringType Unicode)
        -> OptionStyle (BaseStringType Unicode))
    -> OptionStyle (BaseStringType Unicode)
    forall a b. a -> (a -> b) -> b
    & Doc Void
    -> OptionStyle (BaseStringType Unicode)
    -> OptionStyle (BaseStringType Unicode)
    forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    set_opt_help Doc Void
    help
      where help :: Doc Void
    help = Doc Void
    "<path>"
            vf :: Maybe (ConcreteVal (BaseStringType Unicode))
               -> ConcreteVal (BaseStringType Unicode)
               -> IO OptionSetResult
            vf :: Maybe (ConcreteVal (BaseStringType Unicode))
    -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult
    vf Maybe (ConcreteVal (BaseStringType Unicode))
    _ (ConcreteString (UnicodeLiteral Text
    x)) =
                     do me <- IO String -> IO (Either IOError String)
    forall (m :: Type -> Type) e a.
    (HasCallStack, MonadCatch m, Exception e) =>
    m a -> m (Either e a)
    try (String -> IO String
    forall (m :: Type -> Type).
    (MonadIO m, MonadFail m) =>
    String -> m String
    Env.findExecutable (Text -> String
    Text.unpack Text
    x))
                        case me of
                           Right{} -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (OptionSetResult -> IO OptionSetResult)
    -> OptionSetResult -> IO OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ OptionSetResult
    optOK
                           Left IOError
    e  -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (OptionSetResult -> IO OptionSetResult)
    -> OptionSetResult -> IO OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ Doc Void -> OptionSetResult
    optWarn (Doc Void -> OptionSetResult) -> Doc Void -> OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ String -> Doc Void
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (String -> Doc Void) -> String -> Doc Void
    forall a b. (a -> b) -> a -> b
    $ IOError -> String
    ioeGetErrorString IOError
    e

    -- | A @ConfigDesc@ describes a configuration option before it is installed into
    --   a @Config@ object.  It consists of a @ConfigOption@ name for the option,
    --   an @OptionStyle@ describing the sort of option it is, and an optional
    --   help message describing the semantics of this option.
    data ConfigDesc where
      ConfigDesc :: ConfigOption tp  -- describes option name and type
                 -> OptionStyle tp   -- option validators, help info, type and default
                 -> Maybe (Doc Void) -- help text
                 -> Maybe [ConfigDesc] -- Deprecation and newer replacements
                 -> ConfigDesc

    instance Show ConfigDesc where
      show :: ConfigDesc -> String
    show (ConfigDesc ConfigOption tp
    o OptionStyle tp
    _ Maybe (Doc Void)
    _ Maybe [ConfigDesc]
    _) = ConfigOption tp -> String
    forall a. Show a => a -> String
    show ConfigOption tp
    o

    -- | The most general method for constructing a normal `ConfigDesc`.
    mkOpt :: ConfigOption tp     -- ^ Fixes the name and the type of this option
          -> OptionStyle tp      -- ^ Define the style of this option
          -> Maybe (Doc Void)    -- ^ Help text
          -> Maybe (ConcreteVal tp) -- ^ A default value for this option
          -> ConfigDesc
    mkOpt :: forall (tp :: BaseType).
    ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe (ConcreteVal tp)
    -> ConfigDesc
    mkOpt ConfigOption tp
    o OptionStyle tp
    sty Maybe (Doc Void)
    h Maybe (ConcreteVal tp)
    def = ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe [ConfigDesc]
    -> ConfigDesc
    forall (tp :: BaseType).
    ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe [ConfigDesc]
    -> ConfigDesc
    ConfigDesc ConfigOption tp
    o OptionStyle tp
    sty{ opt_default_value = def } Maybe (Doc Void)
    h Maybe [ConfigDesc]
    forall a. Maybe a
    Nothing

    -- | Construct an option using a default style with a given initial value
    opt :: Pretty help
        => ConfigOption tp      -- ^ Fixes the name and the type of this option
        -> ConcreteVal tp       -- ^ Default value for the option
        -> help                 -- ^ An informational message describing this option
        -> ConfigDesc
    opt :: forall help (tp :: BaseType).
    Pretty help =>
    ConfigOption tp -> ConcreteVal tp -> help -> ConfigDesc
    opt ConfigOption tp
    o ConcreteVal tp
    a help
    help = ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe (ConcreteVal tp)
    -> ConfigDesc
    forall (tp :: BaseType).
    ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe (ConcreteVal tp)
    -> ConfigDesc
    mkOpt ConfigOption tp
    o (BaseTypeRepr tp -> OptionStyle tp
    forall (tp :: BaseType). BaseTypeRepr tp -> OptionStyle tp
    defaultOpt (ConfigOption tp -> BaseTypeRepr tp
    forall (tp :: BaseType). ConfigOption tp -> BaseTypeRepr tp
    configOptionType ConfigOption tp
    o))
                           (Doc Void -> Maybe (Doc Void)
    forall a. a -> Maybe a
    Just (help -> Doc Void
    forall ann. help -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty help
    help))
                           (ConcreteVal tp -> Maybe (ConcreteVal tp)
    forall a. a -> Maybe a
    Just ConcreteVal tp
    a)

    -- | Construct an option using a default style with a given initial value.
    --   Also provide a validation function to check new values as they are set.
    optV :: forall tp help
          . Pretty help
         => ConfigOption tp      -- ^ Fixes the name and the type of this option
         -> ConcreteVal tp       -- ^ Default value for the option
         -> (ConcreteVal tp -> Maybe help)
             -- ^ Validation function.  Return `Just err` if the value to set
             --   is not valid.
         -> help                -- ^ An informational message describing this option
         -> ConfigDesc
    optV :: forall (tp :: BaseType) help.
    Pretty help =>
    ConfigOption tp
    -> ConcreteVal tp
    -> (ConcreteVal tp -> Maybe help)
    -> help
    -> ConfigDesc
    optV ConfigOption tp
    o ConcreteVal tp
    a ConcreteVal tp -> Maybe help
    vf help
    h = ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe (ConcreteVal tp)
    -> ConfigDesc
    forall (tp :: BaseType).
    ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe (ConcreteVal tp)
    -> ConfigDesc
    mkOpt ConfigOption tp
    o (BaseTypeRepr tp -> OptionStyle tp
    forall (tp :: BaseType). BaseTypeRepr tp -> OptionStyle tp
    defaultOpt (ConfigOption tp -> BaseTypeRepr tp
    forall (tp :: BaseType). ConfigOption tp -> BaseTypeRepr tp
    configOptionType ConfigOption tp
    o)
                               OptionStyle tp
    -> (OptionStyle tp -> OptionStyle tp) -> OptionStyle tp
    forall a b. a -> (a -> b) -> b
    & (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    forall (tp :: BaseType).
    (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    set_opt_onset Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    onset)
                            (Doc Void -> Maybe (Doc Void)
    forall a. a -> Maybe a
    Just (help -> Doc Void
    forall ann. help -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty help
    h))
                            (ConcreteVal tp -> Maybe (ConcreteVal tp)
    forall a. a -> Maybe a
    Just ConcreteVal tp
    a)

       where onset :: Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
             onset :: Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    onset Maybe (ConcreteVal tp)
    _ ConcreteVal tp
    x = case ConcreteVal tp -> Maybe help
    vf ConcreteVal tp
    x of
                           Maybe help
    Nothing -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return OptionSetResult
    optOK
                           Just help
    z  -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (OptionSetResult -> IO OptionSetResult)
    -> OptionSetResult -> IO OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ Doc Void -> OptionSetResult
    optErr (Doc Void -> OptionSetResult) -> Doc Void -> OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ help -> Doc Void
    forall ann. help -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty help
    z

    -- | Construct an option using a default style with no initial value.
    optU :: Pretty help
         => ConfigOption tp    -- ^ Fixes the name and the type of this option
         -> help               -- ^ An informational message describing this option
         -> ConfigDesc
    optU :: forall help (tp :: BaseType).
    Pretty help =>
    ConfigOption tp -> help -> ConfigDesc
    optU ConfigOption tp
    o help
    h = ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe (ConcreteVal tp)
    -> ConfigDesc
    forall (tp :: BaseType).
    ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe (ConcreteVal tp)
    -> ConfigDesc
    mkOpt ConfigOption tp
    o (BaseTypeRepr tp -> OptionStyle tp
    forall (tp :: BaseType). BaseTypeRepr tp -> OptionStyle tp
    defaultOpt (ConfigOption tp -> BaseTypeRepr tp
    forall (tp :: BaseType). ConfigOption tp -> BaseTypeRepr tp
    configOptionType ConfigOption tp
    o)) (Doc Void -> Maybe (Doc Void)
    forall a. a -> Maybe a
    Just (help -> Doc Void
    forall ann. help -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty help
    h)) Maybe (ConcreteVal tp)
    forall a. Maybe a
    Nothing

    -- | Construct an option using a default style with no initial value.
    --   Also provide a validation function to check new values as they are set.
    optUV :: forall help tp.
       Pretty help =>
       ConfigOption tp {- ^ Fixes the name and the type of this option -} ->
       (ConcreteVal tp -> Maybe help) {- ^ Validation function.  Return `Just err` if the value to set is not valid. -} ->
       help                {- ^ An informational message describing this option -} ->
       ConfigDesc
    optUV :: forall help (tp :: BaseType).
    Pretty help =>
    ConfigOption tp
    -> (ConcreteVal tp -> Maybe help) -> help -> ConfigDesc
    optUV ConfigOption tp
    o ConcreteVal tp -> Maybe help
    vf help
    h = ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe (ConcreteVal tp)
    -> ConfigDesc
    forall (tp :: BaseType).
    ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe (ConcreteVal tp)
    -> ConfigDesc
    mkOpt ConfigOption tp
    o (BaseTypeRepr tp -> OptionStyle tp
    forall (tp :: BaseType). BaseTypeRepr tp -> OptionStyle tp
    defaultOpt (ConfigOption tp -> BaseTypeRepr tp
    forall (tp :: BaseType). ConfigOption tp -> BaseTypeRepr tp
    configOptionType ConfigOption tp
    o)
                                OptionStyle tp
    -> (OptionStyle tp -> OptionStyle tp) -> OptionStyle tp
    forall a b. a -> (a -> b) -> b
    & (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    forall (tp :: BaseType).
    (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    set_opt_onset Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    onset)
                           (Doc Void -> Maybe (Doc Void)
    forall a. a -> Maybe a
    Just (help -> Doc Void
    forall ann. help -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty help
    h))
                           Maybe (ConcreteVal tp)
    forall a. Maybe a
    Nothing
       where onset :: Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
             onset :: Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    onset Maybe (ConcreteVal tp)
    _ ConcreteVal tp
    x = case ConcreteVal tp -> Maybe help
    vf ConcreteVal tp
    x of
                           Maybe help
    Nothing -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return OptionSetResult
    optOK
                           Just help
    z  -> OptionSetResult -> IO OptionSetResult
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (OptionSetResult -> IO OptionSetResult)
    -> OptionSetResult -> IO OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ Doc Void -> OptionSetResult
    optErr (Doc Void -> OptionSetResult) -> Doc Void -> OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ help -> Doc Void
    forall ann. help -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty help
    z

    -- | The copyOpt creates a duplicate ConfigDesc under a different
    -- name.  This is typically used to taking a common operation and
    -- modify the prefix to apply it to a more specialized role
    -- (e.g. solver.strict_parsing --> solver.z3.strict_parsing).  The
    -- style and help text of the input ConfigDesc are preserved, but any
    -- deprecation is discarded.
    copyOpt :: (Text -> Text) -> ConfigDesc -> ConfigDesc
    copyOpt :: (Text -> Text) -> ConfigDesc -> ConfigDesc
    copyOpt Text -> Text
    modName (ConfigDesc o :: ConfigOption tp
    o@(ConfigOption BaseTypeRepr tp
    ty NonEmpty Text
    _) OptionStyle tp
    sty Maybe (Doc Void)
    h Maybe [ConfigDesc]
    _) =
      let newName :: NonEmpty Text
    newName = case Text -> Maybe (NonEmpty Text)
    splitPath (Text -> Text
    modName (ConfigOption tp -> Text
    forall (tp :: BaseType). ConfigOption tp -> Text
    configOptionText ConfigOption tp
    o)) of
            Just NonEmpty Text
    ps -> NonEmpty Text
    ps
            Maybe (NonEmpty Text)
    Nothing -> String -> NonEmpty Text
    forall a. HasCallStack => String -> a
    error String
    "new config option must not be empty"
      in ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe [ConfigDesc]
    -> ConfigDesc
    forall (tp :: BaseType).
    ConfigOption tp
    -> OptionStyle tp
    -> Maybe (Doc Void)
    -> Maybe [ConfigDesc]
    -> ConfigDesc
    ConfigDesc (BaseTypeRepr tp -> NonEmpty Text -> ConfigOption tp
    forall (tp :: BaseType).
    BaseTypeRepr tp -> NonEmpty Text -> ConfigOption tp
    ConfigOption BaseTypeRepr tp
    ty NonEmpty Text
    newName) OptionStyle tp
    sty Maybe (Doc Void)
    h Maybe [ConfigDesc]
    forall a. Maybe a
    Nothing

    ------------------------------------------------------------------------
    -- ConfigState

    data ConfigLeaf where
      ConfigLeaf ::
        !(OptionStyle tp)              {- Style for this option -} ->
        MVar (Maybe (ConcreteVal tp))  {- State of the option -} ->
        Maybe (Doc Void)               {- Help text for the option -} ->
        ConfigLeaf

    -- | Main configuration data type.  It is organized as a trie based on the
    --   name segments of the configuration option name.
    data ConfigTrie where
      ConfigTrie ::
        !(Maybe ConfigLeaf) ->
        !ConfigMap ->
        ConfigTrie

    type ConfigMap = Map Text ConfigTrie

    freshLeaf :: [Text] -> ConfigLeaf -> ConfigTrie
    freshLeaf :: [Text] -> ConfigLeaf -> ConfigTrie
    freshLeaf [] ConfigLeaf
    l     = Maybe ConfigLeaf -> ConfigMap -> ConfigTrie
    ConfigTrie (ConfigLeaf -> Maybe ConfigLeaf
    forall a. a -> Maybe a
    Just ConfigLeaf
    l) ConfigMap
    forall a. Monoid a => a
    mempty
    freshLeaf (Text
    a:[Text]
    as) ConfigLeaf
    l = Maybe ConfigLeaf -> ConfigMap -> ConfigTrie
    ConfigTrie Maybe ConfigLeaf
    forall a. Maybe a
    Nothing (Text -> ConfigTrie -> ConfigMap
    forall k a. k -> a -> Map k a
    Map.singleton Text
    a ([Text] -> ConfigLeaf -> ConfigTrie
    freshLeaf [Text]
    as ConfigLeaf
    l))

    -- | The given list of name segments defines a lens into a config trie.
    adjustConfigTrie :: Functor t => [Text] -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf)) -> Maybe (ConfigTrie) -> t (Maybe ConfigTrie)
    adjustConfigTrie :: forall (t :: Type -> Type).
    Functor t =>
    [Text]
    -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf))
    -> Maybe ConfigTrie
    -> t (Maybe ConfigTrie)
    adjustConfigTrie     [Text]
    as Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    f Maybe ConfigTrie
    Nothing                 = (ConfigLeaf -> ConfigTrie) -> Maybe ConfigLeaf -> Maybe ConfigTrie
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Text] -> ConfigLeaf -> ConfigTrie
    freshLeaf [Text]
    as) (Maybe ConfigLeaf -> Maybe ConfigTrie)
    -> t (Maybe ConfigLeaf) -> t (Maybe ConfigTrie)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    f Maybe ConfigLeaf
    forall a. Maybe a
    Nothing
    adjustConfigTrie (Text
    a:[Text]
    as) Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    f (Just (ConfigTrie Maybe ConfigLeaf
    x ConfigMap
    m)) = ConfigTrie -> Maybe ConfigTrie
    forall a. a -> Maybe a
    Just (ConfigTrie -> Maybe ConfigTrie)
    -> (ConfigMap -> ConfigTrie) -> ConfigMap -> Maybe ConfigTrie
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe ConfigLeaf -> ConfigMap -> ConfigTrie
    ConfigTrie Maybe ConfigLeaf
    x (ConfigMap -> Maybe ConfigTrie)
    -> t ConfigMap -> t (Maybe ConfigTrie)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text
    -> [Text]
    -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf))
    -> ConfigMap
    -> t ConfigMap
    forall (t :: Type -> Type).
    Functor t =>
    Text
    -> [Text]
    -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf))
    -> ConfigMap
    -> t ConfigMap
    adjustConfigMap Text
    a [Text]
    as Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    f ConfigMap
    m
    adjustConfigTrie     [] Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    f (Just (ConfigTrie Maybe ConfigLeaf
    x ConfigMap
    m)) = Maybe ConfigLeaf -> Maybe ConfigTrie
    g (Maybe ConfigLeaf -> Maybe ConfigTrie)
    -> t (Maybe ConfigLeaf) -> t (Maybe ConfigTrie)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    f Maybe ConfigLeaf
    x
      where g :: Maybe ConfigLeaf -> Maybe ConfigTrie
    g Maybe ConfigLeaf
    Nothing | ConfigMap -> Bool
    forall k a. Map k a -> Bool
    Map.null ConfigMap
    m = Maybe ConfigTrie
    forall a. Maybe a
    Nothing
            g Maybe ConfigLeaf
    x' = ConfigTrie -> Maybe ConfigTrie
    forall a. a -> Maybe a
    Just (Maybe ConfigLeaf -> ConfigMap -> ConfigTrie
    ConfigTrie Maybe ConfigLeaf
    x' ConfigMap
    m)

    -- | The given nonempty list of name segments (with the initial segment given as the first argument)
    --   defines a lens into a @ConfigMap@.
    adjustConfigMap :: Functor t => Text -> [Text] -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf)) -> ConfigMap -> t ConfigMap
    adjustConfigMap :: forall (t :: Type -> Type).
    Functor t =>
    Text
    -> [Text]
    -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf))
    -> ConfigMap
    -> t ConfigMap
    adjustConfigMap Text
    a [Text]
    as Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    f = (Maybe ConfigTrie -> t (Maybe ConfigTrie))
    -> Text -> ConfigMap -> t ConfigMap
    forall (f :: Type -> Type) k a.
    (Functor f, Ord k) =>
    (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
    Map.alterF ([Text]
    -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf))
    -> Maybe ConfigTrie
    -> t (Maybe ConfigTrie)
    forall (t :: Type -> Type).
    Functor t =>
    [Text]
    -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf))
    -> Maybe ConfigTrie
    -> t (Maybe ConfigTrie)
    adjustConfigTrie [Text]
    as Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    f) Text
    a

    -- | Traverse an entire @ConfigMap@.  The first argument is the
    -- reversed heirarchical location of the starting map entry location.
    traverseConfigMap ::
      Applicative t =>
      [Text] {- ^ A REVERSED LIST of the name segments that represent the context from the root to the current @ConfigMap@. -} ->
      ([Text] -> ConfigLeaf -> t ConfigLeaf) {- ^ An action to apply to each leaf. The path to the leaf is provided. -} ->
      ConfigMap {- ^ ConfigMap to traverse -} ->
      t ConfigMap
    traverseConfigMap :: forall (t :: Type -> Type).
    Applicative t =>
    [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigMap
    -> t ConfigMap
    traverseConfigMap [Text]
    revPath [Text] -> ConfigLeaf -> t ConfigLeaf
    f = (Text -> ConfigTrie -> t ConfigTrie) -> ConfigMap -> t ConfigMap
    forall (t :: Type -> Type) k a b.
    Applicative t =>
    (k -> a -> t b) -> Map k a -> t (Map k b)
    Map.traverseWithKey (\Text
    k -> [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigTrie
    -> t ConfigTrie
    forall (t :: Type -> Type).
    Applicative t =>
    [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigTrie
    -> t ConfigTrie
    traverseConfigTrie (Text
    kText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    revPath) [Text] -> ConfigLeaf -> t ConfigLeaf
    f)

    -- | Traverse an entire @ConfigTrie@.
    traverseConfigTrie ::
      Applicative t =>
      [Text] {- ^ A REVERSED LIST of the name segments that represent the context from the root to the current @ConfigTrie@. -} ->
      ([Text] -> ConfigLeaf -> t ConfigLeaf) {- ^ An action to apply to each leaf. The path to the leaf is provided. -} ->
      ConfigTrie {- ^ @ConfigTrie@ to traverse -} ->
      t ConfigTrie
    traverseConfigTrie :: forall (t :: Type -> Type).
    Applicative t =>
    [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigTrie
    -> t ConfigTrie
    traverseConfigTrie [Text]
    revPath [Text] -> ConfigLeaf -> t ConfigLeaf
    f (ConfigTrie Maybe ConfigLeaf
    x ConfigMap
    m) =
      Maybe ConfigLeaf -> ConfigMap -> ConfigTrie
    ConfigTrie (Maybe ConfigLeaf -> ConfigMap -> ConfigTrie)
    -> t (Maybe ConfigLeaf) -> t (ConfigMap -> ConfigTrie)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ConfigLeaf -> t ConfigLeaf)
    -> Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse ([Text] -> ConfigLeaf -> t ConfigLeaf
    f ([Text] -> [Text]
    forall a. [a] -> [a]
    reverse [Text]
    revPath)) Maybe ConfigLeaf
    x t (ConfigMap -> ConfigTrie) -> t ConfigMap -> t ConfigTrie
    forall a b. t (a -> b) -> t a -> t b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigMap
    -> t ConfigMap
    forall (t :: Type -> Type).
    Applicative t =>
    [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigMap
    -> t ConfigMap
    traverseConfigMap [Text]
    revPath [Text] -> ConfigLeaf -> t ConfigLeaf
    f ConfigMap
    m

    -- | Traverse a subtree of a @ConfigMap@.  If an empty path is provided, the entire @ConfigMap@ will
    --   be traversed.
    traverseSubtree ::
      Applicative t =>
      [Text] {- ^ Path indicating the subtree to traverse -} ->
      ([Text] -> ConfigLeaf -> t ConfigLeaf) {- ^ Action to apply to each leaf in the indicated subtree.  The path to the leaf is provided. -} ->
      ConfigMap {- ^ @ConfigMap@ to traverse -} ->
      t ConfigMap
    traverseSubtree :: forall (t :: Type -> Type).
    Applicative t =>
    [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigMap
    -> t ConfigMap
    traverseSubtree [Text]
    ps0 [Text] -> ConfigLeaf -> t ConfigLeaf
    f = [Text] -> [Text] -> ConfigMap -> t ConfigMap
    go [Text]
    ps0 []
      where
      go :: [Text] -> [Text] -> ConfigMap -> t ConfigMap
    go     [] [Text]
    revPath = [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigMap
    -> t ConfigMap
    forall (t :: Type -> Type).
    Applicative t =>
    [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigMap
    -> t ConfigMap
    traverseConfigMap [Text]
    revPath [Text] -> ConfigLeaf -> t ConfigLeaf
    f
      go (Text
    p:[Text]
    ps) [Text]
    revPath = (Maybe ConfigTrie -> t (Maybe ConfigTrie))
    -> Text -> ConfigMap -> t ConfigMap
    forall (f :: Type -> Type) k a.
    (Functor f, Ord k) =>
    (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
    Map.alterF ((ConfigTrie -> t ConfigTrie)
    -> Maybe ConfigTrie -> t (Maybe ConfigTrie)
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse ConfigTrie -> t ConfigTrie
    g) Text
    p
         where g :: ConfigTrie -> t ConfigTrie
    g (ConfigTrie Maybe ConfigLeaf
    x ConfigMap
    m) = Maybe ConfigLeaf -> ConfigMap -> ConfigTrie
    ConfigTrie (Maybe ConfigLeaf -> ConfigMap -> ConfigTrie)
    -> t (Maybe ConfigLeaf) -> t (ConfigMap -> ConfigTrie)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    here Maybe ConfigLeaf
    x t (ConfigMap -> ConfigTrie) -> t ConfigMap -> t ConfigTrie
    forall a b. t (a -> b) -> t a -> t b
    forall (f :: Type -> Type) a b.
    Applicative f =>
    f (a -> b) -> f a -> f b
    <*> [Text] -> [Text] -> ConfigMap -> t ConfigMap
    go [Text]
    ps (Text
    pText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    revPath) ConfigMap
    m
               here :: Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    here = (ConfigLeaf -> t ConfigLeaf)
    -> Maybe ConfigLeaf -> t (Maybe ConfigLeaf)
    forall (t :: Type -> Type) (f :: Type -> Type) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse ([Text] -> ConfigLeaf -> t ConfigLeaf
    f ([Text] -> [Text]
    forall a. [a] -> [a]
    reverse (Text
    pText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    revPath)))

    -- | Add an option to the given @ConfigMap@.  If the
    --   option cannot be added (because it already exists
    --   in the map) the map is instead returned unchanged.
    tryInsertOption ::
      (MonadIO m, MonadCatch m) =>
      ConfigMap -> ConfigDesc -> m ConfigMap
    tryInsertOption :: forall (m :: Type -> Type).
    (MonadIO m, MonadCatch m) =>
    ConfigMap -> ConfigDesc -> m ConfigMap
    tryInsertOption ConfigMap
    m ConfigDesc
    d =
      m ConfigMap -> (OptCreateFailure -> m ConfigMap) -> m ConfigMap
    forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
    forall (m :: Type -> Type) e a.
    (MonadCatch m, HasCallStack, Exception e) =>
    m a -> (e -> m a) -> m a
    catch (ConfigMap -> ConfigDesc -> m ConfigMap
    forall (m :: Type -> Type).
    (MonadIO m, MonadThrow m) =>
    ConfigMap -> ConfigDesc -> m ConfigMap
    insertOption ConfigMap
    m ConfigDesc
    d)
        (\OptCreateFailure{} -> ConfigMap -> m ConfigMap
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ConfigMap
    m)

    -- | Add an option to the given @ConfigMap@ or throws an
    -- 'OptCreateFailure' exception on error.
    --
    -- Inserting an option multiple times is idempotent under equivalency
    -- modulo the opt_onset in the option's style, otherwise it is an
    -- error.
    insertOption ::
      (MonadIO m, MonadThrow m) =>
      ConfigMap -> ConfigDesc -> m ConfigMap
    insertOption :: forall (m :: Type -> Type).
    (MonadIO m, MonadThrow m) =>
    ConfigMap -> ConfigDesc -> m ConfigMap
    insertOption ConfigMap
    m d :: ConfigDesc
    d@(ConfigDesc o :: ConfigOption tp
    o@(ConfigOption BaseTypeRepr tp
    _tp (Text
    p:|[Text]
    ps)) OptionStyle tp
    sty Maybe (Doc Void)
    h Maybe [ConfigDesc]
    newRepls) =
      Text
    -> [Text]
    -> (Maybe ConfigLeaf -> m (Maybe ConfigLeaf))
    -> ConfigMap
    -> m ConfigMap
    forall (t :: Type -> Type).
    Functor t =>
    Text
    -> [Text]
    -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf))
    -> ConfigMap
    -> t ConfigMap
    adjustConfigMap Text
    p [Text]
    ps Maybe ConfigLeaf -> m (Maybe ConfigLeaf)
    f ConfigMap
    m
      where
      f :: Maybe ConfigLeaf -> m (Maybe ConfigLeaf)
    f Maybe ConfigLeaf
    Nothing =
        let addOnSetWarning :: Doc Void -> OptionStyle tp -> OptionStyle tp
    addOnSetWarning Doc Void
    warning OptionStyle tp
    oldSty =
              let newSty :: OptionStyle tp
    newSty = (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    forall (tp :: BaseType).
    (Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
    -> OptionStyle tp -> OptionStyle tp
    set_opt_onset Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    depF OptionStyle tp
    oldSty
                  oldVF :: Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    oldVF = OptionStyle tp
    -> Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    forall (tp :: BaseType).
    OptionStyle tp
    -> Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    opt_onset OptionStyle tp
    oldSty
                  depF :: Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    depF Maybe (ConcreteVal tp)
    oldV ConcreteVal tp
    newV =
                    do v <- Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    oldVF Maybe (ConcreteVal tp)
    oldV ConcreteVal tp
    newV
                       return (v <> optWarn warning)
              in OptionStyle tp
    newSty
            deprHelp :: Doc ann -> f (Doc ann) -> f (Doc ann)
    deprHelp Doc ann
    depMsg f (Doc ann)
    ontoHelp =
              let hMod :: Doc ann -> Doc ann
    hMod Doc ann
    oldHelp = [Doc ann] -> Doc ann
    forall ann. [Doc ann] -> Doc ann
    vsep [ Doc ann
    oldHelp, Doc ann
    "*** DEPRECATED! ***", Doc ann
    depMsg ]
              in Doc ann -> Doc ann
    hMod (Doc ann -> Doc ann) -> f (Doc ann) -> f (Doc ann)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Doc ann)
    ontoHelp
            newRefs :: Doc ann -> [(a, ConfigLeaf)] -> Doc ann
    newRefs Doc ann
    tySep = [Doc ann] -> Doc ann
    forall ann. [Doc ann] -> Doc ann
    hsep ([Doc ann] -> Doc ann)
    -> ([(a, ConfigLeaf)] -> [Doc ann]) -> [(a, ConfigLeaf)] -> Doc ann
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Doc ann -> [Doc ann] -> [Doc ann]
    forall ann. Doc ann -> [Doc ann] -> [Doc ann]
    punctuate Doc ann
    forall ann. Doc ann
    comma ([Doc ann] -> [Doc ann])
    -> ([(a, ConfigLeaf)] -> [Doc ann])
    -> [(a, ConfigLeaf)]
    -> [Doc ann]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                            ((a, ConfigLeaf) -> Doc ann) -> [(a, ConfigLeaf)] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(a
    n, ConfigLeaf OptionStyle tp
    s MVar (Maybe (ConcreteVal tp))
    _ Maybe (Doc Void)
    _) -> Doc ann -> a -> OptionStyle tp -> Doc ann
    forall {a} {ann} {tp :: BaseType}.
    Show a =>
    Doc ann -> a -> OptionStyle tp -> Doc ann
    optRef Doc ann
    tySep a
    n OptionStyle tp
    s)
            optRef :: Doc ann -> a -> OptionStyle tp -> Doc ann
    optRef Doc ann
    tySep a
    nm OptionStyle tp
    s = [Doc ann] -> Doc ann
    forall ann. [Doc ann] -> Doc ann
    hcat [ String -> Doc ann
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (a -> String
    forall a. Show a => a -> String
    show a
    nm), Doc ann
    tySep
                                     , String -> Doc ann
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (BaseTypeRepr tp -> String
    forall a. Show a => a -> String
    show (OptionStyle tp -> BaseTypeRepr tp
    forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type OptionStyle tp
    s))
                                     ]
        in case Maybe [ConfigDesc]
    newRepls of
             -- not deprecated
             Maybe [ConfigDesc]
    Nothing ->
               do ref <- IO (MVar (Maybe (ConcreteVal tp)))
    -> m (MVar (Maybe (ConcreteVal tp)))
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (Maybe (ConcreteVal tp) -> IO (MVar (Maybe (ConcreteVal tp)))
    forall a. a -> IO (MVar a)
    newMVar (OptionStyle tp -> Maybe (ConcreteVal tp)
    forall (tp :: BaseType). OptionStyle tp -> Maybe (ConcreteVal tp)
    opt_default_value OptionStyle tp
    sty))
                  return (Just (ConfigLeaf sty ref h))

             -- deprecation case #1 (removal)
             Just [] ->
               do ref <- IO (MVar (Maybe (ConcreteVal tp)))
    -> m (MVar (Maybe (ConcreteVal tp)))
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (Maybe (ConcreteVal tp) -> IO (MVar (Maybe (ConcreteVal tp)))
    forall a. a -> IO (MVar a)
    newMVar (OptionStyle tp -> Maybe (ConcreteVal tp)
    forall (tp :: BaseType). OptionStyle tp -> Maybe (ConcreteVal tp)
    opt_default_value OptionStyle tp
    sty))
                  let sty' = Doc Void -> OptionStyle tp -> OptionStyle tp
    forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    addOnSetWarning
                             (Doc Void
    "DEPRECATED CONFIG OPTION WILL BE IGNORED: " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                               String -> Doc Void
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (ConfigOption tp -> String
    forall a. Show a => a -> String
    show ConfigOption tp
    o) Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                               Doc Void
    " (no longer valid)")
                             OptionStyle tp
    sty
                      hmsg = Doc Void
    "Option '" Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <> String -> Doc Void
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (ConfigOption tp -> String
    forall a. Show a => a -> String
    show ConfigOption tp
    o) Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <> Doc Void
    "' is no longer valid."
                  return (Just (ConfigLeaf sty' ref (deprHelp hmsg h)))

             Just [ConfigDesc]
    n -> do
               let newer :: [[Maybe (Text, ConfigLeaf)]]
    newer =
                     let returnFnd :: Text -> [Text] -> b -> Const [Maybe (Text, b)] b
    returnFnd Text
    fnd [Text]
    loc b
    lf =
                           if [Text] -> Text
    name [Text]
    loc Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    fnd
                           then [Maybe (Text, b)] -> Const [Maybe (Text, b)] b
    forall {k} a (b :: k). a -> Const a b
    Const [(Text, b) -> Maybe (Text, b)
    forall a. a -> Maybe a
    Just (Text
    fnd, b
    lf)]
                           else [Maybe (Text, b)] -> Const [Maybe (Text, b)] b
    forall {k} a (b :: k). a -> Const a b
    Const [Maybe (Text, b)
    forall a. Maybe a
    Nothing]
                         name :: [Text] -> Text
    name [Text]
    parts = Text -> [Text] -> Text
    Text.intercalate Text
    "." [Text]
    parts
                         lookupNewer :: ConfigDesc -> [Maybe (Text, ConfigLeaf)]
    lookupNewer (ConfigDesc (ConfigOption BaseTypeRepr tp
    _ (Text
    t:|[Text]
    ts)) OptionStyle tp
    _sty Maybe (Doc Void)
    _h Maybe [ConfigDesc]
    new2) =
                           case Maybe [ConfigDesc]
    new2 of
                             Maybe [ConfigDesc]
    Nothing -> Const [Maybe (Text, ConfigLeaf)] ConfigMap
    -> [Maybe (Text, ConfigLeaf)]
    forall {k} a (b :: k). Const a b -> a
    getConst (Const [Maybe (Text, ConfigLeaf)] ConfigMap
     -> [Maybe (Text, ConfigLeaf)])
    -> Const [Maybe (Text, ConfigLeaf)] ConfigMap
    -> [Maybe (Text, ConfigLeaf)]
    forall a b. (a -> b) -> a -> b
    $ [Text]
    -> ([Text]
        -> ConfigLeaf -> Const [Maybe (Text, ConfigLeaf)] ConfigLeaf)
    -> ConfigMap
    -> Const [Maybe (Text, ConfigLeaf)] ConfigMap
    forall (t :: Type -> Type).
    Applicative t =>
    [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigMap
    -> t ConfigMap
    traverseConfigMap [] (Text
    -> [Text]
    -> ConfigLeaf
    -> Const [Maybe (Text, ConfigLeaf)] ConfigLeaf
    forall {k} {b} {b :: k}.
    Text -> [Text] -> b -> Const [Maybe (Text, b)] b
    returnFnd ([Text] -> Text
    name (Text
    tText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    ts))) ConfigMap
    m
                             Just [ConfigDesc]
    n2 -> [[Maybe (Text, ConfigLeaf)]] -> [Maybe (Text, ConfigLeaf)]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat (ConfigDesc -> [Maybe (Text, ConfigLeaf)]
    lookupNewer (ConfigDesc -> [Maybe (Text, ConfigLeaf)])
    -> [ConfigDesc] -> [[Maybe (Text, ConfigLeaf)]]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ConfigDesc]
    n2)
                     in ConfigDesc -> [Maybe (Text, ConfigLeaf)]
    lookupNewer (ConfigDesc -> [Maybe (Text, ConfigLeaf)])
    -> [ConfigDesc] -> [[Maybe (Text, ConfigLeaf)]]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ConfigDesc]
    n
                   chkMissing :: [Maybe (Text, ConfigLeaf)] -> m [Maybe (Text, ConfigLeaf)]
    chkMissing [Maybe (Text, ConfigLeaf)]
    opts =
                     if Bool -> Bool
    not ([Maybe (Text, ConfigLeaf)] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null [Maybe (Text, ConfigLeaf)]
    opts) Bool -> Bool -> Bool
    && [(Text, ConfigLeaf)] -> Bool
    forall a. [a] -> Bool
    forall (t :: Type -> Type) a. Foldable t => t a -> Bool
    null ([Maybe (Text, ConfigLeaf)] -> [(Text, ConfigLeaf)]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe (Text, ConfigLeaf)]
    opts)
                     then OptCreateFailure -> m [Maybe (Text, ConfigLeaf)]
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: Type -> Type) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (OptCreateFailure -> m [Maybe (Text, ConfigLeaf)])
    -> OptCreateFailure -> m [Maybe (Text, ConfigLeaf)]
    forall a b. (a -> b) -> a -> b
    $ ConfigDesc -> Doc Void -> OptCreateFailure
    OptCreateFailure ConfigDesc
    d (Doc Void -> OptCreateFailure) -> Doc Void -> OptCreateFailure
    forall a b. (a -> b) -> a -> b
    $
                          Doc Void
    "replacement options must be inserted into" Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                          Doc Void
    " Config before this deprecated option"
                     else [Maybe (Text, ConfigLeaf)] -> m [Maybe (Text, ConfigLeaf)]
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return [Maybe (Text, ConfigLeaf)]
    opts
               newOpts <- [Maybe (Text, ConfigLeaf)] -> [(Text, ConfigLeaf)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (Text, ConfigLeaf)] -> [(Text, ConfigLeaf)])
    -> ([[Maybe (Text, ConfigLeaf)]] -> [Maybe (Text, ConfigLeaf)])
    -> [[Maybe (Text, ConfigLeaf)]]
    -> [(Text, ConfigLeaf)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Maybe (Text, ConfigLeaf)]] -> [Maybe (Text, ConfigLeaf)]
    forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
    concat ([[Maybe (Text, ConfigLeaf)]] -> [(Text, ConfigLeaf)])
    -> m [[Maybe (Text, ConfigLeaf)]] -> m [(Text, ConfigLeaf)]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([Maybe (Text, ConfigLeaf)] -> m [Maybe (Text, ConfigLeaf)])
    -> [[Maybe (Text, ConfigLeaf)]] -> m [[Maybe (Text, ConfigLeaf)]]
    forall (t :: Type -> Type) (m :: Type -> Type) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> [a] -> m [b]
    mapM [Maybe (Text, ConfigLeaf)] -> m [Maybe (Text, ConfigLeaf)]
    chkMissing [[Maybe (Text, ConfigLeaf)]]
    newer

               case newOpts of

                 -- deprecation case #1 (removal)
                 [] ->
                   do ref <- IO (MVar (Maybe (ConcreteVal tp)))
    -> m (MVar (Maybe (ConcreteVal tp)))
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (Maybe (ConcreteVal tp) -> IO (MVar (Maybe (ConcreteVal tp)))
    forall a. a -> IO (MVar a)
    newMVar (OptionStyle tp -> Maybe (ConcreteVal tp)
    forall (tp :: BaseType). OptionStyle tp -> Maybe (ConcreteVal tp)
    opt_default_value OptionStyle tp
    sty))
                      let sty' = Doc Void -> OptionStyle tp -> OptionStyle tp
    forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    addOnSetWarning
                                 (Doc Void
    "DEPRECATED CONFIG OPTION WILL BE IGNORED: " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                  String -> Doc Void
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (ConfigOption tp -> String
    forall a. Show a => a -> String
    show ConfigOption tp
    o) Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                  Doc Void
    " (no longer valid)")
                                 OptionStyle tp
    sty
                          hmsg = Doc Void
    "Option '" Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <> String -> Doc Void
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (ConfigOption tp -> String
    forall a. Show a => a -> String
    show ConfigOption tp
    o) Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <> Doc Void
    "' is no longer valid."
                      return (Just (ConfigLeaf sty' ref (deprHelp hmsg h)))

                 -- deprecation case #2 (renamed)
                 ((Text
    nm, ConfigLeaf OptionStyle tp
    sty' MVar (Maybe (ConcreteVal tp))
    v Maybe (Doc Void)
    _):[])
                   | Just tp :~: tp
    Refl <- BaseTypeRepr tp -> BaseTypeRepr tp -> Maybe (tp :~: tp)
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: BaseType) (b :: BaseType).
    BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
    testEquality (OptionStyle tp -> BaseTypeRepr tp
    forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type OptionStyle tp
    sty) (OptionStyle tp -> BaseTypeRepr tp
    forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type OptionStyle tp
    sty') ->
                     do let updSty :: OptionStyle tp -> OptionStyle tp
    updSty = Doc Void -> OptionStyle tp -> OptionStyle tp
    forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    addOnSetWarning
                                     (Doc Void
    "DEPRECATED CONFIG OPTION USED: " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                      String -> Doc Void
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (ConfigOption tp -> String
    forall a. Show a => a -> String
    show ConfigOption tp
    o) Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                      Doc Void
    " (renamed to: " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <> Text -> Doc Void
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Text
    nm Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <> Doc Void
    ")")
                            hmsg :: Doc Void
    hmsg = Doc Void
    "Suggest replacing '" Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <> String -> Doc Void
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (ConfigOption tp -> String
    forall a. Show a => a -> String
    show ConfigOption tp
    o) Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                   Doc Void
    "' with '" Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <> Text -> Doc Void
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty Text
    nm Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <> Doc Void
    "'."
                        Maybe ConfigLeaf -> m (Maybe ConfigLeaf)
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (ConfigLeaf -> Maybe ConfigLeaf
    forall a. a -> Maybe a
    Just (OptionStyle tp
    -> MVar (Maybe (ConcreteVal tp)) -> Maybe (Doc Void) -> ConfigLeaf
    forall (tp :: BaseType).
    OptionStyle tp
    -> MVar (Maybe (ConcreteVal tp)) -> Maybe (Doc Void) -> ConfigLeaf
    ConfigLeaf (OptionStyle tp -> OptionStyle tp
    updSty OptionStyle tp
    sty) MVar (Maybe (ConcreteVal tp))
    MVar (Maybe (ConcreteVal tp))
    v (Doc Void -> Maybe (Doc Void) -> Maybe (Doc Void)
    forall {f :: Type -> Type} {ann}.
    Functor f =>
    Doc ann -> f (Doc ann) -> f (Doc ann)
    deprHelp Doc Void
    hmsg Maybe (Doc Void)
    h)))

                 -- deprecation case #3 (renamed and re-typed)
                 ((Text, ConfigLeaf)
    new1:[]) ->
                   do ref <- IO (MVar (Maybe (ConcreteVal tp)))
    -> m (MVar (Maybe (ConcreteVal tp)))
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (Maybe (ConcreteVal tp) -> IO (MVar (Maybe (ConcreteVal tp)))
    forall a. a -> IO (MVar a)
    newMVar (OptionStyle tp -> Maybe (ConcreteVal tp)
    forall (tp :: BaseType). OptionStyle tp -> Maybe (ConcreteVal tp)
    opt_default_value OptionStyle tp
    sty))
                      let updSty = Doc Void -> OptionStyle tp -> OptionStyle tp
    forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    addOnSetWarning
                                   (Doc Void
    "DEPRECATED CONFIG OPTION USED: " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                    Doc Void -> ConfigOption tp -> OptionStyle tp -> Doc Void
    forall {a} {ann} {tp :: BaseType}.
    Show a =>
    Doc ann -> a -> OptionStyle tp -> Doc ann
    optRef Doc Void
    "::" ConfigOption tp
    o OptionStyle tp
    sty Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                    Doc Void
    " (changed to: " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                    Doc Void -> [(Text, ConfigLeaf)] -> Doc Void
    forall {a} {ann}. Show a => Doc ann -> [(a, ConfigLeaf)] -> Doc ann
    newRefs Doc Void
    "::" [(Text, ConfigLeaf)
    new1] Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                    Doc Void
    "); this value may be ignored")
                          hmsg = Doc Void
    "Suggest converting '" Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                 Doc Void -> ConfigOption tp -> OptionStyle tp -> Doc Void
    forall {a} {ann} {tp :: BaseType}.
    Show a =>
    Doc ann -> a -> OptionStyle tp -> Doc ann
    optRef Doc Void
    " of type " ConfigOption tp
    o OptionStyle tp
    sty Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                 Doc Void
    " to " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                 Doc Void -> [(Text, ConfigLeaf)] -> Doc Void
    forall {a} {ann}. Show a => Doc ann -> [(a, ConfigLeaf)] -> Doc ann
    newRefs Doc Void
    " of type " [(Text, ConfigLeaf)
    new1]
                      return (Just (ConfigLeaf (updSty sty) ref (deprHelp hmsg h)))

                 -- deprecation case #4 (split to multiple options)
                 [(Text, ConfigLeaf)]
    newMulti ->
                   do ref <- IO (MVar (Maybe (ConcreteVal tp)))
    -> m (MVar (Maybe (ConcreteVal tp)))
    forall a. IO a -> m a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (Maybe (ConcreteVal tp) -> IO (MVar (Maybe (ConcreteVal tp)))
    forall a. a -> IO (MVar a)
    newMVar (OptionStyle tp -> Maybe (ConcreteVal tp)
    forall (tp :: BaseType). OptionStyle tp -> Maybe (ConcreteVal tp)
    opt_default_value OptionStyle tp
    sty))
                      let updSty = Doc Void -> OptionStyle tp -> OptionStyle tp
    forall (tp :: BaseType).
    Doc Void -> OptionStyle tp -> OptionStyle tp
    addOnSetWarning
                                   (Doc Void
    "DEPRECATED CONFIG OPTION USED: " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                    Doc Void -> ConfigOption tp -> OptionStyle tp -> Doc Void
    forall {a} {ann} {tp :: BaseType}.
    Show a =>
    Doc ann -> a -> OptionStyle tp -> Doc ann
    optRef Doc Void
    "::" ConfigOption tp
    o OptionStyle tp
    sty Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                    Doc Void
    " (replaced by: " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                    Doc Void -> [(Text, ConfigLeaf)] -> Doc Void
    forall {a} {ann}. Show a => Doc ann -> [(a, ConfigLeaf)] -> Doc ann
    newRefs Doc Void
    "::" [(Text, ConfigLeaf)]
    newMulti Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                    Doc Void
    "); this value may be ignored")
                          hmsg = Doc Void
    "Suggest converting " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                 Doc Void -> ConfigOption tp -> OptionStyle tp -> Doc Void
    forall {a} {ann} {tp :: BaseType}.
    Show a =>
    Doc ann -> a -> OptionStyle tp -> Doc ann
    optRef Doc Void
    " of type " ConfigOption tp
    o OptionStyle tp
    sty Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <>
                                 Doc Void
    " to: " Doc Void -> Doc Void -> Doc Void
    forall a. Semigroup a => a -> a -> a
    <> (Doc Void -> [(Text, ConfigLeaf)] -> Doc Void
    forall {a} {ann}. Show a => Doc ann -> [(a, ConfigLeaf)] -> Doc ann
    newRefs Doc Void
    " of type " [(Text, ConfigLeaf)]
    newMulti)
                      return (Just (ConfigLeaf (updSty sty) ref (deprHelp hmsg h)))

      f (Just existing :: ConfigLeaf
    existing@(ConfigLeaf OptionStyle tp
    sty' MVar (Maybe (ConcreteVal tp))
    _ Maybe (Doc Void)
    h')) =
        case BaseTypeRepr tp -> BaseTypeRepr tp -> Maybe (tp :~: tp)
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: BaseType) (b :: BaseType).
    BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
    testEquality (OptionStyle tp -> BaseTypeRepr tp
    forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type OptionStyle tp
    sty) (OptionStyle tp -> BaseTypeRepr tp
    forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type OptionStyle tp
    sty') of
          Just tp :~: tp
    Refl ->
            if [Bool] -> Bool
    forall (t :: Type -> Type). Foldable t => t Bool -> Bool
    and [ Doc Void -> String
    forall a. Show a => a -> String
    show (OptionStyle tp -> Doc Void
    forall (tp :: BaseType). OptionStyle tp -> Doc Void
    opt_help OptionStyle tp
    sty) String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Doc Void -> String
    forall a. Show a => a -> String
    show (OptionStyle tp -> Doc Void
    forall (tp :: BaseType). OptionStyle tp -> Doc Void
    opt_help OptionStyle tp
    sty')
                   , OptionStyle tp -> Maybe (ConcreteVal tp)
    forall (tp :: BaseType). OptionStyle tp -> Maybe (ConcreteVal tp)
    opt_default_value OptionStyle tp
    sty Maybe (ConcreteVal tp) -> Maybe (ConcreteVal tp) -> Bool
    forall a. Eq a => a -> a -> Bool
    == OptionStyle tp -> Maybe (ConcreteVal tp)
    forall (tp :: BaseType). OptionStyle tp -> Maybe (ConcreteVal tp)
    opt_default_value OptionStyle tp
    OptionStyle tp
    sty'
                   -- Note opt_onset in sty is ignored/dropped
                   , Maybe (Doc Void) -> String
    forall a. Show a => a -> String
    show Maybe (Doc Void)
    h String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe (Doc Void) -> String
    forall a. Show a => a -> String
    show Maybe (Doc Void)
    h'
                   ]
            then Maybe ConfigLeaf -> m (Maybe ConfigLeaf)
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Maybe ConfigLeaf -> m (Maybe ConfigLeaf))
    -> Maybe ConfigLeaf -> m (Maybe ConfigLeaf)
    forall a b. (a -> b) -> a -> b
    $ ConfigLeaf -> Maybe ConfigLeaf
    forall a. a -> Maybe a
    Just ConfigLeaf
    existing
            else OptCreateFailure -> m (Maybe ConfigLeaf)
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: Type -> Type) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (OptCreateFailure -> m (Maybe ConfigLeaf))
    -> OptCreateFailure -> m (Maybe ConfigLeaf)
    forall a b. (a -> b) -> a -> b
    $ ConfigDesc -> Doc Void -> OptCreateFailure
    OptCreateFailure ConfigDesc
    d Doc Void
    "already exists"
          Maybe (tp :~: tp)
    Nothing -> OptCreateFailure -> m (Maybe ConfigLeaf)
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: Type -> Type) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (OptCreateFailure -> m (Maybe ConfigLeaf))
    -> OptCreateFailure -> m (Maybe ConfigLeaf)
    forall a b. (a -> b) -> a -> b
    $ ConfigDesc -> Doc Void -> OptCreateFailure
    OptCreateFailure ConfigDesc
    d
                     (String -> Doc Void
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (String -> Doc Void) -> String -> Doc Void
    forall a b. (a -> b) -> a -> b
    $ String
    "already exists with type " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> BaseTypeRepr tp -> String
    forall a. Show a => a -> String
    show (OptionStyle tp -> BaseTypeRepr tp
    forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type OptionStyle tp
    sty'))

    data OptCreateFailure = OptCreateFailure ConfigDesc (Doc Void)

    instance Exception OptCreateFailure
    instance Show OptCreateFailure where
      show :: OptCreateFailure -> String
    show (OptCreateFailure ConfigDesc
    cfgdesc Doc Void
    msg) =
        String
    "Failed to create option " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ConfigDesc -> String
    forall a. Show a => a -> String
    show ConfigDesc
    cfgdesc String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    ": " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Doc Void -> String
    forall a. Show a => a -> String
    show Doc Void
    msg

    ------------------------------------------------------------------------
    -- Config

    -- | The main configuration datatype.  It consists of a Read/Write var
    --   containing the actual configuration data.
    newtype Config = Config (RWV.RWVar ConfigMap)

    -- | Construct a new configuration from the given configuration
    --   descriptions.
    initialConfig ::
      Integer      {- ^ Initial value for the `verbosity` option -} ->
      [ConfigDesc] {- ^ Option descriptions to install -} ->
      IO (Config)
    initialConfig :: Integer -> [ConfigDesc] -> IO Config
    initialConfig Integer
    initVerbosity [ConfigDesc]
    ts = do
       cfg <- RWVar ConfigMap -> Config
    Config (RWVar ConfigMap -> Config) -> IO (RWVar ConfigMap) -> IO Config
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> ConfigMap -> IO (RWVar ConfigMap)
    forall a. a -> IO (RWVar a)
    RWV.new ConfigMap
    forall k a. Map k a
    Map.empty
       extendConfig (builtInOpts initVerbosity ++ ts) cfg
       return cfg

    -- | Extend an existing configuration with new options.  An
    --   'OptCreateFailure' exception will be raised if any of the given
    --   options clash with options that already exists.
    extendConfig :: [ConfigDesc] -> Config -> IO ()
    extendConfig :: [ConfigDesc] -> Config -> IO ()
    extendConfig [ConfigDesc]
    ts (Config RWVar ConfigMap
    cfg) =
      RWVar ConfigMap -> (ConfigMap -> IO ConfigMap) -> IO ()
    forall a. RWVar a -> (a -> IO a) -> IO ()
    RWV.modify_ RWVar ConfigMap
    cfg (\ConfigMap
    m -> (ConfigMap -> ConfigDesc -> IO ConfigMap)
    -> ConfigMap -> [ConfigDesc] -> IO ConfigMap
    forall (t :: Type -> Type) (m :: Type -> Type) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ConfigMap -> ConfigDesc -> IO ConfigMap
    forall (m :: Type -> Type).
    (MonadIO m, MonadThrow m) =>
    ConfigMap -> ConfigDesc -> m ConfigMap
    insertOption ConfigMap
    m [ConfigDesc]
    ts)

    -- | Extend an existing configuration with new options. If any
    --   of the given options are already present in the configuration,
    --   nothing is done for that option and it is silently skipped.
    tryExtendConfig :: [ConfigDesc] -> Config -> IO ()
    tryExtendConfig :: [ConfigDesc] -> Config -> IO ()
    tryExtendConfig [ConfigDesc]
    ts (Config RWVar ConfigMap
    cfg) =
      RWVar ConfigMap -> (ConfigMap -> IO ConfigMap) -> IO ()
    forall a. RWVar a -> (a -> IO a) -> IO ()
    RWV.modify_ RWVar ConfigMap
    cfg (\ConfigMap
    m -> (ConfigMap -> ConfigDesc -> IO ConfigMap)
    -> ConfigMap -> [ConfigDesc] -> IO ConfigMap
    forall (t :: Type -> Type) (m :: Type -> Type) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ConfigMap -> ConfigDesc -> IO ConfigMap
    forall (m :: Type -> Type).
    (MonadIO m, MonadCatch m) =>
    ConfigMap -> ConfigDesc -> m ConfigMap
    tryInsertOption ConfigMap
    m [ConfigDesc]
    ts)

    -- | Create a new configuration object that shares the option
    --   settings currently in the given input config. However,
    --   any options added to either configuration using @extendConfig@
    --   will not be propagated to the other.
    --
    --   Option settings that already exist in the input configuration
    --   will be shared between both; changes to those options will be
    --   visible in both configurations.
    splitConfig :: Config -> IO Config
    splitConfig :: Config -> IO Config
    splitConfig (Config RWVar ConfigMap
    cfg) = RWVar ConfigMap -> Config
    Config (RWVar ConfigMap -> Config) -> IO (RWVar ConfigMap) -> IO Config
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (RWVar ConfigMap
    -> (ConfigMap -> IO (RWVar ConfigMap)) -> IO (RWVar ConfigMap)
    forall a b. RWVar a -> (a -> IO b) -> IO b
    RWV.with RWVar ConfigMap
    cfg ConfigMap -> IO (RWVar ConfigMap)
    forall a. a -> IO (RWVar a)
    RWV.new)

    -- | Verbosity of the simulator.  This option controls how much
    --   informational and debugging output is generated.
    --   0 yields low information output; 5 is extremely chatty.
    verbosity :: ConfigOption BaseIntegerType
    verbosity :: ConfigOption BaseIntegerType
    verbosity = BaseTypeRepr BaseIntegerType
    -> String -> ConfigOption BaseIntegerType
    forall (tp :: BaseType).
    BaseTypeRepr tp -> String -> ConfigOption tp
    configOption BaseTypeRepr BaseIntegerType
    BaseIntegerRepr String
    "verbosity"

    -- | Built-in options that are installed in every @Config@ object.
    builtInOpts :: Integer -> [ConfigDesc]
    builtInOpts :: Integer -> [ConfigDesc]
    builtInOpts Integer
    initialVerbosity =
      [ ConfigOption BaseIntegerType
    -> ConcreteVal BaseIntegerType -> Text -> ConfigDesc
    forall help (tp :: BaseType).
    Pretty help =>
    ConfigOption tp -> ConcreteVal tp -> help -> ConfigDesc
    opt ConfigOption BaseIntegerType
    verbosity
            (Integer -> ConcreteVal BaseIntegerType
    ConcreteInteger Integer
    initialVerbosity)
            (Text
    "Verbosity of the simulator: higher values produce more detailed informational and debugging output." :: Text)
      ]

    -- | Return an operation that will consult the current value of the
    --   verbosity option, and will print a string to the given @Handle@
    --   if the provided int is smaller than the current verbosity setting.
    verbosityLogger :: Config -> Handle -> IO (Int -> String -> IO ())
    verbosityLogger :: Config -> Handle -> IO (Int -> String -> IO ())
    verbosityLogger Config
    cfg Handle
    h =
      do verb <- ConfigOption BaseIntegerType
    -> Config -> IO (OptionSetting BaseIntegerType)
    forall (tp :: BaseType).
    ConfigOption tp -> Config -> IO (OptionSetting tp)
    getOptionSetting ConfigOption BaseIntegerType
    verbosity Config
    cfg
         return $ \Int
    n String
    msg ->
           do v <- OptionSetting BaseIntegerType -> IO Integer
    forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
    getOpt OptionSetting BaseIntegerType
    verb
              when (toInteger n < v) (hPutStr h msg)

    -- | A utility class for making working with option settings
    --   easier.  The @tp@ argument is a @BaseType@, and the @a@
    --   argument is an associcated Haskell type.
    class Opt (tp :: BaseType) (a :: Type) | tp -> a where
      -- | Return the current value of the option, as a @Maybe@ value.
      getMaybeOpt :: OptionSetting tp -> IO (Maybe a)

      -- | Attempt to set the value of an option.  Return any errors
      --   or warnings.
      trySetOpt :: OptionSetting tp -> a -> IO OptionSetResult

      -- | Set the value of an option.  Return any generated warnings.
      --   Throws an OptSetFailure exception if a validation error occurs.
      setOpt :: OptionSetting tp -> a -> IO [Doc Void]
      setOpt OptionSetting tp
    x a
    v = OptionSetting tp -> a -> IO OptionSetResult
    forall (tp :: BaseType) a.
    Opt tp a =>
    OptionSetting tp -> a -> IO OptionSetResult
    trySetOpt OptionSetting tp
    x a
    v IO OptionSetResult
    -> (OptionSetResult -> IO [Doc Void]) -> IO [Doc Void]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= OptionSetting tp -> OptionSetResult -> IO [Doc Void]
    forall (tp :: BaseType).
    OptionSetting tp -> OptionSetResult -> IO [Doc Void]
    checkOptSetResult OptionSetting tp
    x

      -- | Get the current value of an option.  Throw an exception
      --   if the option is not currently set.
      getOpt :: OptionSetting tp -> IO a
      getOpt OptionSetting tp
    x = IO a -> (a -> IO a) -> Maybe a -> IO a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (OptGetFailure -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: Type -> Type) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (OptGetFailure -> IO a) -> OptGetFailure -> IO a
    forall a b. (a -> b) -> a -> b
    $ OptRef -> Doc Void -> OptGetFailure
    OptGetFailure (Some OptionSetting -> OptRef
    OSet (Some OptionSetting -> OptRef) -> Some OptionSetting -> OptRef
    forall a b. (a -> b) -> a -> b
    $ OptionSetting tp -> Some OptionSetting
    forall k (f :: k -> Type) (x :: k). f x -> Some f
    Some OptionSetting tp
    x) Doc Void
    "not set") a -> IO a
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return
                 (Maybe a -> IO a) -> IO (Maybe a) -> IO a
    forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
    =<< OptionSetting tp -> IO (Maybe a)
    forall (tp :: BaseType) a.
    Opt tp a =>
    OptionSetting tp -> IO (Maybe a)
    getMaybeOpt OptionSetting tp
    x

    -- | Throw an exception if the given @OptionSetResult@ indicates
    --   an error.  Otherwise, return any generated warnings.
    checkOptSetResult :: OptionSetting tp -> OptionSetResult -> IO [Doc Void]
    checkOptSetResult :: forall (tp :: BaseType).
    OptionSetting tp -> OptionSetResult -> IO [Doc Void]
    checkOptSetResult OptionSetting tp
    optset OptionSetResult
    res =
      case OptionSetResult -> Maybe (Doc Void)
    optionSetError OptionSetResult
    res of
        Just Doc Void
    msg -> OptSetFailure -> IO [Doc Void]
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: Type -> Type) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (OptSetFailure -> IO [Doc Void]) -> OptSetFailure -> IO [Doc Void]
    forall a b. (a -> b) -> a -> b
    $ Some OptionSetting -> Doc Void -> OptSetFailure
    OptSetFailure (OptionSetting tp -> Some OptionSetting
    forall k (f :: k -> Type) (x :: k). f x -> Some f
    Some OptionSetting tp
    optset) Doc Void
    msg
        Maybe (Doc Void)
    Nothing -> [Doc Void] -> IO [Doc Void]
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Seq (Doc Void) -> [Doc Void]
    forall a. Seq a -> [a]
    forall (t :: Type -> Type) a. Foldable t => t a -> [a]
    toList (OptionSetResult -> Seq (Doc Void)
    optionSetWarnings OptionSetResult
    res))

    data OptSetFailure = OptSetFailure (Some OptionSetting) (Doc Void)
    instance Exception OptSetFailure
    instance Show OptSetFailure where
      show :: OptSetFailure -> String
    show (OptSetFailure Some OptionSetting
    optset Doc Void
    msg) =
        String
    "Failed to set " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Some OptionSetting -> String
    forall a. Show a => a -> String
    show Some OptionSetting
    optset String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    ": " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Doc Void -> String
    forall a. Show a => a -> String
    show Doc Void
    msg

    data OptRef = OName Text | OSet (Some OptionSetting) | OCfg (Some ConfigOption)
    instance Show OptRef where
      show :: OptRef -> String
    show = \case
        OName Text
    t -> Text -> String
    forall a. Show a => a -> String
    show Text
    t
        OSet (Some OptionSetting x
    s) -> OptionSetting x -> String
    forall a. Show a => a -> String
    show OptionSetting x
    s
        OCfg (Some ConfigOption x
    c) -> ConfigOption x -> String
    forall a. Show a => a -> String
    show ConfigOption x
    c

    data OptGetFailure = OptGetFailure OptRef (Doc Void)
    instance Exception OptGetFailure
    instance Show OptGetFailure where
      show :: OptGetFailure -> String
    show (OptGetFailure OptRef
    optref Doc Void
    msg) =
        String
    "Failed to get " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> (OptRef -> String
    forall a. Show a => a -> String
    show OptRef
    optref) String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    ": " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Doc Void -> String
    forall a. Show a => a -> String
    show Doc Void
    msg

    instance Opt (BaseStringType Unicode) Text where
      getMaybeOpt :: OptionSetting (BaseStringType Unicode) -> IO (Maybe Text)
    getMaybeOpt OptionSetting (BaseStringType Unicode)
    x = (ConcreteVal (BaseStringType Unicode) -> Text)
    -> Maybe (ConcreteVal (BaseStringType Unicode)) -> Maybe Text
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap (StringLiteral Unicode -> Text
    fromUnicodeLit (StringLiteral Unicode -> Text)
    -> (ConcreteVal (BaseStringType Unicode) -> StringLiteral Unicode)
    -> ConcreteVal (BaseStringType Unicode)
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConcreteVal (BaseStringType Unicode) -> StringLiteral Unicode
    forall (si :: StringInfo).
    ConcreteVal (BaseStringType si) -> StringLiteral si
    fromConcreteString) (Maybe (ConcreteVal (BaseStringType Unicode)) -> Maybe Text)
    -> IO (Maybe (ConcreteVal (BaseStringType Unicode)))
    -> IO (Maybe Text)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> OptionSetting (BaseStringType Unicode)
    -> IO (Maybe (ConcreteVal (BaseStringType Unicode)))
    forall (tp :: BaseType).
    OptionSetting tp -> IO (Maybe (ConcreteVal tp))
    getOption OptionSetting (BaseStringType Unicode)
    x
      trySetOpt :: OptionSetting (BaseStringType Unicode)
    -> Text -> IO OptionSetResult
    trySetOpt OptionSetting (BaseStringType Unicode)
    x Text
    v = OptionSetting (BaseStringType Unicode)
    -> ConcreteVal (BaseStringType Unicode) -> IO OptionSetResult
    forall (tp :: BaseType).
    OptionSetting tp -> ConcreteVal tp -> IO OptionSetResult
    setOption OptionSetting (BaseStringType Unicode)
    x (StringLiteral Unicode -> ConcreteVal (BaseStringType Unicode)
    forall (si :: StringInfo).
    StringLiteral si -> ConcreteVal ('BaseStringType si)
    ConcreteString (Text -> StringLiteral Unicode
    UnicodeLiteral Text
    v))

    instance Opt BaseIntegerType Integer where
      getMaybeOpt :: OptionSetting BaseIntegerType -> IO (Maybe Integer)
    getMaybeOpt OptionSetting BaseIntegerType
    x = (ConcreteVal BaseIntegerType -> Integer)
    -> Maybe (ConcreteVal BaseIntegerType) -> Maybe Integer
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ConcreteVal BaseIntegerType -> Integer
    fromConcreteInteger (Maybe (ConcreteVal BaseIntegerType) -> Maybe Integer)
    -> IO (Maybe (ConcreteVal BaseIntegerType)) -> IO (Maybe Integer)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> OptionSetting BaseIntegerType
    -> IO (Maybe (ConcreteVal BaseIntegerType))
    forall (tp :: BaseType).
    OptionSetting tp -> IO (Maybe (ConcreteVal tp))
    getOption OptionSetting BaseIntegerType
    x
      trySetOpt :: OptionSetting BaseIntegerType -> Integer -> IO OptionSetResult
    trySetOpt OptionSetting BaseIntegerType
    x Integer
    v = OptionSetting BaseIntegerType
    -> ConcreteVal BaseIntegerType -> IO OptionSetResult
    forall (tp :: BaseType).
    OptionSetting tp -> ConcreteVal tp -> IO OptionSetResult
    setOption OptionSetting BaseIntegerType
    x (Integer -> ConcreteVal BaseIntegerType
    ConcreteInteger Integer
    v)

    instance Opt BaseBoolType Bool where
      getMaybeOpt :: OptionSetting BaseBoolType -> IO (Maybe Bool)
    getMaybeOpt OptionSetting BaseBoolType
    x = (ConcreteVal BaseBoolType -> Bool)
    -> Maybe (ConcreteVal BaseBoolType) -> Maybe Bool
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ConcreteVal BaseBoolType -> Bool
    fromConcreteBool (Maybe (ConcreteVal BaseBoolType) -> Maybe Bool)
    -> IO (Maybe (ConcreteVal BaseBoolType)) -> IO (Maybe Bool)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> OptionSetting BaseBoolType -> IO (Maybe (ConcreteVal BaseBoolType))
    forall (tp :: BaseType).
    OptionSetting tp -> IO (Maybe (ConcreteVal tp))
    getOption OptionSetting BaseBoolType
    x
      trySetOpt :: OptionSetting BaseBoolType -> Bool -> IO OptionSetResult
    trySetOpt OptionSetting BaseBoolType
    x Bool
    v = OptionSetting BaseBoolType
    -> ConcreteVal BaseBoolType -> IO OptionSetResult
    forall (tp :: BaseType).
    OptionSetting tp -> ConcreteVal tp -> IO OptionSetResult
    setOption OptionSetting BaseBoolType
    x (Bool -> ConcreteVal BaseBoolType
    ConcreteBool Bool
    v)

    instance Opt BaseRealType Rational where
      getMaybeOpt :: OptionSetting BaseRealType -> IO (Maybe Rational)
    getMaybeOpt OptionSetting BaseRealType
    x = (ConcreteVal BaseRealType -> Rational)
    -> Maybe (ConcreteVal BaseRealType) -> Maybe Rational
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    fmap ConcreteVal BaseRealType -> Rational
    fromConcreteReal (Maybe (ConcreteVal BaseRealType) -> Maybe Rational)
    -> IO (Maybe (ConcreteVal BaseRealType)) -> IO (Maybe Rational)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> OptionSetting BaseRealType -> IO (Maybe (ConcreteVal BaseRealType))
    forall (tp :: BaseType).
    OptionSetting tp -> IO (Maybe (ConcreteVal tp))
    getOption OptionSetting BaseRealType
    x
      trySetOpt :: OptionSetting BaseRealType -> Rational -> IO OptionSetResult
    trySetOpt OptionSetting BaseRealType
    x Rational
    v = OptionSetting BaseRealType
    -> ConcreteVal BaseRealType -> IO OptionSetResult
    forall (tp :: BaseType).
    OptionSetting tp -> ConcreteVal tp -> IO OptionSetResult
    setOption OptionSetting BaseRealType
    x (Rational -> ConcreteVal BaseRealType
    ConcreteReal Rational
    v)

    -- | Given a unicode text value, set the named option to that value or
    -- generate an OptSetFailure exception if the option is not a unicode
    -- text valued option.
    setUnicodeOpt :: Some OptionSetting -> Text -> IO [Doc Void]
    setUnicodeOpt :: Some OptionSetting -> Text -> IO [Doc Void]
    setUnicodeOpt (Some OptionSetting x
    optset) Text
    val =
      let tyOpt :: BaseTypeRepr x
    tyOpt = ConfigOption x -> BaseTypeRepr x
    forall (tp :: BaseType). ConfigOption tp -> BaseTypeRepr tp
    configOptionType (OptionSetting x -> ConfigOption x
    forall (tp :: BaseType). OptionSetting tp -> ConfigOption tp
    optionSettingName OptionSetting x
    optset)
      in case BaseTypeRepr x
    -> BaseTypeRepr (BaseStringType Unicode)
    -> Maybe (x :~: BaseStringType Unicode)
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: BaseType) (b :: BaseType).
    BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
    testEquality BaseTypeRepr x
    tyOpt (StringInfoRepr Unicode -> BaseTypeRepr (BaseStringType Unicode)
    forall (si :: StringInfo).
    StringInfoRepr si -> BaseTypeRepr ('BaseStringType si)
    BaseStringRepr StringInfoRepr Unicode
    UnicodeRepr) of
           Just x :~: BaseStringType Unicode
    Refl -> OptionSetting x -> Text -> IO [Doc Void]
    forall (tp :: BaseType) a.
    Opt tp a =>
    OptionSetting tp -> a -> IO [Doc Void]
    setOpt OptionSetting x
    optset Text
    val
           Maybe (x :~: BaseStringType Unicode)
    Nothing ->
             OptionSetting x -> OptionSetResult -> IO [Doc Void]
    forall (tp :: BaseType).
    OptionSetting tp -> OptionSetResult -> IO [Doc Void]
    checkOptSetResult OptionSetting x
    optset (OptionSetResult -> IO [Doc Void])
    -> OptionSetResult -> IO [Doc Void]
    forall a b. (a -> b) -> a -> b
    $ Doc Void -> OptionSetResult
    optErr (Doc Void -> OptionSetResult) -> Doc Void -> OptionSetResult
    forall a b. (a -> b) -> a -> b
    $
             Doc Void
    "option type is a" Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> BaseTypeRepr x -> Doc Void
    forall a ann. Pretty a => a -> Doc ann
    forall ann. BaseTypeRepr x -> Doc ann
    pretty BaseTypeRepr x
    tyOpt Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc Void
    "but given a text string"

    -- | Given an integer value, set the named option to that value or
    -- generate an OptSetFailure exception if the option is not an integer
    -- valued option.
    setIntegerOpt :: Some OptionSetting -> Integer -> IO [Doc Void]
    setIntegerOpt :: Some OptionSetting -> Integer -> IO [Doc Void]
    setIntegerOpt (Some OptionSetting x
    optset) Integer
    val =
      let tyOpt :: BaseTypeRepr x
    tyOpt = ConfigOption x -> BaseTypeRepr x
    forall (tp :: BaseType). ConfigOption tp -> BaseTypeRepr tp
    configOptionType (OptionSetting x -> ConfigOption x
    forall (tp :: BaseType). OptionSetting tp -> ConfigOption tp
    optionSettingName OptionSetting x
    optset)
      in case BaseTypeRepr x
    -> BaseTypeRepr BaseIntegerType -> Maybe (x :~: BaseIntegerType)
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: BaseType) (b :: BaseType).
    BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
    testEquality BaseTypeRepr x
    tyOpt BaseTypeRepr BaseIntegerType
    BaseIntegerRepr of
           Just x :~: BaseIntegerType
    Refl -> OptionSetting x -> Integer -> IO [Doc Void]
    forall (tp :: BaseType) a.
    Opt tp a =>
    OptionSetting tp -> a -> IO [Doc Void]
    setOpt OptionSetting x
    optset Integer
    val
           Maybe (x :~: BaseIntegerType)
    Nothing ->
             OptionSetting x -> OptionSetResult -> IO [Doc Void]
    forall (tp :: BaseType).
    OptionSetting tp -> OptionSetResult -> IO [Doc Void]
    checkOptSetResult OptionSetting x
    optset (OptionSetResult -> IO [Doc Void])
    -> OptionSetResult -> IO [Doc Void]
    forall a b. (a -> b) -> a -> b
    $ Doc Void -> OptionSetResult
    optErr (Doc Void -> OptionSetResult) -> Doc Void -> OptionSetResult
    forall a b. (a -> b) -> a -> b
    $
             Doc Void
    "option type is a" Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> BaseTypeRepr x -> Doc Void
    forall a ann. Pretty a => a -> Doc ann
    forall ann. BaseTypeRepr x -> Doc ann
    pretty BaseTypeRepr x
    tyOpt Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc Void
    "but given an integer"

    -- | Given a boolean value, set the named option to that value or
    -- generate an OptSetFailure exception if the option is not a boolean
    -- valued option.
    setBoolOpt :: Some OptionSetting -> Bool -> IO [Doc Void]
    setBoolOpt :: Some OptionSetting -> Bool -> IO [Doc Void]
    setBoolOpt (Some OptionSetting x
    optset) Bool
    val =
      let tyOpt :: BaseTypeRepr x
    tyOpt = ConfigOption x -> BaseTypeRepr x
    forall (tp :: BaseType). ConfigOption tp -> BaseTypeRepr tp
    configOptionType (OptionSetting x -> ConfigOption x
    forall (tp :: BaseType). OptionSetting tp -> ConfigOption tp
    optionSettingName OptionSetting x
    optset)
      in case BaseTypeRepr x
    -> BaseTypeRepr BaseBoolType -> Maybe (x :~: BaseBoolType)
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: BaseType) (b :: BaseType).
    BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
    testEquality BaseTypeRepr x
    tyOpt BaseTypeRepr BaseBoolType
    BaseBoolRepr of
           Just x :~: BaseBoolType
    Refl -> OptionSetting x -> Bool -> IO [Doc Void]
    forall (tp :: BaseType) a.
    Opt tp a =>
    OptionSetting tp -> a -> IO [Doc Void]
    setOpt OptionSetting x
    optset Bool
    val
           Maybe (x :~: BaseBoolType)
    Nothing ->
             OptionSetting x -> OptionSetResult -> IO [Doc Void]
    forall (tp :: BaseType).
    OptionSetting tp -> OptionSetResult -> IO [Doc Void]
    checkOptSetResult OptionSetting x
    optset (OptionSetResult -> IO [Doc Void])
    -> OptionSetResult -> IO [Doc Void]
    forall a b. (a -> b) -> a -> b
    $ Doc Void -> OptionSetResult
    optErr (Doc Void -> OptionSetResult) -> Doc Void -> OptionSetResult
    forall a b. (a -> b) -> a -> b
    $
             Doc Void
    "option type is a" Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> BaseTypeRepr x -> Doc Void
    forall a ann. Pretty a => a -> Doc ann
    forall ann. BaseTypeRepr x -> Doc ann
    pretty BaseTypeRepr x
    tyOpt Doc Void -> Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc Void
    "but given a boolean"

    -- | Given a @ConfigOption@ name, produce an @OptionSetting@
    --   object for accessing and setting the value of that option.
    --
    --   An exception is thrown if the named option cannot be found
    --   the @Config@ object, or if a type mismatch occurs.
    getOptionSetting ::
      ConfigOption tp ->
      Config ->
      IO (OptionSetting tp)
    getOptionSetting :: forall (tp :: BaseType).
    ConfigOption tp -> Config -> IO (OptionSetting tp)
    getOptionSetting o :: ConfigOption tp
    o@(ConfigOption BaseTypeRepr tp
    tp (Text
    p:|[Text]
    ps)) (Config RWVar ConfigMap
    cfg) =
       RWVar ConfigMap
    -> (ConfigMap -> IO (OptionSetting tp)) -> IO (OptionSetting tp)
    forall a b. RWVar a -> (a -> IO b) -> IO b
    RWV.with RWVar ConfigMap
    cfg (Const (IO (OptionSetting tp)) ConfigMap -> IO (OptionSetting tp)
    forall {k} a (b :: k). Const a b -> a
    getConst (Const (IO (OptionSetting tp)) ConfigMap -> IO (OptionSetting tp))
    -> (ConfigMap -> Const (IO (OptionSetting tp)) ConfigMap)
    -> ConfigMap
    -> IO (OptionSetting tp)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text
    -> [Text]
    -> (Maybe ConfigLeaf
        -> Const (IO (OptionSetting tp)) (Maybe ConfigLeaf))
    -> ConfigMap
    -> Const (IO (OptionSetting tp)) ConfigMap
    forall (t :: Type -> Type).
    Functor t =>
    Text
    -> [Text]
    -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf))
    -> ConfigMap
    -> t ConfigMap
    adjustConfigMap Text
    p [Text]
    ps Maybe ConfigLeaf
    -> Const (IO (OptionSetting tp)) (Maybe ConfigLeaf)
    f)

     where
      f :: Maybe ConfigLeaf
    -> Const (IO (OptionSetting tp)) (Maybe ConfigLeaf)
    f Maybe ConfigLeaf
    Nothing  = IO (OptionSetting tp)
    -> Const (IO (OptionSetting tp)) (Maybe ConfigLeaf)
    forall {k} a (b :: k). a -> Const a b
    Const (OptGetFailure -> IO (OptionSetting tp)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: Type -> Type) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (OptGetFailure -> IO (OptionSetting tp))
    -> OptGetFailure -> IO (OptionSetting tp)
    forall a b. (a -> b) -> a -> b
    $ OptRef -> Doc Void -> OptGetFailure
    OptGetFailure (Some ConfigOption -> OptRef
    OCfg (Some ConfigOption -> OptRef) -> Some ConfigOption -> OptRef
    forall a b. (a -> b) -> a -> b
    $ ConfigOption tp -> Some ConfigOption
    forall k (f :: k -> Type) (x :: k). f x -> Some f
    Some ConfigOption tp
    o) Doc Void
    "not found")
      f (Just ConfigLeaf
    x) = IO (OptionSetting tp)
    -> Const (IO (OptionSetting tp)) (Maybe ConfigLeaf)
    forall {k} a (b :: k). a -> Const a b
    Const (ConfigLeaf -> IO (OptionSetting tp)
    leafToSetting ConfigLeaf
    x)

      leafToSetting :: ConfigLeaf -> IO (OptionSetting tp)
    leafToSetting (ConfigLeaf OptionStyle tp
    sty MVar (Maybe (ConcreteVal tp))
    ref Maybe (Doc Void)
    _h)
        | Just tp :~: tp
    Refl <- BaseTypeRepr tp -> BaseTypeRepr tp -> Maybe (tp :~: tp)
    forall {k} (f :: k -> Type) (a :: k) (b :: k).
    TestEquality f =>
    f a -> f b -> Maybe (a :~: b)
    forall (a :: BaseType) (b :: BaseType).
    BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
    testEquality (OptionStyle tp -> BaseTypeRepr tp
    forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type OptionStyle tp
    sty) BaseTypeRepr tp
    tp = OptionSetting tp -> IO (OptionSetting tp)
    forall a. a -> IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (OptionSetting tp -> IO (OptionSetting tp))
    -> OptionSetting tp -> IO (OptionSetting tp)
    forall a b. (a -> b) -> a -> b
    $
          OptionSetting
          { optionSettingName :: ConfigOption tp
    optionSettingName = ConfigOption tp
    o
          , getOption :: IO (Maybe (ConcreteVal tp))
    getOption  = MVar (Maybe (ConcreteVal tp)) -> IO (Maybe (ConcreteVal tp))
    forall a. MVar a -> IO a
    readMVar MVar (Maybe (ConcreteVal tp))
    MVar (Maybe (ConcreteVal tp))
    ref
          , setOption :: ConcreteVal tp -> IO OptionSetResult
    setOption = \ConcreteVal tp
    v -> MVar (Maybe (ConcreteVal tp))
    -> (Maybe (ConcreteVal tp)
        -> IO (Maybe (ConcreteVal tp), OptionSetResult))
    -> IO OptionSetResult
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar (Maybe (ConcreteVal tp))
    ref ((Maybe (ConcreteVal tp)
      -> IO (Maybe (ConcreteVal tp), OptionSetResult))
     -> IO OptionSetResult)
    -> (Maybe (ConcreteVal tp)
        -> IO (Maybe (ConcreteVal tp), OptionSetResult))
    -> IO OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ \Maybe (ConcreteVal tp)
    old ->
              do res <- OptionStyle tp
    -> Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    forall (tp :: BaseType).
    OptionStyle tp
    -> Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    opt_onset OptionStyle tp
    sty Maybe (ConcreteVal tp)
    old ConcreteVal tp
    ConcreteVal tp
    v
                 let new = if (Maybe (Doc Void) -> Bool
    forall a. Maybe a -> Bool
    isJust (OptionSetResult -> Maybe (Doc Void)
    optionSetError OptionSetResult
    res)) then Maybe (ConcreteVal tp)
    old else (ConcreteVal tp -> Maybe (ConcreteVal tp)
    forall a. a -> Maybe a
    Just ConcreteVal tp
    ConcreteVal tp
    v)
                 new `seq` return (new, res)
          }
        | Bool
    otherwise = OptGetFailure -> IO (OptionSetting tp)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: Type -> Type) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (OptGetFailure -> IO (OptionSetting tp))
    -> OptGetFailure -> IO (OptionSetting tp)
    forall a b. (a -> b) -> a -> b
    $ OptRef -> Doc Void -> OptGetFailure
    OptGetFailure (Some ConfigOption -> OptRef
    OCfg (Some ConfigOption -> OptRef) -> Some ConfigOption -> OptRef
    forall a b. (a -> b) -> a -> b
    $ ConfigOption tp -> Some ConfigOption
    forall k (f :: k -> Type) (x :: k). f x -> Some f
    Some ConfigOption tp
    o)
                      (String -> Doc Void
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (String -> Doc Void) -> String -> Doc Void
    forall a b. (a -> b) -> a -> b
    $ String
    "Type mismatch: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
                        String
    "expected '" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> BaseTypeRepr tp -> String
    forall a. Show a => a -> String
    show BaseTypeRepr tp
    tp String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>
                        String
    "' but found '" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> BaseTypeRepr tp -> String
    forall a. Show a => a -> String
    show (OptionStyle tp -> BaseTypeRepr tp
    forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type OptionStyle tp
    sty) String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "'"
                      )

    -- | Given a text name, produce an @OptionSetting@
    --   object for accessing and setting the value of that option.
    --
    --   An exception is thrown if the named option cannot be found.
    getOptionSettingFromText ::
      Text ->
      Config ->
      IO (Some OptionSetting)
    getOptionSettingFromText :: Text -> Config -> IO (Some OptionSetting)
    getOptionSettingFromText Text
    nm (Config RWVar ConfigMap
    cfg) =
       case Text -> Maybe (NonEmpty Text)
    splitPath Text
    nm of
         Maybe (NonEmpty Text)
    Nothing -> OptGetFailure -> IO (Some OptionSetting)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    forall (m :: Type -> Type) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (OptGetFailure -> IO (Some OptionSetting))
    -> OptGetFailure -> IO (Some OptionSetting)
    forall a b. (a -> b) -> a -> b
    $ OptRef -> Doc Void -> OptGetFailure
    OptGetFailure (Text -> OptRef
    OName Text
    "") Doc Void
    "Illegal empty name for option"
         Just (Text
    p:|[Text]
    ps) -> RWVar ConfigMap
    -> (ConfigMap -> IO (Some OptionSetting))
    -> IO (Some OptionSetting)
    forall a b. RWVar a -> (a -> IO b) -> IO b
    RWV.with RWVar ConfigMap
    cfg (Const (IO (Some OptionSetting)) ConfigMap
    -> IO (Some OptionSetting)
    forall {k} a (b :: k). Const a b -> a
    getConst (Const (IO (Some OptionSetting)) ConfigMap
     -> IO (Some OptionSetting))
    -> (ConfigMap -> Const (IO (Some OptionSetting)) ConfigMap)
    -> ConfigMap
    -> IO (Some OptionSetting)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text
    -> [Text]
    -> (Maybe ConfigLeaf
        -> Const (IO (Some OptionSetting)) (Maybe ConfigLeaf))
    -> ConfigMap
    -> Const (IO (Some OptionSetting)) ConfigMap
    forall (t :: Type -> Type).
    Functor t =>
    Text
    -> [Text]
    -> (Maybe ConfigLeaf -> t (Maybe ConfigLeaf))
    -> ConfigMap
    -> t ConfigMap
    adjustConfigMap Text
    p [Text]
    ps (NonEmpty Text
    -> Maybe ConfigLeaf
    -> Const (IO (Some OptionSetting)) (Maybe ConfigLeaf)
    forall {k} {m :: Type -> Type} {b :: k}.
    MonadThrow m =>
    NonEmpty Text
    -> Maybe ConfigLeaf -> Const (m (Some OptionSetting)) b
    f (Text
    pText -> [Text] -> NonEmpty Text
    forall a. a -> [a] -> NonEmpty a
    :|[Text]
    ps)))
      where
      f :: NonEmpty Text
    -> Maybe ConfigLeaf -> Const (m (Some OptionSetting)) b
    f (Text
    p:|[Text]
    ps) Maybe ConfigLeaf
    Nothing  = m (Some OptionSetting) -> Const (m (Some OptionSetting)) b
    forall {k} a (b :: k). a -> Const a b
    Const (OptGetFailure -> m (Some OptionSetting)
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: Type -> Type) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (OptGetFailure -> m (Some OptionSetting))
    -> OptGetFailure -> m (Some OptionSetting)
    forall a b. (a -> b) -> a -> b
    $ OptRef -> Doc Void -> OptGetFailure
    OptGetFailure
                                  (Text -> OptRef
    OName (Text -> [Text] -> Text
    Text.intercalate Text
    "." (Text
    pText -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :[Text]
    ps)))
                                  Doc Void
    "not found")
      f NonEmpty Text
    path (Just ConfigLeaf
    x) = m (Some OptionSetting) -> Const (m (Some OptionSetting)) b
    forall {k} a (b :: k). a -> Const a b
    Const (NonEmpty Text -> ConfigLeaf -> m (Some OptionSetting)
    forall {m :: Type -> Type}.
    Monad m =>
    NonEmpty Text -> ConfigLeaf -> m (Some OptionSetting)
    leafToSetting NonEmpty Text
    path ConfigLeaf
    x)

      leafToSetting :: NonEmpty Text -> ConfigLeaf -> m (Some OptionSetting)
    leafToSetting NonEmpty Text
    path (ConfigLeaf OptionStyle tp
    sty MVar (Maybe (ConcreteVal tp))
    ref Maybe (Doc Void)
    _h) = Some OptionSetting -> m (Some OptionSetting)
    forall a. a -> m a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return (Some OptionSetting -> m (Some OptionSetting))
    -> Some OptionSetting -> m (Some OptionSetting)
    forall a b. (a -> b) -> a -> b
    $
        OptionSetting tp -> Some OptionSetting
    forall k (f :: k -> Type) (x :: k). f x -> Some f
    Some OptionSetting
             { optionSettingName :: ConfigOption tp
    optionSettingName = BaseTypeRepr tp -> NonEmpty Text -> ConfigOption tp
    forall (tp :: BaseType).
    BaseTypeRepr tp -> NonEmpty Text -> ConfigOption tp
    ConfigOption (OptionStyle tp -> BaseTypeRepr tp
    forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type OptionStyle tp
    sty) NonEmpty Text
    path
             , getOption :: IO (Maybe (ConcreteVal tp))
    getOption = MVar (Maybe (ConcreteVal tp)) -> IO (Maybe (ConcreteVal tp))
    forall a. MVar a -> IO a
    readMVar MVar (Maybe (ConcreteVal tp))
    ref
             , setOption :: ConcreteVal tp -> IO OptionSetResult
    setOption = \ConcreteVal tp
    v -> MVar (Maybe (ConcreteVal tp))
    -> (Maybe (ConcreteVal tp)
        -> IO (Maybe (ConcreteVal tp), OptionSetResult))
    -> IO OptionSetResult
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar (Maybe (ConcreteVal tp))
    ref ((Maybe (ConcreteVal tp)
      -> IO (Maybe (ConcreteVal tp), OptionSetResult))
     -> IO OptionSetResult)
    -> (Maybe (ConcreteVal tp)
        -> IO (Maybe (ConcreteVal tp), OptionSetResult))
    -> IO OptionSetResult
    forall a b. (a -> b) -> a -> b
    $ \Maybe (ConcreteVal tp)
    old ->
                 do res <- OptionStyle tp
    -> Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    forall (tp :: BaseType).
    OptionStyle tp
    -> Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult
    opt_onset OptionStyle tp
    sty Maybe (ConcreteVal tp)
    old ConcreteVal tp
    v
                    let new = if (Maybe (Doc Void) -> Bool
    forall a. Maybe a -> Bool
    isJust (OptionSetResult -> Maybe (Doc Void)
    optionSetError OptionSetResult
    res)) then Maybe (ConcreteVal tp)
    old else (ConcreteVal tp -> Maybe (ConcreteVal tp)
    forall a. a -> Maybe a
    Just ConcreteVal tp
    v)
                    new `seq` return (new, res)
             }

    -- | A @ConfigValue@ bundles together the name of an option with its current value.
    data ConfigValue where
      ConfigValue :: ConfigOption tp -> ConcreteVal tp -> ConfigValue

    instance Pretty ConfigValue where
      pretty :: forall ann. ConfigValue -> Doc ann
    pretty (ConfigValue ConfigOption tp
    option ConcreteVal tp
    val) =
        [Text] -> Maybe (ConcreteVal tp) -> Doc ann
    forall (tp :: BaseType) ann.
    [Text] -> Maybe (ConcreteVal tp) -> Doc ann
    ppSetting (ConfigOption tp -> [Text]
    forall (tp :: BaseType). ConfigOption tp -> [Text]
    configOptionNameParts ConfigOption tp
    option) (ConcreteVal tp -> Maybe (ConcreteVal tp)
    forall a. a -> Maybe a
    Just ConcreteVal tp
    val)
        Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc ann
    "::" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> BaseTypeRepr tp -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    forall ann. BaseTypeRepr tp -> Doc ann
    pretty (ConfigOption tp -> BaseTypeRepr tp
    forall (tp :: BaseType). ConfigOption tp -> BaseTypeRepr tp
    configOptionType ConfigOption tp
    option)

    -- | Given the name of a subtree, return all
    --   the currently-set configuration values in that subtree.
    --
    --   If the subtree name is empty, the entire tree will be traversed.
    getConfigValues ::
      Text ->
      Config ->
      IO [ConfigValue]
    getConfigValues :: Text -> Config -> IO [ConfigValue]
    getConfigValues Text
    prefix (Config RWVar ConfigMap
    cfg) =
      RWVar ConfigMap
    -> (ConfigMap -> IO [ConfigValue]) -> IO [ConfigValue]
    forall a b. RWVar a -> (a -> IO b) -> IO b
    RWV.with RWVar ConfigMap
    cfg ((ConfigMap -> IO [ConfigValue]) -> IO [ConfigValue])
    -> (ConfigMap -> IO [ConfigValue]) -> IO [ConfigValue]
    forall a b. (a -> b) -> a -> b
    $ \ConfigMap
    m ->
      do let ps :: [Text]
    ps = (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Text -> Bool
    Text.null ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    Text.splitOn Text
    "." Text
    prefix
             f :: [Text] -> ConfigLeaf -> WriterT (Seq ConfigValue) IO ConfigLeaf
             f :: [Text] -> ConfigLeaf -> WriterT (Seq ConfigValue) IO ConfigLeaf
    f [] ConfigLeaf
    _ = OptGetFailure -> WriterT (Seq ConfigValue) IO ConfigLeaf
    forall e a.
    (HasCallStack, Exception e) =>
    e -> WriterT (Seq ConfigValue) IO a
    forall (m :: Type -> Type) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (OptGetFailure -> WriterT (Seq ConfigValue) IO ConfigLeaf)
    -> OptGetFailure -> WriterT (Seq ConfigValue) IO ConfigLeaf
    forall a b. (a -> b) -> a -> b
    $ OptRef -> Doc Void -> OptGetFailure
    OptGetFailure (Text -> OptRef
    OName Text
    prefix)
                      Doc Void
    "illegal empty option prefix name"
             f (Text
    p:[Text]
    path) l :: ConfigLeaf
    l@(ConfigLeaf OptionStyle tp
    sty MVar (Maybe (ConcreteVal tp))
    ref Maybe (Doc Void)
    _h) =
                do IO (Maybe (ConcreteVal tp))
    -> WriterT (Seq ConfigValue) IO (Maybe (ConcreteVal tp))
    forall a. IO a -> WriterT (Seq ConfigValue) IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO (MVar (Maybe (ConcreteVal tp)) -> IO (Maybe (ConcreteVal tp))
    forall a. MVar a -> IO a
    readMVar MVar (Maybe (ConcreteVal tp))
    ref) WriterT (Seq ConfigValue) IO (Maybe (ConcreteVal tp))
    -> (Maybe (ConcreteVal tp) -> WriterT (Seq ConfigValue) IO ())
    -> WriterT (Seq ConfigValue) IO ()
    forall a b.
    WriterT (Seq ConfigValue) IO a
    -> (a -> WriterT (Seq ConfigValue) IO b)
    -> WriterT (Seq ConfigValue) IO b
    forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                     Just ConcreteVal tp
    x  -> Seq ConfigValue -> WriterT (Seq ConfigValue) IO ()
    forall w (m :: Type -> Type). MonadWriter w m => w -> m ()
    tell (ConfigValue -> Seq ConfigValue
    forall a. a -> Seq a
    Seq.singleton (ConfigOption tp -> ConcreteVal tp -> ConfigValue
    forall (tp :: BaseType).
    ConfigOption tp -> ConcreteVal tp -> ConfigValue
    ConfigValue (BaseTypeRepr tp -> NonEmpty Text -> ConfigOption tp
    forall (tp :: BaseType).
    BaseTypeRepr tp -> NonEmpty Text -> ConfigOption tp
    ConfigOption (OptionStyle tp -> BaseTypeRepr tp
    forall (tp :: BaseType). OptionStyle tp -> BaseTypeRepr tp
    opt_type OptionStyle tp
    sty) (Text
    pText -> [Text] -> NonEmpty Text
    forall a. a -> [a] -> NonEmpty a
    :|[Text]
    path)) ConcreteVal tp
    x))
                     Maybe (ConcreteVal tp)
    Nothing -> () -> WriterT (Seq ConfigValue) IO ()
    forall a. a -> WriterT (Seq ConfigValue) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ()
                   ConfigLeaf -> WriterT (Seq ConfigValue) IO ConfigLeaf
    forall a. a -> WriterT (Seq ConfigValue) IO a
    forall (m :: Type -> Type) a. Monad m => a -> m a
    return ConfigLeaf
    l
         Seq ConfigValue -> [ConfigValue]
    forall a. Seq a -> [a]
    forall (t :: Type -> Type) a. Foldable t => t a -> [a]
    toList (Seq ConfigValue -> [ConfigValue])
    -> IO (Seq ConfigValue) -> IO [ConfigValue]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterT (Seq ConfigValue) IO ConfigMap -> IO (Seq ConfigValue)
    forall (m :: Type -> Type) w a. Monad m => WriterT w m a -> m w
    execWriterT ([Text]
    -> ([Text]
        -> ConfigLeaf -> WriterT (Seq ConfigValue) IO ConfigLeaf)
    -> ConfigMap
    -> WriterT (Seq ConfigValue) IO ConfigMap
    forall (t :: Type -> Type).
    Applicative t =>
    [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigMap
    -> t ConfigMap
    traverseSubtree [Text]
    ps [Text] -> ConfigLeaf -> WriterT (Seq ConfigValue) IO ConfigLeaf
    f ConfigMap
    m)

    ppSetting :: [Text] -> Maybe (ConcreteVal tp) -> Doc ann
    ppSetting :: forall (tp :: BaseType) ann.
    [Text] -> Maybe (ConcreteVal tp) -> Doc ann
    ppSetting [Text]
    nm Maybe (ConcreteVal tp)
    v = Int -> Doc ann -> Doc ann
    forall ann. Int -> Doc ann -> Doc ann
    fill Int
    30 (Text -> Doc ann
    forall ann. Text -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty (Text -> [Text] -> Text
    Text.intercalate Text
    "." [Text]
    nm)
                               Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> Doc ann
    -> (ConcreteVal tp -> Doc ann) -> Maybe (ConcreteVal tp) -> Doc ann
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc ann
    forall a. Monoid a => a
    mempty (\ConcreteVal tp
    x -> Doc ann
    " = " Doc ann -> Doc ann -> Doc ann
    forall a. Semigroup a => a -> a -> a
    <> ConcreteVal tp -> Doc ann
    forall (tp :: BaseType) ann. ConcreteVal tp -> Doc ann
    ppConcrete ConcreteVal tp
    x) Maybe (ConcreteVal tp)
    v
                             )

    ppOption :: [Text] -> OptionStyle tp -> Maybe (ConcreteVal tp) -> Maybe (Doc Void) -> Doc Void
    ppOption :: forall (tp :: BaseType).
    [Text]
    -> OptionStyle tp
    -> Maybe (ConcreteVal tp)
    -> Maybe (Doc Void)
    -> Doc Void
    ppOption [Text]
    nm OptionStyle tp
    sty Maybe (ConcreteVal tp)
    x Maybe (Doc Void)
    help =
      [Doc Void] -> Doc Void
    forall ann. [Doc ann] -> Doc ann
    vcat
      [ Doc Void -> Doc Void
    forall ann. Doc ann -> Doc ann
    group (Doc Void -> Doc Void) -> Doc Void -> Doc Void
    forall a b. (a -> b) -> a -> b
    $ [Doc Void] -> Doc Void
    forall ann. [Doc ann] -> Doc ann
    fillCat [[Text] -> Maybe (ConcreteVal tp) -> Doc Void
    forall (tp :: BaseType) ann.
    [Text] -> Maybe (ConcreteVal tp) -> Doc ann
    ppSetting [Text]
    nm Maybe (ConcreteVal tp)
    x, Int -> Doc Void -> Doc Void
    forall ann. Int -> Doc ann -> Doc ann
    indent Int
    2 (OptionStyle tp -> Doc Void
    forall (tp :: BaseType). OptionStyle tp -> Doc Void
    opt_help OptionStyle tp
    sty)]
      , Doc Void -> (Doc Void -> Doc Void) -> Maybe (Doc Void) -> Doc Void
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Doc Void
    forall a. Monoid a => a
    mempty (Int -> Doc Void -> Doc Void
    forall ann. Int -> Doc ann -> Doc ann
    indent Int
    4) Maybe (Doc Void)
    help
      ]

    ppConfigLeaf :: [Text] -> ConfigLeaf -> IO (Doc Void)
    ppConfigLeaf :: [Text] -> ConfigLeaf -> IO (Doc Void)
    ppConfigLeaf [Text]
    nm (ConfigLeaf OptionStyle tp
    sty MVar (Maybe (ConcreteVal tp))
    ref Maybe (Doc Void)
    help) =
      do x <- MVar (Maybe (ConcreteVal tp)) -> IO (Maybe (ConcreteVal tp))
    forall a. MVar a -> IO a
    readMVar MVar (Maybe (ConcreteVal tp))
    ref
         return $ ppOption nm sty x help

    -- | Given the name of a subtree, compute help text for
    --   all the options available in that subtree.
    --
    --   If the subtree name is empty, the entire tree will be traversed.
    configHelp ::
      Text ->
      Config ->
      IO [Doc Void]
    configHelp :: Text -> Config -> IO [Doc Void]
    configHelp Text
    prefix (Config RWVar ConfigMap
    cfg) =
      RWVar ConfigMap -> (ConfigMap -> IO [Doc Void]) -> IO [Doc Void]
    forall a b. RWVar a -> (a -> IO b) -> IO b
    RWV.with RWVar ConfigMap
    cfg ((ConfigMap -> IO [Doc Void]) -> IO [Doc Void])
    -> (ConfigMap -> IO [Doc Void]) -> IO [Doc Void]
    forall a b. (a -> b) -> a -> b
    $ \ConfigMap
    m ->
      do let ps :: [Text]
    ps = (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Text -> Bool
    Text.null ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    Text.splitOn Text
    "." Text
    prefix
             f :: [Text] -> ConfigLeaf -> WriterT (Seq (Doc Void)) IO ConfigLeaf
             f :: [Text] -> ConfigLeaf -> WriterT (Seq (Doc Void)) IO ConfigLeaf
    f [Text]
    nm ConfigLeaf
    leaf = do d <- IO (Doc Void) -> WriterT (Seq (Doc Void)) IO (Doc Void)
    forall a. IO a -> WriterT (Seq (Doc Void)) IO a
    forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
    liftIO ([Text] -> ConfigLeaf -> IO (Doc Void)
    ppConfigLeaf [Text]
    nm ConfigLeaf
    leaf)
                            tell (Seq.singleton d)
                            return leaf
         Seq (Doc Void) -> [Doc Void]
    forall a. Seq a -> [a]
    forall (t :: Type -> Type) a. Foldable t => t a -> [a]
    toList (Seq (Doc Void) -> [Doc Void])
    -> IO (Seq (Doc Void)) -> IO [Doc Void]
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
    <$> (WriterT (Seq (Doc Void)) IO ConfigMap -> IO (Seq (Doc Void))
    forall (m :: Type -> Type) w a. Monad m => WriterT w m a -> m w
    execWriterT ([Text]
    -> ([Text] -> ConfigLeaf -> WriterT (Seq (Doc Void)) IO ConfigLeaf)
    -> ConfigMap
    -> WriterT (Seq (Doc Void)) IO ConfigMap
    forall (t :: Type -> Type).
    Applicative t =>
    [Text]
    -> ([Text] -> ConfigLeaf -> t ConfigLeaf)
    -> ConfigMap
    -> t ConfigMap
    traverseSubtree [Text]
    ps [Text] -> ConfigLeaf -> WriterT (Seq (Doc Void)) IO ConfigLeaf
    f ConfigMap
    m))

    prettyRational :: Rational -> Doc ann
    prettyRational :: forall ann. Rational -> Doc ann
    prettyRational = Rational -> Doc ann
    forall a ann. Show a => a -> Doc ann
    viaShow