{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
module OptEnvConf.Setting
( Setting (..),
help,
metavar,
argument,
option,
switch,
reader,
str,
auto,
long,
short,
env,
conf,
confWith,
confWith',
name,
value,
valueWithShown,
example,
shownExample,
hidden,
Builder (..),
showSettingABit,
completeBuilder,
emptySetting,
DecodingCodec (..),
Metavar,
Help,
)
where
import Autodocodec
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
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 (NonEmpty String, DecodingCodec a))
settingConfigVals :: !(Maybe (NonEmpty (NonEmpty String, DecodingCodec 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 DecodingCodec a = forall void. DecodingCodec (ValueCodec void (Maybe a))
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 (NonEmpty String, DecodingCodec a))
settingConfigVals = Maybe (NonEmpty (NonEmpty String, DecodingCodec 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 (NonEmpty String, DecodingCodec 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 (NonEmpty String, DecodingCodec 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 (NonEmpty String, DecodingCodec 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 (NonEmpty String, DecodingCodec a) -> ShowS)
-> Maybe (NonEmpty (NonEmpty String, DecodingCodec a)) -> ShowS
forall a. (a -> ShowS) -> Maybe a -> ShowS
showMaybeWith
( ((NonEmpty String, DecodingCodec a) -> ShowS)
-> [(NonEmpty String, DecodingCodec a)] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith
( \(NonEmpty String
k, DecodingCodec ValueCodec void (Maybe a)
c) ->
String -> ShowS
showString String
"("
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> ShowS
forall a. Show a => a -> ShowS
shows NonEmpty String
k
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)
c)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"
)
([(NonEmpty String, DecodingCodec a)] -> ShowS)
-> (NonEmpty (NonEmpty String, DecodingCodec a)
-> [(NonEmpty String, DecodingCodec a)])
-> NonEmpty (NonEmpty String, DecodingCodec a)
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (NonEmpty String, DecodingCodec a)
-> [(NonEmpty String, DecodingCodec a)]
forall a. NonEmpty a -> [a]
NE.toList
)
Maybe (NonEmpty (NonEmpty String, DecodingCodec 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
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
newtype Builder a = Builder {forall a. Builder a -> Setting a -> Setting a
unBuilder :: Setting a -> Setting a}
instance Semigroup (Builder f) where
<> :: Builder f -> Builder f -> Builder f
(<>) (Builder Setting f -> Setting f
f1) (Builder Setting f -> Setting f
f2) = (Setting f -> Setting f) -> Builder f
forall a. (Setting a -> Setting a) -> Builder a
Builder (Setting f -> Setting f
f1 (Setting f -> Setting f)
-> (Setting f -> Setting f) -> Setting f -> Setting f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Setting f -> Setting f
f2)
instance Monoid (Builder f) where
mempty :: Builder f
mempty = (Setting f -> Setting f) -> Builder f
forall a. (Setting a -> Setting a) -> Builder a
Builder Setting f -> Setting f
forall a. a -> a
id
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 = Builder a -> Setting a -> Setting a
forall a. Builder a -> Setting a -> Setting 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 = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
op -> Setting a
op {settingHelp = Just $ maybe s (s <>) (settingHelp op)}
metavar :: String -> Builder a
metavar :: forall a. String -> Builder a
metavar String
mv = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> Setting a
s {settingMetavar = Just mv}
argument :: Builder a
argument :: forall f. Builder f
argument = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> Setting a
s {settingTryArgument = True}
option :: Builder a
option :: forall f. Builder f
option = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> Setting a
s {settingTryOption = True}
switch :: a -> Builder a
switch :: forall a. a -> Builder a
switch a
v = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> Setting a
s {settingSwitchValue = Just v}
reader :: Reader a -> Builder a
reader :: forall a. Reader a -> Builder a
reader Reader a
r = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> Setting a
s {settingReaders = r : settingReaders s}
long :: String -> Builder a
long :: forall a. String -> Builder a
long String
l = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> case String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty String
l of
Maybe (NonEmpty Char)
Nothing -> Setting a
s
Just NonEmpty Char
ne -> Setting a
s {settingDasheds = DashedLong ne : settingDasheds s}
short :: Char -> Builder a
short :: forall a. Char -> Builder a
short Char
c = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> Setting a
s {settingDasheds = DashedShort c : settingDasheds s}
env :: String -> Builder a
env :: forall a. String -> Builder a
env String
v = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> Setting a
s {settingEnvVars = Just $ maybe (v :| []) (v <|) $ settingEnvVars s}
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
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)
]
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 :: (NonEmpty String, DecodingCodec a)
t = (String
k String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [], ValueCodec void (Maybe a) -> DecodingCodec a
forall a void. ValueCodec void (Maybe a) -> DecodingCodec a
DecodingCodec ValueCodec void (Maybe a)
c)
in (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> Setting a
s {settingConfigVals = Just $ maybe (t :| []) (t <|) $ settingConfigVals 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 = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> Setting a
s {settingDefaultValue = Just (a, shown)}
example :: String -> Builder a
example :: forall a. String -> Builder a
example String
s = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
set -> Setting a
set {settingExamples = s : settingExamples set}
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 = (Setting a -> Setting a) -> Builder a
forall a. (Setting a -> Setting a) -> Builder a
Builder ((Setting a -> Setting a) -> Builder a)
-> (Setting a -> Setting a) -> Builder a
forall a b. (a -> b) -> a -> b
$ \Setting a
s -> Setting a
s {settingHidden = True}