module Cfg.Parser.Config
(
defaultParseConfig
, GConfigParser (..)
)
where
import Cfg.Options
import Cfg.Parser (ConfigParseError (..), ConfigParser (..))
import Data.Kind (Type)
import Data.Map qualified as M
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics
import KeyTree
defaultParseConfig
:: forall a
. (Generic a, GConfigParser (Rep a))
=> ConfigOptions
-> KeyTree Text Text
-> Either ConfigParseError a
defaultParseConfig :: forall a.
(Generic a, GConfigParser (Rep a)) =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError a
defaultParseConfig ConfigOptions
opts KeyTree Text Text
tree = (Rep a Any -> a)
-> Either ConfigParseError (Rep a Any) -> Either ConfigParseError a
forall a b.
(a -> b) -> Either ConfigParseError a -> Either ConfigParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Either ConfigParseError (Rep a Any) -> Either ConfigParseError a)
-> Either ConfigParseError (Rep a Any) -> Either ConfigParseError a
forall a b. (a -> b) -> a -> b
$ ConfigOptions
-> KeyTree Text Text -> Either ConfigParseError (Rep a Any)
forall p.
ConfigOptions
-> KeyTree Text Text -> Either ConfigParseError (Rep a p)
forall (f :: * -> *) p.
GConfigParser f =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
gParseConfig ConfigOptions
opts KeyTree Text Text
tree
class GConfigParser (f :: Type -> Type) where
gParseConfig :: ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
instance (ConfigParser a) => GConfigParser (K1 R a) where
gParseConfig :: forall p.
ConfigOptions
-> KeyTree Text Text -> Either ConfigParseError (K1 R a p)
gParseConfig ConfigOptions
_ KeyTree Text Text
kt = a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 R a p)
-> Either ConfigParseError a -> Either ConfigParseError (K1 R a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyTree Text Text -> Either ConfigParseError a
forall a.
ConfigParser a =>
KeyTree Text Text -> Either ConfigParseError a
parseConfig KeyTree Text Text
kt
instance (GConfigParser f, Datatype d) => GConfigParser (M1 D d f) where
gParseConfig :: forall p.
ConfigOptions
-> KeyTree Text Text -> Either ConfigParseError (M1 D d f p)
gParseConfig ConfigOptions
opts t :: KeyTree Text Text
t@(Free Map Text (KeyTree Text Text)
keyForest) =
case ConfigOptions
opts of
Root (RootOptions{rootOptionsRootKey :: RootOptions -> RootKey (Text -> Text)
rootOptionsRootKey = TypeName Text -> Text
modifier}) ->
let
key :: Text
key = Text -> Text
modifier (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> [Char]
forall (d :: Meta) k1 (t :: Meta -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> [Char]
datatypeName @d Any d Any Any
forall a. HasCallStack => a
undefined
in
case Text -> Map Text (KeyTree Text Text) -> Maybe (KeyTree Text Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Map Text (KeyTree Text Text)
keyForest of
Just KeyTree Text Text
subTree -> f p -> M1 D d f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D d f p)
-> Either ConfigParseError (f p)
-> Either ConfigParseError (M1 D d f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
forall p.
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GConfigParser f =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
gParseConfig ConfigOptions
opts KeyTree Text Text
subTree
Maybe (KeyTree Text Text)
Nothing -> ConfigParseError -> Either ConfigParseError (M1 D d f p)
forall a b. a -> Either a b
Left (ConfigParseError -> Either ConfigParseError (M1 D d f p))
-> ConfigParseError -> Either ConfigParseError (M1 D d f p)
forall a b. (a -> b) -> a -> b
$ Text -> KeyTree Text Text -> ConfigParseError
MissingKey Text
key KeyTree Text Text
t
ConfigOptions
_ -> f p -> M1 D d f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D d f p)
-> Either ConfigParseError (f p)
-> Either ConfigParseError (M1 D d f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
forall p.
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GConfigParser f =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
gParseConfig ConfigOptions
opts KeyTree Text Text
t
gParseConfig ConfigOptions
opts (Pure Text
value) = ConfigParseError -> Either ConfigParseError (M1 D d f p)
forall a b. a -> Either a b
Left (ConfigParseError -> Either ConfigParseError (M1 D d f p))
-> ConfigParseError -> Either ConfigParseError (M1 D d f p)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ConfigParseError
ExpectedKeyFoundValue Text
key Text
value
where
key :: Text
key = ConfigOptions -> Text -> Text
keyModifier ConfigOptions
opts (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> [Char]
forall (d :: Meta) k1 (t :: Meta -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> [Char]
datatypeName @d Any d Any Any
forall a. HasCallStack => a
undefined
instance (Constructor c, GConfigParser f) => GConfigParser (M1 C c f) where
gParseConfig :: forall p.
ConfigOptions
-> KeyTree Text Text -> Either ConfigParseError (M1 C c f p)
gParseConfig ConfigOptions
opts t :: KeyTree Text Text
t@(Free Map Text (KeyTree Text Text)
keyForest) =
case ConfigOptions
opts of
Root (RootOptions{rootOptionsRootKey :: RootOptions -> RootKey (Text -> Text)
rootOptionsRootKey = ConstructorName Text -> Text
modifier}) ->
let
key :: Text
key = Text -> Text
modifier (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall (c :: Meta) k1 (t :: Meta -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
in
case Text -> Map Text (KeyTree Text Text) -> Maybe (KeyTree Text Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
key Map Text (KeyTree Text Text)
keyForest of
Just KeyTree Text Text
subTree -> f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 C c f p)
-> Either ConfigParseError (f p)
-> Either ConfigParseError (M1 C c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
forall p.
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GConfigParser f =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
gParseConfig ConfigOptions
opts KeyTree Text Text
subTree
Maybe (KeyTree Text Text)
Nothing -> ConfigParseError -> Either ConfigParseError (M1 C c f p)
forall a b. a -> Either a b
Left (ConfigParseError -> Either ConfigParseError (M1 C c f p))
-> ConfigParseError -> Either ConfigParseError (M1 C c f p)
forall a b. (a -> b) -> a -> b
$ Text -> KeyTree Text Text -> ConfigParseError
MissingKey Text
key KeyTree Text Text
t
ConfigOptions
_ -> f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 C c f p)
-> Either ConfigParseError (f p)
-> Either ConfigParseError (M1 C c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
forall p.
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GConfigParser f =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
gParseConfig ConfigOptions
opts KeyTree Text Text
t
gParseConfig ConfigOptions
opts (Pure Text
value) = ConfigParseError -> Either ConfigParseError (M1 C c f p)
forall a b. a -> Either a b
Left (ConfigParseError -> Either ConfigParseError (M1 C c f p))
-> ConfigParseError -> Either ConfigParseError (M1 C c f p)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ConfigParseError
ExpectedKeyFoundValue Text
key Text
value
where
key :: Text
key = ConfigOptions -> Text -> Text
keyModifier ConfigOptions
opts (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall (c :: Meta) k1 (t :: Meta -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
instance (Selector s, GConfigParser f) => GConfigParser (M1 S s f) where
gParseConfig :: forall p.
ConfigOptions
-> KeyTree Text Text -> Either ConfigParseError (M1 S s f p)
gParseConfig ConfigOptions
opts (Pure Text
value) = ConfigParseError -> Either ConfigParseError (M1 S s f p)
forall a b. a -> Either a b
Left (ConfigParseError -> Either ConfigParseError (M1 S s f p))
-> ConfigParseError -> Either ConfigParseError (M1 S s f p)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ConfigParseError
ExpectedKeyFoundValue Text
key Text
value
where
key :: Text
key = ConfigOptions -> Text -> Text
keyModifier ConfigOptions
opts (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall (s :: Meta) k1 (t :: Meta -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName @s Any s Any Any
forall a. HasCallStack => a
undefined
gParseConfig ConfigOptions
opts t :: KeyTree Text Text
t@(Free Map Text (KeyTree Text Text)
keyForest) =
case Text -> Map Text (KeyTree Text Text) -> Maybe (KeyTree Text Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
selectorName Map Text (KeyTree Text Text)
keyForest of
Maybe (KeyTree Text Text)
Nothing -> ConfigParseError -> Either ConfigParseError (M1 S s f p)
forall a b. a -> Either a b
Left (ConfigParseError -> Either ConfigParseError (M1 S s f p))
-> ConfigParseError -> Either ConfigParseError (M1 S s f p)
forall a b. (a -> b) -> a -> b
$ Text -> KeyTree Text Text -> ConfigParseError
MissingKey Text
selectorName KeyTree Text Text
t
Just KeyTree Text Text
subTree -> f p -> M1 S s f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 S s f p)
-> Either ConfigParseError (f p)
-> Either ConfigParseError (M1 S s f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
forall p.
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GConfigParser f =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
gParseConfig ConfigOptions
opts KeyTree Text Text
subTree
where
selectorName :: Text
selectorName = ConfigOptions -> Text -> Text
keyModifier ConfigOptions
opts (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall (s :: Meta) k1 (t :: Meta -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName @s Any s Any Any
forall a. HasCallStack => a
undefined
instance (GConfigParser a, GConfigParser b) => GConfigParser (a :*: b) where
gParseConfig :: forall p.
ConfigOptions
-> KeyTree Text Text -> Either ConfigParseError ((:*:) a b p)
gParseConfig ConfigOptions
opts KeyTree Text Text
xs = do
a p
a <- ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (a p)
forall p.
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (a p)
forall (f :: * -> *) p.
GConfigParser f =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
gParseConfig ConfigOptions
opts KeyTree Text Text
xs
b p
b <- ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (b p)
forall p.
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (b p)
forall (f :: * -> *) p.
GConfigParser f =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError (f p)
gParseConfig ConfigOptions
opts KeyTree Text Text
xs
(:*:) a b p -> Either ConfigParseError ((:*:) a b p)
forall a. a -> Either ConfigParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((:*:) a b p -> Either ConfigParseError ((:*:) a b p))
-> (:*:) a b p -> Either ConfigParseError ((:*:) a b p)
forall a b. (a -> b) -> a -> b
$ a p
a a p -> b p -> (:*:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b p
b