{-# Language MultiWayIf, OverloadedStrings, RankNTypes #-}
module Crux.Config
(
Config(..), cfgJoin
, SectionsSpec, section, sectionMaybe
, yesOrNoSpec, stringSpec, numSpec, fractionalSpec
, oneOrList, fileSpec, dirSpec, listSpec
, EnvDescr(..), mapEnvDescr, liftEnvDescr, liftOptDescr
, OptDescr(..), ArgDescr(..), OptSetter
, mapOptDescr, mapArgDescr
, parsePosNum
) where
import Control.Lens (Lens', set, view)
import Data.Text (Text)
import Data.Maybe (fromMaybe)
import Text.Read(readMaybe)
import SimpleGetOpt
import Config.Schema
data Config opts = Config
{ forall opts. Config opts -> SectionsSpec opts
cfgFile :: SectionsSpec opts
, forall opts. Config opts -> [EnvDescr opts]
cfgEnv :: [ EnvDescr opts ]
, forall opts. Config opts -> [OptDescr opts]
cfgCmdLineFlag :: [ OptDescr opts ]
}
data EnvDescr opts =
EnvVar { forall opts. EnvDescr opts -> String
evName :: String
, forall opts. EnvDescr opts -> String
evDoc :: String
, forall opts. EnvDescr opts -> String -> OptSetter opts
evValue :: String -> OptSetter opts
}
liftEnvDescr :: Lens' a b -> EnvDescr b -> EnvDescr a
liftEnvDescr :: forall a b. Lens' a b -> EnvDescr b -> EnvDescr a
liftEnvDescr Lens' a b
lens EnvDescr b
envDescr =
EnvDescr b
envDescr { evValue = liftOptSetter lens . evValue envDescr }
liftOptDescr :: Lens' a b -> OptDescr b -> OptDescr a
liftOptDescr :: forall a b. Lens' a b -> OptDescr b -> OptDescr a
liftOptDescr Lens' a b
lens (Option String
a [String]
b String
c ArgDescr b
d) = String -> [String] -> String -> ArgDescr a -> OptDescr a
forall a. String -> [String] -> String -> ArgDescr a -> OptDescr a
Option String
a [String]
b String
c (Lens' a b -> ArgDescr b -> ArgDescr a
forall a b. Lens' a b -> ArgDescr b -> ArgDescr a
liftArgDescr (b -> f b) -> a -> f a
Lens' a b
lens ArgDescr b
d)
liftArgDescr :: Lens' a b -> ArgDescr b -> ArgDescr a
liftArgDescr :: forall a b. Lens' a b -> ArgDescr b -> ArgDescr a
liftArgDescr Lens' a b
lens (NoArg OptSetter b
s) = OptSetter a -> ArgDescr a
forall a. OptSetter a -> ArgDescr a
NoArg (Lens' a b -> OptSetter b -> OptSetter a
forall a b. Lens' a b -> OptSetter b -> OptSetter a
liftOptSetter (b -> f b) -> a -> f a
Lens' a b
lens OptSetter b
s)
liftArgDescr Lens' a b
lens (ReqArg String
v String -> OptSetter b
s) = String -> (String -> OptSetter a) -> ArgDescr a
forall a. String -> (String -> OptSetter a) -> ArgDescr a
ReqArg String
v (Lens' a b -> OptSetter b -> OptSetter a
forall a b. Lens' a b -> OptSetter b -> OptSetter a
liftOptSetter (b -> f b) -> a -> f a
Lens' a b
lens (OptSetter b -> OptSetter a)
-> (String -> OptSetter b) -> String -> OptSetter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OptSetter b
s)
liftArgDescr Lens' a b
lens (OptArg String
v Maybe String -> OptSetter b
s) = String -> (Maybe String -> OptSetter a) -> ArgDescr a
forall a. String -> (Maybe String -> OptSetter a) -> ArgDescr a
OptArg String
v (Lens' a b -> OptSetter b -> OptSetter a
forall a b. Lens' a b -> OptSetter b -> OptSetter a
liftOptSetter (b -> f b) -> a -> f a
Lens' a b
lens (OptSetter b -> OptSetter a)
-> (Maybe String -> OptSetter b) -> Maybe String -> OptSetter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> OptSetter b
s)
liftOptSetter :: Lens' a b -> OptSetter b -> OptSetter a
liftOptSetter :: forall a b. Lens' a b -> OptSetter b -> OptSetter a
liftOptSetter Lens' a b
lens OptSetter b
v a
o = (b -> a -> a) -> a -> b -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ASetter a a b b -> b -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter a a b b
Lens' a b
lens) a
o (b -> a) -> Either String b -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OptSetter b
v (Getting b a b -> a -> b
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting b a b
Lens' a b
lens a
o)
cfgJoin :: Config a -> Config b -> Config (a,b)
cfgJoin :: forall a b. Config a -> Config b -> Config (a, b)
cfgJoin Config a
cfg1 Config b
cfg2 = Config
{ cfgFile :: SectionsSpec (a, b)
cfgFile = (,) (a -> b -> (a, b)) -> SectionsSpec a -> SectionsSpec (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config a -> SectionsSpec a
forall opts. Config opts -> SectionsSpec opts
cfgFile Config a
cfg1 SectionsSpec (b -> (a, b)) -> SectionsSpec b -> SectionsSpec (a, b)
forall a b.
SectionsSpec (a -> b) -> SectionsSpec a -> SectionsSpec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Config b -> SectionsSpec b
forall opts. Config opts -> SectionsSpec opts
cfgFile Config b
cfg2
, cfgEnv :: [EnvDescr (a, b)]
cfgEnv = (EnvDescr a -> EnvDescr (a, b))
-> [EnvDescr a] -> [EnvDescr (a, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((OptSetter a -> OptSetter (a, b)) -> EnvDescr a -> EnvDescr (a, b)
forall a b.
(OptSetter a -> OptSetter b) -> EnvDescr a -> EnvDescr b
mapEnvDescr OptSetter a -> OptSetter (a, b)
forall a b. OptSetter a -> OptSetter (a, b)
inFst) (Config a -> [EnvDescr a]
forall opts. Config opts -> [EnvDescr opts]
cfgEnv Config a
cfg1) [EnvDescr (a, b)] -> [EnvDescr (a, b)] -> [EnvDescr (a, b)]
forall a. [a] -> [a] -> [a]
++
(EnvDescr b -> EnvDescr (a, b))
-> [EnvDescr b] -> [EnvDescr (a, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((OptSetter b -> OptSetter (a, b)) -> EnvDescr b -> EnvDescr (a, b)
forall a b.
(OptSetter a -> OptSetter b) -> EnvDescr a -> EnvDescr b
mapEnvDescr OptSetter b -> OptSetter (a, b)
forall b a. OptSetter b -> OptSetter (a, b)
inSnd) (Config b -> [EnvDescr b]
forall opts. Config opts -> [EnvDescr opts]
cfgEnv Config b
cfg2)
, cfgCmdLineFlag :: [OptDescr (a, b)]
cfgCmdLineFlag = (OptDescr a -> OptDescr (a, b))
-> [OptDescr a] -> [OptDescr (a, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((OptSetter a -> OptSetter (a, b)) -> OptDescr a -> OptDescr (a, b)
forall a b.
(OptSetter a -> OptSetter b) -> OptDescr a -> OptDescr b
mapOptDescr OptSetter a -> OptSetter (a, b)
forall a b. OptSetter a -> OptSetter (a, b)
inFst) (Config a -> [OptDescr a]
forall opts. Config opts -> [OptDescr opts]
cfgCmdLineFlag Config a
cfg1) [OptDescr (a, b)] -> [OptDescr (a, b)] -> [OptDescr (a, b)]
forall a. [a] -> [a] -> [a]
++
(OptDescr b -> OptDescr (a, b))
-> [OptDescr b] -> [OptDescr (a, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((OptSetter b -> OptSetter (a, b)) -> OptDescr b -> OptDescr (a, b)
forall a b.
(OptSetter a -> OptSetter b) -> OptDescr a -> OptDescr b
mapOptDescr OptSetter b -> OptSetter (a, b)
forall b a. OptSetter b -> OptSetter (a, b)
inSnd) (Config b -> [OptDescr b]
forall opts. Config opts -> [OptDescr opts]
cfgCmdLineFlag Config b
cfg2)
}
inFst :: OptSetter a -> OptSetter (a,b)
inFst :: forall a b. OptSetter a -> OptSetter (a, b)
inFst OptSetter a
f = \(a
a,b
b) -> do a
a' <- OptSetter a
f a
a
(a, b) -> Either String (a, b)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a',b
b)
inSnd :: OptSetter b -> OptSetter (a,b)
inSnd :: forall b a. OptSetter b -> OptSetter (a, b)
inSnd OptSetter b
f = \(a
a,b
b) -> do b
b' <- OptSetter b
f b
b
(a, b) -> Either String (a, b)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a,b
b')
section :: Text ->
ValueSpec a ->
a ->
Text ->
SectionsSpec a
section :: forall a. Text -> ValueSpec a -> a -> Text -> SectionsSpec a
section Text
nm ValueSpec a
spec a
def Text
doc = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a -> a) -> SectionsSpec (Maybe a) -> SectionsSpec a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
nm ValueSpec a
spec Text
doc
sectionMaybe :: Text ->
ValueSpec a ->
Text ->
SectionsSpec (Maybe a)
sectionMaybe :: forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
sectionMaybe = Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection'
fileSpec :: ValueSpec FilePath
fileSpec :: ValueSpec String
fileSpec = Text -> ValueSpec String -> ValueSpec String
forall a. Text -> ValueSpec a -> ValueSpec a
namedSpec Text
"FILE" ValueSpec String
stringSpec
dirSpec :: ValueSpec FilePath
dirSpec :: ValueSpec String
dirSpec = Text -> ValueSpec String -> ValueSpec String
forall a. Text -> ValueSpec a -> ValueSpec a
namedSpec Text
"DIR" ValueSpec String
stringSpec
mapEnvDescr :: (OptSetter a -> OptSetter b) -> EnvDescr a -> EnvDescr b
mapEnvDescr :: forall a b.
(OptSetter a -> OptSetter b) -> EnvDescr a -> EnvDescr b
mapEnvDescr OptSetter a -> OptSetter b
f EnvDescr a
e = EnvDescr a
e { evValue = f . evValue e }
mapArgDescr :: (OptSetter a -> OptSetter b) -> ArgDescr a -> ArgDescr b
mapArgDescr :: forall a b.
(OptSetter a -> OptSetter b) -> ArgDescr a -> ArgDescr b
mapArgDescr OptSetter a -> OptSetter b
g ArgDescr a
ad =
case ArgDescr a
ad of
NoArg OptSetter a
os -> OptSetter b -> ArgDescr b
forall a. OptSetter a -> ArgDescr a
NoArg (OptSetter a -> OptSetter b
g OptSetter a
os)
ReqArg String
s String -> OptSetter a
f -> String -> (String -> OptSetter b) -> ArgDescr b
forall a. String -> (String -> OptSetter a) -> ArgDescr a
ReqArg String
s (OptSetter a -> OptSetter b
g (OptSetter a -> OptSetter b)
-> (String -> OptSetter a) -> String -> OptSetter b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OptSetter a
f)
OptArg String
s Maybe String -> OptSetter a
f -> String -> (Maybe String -> OptSetter b) -> ArgDescr b
forall a. String -> (Maybe String -> OptSetter a) -> ArgDescr a
OptArg String
s (OptSetter a -> OptSetter b
g (OptSetter a -> OptSetter b)
-> (Maybe String -> OptSetter a) -> Maybe String -> OptSetter b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> OptSetter a
f)
mapOptDescr :: (OptSetter a -> OptSetter b) -> OptDescr a -> OptDescr b
mapOptDescr :: forall a b.
(OptSetter a -> OptSetter b) -> OptDescr a -> OptDescr b
mapOptDescr OptSetter a -> OptSetter b
f OptDescr a
o = OptDescr a
o { optArgument = mapArgDescr f (optArgument o) }
parsePosNum :: (Read a, Num a, Ord a) =>
String -> (a -> opts -> opts) -> String -> OptSetter opts
parsePosNum :: forall a opts.
(Read a, Num a, Ord a) =>
String -> (a -> opts -> opts) -> String -> OptSetter opts
parsePosNum String
thing a -> opts -> opts
mk = \String
txt opts
opts ->
case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
txt of
Just a
a | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 -> opts -> Either String opts
forall a b. b -> Either a b
Right (a -> opts -> opts
mk a
a opts
opts)
Maybe a
_ -> String -> Either String opts
forall a b. a -> Either a b
Left (String
"Invalid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
thing)