{-# 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