{-# LANGUAGE UndecidableInstances #-}
module Cfg.Deriving.ConfigRoot where

import Cfg.Deriving.Assert (AssertTopLevelRecord)
import Cfg.Deriving.LabelModifier (LabelModifier (..))
import Cfg.Options (ConfigOptions (..), RootOptions (..), defaultRootOptions)
import Cfg.Source (RootConfig (..))
import Cfg.Source.RootConfig (GConfigTree, defaultToRootConfig)
import GHC.Generics
import Cfg.Parser.ConfigParser
import Cfg.Parser (RootParser (..))
import Data.Coerce

newtype ConfigRoot a = ConfigRoot {forall a. ConfigRoot a -> a
unConfigRoot :: a}

instance Generic a => Generic (ConfigRoot a) where
    type Rep (ConfigRoot a) = Rep a
    to :: forall x. Rep (ConfigRoot a) x -> ConfigRoot a
to = a -> ConfigRoot a
forall a. a -> ConfigRoot a
ConfigRoot (a -> ConfigRoot a) -> (Rep a x -> a) -> Rep a x -> ConfigRoot a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a x -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to
    from :: forall x. ConfigRoot a -> Rep (ConfigRoot a) x
from (ConfigRoot a
x) = a -> Rep a x
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
x

newtype ConfigRootOpts t t' a = ConfigRootOpts {forall t t' a. ConfigRootOpts t t' a -> a
unConfigRootOpts :: a}

instance Generic a => Generic (ConfigRootOpts t t' a) where
    type Rep (ConfigRootOpts t t' a) = Rep a
    to :: forall x. Rep (ConfigRootOpts t t' a) x -> ConfigRootOpts t t' a
to = a -> ConfigRootOpts t t' a
forall t t' a. a -> ConfigRootOpts t t' a
ConfigRootOpts (a -> ConfigRootOpts t t' a)
-> (Rep a x -> a) -> Rep a x -> ConfigRootOpts t t' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a x -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to
    from :: forall x. ConfigRootOpts t t' a -> Rep (ConfigRootOpts t t' a) x
from (ConfigRootOpts a
x) = a -> Rep a x
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
x

class (LabelModifier t, LabelModifier t') => GetConfigRootOptions t t' where
    getConfigRootOptions :: RootOptions

instance (LabelModifier t, LabelModifier t') => GetConfigRootOptions t t' where
    getConfigRootOptions :: RootOptions
getConfigRootOptions = (Text -> Text) -> ConfigOptions -> RootOptions
RootOptions (forall t. LabelModifier t => Text -> Text
getLabelModifier @t) ((Text -> Text) -> ConfigOptions
ConfigOptions ((Text -> Text) -> ConfigOptions)
-> (Text -> Text) -> ConfigOptions
forall a b. (a -> b) -> a -> b
$ forall t. LabelModifier t => Text -> Text
getLabelModifier @t')

-- Source
instance (AssertTopLevelRecord RootConfig a, Generic a, GConfigTree (Rep a)) => RootConfig (ConfigRoot a) where
    toRootConfig :: Tree Text
toRootConfig = forall a.
(Generic a, GConfigTree (Rep a)) =>
RootOptions -> Tree Text
defaultToRootConfig @a RootOptions
defaultRootOptions

instance (LabelModifier t, LabelModifier t', AssertTopLevelRecord RootConfig a, Generic a, GConfigTree (Rep a)) => RootConfig (ConfigRootOpts t t' a) where
    toRootConfig :: Tree Text
toRootConfig = forall a.
(Generic a, GConfigTree (Rep a)) =>
RootOptions -> Tree Text
defaultToRootConfig @a (forall t t'. GetConfigRootOptions t t' => RootOptions
getConfigRootOptions @t @t')

-- Parser
instance (AssertTopLevelRecord RootConfig a, Generic a, GRootConfigParser (Rep a)) => RootParser (ConfigRoot a) where
  parseRootConfig :: Tree Text -> Either ConfigParseError (ConfigRoot a)
parseRootConfig Tree Text
tree = Either ConfigParseError a -> Either ConfigParseError (ConfigRoot a)
forall a b. Coercible a b => a -> b
coerce (Either ConfigParseError a
 -> Either ConfigParseError (ConfigRoot a))
-> (Either ConfigParseError a
    -> Either ConfigParseError (ConfigRoot a))
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigRoot a)
forall a. a -> a -> a
`asTypeOf` (a -> ConfigRoot a)
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigRoot 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 a -> ConfigRoot a
forall a. a -> ConfigRoot a
ConfigRoot (Either ConfigParseError a
 -> Either ConfigParseError (ConfigRoot a))
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigRoot a)
forall a b. (a -> b) -> a -> b
$ RootOptions -> Tree Text -> Either ConfigParseError a
forall a.
(Generic a, GRootConfigParser (Rep a)) =>
RootOptions -> Tree Text -> Either ConfigParseError a
defaultParseRootConfig RootOptions
defaultRootOptions Tree Text
tree

instance
  ( LabelModifier t
  , LabelModifier t'
  , AssertTopLevelRecord RootConfig a
  , Generic a
  , GRootConfigParser (Rep a)
  ) => RootParser (ConfigRootOpts t t' a) where
    parseRootConfig :: Tree Text -> Either ConfigParseError (ConfigRootOpts t t' a)
parseRootConfig Tree Text
tree = Either ConfigParseError a
-> Either ConfigParseError (ConfigRootOpts t t' a)
forall a b. Coercible a b => a -> b
coerce (Either ConfigParseError a
 -> Either ConfigParseError (ConfigRootOpts t t' a))
-> (Either ConfigParseError a
    -> Either ConfigParseError (ConfigRootOpts t t' a))
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigRootOpts t t' a)
forall a. a -> a -> a
`asTypeOf` (a -> ConfigRootOpts t t' a)
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigRootOpts t t' 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 a -> ConfigRootOpts t t' a
forall t t' a. a -> ConfigRootOpts t t' a
ConfigRootOpts (Either ConfigParseError a
 -> Either ConfigParseError (ConfigRootOpts t t' a))
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigRootOpts t t' a)
forall a b. (a -> b) -> a -> b
$ RootOptions -> Tree Text -> Either ConfigParseError a
forall a.
(Generic a, GRootConfigParser (Rep a)) =>
RootOptions -> Tree Text -> Either ConfigParseError a
defaultParseRootConfig (forall t t'. GetConfigRootOptions t t' => RootOptions
getConfigRootOptions @t @t') Tree Text
tree