{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-unused-pattern-binds #-}

module OptEnvConf.Setting
  ( Setting (..),
    EnvVarSetting (..),
    ConfigValSetting (..),

    -- * Builders
    help,
    metavar,
    argument,
    option,
    switch,
    reader,
    str,
    auto,
    long,
    short,
    env,
    unprefixedEnv,
    conf,
    confWith,
    confWith',
    unprefixedConf,
    unprefixedConfWith,
    unprefixedConfWith',
    name,
    value,
    valueWithShown,
    example,
    shownExample,
    hidden,
    completer,
    Builder (..),
    BuildInstruction (..),
    requiredCapability,
    readSecretCapability,

    -- * Internal
    showSettingABit,
    SettingHash (..),
    hashSetting,
    completeBuilder,
    mapMaybeBuilder,
    emptySetting,
    Metavar,
    Help,
    prefixEnvVarSetting,
    suffixEnvVarSetting,
    prefixConfigValSetting,
    suffixConfigValSettingKey,
  )
where

import Autodocodec
import Data.Hashable
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text as T
import OptEnvConf.Args (Dashed (..), renderDashed)
import OptEnvConf.Capability
import OptEnvConf.Casing
import OptEnvConf.Completer
import OptEnvConf.Reader
import Text.Show

type Metavar = String

type Help = String

-- | A setting for parsing and documenting a single value.
data Setting a = Setting
  { -- | Which dashed values are required for parsing
    --
    -- No dashed values means this is an argument.
    forall a. Setting a -> [Dashed]
settingDasheds :: ![Dashed],
    -- | Which readers should be tried to parse a value from a string
    forall a. Setting a -> [Reader a]
settingReaders :: ![Reader a],
    -- | Whether the readers should be used to parsed arguments
    forall a. Setting a -> Bool
settingTryArgument :: !Bool,
    -- | What value to parse when the switch exists.
    --
    -- Nothing means this is not a switch.
    forall a. Setting a -> Maybe a
settingSwitchValue :: !(Maybe a),
    -- | Whether the dasheds should be tried together with the readers as
    -- options.
    forall a. Setting a -> Bool
settingTryOption :: !Bool,
    -- | Which env vars can be read.
    forall a. Setting a -> Maybe (NonEmpty EnvVarSetting)
settingEnvVars :: !(Maybe (NonEmpty EnvVarSetting)),
    -- | Which and how to parse config values
    forall a. Setting a -> Maybe (NonEmpty (ConfigValSetting a))
settingConfigVals :: !(Maybe (NonEmpty (ConfigValSetting a))),
    -- | Default value, if none of the above find the setting.
    forall a. Setting a -> Maybe (a, String)
settingDefaultValue :: !(Maybe (a, String)),
    -- | Example values
    forall a. Setting a -> [String]
settingExamples :: ![String],
    -- | Whether to hide docs
    forall a. Setting a -> Bool
settingHidden :: !Bool,
    -- | Which metavar should be show in documentation
    forall a. Setting a -> Maybe String
settingMetavar :: !(Maybe Metavar),
    forall a. Setting a -> Maybe String
settingHelp :: !(Maybe String),
    forall a. Setting a -> Maybe Completer
settingCompleter :: !(Maybe Completer),
    forall a. Setting a -> Set Capability
settingRequiredCapabilities :: !(Set Capability)
  }

-- An 'Ord'-able Setting without giving 'Setting' an 'Eq' instance
newtype SettingHash = SettingHash Int
  deriving (Int -> SettingHash -> ShowS
[SettingHash] -> ShowS
SettingHash -> String
(Int -> SettingHash -> ShowS)
-> (SettingHash -> String)
-> ([SettingHash] -> ShowS)
-> Show SettingHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SettingHash -> ShowS
showsPrec :: Int -> SettingHash -> ShowS
$cshow :: SettingHash -> String
show :: SettingHash -> String
$cshowList :: [SettingHash] -> ShowS
showList :: [SettingHash] -> ShowS
Show, SettingHash -> SettingHash -> Bool
(SettingHash -> SettingHash -> Bool)
-> (SettingHash -> SettingHash -> Bool) -> Eq SettingHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SettingHash -> SettingHash -> Bool
== :: SettingHash -> SettingHash -> Bool
$c/= :: SettingHash -> SettingHash -> Bool
/= :: SettingHash -> SettingHash -> Bool
Eq, Eq SettingHash
Eq SettingHash =>
(SettingHash -> SettingHash -> Ordering)
-> (SettingHash -> SettingHash -> Bool)
-> (SettingHash -> SettingHash -> Bool)
-> (SettingHash -> SettingHash -> Bool)
-> (SettingHash -> SettingHash -> Bool)
-> (SettingHash -> SettingHash -> SettingHash)
-> (SettingHash -> SettingHash -> SettingHash)
-> Ord SettingHash
SettingHash -> SettingHash -> Bool
SettingHash -> SettingHash -> Ordering
SettingHash -> SettingHash -> SettingHash
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SettingHash -> SettingHash -> Ordering
compare :: SettingHash -> SettingHash -> Ordering
$c< :: SettingHash -> SettingHash -> Bool
< :: SettingHash -> SettingHash -> Bool
$c<= :: SettingHash -> SettingHash -> Bool
<= :: SettingHash -> SettingHash -> Bool
$c> :: SettingHash -> SettingHash -> Bool
> :: SettingHash -> SettingHash -> Bool
$c>= :: SettingHash -> SettingHash -> Bool
>= :: SettingHash -> SettingHash -> Bool
$cmax :: SettingHash -> SettingHash -> SettingHash
max :: SettingHash -> SettingHash -> SettingHash
$cmin :: SettingHash -> SettingHash -> SettingHash
min :: SettingHash -> SettingHash -> SettingHash
Ord)

-- We hash only the parts of the setting that have anything to do with how the
-- setting is parsed, not the parts that are for documentation.
hashSetting :: Setting a -> SettingHash
hashSetting :: forall a. Setting a -> SettingHash
hashSetting Setting {Bool
[String]
[Dashed]
[Reader a]
Maybe a
Maybe String
Maybe (NonEmpty (ConfigValSetting a))
Maybe (NonEmpty EnvVarSetting)
Maybe (a, String)
Maybe Completer
Set Capability
settingDasheds :: forall a. Setting a -> [Dashed]
settingReaders :: forall a. Setting a -> [Reader a]
settingTryArgument :: forall a. Setting a -> Bool
settingSwitchValue :: forall a. Setting a -> Maybe a
settingTryOption :: forall a. Setting a -> Bool
settingEnvVars :: forall a. Setting a -> Maybe (NonEmpty EnvVarSetting)
settingConfigVals :: forall a. Setting a -> Maybe (NonEmpty (ConfigValSetting a))
settingDefaultValue :: forall a. Setting a -> Maybe (a, String)
settingExamples :: forall a. Setting a -> [String]
settingHidden :: forall a. Setting a -> Bool
settingMetavar :: forall a. Setting a -> Maybe String
settingHelp :: forall a. Setting a -> Maybe String
settingCompleter :: forall a. Setting a -> Maybe Completer
settingRequiredCapabilities :: forall a. Setting a -> Set Capability
settingDasheds :: [Dashed]
settingReaders :: [Reader a]
settingTryArgument :: Bool
settingSwitchValue :: Maybe a
settingTryOption :: Bool
settingEnvVars :: Maybe (NonEmpty EnvVarSetting)
settingConfigVals :: Maybe (NonEmpty (ConfigValSetting a))
settingDefaultValue :: Maybe (a, String)
settingExamples :: [String]
settingHidden :: Bool
settingMetavar :: Maybe String
settingHelp :: Maybe String
settingCompleter :: Maybe Completer
settingRequiredCapabilities :: Set Capability
..} =
  Int -> SettingHash
SettingHash
    ( Int
42
        Int -> [String] -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Dashed -> String) -> [Dashed] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Dashed -> String
renderDashed [Dashed]
settingDasheds
        Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
settingTryArgument
        Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` [Reader a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Reader a]
settingReaders
        Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
settingSwitchValue
        Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
settingTryOption
        Int -> Maybe (NonEmpty EnvVarSetting) -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Maybe (NonEmpty EnvVarSetting)
settingEnvVars
        Int -> Maybe (NonEmpty (NonEmpty String)) -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ((ConfigValSetting a -> NonEmpty String)
-> NonEmpty (ConfigValSetting a) -> NonEmpty (NonEmpty String)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map ConfigValSetting a -> NonEmpty String
forall a. ConfigValSetting a -> NonEmpty String
configValSettingPath (NonEmpty (ConfigValSetting a) -> NonEmpty (NonEmpty String))
-> Maybe (NonEmpty (ConfigValSetting a))
-> Maybe (NonEmpty (NonEmpty String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty (ConfigValSetting a))
settingConfigVals)
        Int -> Maybe String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ((a, String) -> String
forall a b. (a, b) -> b
snd ((a, String) -> String) -> Maybe (a, String) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, String)
settingDefaultValue)
    )

data EnvVarSetting = EnvVarSetting
  { EnvVarSetting -> String
envVarSettingVar :: !String,
    EnvVarSetting -> Bool
envVarSettingAllowPrefix :: !Bool
  }
  deriving (Int -> EnvVarSetting -> ShowS
[EnvVarSetting] -> ShowS
EnvVarSetting -> String
(Int -> EnvVarSetting -> ShowS)
-> (EnvVarSetting -> String)
-> ([EnvVarSetting] -> ShowS)
-> Show EnvVarSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvVarSetting -> ShowS
showsPrec :: Int -> EnvVarSetting -> ShowS
$cshow :: EnvVarSetting -> String
show :: EnvVarSetting -> String
$cshowList :: [EnvVarSetting] -> ShowS
showList :: [EnvVarSetting] -> ShowS
Show, EnvVarSetting -> EnvVarSetting -> Bool
(EnvVarSetting -> EnvVarSetting -> Bool)
-> (EnvVarSetting -> EnvVarSetting -> Bool) -> Eq EnvVarSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnvVarSetting -> EnvVarSetting -> Bool
== :: EnvVarSetting -> EnvVarSetting -> Bool
$c/= :: EnvVarSetting -> EnvVarSetting -> Bool
/= :: EnvVarSetting -> EnvVarSetting -> Bool
Eq)

instance Hashable EnvVarSetting where
  hashWithSalt :: Int -> EnvVarSetting -> Int
hashWithSalt Int
salt EnvVarSetting {Bool
String
envVarSettingVar :: EnvVarSetting -> String
envVarSettingAllowPrefix :: EnvVarSetting -> Bool
envVarSettingVar :: String
envVarSettingAllowPrefix :: Bool
..} =
    Int
salt
      Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
envVarSettingVar
      Int -> Bool -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
envVarSettingAllowPrefix

prefixEnvVarSetting :: String -> EnvVarSetting -> EnvVarSetting
prefixEnvVarSetting :: String -> EnvVarSetting -> EnvVarSetting
prefixEnvVarSetting String
prefix EnvVarSetting
e =
  if EnvVarSetting -> Bool
envVarSettingAllowPrefix EnvVarSetting
e
    then EnvVarSetting
e {envVarSettingVar = prefix <> envVarSettingVar e}
    else EnvVarSetting
e

suffixEnvVarSetting :: String -> EnvVarSetting -> EnvVarSetting
suffixEnvVarSetting :: String -> EnvVarSetting -> EnvVarSetting
suffixEnvVarSetting String
suffix EnvVarSetting
e = EnvVarSetting
e {envVarSettingVar = envVarSettingVar e <> suffix}

data ConfigValSetting a = forall void.
  ConfigValSetting
  { forall a. ConfigValSetting a -> NonEmpty String
configValSettingPath :: !(NonEmpty String),
    forall a. ConfigValSetting a -> Bool
configValSettingAllowPrefix :: !Bool,
    ()
configValSettingCodec :: !(ValueCodec void (Maybe a))
  }

prefixConfigValSetting :: String -> ConfigValSetting a -> ConfigValSetting a
prefixConfigValSetting :: forall a. String -> ConfigValSetting a -> ConfigValSetting a
prefixConfigValSetting String
prefix ConfigValSetting a
c =
  if ConfigValSetting a -> Bool
forall a. ConfigValSetting a -> Bool
configValSettingAllowPrefix ConfigValSetting a
c
    then ConfigValSetting a
c {configValSettingPath = prefix NE.<| configValSettingPath c}
    else ConfigValSetting a
c

suffixConfigValSettingKey :: String -> ConfigValSetting a -> ConfigValSetting a
suffixConfigValSettingKey :: forall a. String -> ConfigValSetting a -> ConfigValSetting a
suffixConfigValSettingKey String
suffix ConfigValSetting a
c = ConfigValSetting a
c {configValSettingPath = suffixPath $ configValSettingPath c}
  where
    suffixPath :: NonEmpty String -> NonEmpty String
    suffixPath :: NonEmpty String -> NonEmpty String
suffixPath (String
f :| [String]
rest) = case [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [String]
rest of
      Maybe (NonEmpty String)
Nothing -> (String
f String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
suffix) String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| []
      Just NonEmpty String
ne -> String
f String -> NonEmpty String -> NonEmpty String
forall a. a -> NonEmpty a -> NonEmpty a
NE.<| NonEmpty String -> NonEmpty String
suffixPath NonEmpty String
ne

-- | A 'mempty' 'Setting' to build up a setting from.
emptySetting :: Setting a
emptySetting :: forall a. Setting a
emptySetting =
  Setting
    { settingDasheds :: [Dashed]
settingDasheds = [],
      settingReaders :: [Reader a]
settingReaders = [],
      settingTryArgument :: Bool
settingTryArgument = Bool
False,
      settingSwitchValue :: Maybe a
settingSwitchValue = Maybe a
forall a. Maybe a
Nothing,
      settingTryOption :: Bool
settingTryOption = Bool
False,
      settingEnvVars :: Maybe (NonEmpty EnvVarSetting)
settingEnvVars = Maybe (NonEmpty EnvVarSetting)
forall a. Maybe a
Nothing,
      settingConfigVals :: Maybe (NonEmpty (ConfigValSetting a))
settingConfigVals = Maybe (NonEmpty (ConfigValSetting a))
forall a. Maybe a
Nothing,
      settingMetavar :: Maybe String
settingMetavar = Maybe String
forall a. Maybe a
Nothing,
      settingHelp :: Maybe String
settingHelp = Maybe String
forall a. Maybe a
Nothing,
      settingExamples :: [String]
settingExamples = [],
      settingHidden :: Bool
settingHidden = Bool
False,
      settingDefaultValue :: Maybe (a, String)
settingDefaultValue = Maybe (a, String)
forall a. Maybe a
Nothing,
      settingCompleter :: Maybe Completer
settingCompleter = Maybe Completer
forall a. Maybe a
Nothing,
      settingRequiredCapabilities :: Set Capability
settingRequiredCapabilities = Set Capability
forall a. Set a
Set.empty
    }

-- | Show a 'Setting' as much as possible, for debugging
showSettingABit :: Setting a -> ShowS
showSettingABit :: forall a. Setting a -> ShowS
showSettingABit Setting {Bool
[String]
[Dashed]
[Reader a]
Maybe a
Maybe String
Maybe (NonEmpty (ConfigValSetting a))
Maybe (NonEmpty EnvVarSetting)
Maybe (a, String)
Maybe Completer
Set Capability
settingDasheds :: forall a. Setting a -> [Dashed]
settingReaders :: forall a. Setting a -> [Reader a]
settingTryArgument :: forall a. Setting a -> Bool
settingSwitchValue :: forall a. Setting a -> Maybe a
settingTryOption :: forall a. Setting a -> Bool
settingEnvVars :: forall a. Setting a -> Maybe (NonEmpty EnvVarSetting)
settingConfigVals :: forall a. Setting a -> Maybe (NonEmpty (ConfigValSetting a))
settingDefaultValue :: forall a. Setting a -> Maybe (a, String)
settingExamples :: forall a. Setting a -> [String]
settingHidden :: forall a. Setting a -> Bool
settingMetavar :: forall a. Setting a -> Maybe String
settingHelp :: forall a. Setting a -> Maybe String
settingCompleter :: forall a. Setting a -> Maybe Completer
settingRequiredCapabilities :: forall a. Setting a -> Set Capability
settingDasheds :: [Dashed]
settingReaders :: [Reader a]
settingTryArgument :: Bool
settingSwitchValue :: Maybe a
settingTryOption :: Bool
settingEnvVars :: Maybe (NonEmpty EnvVarSetting)
settingConfigVals :: Maybe (NonEmpty (ConfigValSetting a))
settingDefaultValue :: Maybe (a, String)
settingExamples :: [String]
settingHidden :: Bool
settingMetavar :: Maybe String
settingHelp :: Maybe String
settingCompleter :: Maybe Completer
settingRequiredCapabilities :: Set Capability
..} =
  let Setting [Dashed]
_ [Reader Any]
_ Bool
_ Maybe Any
_ Bool
_ Maybe (NonEmpty EnvVarSetting)
_ Maybe (NonEmpty (ConfigValSetting Any))
_ Maybe (Any, String)
_ [String]
_ Bool
_ Maybe String
_ Maybe String
_ Maybe Completer
_ Set Capability
_ = Setting Any
forall a. HasCallStack => a
undefined
   in Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"Setting "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Dashed] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [Dashed]
settingDasheds
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reader a -> ShowS) -> [Reader a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith (\Reader a
_ -> String -> ShowS
showString String
"_") [Reader a]
settingReaders
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bool
settingTryArgument
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ShowS) -> Maybe a -> ShowS
forall a. (a -> ShowS) -> Maybe a -> ShowS
showMaybeWith (\a
_ -> String -> ShowS
showString String
"_") Maybe a
settingSwitchValue
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bool
settingTryOption
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe (NonEmpty EnvVarSetting) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (NonEmpty EnvVarSetting)
settingEnvVars
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (ConfigValSetting a) -> ShowS)
-> Maybe (NonEmpty (ConfigValSetting a)) -> ShowS
forall a. (a -> ShowS) -> Maybe a -> ShowS
showMaybeWith ((ConfigValSetting a -> ShowS)
-> NonEmpty (ConfigValSetting a) -> ShowS
forall a. (a -> ShowS) -> NonEmpty a -> ShowS
showNonEmptyWith ConfigValSetting a -> ShowS
forall a. ConfigValSetting a -> ShowS
showConfigValSettingABit) Maybe (NonEmpty (ConfigValSetting a))
settingConfigVals
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, String) -> ShowS) -> Maybe (a, String) -> ShowS
forall a. (a -> ShowS) -> Maybe a -> ShowS
showMaybeWith (\(a, String)
_ -> String -> ShowS
showString String
"_") Maybe (a, String)
settingDefaultValue
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 [String]
settingExamples
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bool
settingHidden
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe String
settingMetavar
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe String
settingHelp
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Completer -> ShowS) -> Maybe Completer -> ShowS
forall a. (a -> ShowS) -> Maybe a -> ShowS
showMaybeWith (\Completer
_ -> String -> ShowS
showString String
"_") Maybe Completer
settingCompleter
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Set Capability -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Set Capability
settingRequiredCapabilities

showConfigValSettingABit :: ConfigValSetting a -> ShowS
showConfigValSettingABit :: forall a. ConfigValSetting a -> ShowS
showConfigValSettingABit ConfigValSetting {Bool
NonEmpty String
ValueCodec void (Maybe a)
configValSettingPath :: forall a. ConfigValSetting a -> NonEmpty String
configValSettingAllowPrefix :: forall a. ConfigValSetting a -> Bool
configValSettingCodec :: ()
configValSettingPath :: NonEmpty String
configValSettingAllowPrefix :: Bool
configValSettingCodec :: ValueCodec void (Maybe a)
..} =
  String -> ShowS
showString String
"ConfigValSetting "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> NonEmpty String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 NonEmpty String
configValSettingPath
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (ValueCodec void (Maybe a) -> String
forall context input output. Codec context input output -> String
showCodecABit ValueCodec void (Maybe a)
configValSettingCodec)

showMaybeWith :: (a -> ShowS) -> Maybe a -> ShowS
showMaybeWith :: forall a. (a -> ShowS) -> Maybe a -> ShowS
showMaybeWith a -> ShowS
_ Maybe a
Nothing = String -> ShowS
showString String
"Nothing"
showMaybeWith a -> ShowS
func (Just a
a) = Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Just " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
func a
a

showNonEmptyWith :: (a -> ShowS) -> NonEmpty a -> ShowS
showNonEmptyWith :: forall a. (a -> ShowS) -> NonEmpty a -> ShowS
showNonEmptyWith a -> ShowS
func (a
a :| [a]
as) =
  Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    a -> ShowS
func a
a
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" :| "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ShowS) -> [a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith a -> ShowS
func [a]
as

-- | Builder for a 'Setting'
newtype Builder a = Builder {forall a. Builder a -> [BuildInstruction a]
unBuilder :: [BuildInstruction a]}

data BuildInstruction a
  = BuildAddHelp !String
  | BuildSetMetavar !String
  | BuildTryArgument
  | BuildTryOption
  | BuildSetSwitchValue !a
  | BuildAddReader !(Reader a)
  | BuildAddLong !(NonEmpty Char)
  | BuildAddShort !Char
  | BuildAddEnv !EnvVarSetting
  | BuildAddConf !(ConfigValSetting a)
  | BuildSetDefault !a !String
  | BuildAddExample !String
  | BuildSetHidden
  | BuildSetCompleter !Completer
  | BuildAddRequiredCapability !Capability

applyBuildInstructions :: [BuildInstruction a] -> Setting a -> Setting a
applyBuildInstructions :: forall a. [BuildInstruction a] -> Setting a -> Setting a
applyBuildInstructions [BuildInstruction a]
is Setting a
s = (BuildInstruction a -> Setting a -> Setting a)
-> Setting a -> [BuildInstruction a] -> Setting a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr BuildInstruction a -> Setting a -> Setting a
forall a. BuildInstruction a -> Setting a -> Setting a
applyBuildInstruction Setting a
s [BuildInstruction a]
is

applyBuildInstruction :: BuildInstruction a -> Setting a -> Setting a
applyBuildInstruction :: forall a. BuildInstruction a -> Setting a -> Setting a
applyBuildInstruction BuildInstruction a
bi Setting a
s = case BuildInstruction a
bi of
  BuildAddHelp String
h -> Setting a
s {settingHelp = Just $ maybe h (<> h) (settingHelp s)}
  BuildSetMetavar String
mv -> Setting a
s {settingMetavar = Just mv}
  BuildInstruction a
BuildTryArgument -> Setting a
s {settingTryArgument = True}
  BuildInstruction a
BuildTryOption -> Setting a
s {settingTryOption = True}
  BuildSetSwitchValue a
a -> Setting a
s {settingSwitchValue = Just a}
  BuildAddReader Reader a
r -> Setting a
s {settingReaders = r : settingReaders s}
  BuildAddLong NonEmpty Char
l -> Setting a
s {settingDasheds = DashedLong l : settingDasheds s}
  BuildAddShort Char
c -> Setting a
s {settingDasheds = DashedShort c : settingDasheds s}
  BuildAddEnv EnvVarSetting
v -> Setting a
s {settingEnvVars = Just $ maybe (v :| []) (v <|) $ settingEnvVars s}
  BuildAddConf ConfigValSetting a
t -> Setting a
s {settingConfigVals = Just $ maybe (t :| []) (t <|) $ settingConfigVals s}
  BuildSetDefault a
a String
shown -> Setting a
s {settingDefaultValue = Just (a, shown)}
  BuildAddExample String
e -> Setting a
s {settingExamples = e : settingExamples s}
  BuildInstruction a
BuildSetHidden -> Setting a
s {settingHidden = True}
  BuildSetCompleter Completer
c -> Setting a
s {settingCompleter = Just c}
  BuildAddRequiredCapability Capability
c -> Setting a
s {settingRequiredCapabilities = Set.insert c (settingRequiredCapabilities s)}

instance Semigroup (Builder f) where
  <> :: Builder f -> Builder f -> Builder f
(<>) (Builder [BuildInstruction f]
f1) (Builder [BuildInstruction f]
f2) = [BuildInstruction f] -> Builder f
forall a. [BuildInstruction a] -> Builder a
Builder ([BuildInstruction f]
f1 [BuildInstruction f]
-> [BuildInstruction f] -> [BuildInstruction f]
forall a. Semigroup a => a -> a -> a
<> [BuildInstruction f]
f2)

instance Monoid (Builder f) where
  mempty :: Builder f
mempty = [BuildInstruction f] -> Builder f
forall a. [BuildInstruction a] -> Builder a
Builder []
  mappend :: Builder f -> Builder f -> Builder f
mappend = Builder f -> Builder f -> Builder f
forall a. Semigroup a => a -> a -> a
(<>)

-- | Complete a 'Builder' into a 'Setting'
completeBuilder :: Builder a -> Setting a
completeBuilder :: forall a. Builder a -> Setting a
completeBuilder Builder a
b = [BuildInstruction a] -> Setting a -> Setting a
forall a. [BuildInstruction a] -> Setting a -> Setting a
applyBuildInstructions (Builder a -> [BuildInstruction a]
forall a. Builder a -> [BuildInstruction a]
unBuilder Builder a
b) Setting a
forall a. Setting a
emptySetting

mapMaybeBuilder :: (BuildInstruction a -> Maybe (BuildInstruction b)) -> Builder a -> Builder b
mapMaybeBuilder :: forall a b.
(BuildInstruction a -> Maybe (BuildInstruction b))
-> Builder a -> Builder b
mapMaybeBuilder BuildInstruction a -> Maybe (BuildInstruction b)
func = [BuildInstruction b] -> Builder b
forall a. [BuildInstruction a] -> Builder a
Builder ([BuildInstruction b] -> Builder b)
-> (Builder a -> [BuildInstruction b]) -> Builder a -> Builder b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildInstruction a -> Maybe (BuildInstruction b))
-> [BuildInstruction a] -> [BuildInstruction b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BuildInstruction a -> Maybe (BuildInstruction b)
func ([BuildInstruction a] -> [BuildInstruction b])
-> (Builder a -> [BuildInstruction a])
-> Builder a
-> [BuildInstruction b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder a -> [BuildInstruction a]
forall a. Builder a -> [BuildInstruction a]
unBuilder

-- | Document a setting
--
-- Multiple 'help's concatenate help on new lines.
help :: String -> Builder a
help :: forall a. String -> Builder a
help String
s = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [String -> BuildInstruction a
forall a. String -> BuildInstruction a
BuildAddHelp String
s]

-- | Document an 'option' or 'env' var.
--
-- Multiple 'metavar's override eachother.
metavar :: String -> Builder a
metavar :: forall a. String -> Builder a
metavar String
mv = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [String -> BuildInstruction a
forall a. String -> BuildInstruction a
BuildSetMetavar String
mv]

-- | Try to parse an argument.
--
-- You'll also need to add a 'reader'.
--
-- Multiple 'argument's are redundant.
argument :: Builder a
argument :: forall f. Builder f
argument = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [BuildInstruction a
forall a. BuildInstruction a
BuildTryArgument]

-- | Try to parse an argument.
--
-- You'll also need to add a 'reader', at least one 'long' or 'short', and a
-- 'metavar'.
--
-- Multiple 'option's are redundant.
option :: Builder a
option :: forall f. Builder f
option = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [BuildInstruction a
forall a. BuildInstruction a
BuildTryOption]

-- | Try to parse a switch, activate the given value when succesful
--
-- You'll also need to add at least one 'long' or 'short'.
--
-- Multiple 'switch's override eachother.
switch :: a -> Builder a
switch :: forall a. a -> Builder a
switch a
v = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [a -> BuildInstruction a
forall a. a -> BuildInstruction a
BuildSetSwitchValue a
v]

-- | Declare how to parse an argument, option, or environment variable.
reader :: Reader a -> Builder a
reader :: forall a. Reader a -> Builder a
reader Reader a
r = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [Reader a -> BuildInstruction a
forall a. Reader a -> BuildInstruction a
BuildAddReader Reader a
r]

-- | Try to parse this 'long' 'option' or 'switch'.
--
-- @long "foo"@ corresponds to @--foo@
--
-- Notes:
--     * Parsing options with an empty name in the 'long' is not supported.
--     * Parsing options with an '=' sign in the 'long' is not supported.
--
-- Multiple 'long's will be tried in order.
-- Empty 'long's will be ignored.
long :: String -> Builder a
long :: forall a. String -> Builder a
long String
l = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [NonEmpty Char -> BuildInstruction a
forall a. NonEmpty Char -> BuildInstruction a
BuildAddLong NonEmpty Char
ne | NonEmpty Char
ne <- Maybe (NonEmpty Char) -> [NonEmpty Char]
forall a. Maybe a -> [a]
maybeToList (String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty String
l)]

-- | Try to parse this 'short' 'option' or 'switch'.
--
-- @short 'f'@ corresponds to @-f@
--
-- Notes:
--     * Parsing options with @short '-'@ is not supported.
--
-- Multiple 'short's will be tried in order.
short :: Char -> Builder a
short :: forall a. Char -> Builder a
short Char
c = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [Char -> BuildInstruction a
forall a. Char -> BuildInstruction a
BuildAddShort Char
c]

-- | Try to parse an environment variable.
--
-- You'll also need to add a 'reader' and a 'metavar'.
--
-- Multiple 'env's will be tried in order.
env :: String -> Builder a
env :: forall a. String -> Builder a
env String
v = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [EnvVarSetting -> BuildInstruction a
forall a. EnvVarSetting -> BuildInstruction a
BuildAddEnv (String -> Bool -> EnvVarSetting
EnvVarSetting String
v Bool
True)]

-- | Like 'env' but ignores any 'subEnv', 'subEnv_', or 'subAll'.
unprefixedEnv :: String -> Builder a
unprefixedEnv :: forall a. String -> Builder a
unprefixedEnv String
v = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [EnvVarSetting -> BuildInstruction a
forall a. EnvVarSetting -> BuildInstruction a
BuildAddEnv (String -> Bool -> EnvVarSetting
EnvVarSetting String
v Bool
False)]

-- | Try to parse a configuration value at the given key.
--
-- Multiple 'conf's will be tried in order.
conf :: (HasCodec a) => String -> Builder a
conf :: forall a. HasCodec a => String -> Builder a
conf String
k = String -> ValueCodec a a -> Builder a
forall void a. String -> ValueCodec void a -> Builder a
confWith String
k ValueCodec a a
forall value. HasCodec value => JSONCodec value
codec

-- | Like 'conf' but with a custom 'Codec' for parsing the value.
confWith :: String -> ValueCodec void a -> Builder a
confWith :: forall void a. String -> ValueCodec void a -> Builder a
confWith String
k ValueCodec void a
c = String -> ValueCodec (Maybe void) (Maybe a) -> Builder a
forall void a. String -> ValueCodec void (Maybe a) -> Builder a
confWith' String
k (ValueCodec void a -> ValueCodec (Maybe void) (Maybe a)
forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec ValueCodec void a
c)

-- | Like 'confWith' but allows interpreting 'Null' as a value other than "Not found".
confWith' :: String -> ValueCodec void (Maybe a) -> Builder a
confWith' :: forall void a. String -> ValueCodec void (Maybe a) -> Builder a
confWith' String
k ValueCodec void (Maybe a)
c =
  let t :: ConfigValSetting a
t =
        ConfigValSetting
          { configValSettingPath :: NonEmpty String
configValSettingPath = String
k String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [],
            configValSettingAllowPrefix :: Bool
configValSettingAllowPrefix = Bool
True,
            configValSettingCodec :: ValueCodec void (Maybe a)
configValSettingCodec = ValueCodec void (Maybe a)
c
          }
   in [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [ConfigValSetting a -> BuildInstruction a
forall a. ConfigValSetting a -> BuildInstruction a
BuildAddConf ConfigValSetting a
t]

-- | Like 'conf' but ignores any 'subConf', 'subConf_', or 'subAll'.
unprefixedConf :: (HasCodec a) => String -> Builder a
unprefixedConf :: forall a. HasCodec a => String -> Builder a
unprefixedConf String
k = String -> ValueCodec a a -> Builder a
forall void a. String -> ValueCodec void a -> Builder a
unprefixedConfWith String
k ValueCodec a a
forall value. HasCodec value => JSONCodec value
codec

-- | Like 'confWith' but ignores any 'subConf', 'subConf_', or 'subAll'.
unprefixedConfWith :: String -> ValueCodec void a -> Builder a
unprefixedConfWith :: forall void a. String -> ValueCodec void a -> Builder a
unprefixedConfWith String
k ValueCodec void a
c = String -> ValueCodec (Maybe void) (Maybe a) -> Builder a
forall void a. String -> ValueCodec void (Maybe a) -> Builder a
unprefixedConfWith' String
k (ValueCodec void a -> ValueCodec (Maybe void) (Maybe a)
forall input output.
ValueCodec input output -> ValueCodec (Maybe input) (Maybe output)
maybeCodec ValueCodec void a
c)

-- | Like 'confWith'' but ignores any 'subConf', 'subConf_', or 'subAll'.
unprefixedConfWith' :: String -> ValueCodec void (Maybe a) -> Builder a
unprefixedConfWith' :: forall void a. String -> ValueCodec void (Maybe a) -> Builder a
unprefixedConfWith' String
k ValueCodec void (Maybe a)
c =
  let t :: ConfigValSetting a
t =
        ConfigValSetting
          { configValSettingPath :: NonEmpty String
configValSettingPath = String
k String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [],
            configValSettingAllowPrefix :: Bool
configValSettingAllowPrefix = Bool
False,
            configValSettingCodec :: ValueCodec void (Maybe a)
configValSettingCodec = ValueCodec void (Maybe a)
c
          }
   in [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [ConfigValSetting a -> BuildInstruction a
forall a. ConfigValSetting a -> BuildInstruction a
BuildAddConf ConfigValSetting a
t]

-- | Short-hand function for 'option', 'long', 'env', and 'conf' at the same time.
--
-- Multiple 'name's will be tried in order.
name :: (HasCodec a) => String -> Builder a
name :: forall a. HasCodec a => String -> Builder a
name String
s =
  [Builder a] -> Builder a
forall a. Monoid a => [a] -> a
mconcat
    [ Builder a
forall f. Builder f
option,
      String -> Builder a
forall a. String -> Builder a
long (ShowS
toArgCase String
s),
      String -> Builder a
forall a. String -> Builder a
env (ShowS
toEnvCase String
s),
      String -> Builder a
forall a. HasCodec a => String -> Builder a
conf (ShowS
toConfigCase String
s)
    ]

-- | Set the default value
--
-- Multiple 'value's override eachother.
--
-- API Note: @default@ is not a valid identifier in Haskell.
-- I'd also have preferred @default@ instead.
value :: (Show a) => a -> Builder a
value :: forall a. Show a => a -> Builder a
value = (a -> String) -> a -> Builder a
forall a. (a -> String) -> a -> Builder a
valueWithShown a -> String
forall a. Show a => a -> String
show

-- | Set the default value, along with version of it shown by a custom function.
valueWithShown :: (a -> String) -> a -> Builder a
valueWithShown :: forall a. (a -> String) -> a -> Builder a
valueWithShown a -> String
show' a
a = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [a -> String -> BuildInstruction a
forall a. a -> String -> BuildInstruction a
BuildSetDefault a
a (a -> String
show' a
a)]

-- | Provide an example value for documentation.
--
-- The example is provided as a literal string.
--
-- If you use 'reader' 'auto', you'll want to use 'shownExample' instead.
example :: String -> Builder a
example :: forall a. String -> Builder a
example String
s = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [String -> BuildInstruction a
forall a. String -> BuildInstruction a
BuildAddExample String
s]

-- | Use 'Show' to show an 'example'.
--
-- This only makes sense if you use 'reader' 'auto'.
shownExample :: (Show a) => a -> Builder a
shownExample :: forall a. Show a => a -> Builder a
shownExample = String -> Builder a
forall a. String -> Builder a
example (String -> Builder a) -> (a -> String) -> a -> Builder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Don't show this setting in documentation
--
-- Multiple 'hidden's are redundant.
hidden :: Builder a
hidden :: forall f. Builder f
hidden = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [BuildInstruction a
forall a. BuildInstruction a
BuildSetHidden]

-- | Set the setting to tab-complete with the given completer
--
-- Multiple 'completer's are redundant.
completer :: Completer -> Builder a
completer :: forall a. Completer -> Builder a
completer Completer
c = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [Completer -> BuildInstruction a
forall a. Completer -> BuildInstruction a
BuildSetCompleter Completer
c]

-- | Annotate a setting with a required capability.
requiredCapability :: String -> Builder a
requiredCapability :: forall a. String -> Builder a
requiredCapability String
c = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [Capability -> BuildInstruction a
forall a. Capability -> BuildInstruction a
BuildAddRequiredCapability (Text -> Capability
Capability (String -> Text
T.pack String
c))]