{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module OptEnvConf.Setting
( Setting (..),
ConfigValSetting (..),
help,
metavar,
argument,
option,
switch,
reader,
str,
auto,
long,
short,
env,
conf,
confWith,
confWith',
name,
value,
valueWithShown,
example,
shownExample,
hidden,
Builder (..),
BuildInstruction (..),
showSettingABit,
completeBuilder,
emptySetting,
Metavar,
Help,
prefixConfigValSetting,
)
where
import Autodocodec
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import OptEnvConf.Args (Dashed (..))
import OptEnvConf.Casing
import OptEnvConf.Reader
import Text.Show
type Metavar = String
type Help = String
data Setting a = Setting
{
forall a. Setting a -> [Dashed]
settingDasheds :: ![Dashed],
forall a. Setting a -> [Reader a]
settingReaders :: ![Reader a],
forall a. Setting a -> Bool
settingTryArgument :: !Bool,
forall a. Setting a -> Maybe a
settingSwitchValue :: !(Maybe a),
forall a. Setting a -> Bool
settingTryOption :: !Bool,
forall a. Setting a -> Maybe (NonEmpty String)
settingEnvVars :: !(Maybe (NonEmpty String)),
forall a. Setting a -> Maybe (NonEmpty (ConfigValSetting a))
settingConfigVals :: !(Maybe (NonEmpty (ConfigValSetting a))),
forall a. Setting a -> Maybe (a, String)
settingDefaultValue :: !(Maybe (a, String)),
forall a. Setting a -> [String]
settingExamples :: ![String],
forall a. Setting a -> Bool
settingHidden :: !Bool,
forall a. Setting a -> Maybe String
settingMetavar :: !(Maybe Metavar),
forall a. Setting a -> Maybe String
settingHelp :: !(Maybe String)
}
data ConfigValSetting a = forall void.
ConfigValSetting
{ forall a. ConfigValSetting a -> NonEmpty String
configValSettingPath :: !(NonEmpty String),
()
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 = ConfigValSetting a
c {configValSettingPath = prefix NE.<| configValSettingPath c}
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 String)
settingEnvVars = Maybe (NonEmpty String)
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
}
showSettingABit :: Setting a -> ShowS
showSettingABit :: forall a. Setting a -> ShowS
showSettingABit Setting {Bool
[String]
[Dashed]
[Reader a]
Maybe a
Maybe String
Maybe (NonEmpty String)
Maybe (NonEmpty (ConfigValSetting a))
Maybe (a, String)
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 String)
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
settingDasheds :: [Dashed]
settingReaders :: [Reader a]
settingTryArgument :: Bool
settingSwitchValue :: Maybe a
settingTryOption :: Bool
settingEnvVars :: Maybe (NonEmpty String)
settingConfigVals :: Maybe (NonEmpty (ConfigValSetting a))
settingDefaultValue :: Maybe (a, String)
settingExamples :: [String]
settingHidden :: Bool
settingMetavar :: Maybe String
settingHelp :: Maybe String
..} =
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 String) -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe (NonEmpty String)
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 -> 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
showConfigValSettingABit :: ConfigValSetting a -> ShowS
showConfigValSettingABit :: forall a. ConfigValSetting a -> ShowS
showConfigValSettingABit ConfigValSetting {NonEmpty String
ValueCodec void (Maybe a)
configValSettingPath :: forall a. ConfigValSetting a -> NonEmpty String
configValSettingCodec :: ()
configValSettingPath :: NonEmpty String
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
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 !String
| BuildAddConf !(ConfigValSetting a)
| BuildSetDefault !a !String
| BuildAddExample !String
| BuildSetHidden
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 String
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}
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
(<>)
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
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]
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]
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]
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]
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]
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]
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)]
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]
env :: String -> Builder a
env :: forall a. String -> Builder a
env String
v = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [String -> BuildInstruction a
forall a. String -> BuildInstruction a
BuildAddEnv String
v]
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
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)
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
:| [], 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]
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)
]
value :: (Show a) => a -> Builder a
value :: forall a. Show a => a -> Builder a
value a
a = a -> String -> Builder a
forall a. a -> String -> Builder a
valueWithShown a
a (a -> String
forall a. Show a => a -> String
show a
a)
valueWithShown :: a -> String -> Builder a
valueWithShown :: forall a. a -> String -> Builder a
valueWithShown a
a String
shown = [BuildInstruction a] -> Builder a
forall a. [BuildInstruction a] -> Builder a
Builder [a -> String -> BuildInstruction a
forall a. a -> String -> BuildInstruction a
BuildSetDefault a
a String
shown]
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]
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
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]