{-# LANGUAGE UndecidableInstances #-}
module Cfg.Parser.ConfigParser where

import Cfg.Options (ConfigOptions (..), RootOptions (..))
import Cfg.Parser (ConfigParseError (..), NestedParser (..))
import Data.Kind (Type)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Tree (Tree (..))
import GHC.Generics
import Data.List

defaultParseRootConfig ::
    forall a.
    (Generic a, GRootConfigParser (Rep a)) =>
    RootOptions ->
    Tree Text ->
    Either ConfigParseError a
defaultParseRootConfig :: forall a.
(Generic a, GRootConfigParser (Rep a)) =>
RootOptions -> Tree Text -> Either ConfigParseError a
defaultParseRootConfig RootOptions
opts Tree 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
$ RootOptions -> Tree Text -> Either ConfigParseError (Rep a Any)
forall p.
RootOptions -> Tree Text -> Either ConfigParseError (Rep a p)
forall (f :: * -> *) p.
GRootConfigParser f =>
RootOptions -> Tree Text -> Either ConfigParseError (f p)
gParseRootConfig RootOptions
opts Tree Text
tree

class GRootConfigParser (f :: Type -> Type) where
    gParseRootConfig :: RootOptions -> Tree Text -> Either ConfigParseError (f p)

instance GRootConfigParser f => GRootConfigParser (M1 D s f) where
    gParseRootConfig :: forall p.
RootOptions -> Tree Text -> Either ConfigParseError (M1 D s f p)
gParseRootConfig RootOptions
opts Tree Text
tree = f p -> M1 D s f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D s f p)
-> Either ConfigParseError (f p)
-> Either ConfigParseError (M1 D s f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RootOptions -> Tree Text -> Either ConfigParseError (f p)
forall p. RootOptions -> Tree Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GRootConfigParser f =>
RootOptions -> Tree Text -> Either ConfigParseError (f p)
gParseRootConfig RootOptions
opts Tree Text
tree

instance (Selector s, GNestedParser f) => GRootConfigParser (M1 S s f) where
    gParseRootConfig :: forall p.
RootOptions -> Tree Text -> Either ConfigParseError (M1 S s f p)
gParseRootConfig RootOptions
opts Tree Text
tree = 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 -> Tree Text -> Either ConfigParseError (f p)
forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GNestedParser f =>
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
gParseNestedConfig (RootOptions -> ConfigOptions
rootOptionsFieldOptions RootOptions
opts) Tree Text
tree

instance (Constructor c, GRootConfigParser f) => GRootConfigParser (M1 C c f) where
    gParseRootConfig :: forall p.
RootOptions -> Tree Text -> Either ConfigParseError (M1 C c f p)
gParseRootConfig RootOptions
opts t :: Tree Text
t@(Node Text
label [Tree Text]
_) =
        if Text
label Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (RootOptions -> Text -> Text
rootOptionsLabelModifier RootOptions
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
$ Any c f Any -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName Any c f Any
forall (t :: Meta -> (* -> *) -> * -> *) a. t c f a
m)
            then 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
<$> RootOptions -> Tree Text -> Either ConfigParseError (f p)
forall p. RootOptions -> Tree Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GRootConfigParser f =>
RootOptions -> Tree Text -> Either ConfigParseError (f p)
gParseRootConfig RootOptions
opts Tree Text
t
            else 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
MismatchedRootKey Text
label (RootOptions -> Text -> Text
rootOptionsLabelModifier RootOptions
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
$ Any c f Any -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName Any c f Any
forall (t :: Meta -> (* -> *) -> * -> *) a. t c f a
m)
      where
        m :: t c f a
        m :: forall (t :: Meta -> (* -> *) -> * -> *) a. t c f a
m = t c f a
forall a. HasCallStack => a
undefined

instance (GFieldParser (a :*: b)) => GRootConfigParser (a :*: b) where
    gParseRootConfig :: forall p.
RootOptions -> Tree Text -> Either ConfigParseError ((:*:) a b p)
gParseRootConfig RootOptions
opts (Node Text
_ [Tree Text]
forest) = ConfigOptions
-> [Tree Text] -> Either ConfigParseError ((:*:) a b p)
forall p.
ConfigOptions
-> [Tree Text] -> Either ConfigParseError ((:*:) a b p)
forall (f :: * -> *) p.
GFieldParser f =>
ConfigOptions -> [Tree Text] -> Either ConfigParseError (f p)
gParseFields (RootOptions -> ConfigOptions
rootOptionsFieldOptions RootOptions
opts) [Tree Text]
forest

class FieldParser a where
    parseFields :: [Tree Text] -> Either ConfigParseError a

class GFieldParser (f :: Type -> Type) where
    gParseFields :: ConfigOptions -> [Tree Text] -> Either ConfigParseError (f p)

instance (Selector s, GNestedParser f) => GFieldParser (M1 S s f) where
    gParseFields :: forall p.
ConfigOptions
-> [Tree Text] -> Either ConfigParseError (M1 S s f p)
gParseFields ConfigOptions
opts [Tree Text]
xs = case (Tree Text -> Bool) -> [Tree Text] -> Maybe (Tree Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ConfigOptions -> Text -> Text
configOptionsLabelModifier 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) (Text -> Bool) -> (Tree Text -> Text) -> Tree Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Text -> Text
forall a. Tree a -> a
rootLabel) [Tree Text]
xs of
                              Maybe (Tree 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] -> ConfigParseError
MissingKeys [ConfigOptions -> Text -> Text
configOptionsLabelModifier 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]
                              Just Tree Text
t -> 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 -> Tree Text -> Either ConfigParseError (f p)
forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GNestedParser f =>
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
gParseNestedConfig ConfigOptions
opts Tree Text
t

instance (GFieldParser a, GFieldParser b) => GFieldParser (a :*: b) where
    gParseFields :: forall p.
ConfigOptions
-> [Tree Text] -> Either ConfigParseError ((:*:) a b p)
gParseFields ConfigOptions
opts [Tree Text]
xs = do
        a p
a <- ConfigOptions -> [Tree Text] -> Either ConfigParseError (a p)
forall p.
ConfigOptions -> [Tree Text] -> Either ConfigParseError (a p)
forall (f :: * -> *) p.
GFieldParser f =>
ConfigOptions -> [Tree Text] -> Either ConfigParseError (f p)
gParseFields ConfigOptions
opts [Tree Text]
xs
        b p
b <- ConfigOptions -> [Tree Text] -> Either ConfigParseError (b p)
forall p.
ConfigOptions -> [Tree Text] -> Either ConfigParseError (b p)
forall (f :: * -> *) p.
GFieldParser f =>
ConfigOptions -> [Tree Text] -> Either ConfigParseError (f p)
gParseFields ConfigOptions
opts [Tree 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

defaultParseNestedConfig ::
    forall a.
    (Generic a, GNestedParser (Rep a)) =>
    ConfigOptions ->
    Tree Text ->
    Either ConfigParseError a
defaultParseNestedConfig :: forall a.
(Generic a, GNestedParser (Rep a)) =>
ConfigOptions -> Tree Text -> Either ConfigParseError a
defaultParseNestedConfig ConfigOptions
opts Tree 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 -> Tree Text -> Either ConfigParseError (Rep a Any)
forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError (Rep a p)
forall (f :: * -> *) p.
GNestedParser f =>
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
gParseNestedConfig ConfigOptions
opts Tree Text
tree

class GNestedParser (f :: Type -> Type) where
    gParseNestedConfig :: ConfigOptions -> Tree Text -> Either ConfigParseError (f p)

instance NestedParser a => GNestedParser (K1 R a) where
    gParseNestedConfig :: forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError (K1 R a p)
gParseNestedConfig ConfigOptions
_ (Node Text
label []) = ConfigParseError -> Either ConfigParseError (K1 R a p)
forall a b. a -> Either a b
Left (ConfigParseError -> Either ConfigParseError (K1 R a p))
-> ConfigParseError -> Either ConfigParseError (K1 R a p)
forall a b. (a -> b) -> a -> b
$ Text -> ConfigParseError
MissingValue Text
label
    gParseNestedConfig ConfigOptions
_ (Node Text
_ [Tree Text
val]) = 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
<$> Tree Text -> Either ConfigParseError a
forall a. NestedParser a => Tree Text -> Either ConfigParseError a
parseNestedConfig Tree Text
val
    gParseNestedConfig ConfigOptions
_ Tree Text
tree = 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
<$> Tree Text -> Either ConfigParseError a
forall a. NestedParser a => Tree Text -> Either ConfigParseError a
parseNestedConfig Tree Text
tree

instance (GNestedParser f) => GNestedParser (M1 D c f) where
    gParseNestedConfig :: forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError (M1 D c f p)
gParseNestedConfig ConfigOptions
opts Tree Text
t = f p -> M1 D c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D c f p)
-> Either ConfigParseError (f p)
-> Either ConfigParseError (M1 D c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GNestedParser f =>
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
gParseNestedConfig ConfigOptions
opts Tree Text
t

instance (Constructor c, GNestedParser f) => GNestedParser (M1 C c f) where
    gParseNestedConfig :: forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError (M1 C c f p)
gParseNestedConfig ConfigOptions
opts Tree Text
t = 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 -> Tree Text -> Either ConfigParseError (f p)
forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GNestedParser f =>
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
gParseNestedConfig ConfigOptions
opts Tree Text
t

instance (Selector s, GNestedParser f) => GNestedParser (M1 S s f) where
    gParseNestedConfig :: forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError (M1 S s f p)
gParseNestedConfig ConfigOptions
opts t :: Tree Text
t@(Node Text
label [Tree Text]
_) =
        if Text
label Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
modifiedSelectorName
            then 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, Text) -> ConfigParseError
MismatchedKeyAndField Text
label ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Any s f Any -> [Char]
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> [Char]
selName Any s f Any
forall (t :: Meta -> (* -> *) -> * -> *) a. t s f a
m, Text
modifiedSelectorName)
            else 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 -> Tree Text -> Either ConfigParseError (f p)
forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
forall (f :: * -> *) p.
GNestedParser f =>
ConfigOptions -> Tree Text -> Either ConfigParseError (f p)
gParseNestedConfig ConfigOptions
opts Tree Text
t
      where
        m :: t s f a
        m :: forall (t :: Meta -> (* -> *) -> * -> *) a. t s f a
m = t s f a
forall a. HasCallStack => a
undefined

        modifiedSelectorName :: Text
        modifiedSelectorName :: Text
modifiedSelectorName = ConfigOptions -> Text -> Text
configOptionsLabelModifier 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
$ Any s f Any -> [Char]
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> [Char]
selName Any s f Any
forall (t :: Meta -> (* -> *) -> * -> *) a. t s f a
m

instance (GFieldParser (a :*: b)) => GNestedParser (a :*: b) where
    gParseNestedConfig :: forall p.
ConfigOptions -> Tree Text -> Either ConfigParseError ((:*:) a b p)
gParseNestedConfig ConfigOptions
opts (Node Text
_ [Tree Text]
forest) = ConfigOptions
-> [Tree Text] -> Either ConfigParseError ((:*:) a b p)
forall p.
ConfigOptions
-> [Tree Text] -> Either ConfigParseError ((:*:) a b p)
forall (f :: * -> *) p.
GFieldParser f =>
ConfigOptions -> [Tree Text] -> Either ConfigParseError (f p)
gParseFields ConfigOptions
opts [Tree Text]
forest