-- |
--  Module      : Cfg.Deriving.Config
--  Copyright   : © Jonathan Lorimer, 2023
--  License     : MIT
--  Maintainer  : jonathanlorimer@pm.me
--  Stability   : stable
--
-- @since 0.0.2.0
--
-- This module provides types and instances for deriving 'ConfigSource' and
-- 'ConfigParser' instances via generic machinery. These types are also how you
-- modify the key representation for your configuration.
module Cfg.Deriving.Config
  ( -- * Deriving Types
    Config (..)
  , ConfigOpts (..)
  , ConfigRoot (..)

    -- * Internal Typeclasses
  , GetConfigOptions (..)
  , ConfigRootOptions (..)
  )
where

import Cfg.Deriving.Assert (AssertTopLevelRecord)
import Cfg.Deriving.KeyModifier
import Cfg.Options
import Cfg.Parser
import Cfg.Parser.Config
import Cfg.Source
import Cfg.Source.Config
import Cfg.Source.Default
import Data.Coerce
import GHC.Generics

-- $setup
-- >>> import GHC.Generics (Generic (..))
-- >>> import Cfg.Source (ConfigSource(..))
-- >>> import Cfg.Parser (ConfigParser(..))
-- >>> import Text.Pretty.Simple

-- | This newtype is the simplest deriving option. It doesn't allow you to
-- alter key names with a 'Cfg.Deriving.KeyModifier.KeyModifier', it only
-- specifies record fields as keys within the configuration tree hierarchy.
-- Therefore it is not possible to derive this for configuration /values/ (such
-- as product types without named record fields, or sum types), only top level
-- records.
--
-- ===== __Example__
--
-- >>> import GHC.Generics (Generic (..))
-- >>> import Cfg.Source (ConfigSource(..))
-- >>> import Cfg.Parser (ConfigParser(..))
-- >>> import Cfg.Deriving.Config (Config(..))
-- >>> import Cfg.Source.Default (DefaultSource(..))
-- >>> :{
-- data AppConfig = AppConfig
--   { appConfigSetting1 :: Int
--   , appConfigSetting2 :: Bool
--   , appConfigSetting3 :: String
--   }
--   deriving (Generic, Show, DefaultSource)
--   deriving (ConfigSource, ConfigParser) via (Config AppConfig)
-- :}
--
-- >>> pPrint $ configSource @AppConfig
-- Free
--     ( fromList
--         [
--             ( "appConfigSetting1"
--             , Free
--                 ( fromList [] )
--             )
--         ,
--             ( "appConfigSetting2"
--             , Free
--                 ( fromList [] )
--             )
--         ,
--             ( "appConfigSetting3"
--             , Free
--                 ( fromList [] )
--             )
--         ]
--     )
--
-- @since 0.0.2.0
newtype Config a = Config {forall a. Config a -> a
unConfig :: a}

-- | @since 0.0.2.0
instance (Generic a) => Generic (Config a) where
  type Rep (Config a) = Rep a
  to :: forall x. Rep (Config a) x -> Config a
to = a -> Config a
forall a. a -> Config a
Config (a -> Config a) -> (Rep a x -> a) -> Rep a x -> Config 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. Config a -> Rep (Config a) x
from (Config a
x) = a -> Rep a x
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
x

-- | This newtype is identical to 'Config' except that it accepts a type
-- argument which can be used to apply a 'Cfg.Deriving.KeyModifier.KeyModifier'
-- to each record field name when generating keys.
--
-- ===== __Example__
--
-- >>> import GHC.Generics (Generic (..))
-- >>> import Cfg.Source (ConfigSource(..))
-- >>> import Cfg.Parser (ConfigParser(..))
-- >>> import Cfg.Deriving.Config (Config(..))
-- >>> import Cfg.Source.Default (DefaultSource(..))
-- >>> :{
-- data AppConfig = AppConfig
--   { appConfigSetting1 :: Int
--   , appConfigSetting2 :: Bool
--   , appConfigSetting3 :: String
--   }
--   deriving (Generic, Show, DefaultSource)
--   deriving (ConfigSource, ConfigParser)
--      via (ConfigOpts '[StripPrefix "app", CamelToSnake, ToUpper] AppConfig)
-- :}
--
-- >>> pPrint $ configSource @AppConfig
-- Free
--     ( fromList
--         [
--             ( "CONFIG_SETTING1"
--             , Free
--                 ( fromList [] )
--             )
--         ,
--             ( "CONFIG_SETTING2"
--             , Free
--                 ( fromList [] )
--             )
--         ,
--             ( "CONFIG_SETTING3"
--             , Free
--                 ( fromList [] )
--             )
--         ]
--     )
--
-- @since 0.0.2.0
newtype ConfigOpts fieldModifier a = ConfigOpts {forall {k} (fieldModifier :: k) a. ConfigOpts fieldModifier a -> a
unConfigOptions :: a}

-- | @since 0.0.2.0
instance (Generic a) => Generic (ConfigOpts t a) where
  type Rep (ConfigOpts t a) = Rep a
  to :: forall x. Rep (ConfigOpts t a) x -> ConfigOpts t a
to = a -> ConfigOpts t a
forall {k} (fieldModifier :: k) a. a -> ConfigOpts fieldModifier a
ConfigOpts (a -> ConfigOpts t a)
-> (Rep a x -> a) -> Rep a x -> ConfigOpts 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. ConfigOpts t a -> Rep (ConfigOpts t a) x
from (ConfigOpts a
x) = a -> Rep a x
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
x

-- | This newtype is used to derive instances for your root configuration type
-- (i.e. the top level record for all your configuration). The only additional
-- functionality that it provides is that it lets you specify a root key, which
-- is derived from either the type name or the data constructor name. You
-- choose which name you select by providing either
-- 'Cfg.Options.ConstructorName` or 'Cfg.Options.TypeName' as the first type
-- argument to `ConfigRoot`. These `Cfg.Options.RootKey` types also take a type
-- level argument where you can provide key modifiers, if you don't want to
-- apply any key modifiers you can pass in 'Cfg.Deriving.KeyModifier.Identity'
-- or an empty tuple or an empty type level list.
--
-- ===== __@TypeName@ Example__
--
-- >>> import GHC.Generics (Generic (..))
-- >>> import Cfg.Source (ConfigSource(..))
-- >>> import Cfg.Parser (ConfigParser(..))
-- >>> import Cfg.Deriving.Config (Config(..))
-- >>> import Cfg.Source.Default (DefaultSource(..))
-- >>> import Cfg.Deriving.KeyModifier
-- >>> :{
-- data TypeNameConfig = ConfigConstructor
--   { appConfigSetting1 :: Int
--   , appConfigSetting2 :: Bool
--   , appConfigSetting3 :: String
--   }
--   deriving (Generic, Show, DefaultSource)
--   deriving (ConfigSource, ConfigParser)
--      via ConfigRoot
--        ('TypeName '[StripSuffix "Config", CamelToSnake, ToUpper])
--        '[StripPrefix "app", CamelToSnake, ToUpper]
--        TypeNameConfig
-- :}
--
-- >>> pPrint $ configSource @TypeNameConfig
-- Free
--     ( fromList
--         [
--             ( "TYPE_NAME"
--             , Free
--                 ( fromList
--                     [
--                         ( "CONFIG_SETTING1"
--                         , Free
--                             ( fromList [] )
--                         )
--                     ,
--                         ( "CONFIG_SETTING2"
--                         , Free
--                             ( fromList [] )
--                         )
--                     ,
--                         ( "CONFIG_SETTING3"
--                         , Free
--                             ( fromList [] )
--                         )
--                     ]
--                 )
--             )
--         ]
--     )
--
-- ===== __@ConstructorName@ Example__
--
-- >>> :{
-- data TypeNameConfig = ConfigConstructor
--   { appConfigSetting1 :: Int
--   , appConfigSetting2 :: Bool
--   , appConfigSetting3 :: String
--   }
--   deriving (Generic, Show, DefaultSource)
--   deriving (ConfigSource, ConfigParser)
--      via ConfigRoot
--        ('ConstructorName Identity)
--        '[StripPrefix "app", CamelToSnake, ToUpper]
--        TypeNameConfig
-- :}
--
-- >>> pPrint $ configSource @TypeNameConfig
-- Free
--     ( fromList
--         [
--             ( "ConfigConstructor"
--             , Free
--                 ( fromList
--                     [
--                         ( "CONFIG_SETTING1"
--                         , Free
--                             ( fromList [] )
--                         )
--                     ,
--                         ( "CONFIG_SETTING2"
--                         , Free
--                             ( fromList [] )
--                         )
--                     ,
--                         ( "CONFIG_SETTING3"
--                         , Free
--                             ( fromList [] )
--                         )
--                     ]
--                 )
--             )
--         ]
--     )
--
-- @since 0.0.2.0
newtype ConfigRoot rootType fieldModifier a = ConfigRoot {forall {k} {k} (rootType :: k) (fieldModifier :: k) a.
ConfigRoot rootType fieldModifier a -> a
unConfigRoot :: a}

-- | Typeclass for reifying type level field label modifiers into 'Cfg.Options.KeyOptions'
--
-- @since 0.0.2.0
class (KeyModifier t) => GetConfigOptions t where
  getOptions :: KeyOptions

-- | @since 0.0.2.0
instance (KeyModifier t) => GetConfigOptions t where
  getOptions :: KeyOptions
getOptions = (Text -> Text) -> KeyOptions
KeyOptions (forall (t :: k). KeyModifier t => Text -> Text
forall {k} (t :: k). KeyModifier t => Text -> Text
getKeyModifier @t)

-- | @since 0.0.2.0
instance (Generic a) => Generic (ConfigRoot r f a) where
  type Rep (ConfigRoot r f a) = Rep a
  to :: forall x. Rep (ConfigRoot r f a) x -> ConfigRoot r f a
to = a -> ConfigRoot r f a
forall {k} {k} (rootType :: k) (fieldModifier :: k) a.
a -> ConfigRoot rootType fieldModifier a
ConfigRoot (a -> ConfigRoot r f a)
-> (Rep a x -> a) -> Rep a x -> ConfigRoot r f 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 r f a -> Rep (ConfigRoot r f 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

-- | Typeclass for reifying type level arguments into 'Cfg.Options.RootOptions'
--
-- @since 0.0.2.0
class (KeyModifier r, KeyModifier f) => ConfigRootOptions r f where
  configRootOptions :: RootOptions

-- | @since 0.0.2.0
instance (KeyModifier (TypeName k), KeyModifier f) => ConfigRootOptions (TypeName k) f where
  configRootOptions :: RootOptions
configRootOptions = RootKey (Text -> Text) -> (Text -> Text) -> RootOptions
RootOptions ((Text -> Text) -> RootKey (Text -> Text)
forall a. a -> RootKey a
TypeName ((Text -> Text) -> RootKey (Text -> Text))
-> (Text -> Text) -> RootKey (Text -> Text)
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). KeyModifier t => Text -> Text
forall (t :: RootKey a). KeyModifier t => Text -> Text
getKeyModifier @(TypeName k)) (forall (t :: k). KeyModifier t => Text -> Text
forall {k} (t :: k). KeyModifier t => Text -> Text
getKeyModifier @f)

-- | @since 0.0.2.0
instance (KeyModifier (ConstructorName k), KeyModifier f) => ConfigRootOptions (ConstructorName k) f where
  configRootOptions :: RootOptions
configRootOptions = RootKey (Text -> Text) -> (Text -> Text) -> RootOptions
RootOptions ((Text -> Text) -> RootKey (Text -> Text)
forall a. a -> RootKey a
ConstructorName ((Text -> Text) -> RootKey (Text -> Text))
-> (Text -> Text) -> RootKey (Text -> Text)
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). KeyModifier t => Text -> Text
forall (t :: RootKey a). KeyModifier t => Text -> Text
getKeyModifier @(ConstructorName k)) (forall (t :: k). KeyModifier t => Text -> Text
forall {k} (t :: k). KeyModifier t => Text -> Text
getKeyModifier @f)

-- Source

-- | @since 0.0.2.0
instance
  (AssertTopLevelRecord ConfigSource a, DefaultSource a, Generic a, GConfigSource (Rep a))
  => ConfigSource (Config a)
  where
  configSource :: KeyTree Text Text
configSource = forall a.
(DefaultSource a, Generic a, GConfigSource (Rep a)) =>
ConfigOptions -> KeyTree Text Text
defaultConfigSource @a ConfigOptions
defaultConfigOptions

-- | @since 0.0.2.0
instance
  ( GetConfigOptions t
  , AssertTopLevelRecord ConfigSource a
  , Generic a
  , DefaultSource a
  , GConfigSource (Rep a)
  )
  => ConfigSource (ConfigOpts t a)
  where
  configSource :: KeyTree Text Text
configSource = forall a.
(DefaultSource a, Generic a, GConfigSource (Rep a)) =>
ConfigOptions -> KeyTree Text Text
defaultConfigSource @a (KeyOptions -> ConfigOptions
Key (KeyOptions -> ConfigOptions) -> KeyOptions -> ConfigOptions
forall a b. (a -> b) -> a -> b
$ forall (t :: k). GetConfigOptions t => KeyOptions
forall {k} (t :: k). GetConfigOptions t => KeyOptions
getOptions @t)

-- | @since 0.0.2.0
instance
  ( ConfigRootOptions r f
  , AssertTopLevelRecord ConfigSource a
  , Generic a
  , DefaultSource a
  , GConfigSource (Rep a)
  )
  => ConfigSource (ConfigRoot r f a)
  where
  configSource :: KeyTree Text Text
configSource = forall a.
(DefaultSource a, Generic a, GConfigSource (Rep a)) =>
ConfigOptions -> KeyTree Text Text
defaultConfigSource @a (RootOptions -> ConfigOptions
Root (RootOptions -> ConfigOptions) -> RootOptions -> ConfigOptions
forall a b. (a -> b) -> a -> b
$ forall (r :: k) (f :: k). ConfigRootOptions r f => RootOptions
forall {k} {k} (r :: k) (f :: k).
ConfigRootOptions r f =>
RootOptions
configRootOptions @r @f)

-- Parser

-- | @since 0.0.2.0
instance
  (AssertTopLevelRecord ConfigParser a, Generic a, GConfigParser (Rep a))
  => ConfigParser (Config a)
  where
  parseConfig :: KeyTree Text Text -> Either ConfigParseError (Config a)
parseConfig KeyTree Text Text
keyTree = Either ConfigParseError a -> Either ConfigParseError (Config a)
forall a b. Coercible a b => a -> b
coerce (Either ConfigParseError a -> Either ConfigParseError (Config a))
-> (Either ConfigParseError a
    -> Either ConfigParseError (Config a))
-> Either ConfigParseError a
-> Either ConfigParseError (Config a)
forall a. a -> a -> a
`asTypeOf` (a -> Config a)
-> Either ConfigParseError a -> Either ConfigParseError (Config 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 -> Config a
forall a. a -> Config a
Config (Either ConfigParseError a -> Either ConfigParseError (Config a))
-> Either ConfigParseError a -> Either ConfigParseError (Config a)
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> KeyTree Text Text -> Either ConfigParseError a
forall a.
(Generic a, GConfigParser (Rep a)) =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError a
defaultParseConfig ConfigOptions
defaultConfigOptions KeyTree Text Text
keyTree

-- | @since 0.0.2.0
instance
  ( GetConfigOptions t
  , AssertTopLevelRecord ConfigSource a
  , Generic a
  , GConfigParser (Rep a)
  )
  => ConfigParser (ConfigOpts t a)
  where
  parseConfig :: KeyTree Text Text -> Either ConfigParseError (ConfigOpts t a)
parseConfig KeyTree Text Text
keyTree = Either ConfigParseError a
-> Either ConfigParseError (ConfigOpts t a)
forall a b. Coercible a b => a -> b
coerce (Either ConfigParseError a
 -> Either ConfigParseError (ConfigOpts t a))
-> (Either ConfigParseError a
    -> Either ConfigParseError (ConfigOpts t a))
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigOpts t a)
forall a. a -> a -> a
`asTypeOf` (a -> ConfigOpts t a)
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigOpts 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 -> ConfigOpts t a
forall {k} (fieldModifier :: k) a. a -> ConfigOpts fieldModifier a
ConfigOpts (Either ConfigParseError a
 -> Either ConfigParseError (ConfigOpts t a))
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigOpts t a)
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> KeyTree Text Text -> Either ConfigParseError a
forall a.
(Generic a, GConfigParser (Rep a)) =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError a
defaultParseConfig (KeyOptions -> ConfigOptions
Key (KeyOptions -> ConfigOptions) -> KeyOptions -> ConfigOptions
forall a b. (a -> b) -> a -> b
$ forall (t :: k). GetConfigOptions t => KeyOptions
forall {k} (t :: k). GetConfigOptions t => KeyOptions
getOptions @t) KeyTree Text Text
keyTree

-- | @since 0.0.2.0
instance
  ( ConfigRootOptions r f
  , AssertTopLevelRecord ConfigParser a
  , Generic a
  , GConfigParser (Rep a)
  )
  => ConfigParser (ConfigRoot r f a)
  where
  parseConfig :: KeyTree Text Text -> Either ConfigParseError (ConfigRoot r f a)
parseConfig KeyTree Text Text
keyTree = Either ConfigParseError a
-> Either ConfigParseError (ConfigRoot r f a)
forall a b. Coercible a b => a -> b
coerce (Either ConfigParseError a
 -> Either ConfigParseError (ConfigRoot r f a))
-> (Either ConfigParseError a
    -> Either ConfigParseError (ConfigRoot r f a))
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigRoot r f a)
forall a. a -> a -> a
`asTypeOf` (a -> ConfigRoot r f a)
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigRoot r f 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 r f a
forall {k} {k} (rootType :: k) (fieldModifier :: k) a.
a -> ConfigRoot rootType fieldModifier a
ConfigRoot (Either ConfigParseError a
 -> Either ConfigParseError (ConfigRoot r f a))
-> Either ConfigParseError a
-> Either ConfigParseError (ConfigRoot r f a)
forall a b. (a -> b) -> a -> b
$ ConfigOptions -> KeyTree Text Text -> Either ConfigParseError a
forall a.
(Generic a, GConfigParser (Rep a)) =>
ConfigOptions -> KeyTree Text Text -> Either ConfigParseError a
defaultParseConfig (RootOptions -> ConfigOptions
Root (RootOptions -> ConfigOptions) -> RootOptions -> ConfigOptions
forall a b. (a -> b) -> a -> b
$ forall (r :: k) (f :: k). ConfigRootOptions r f => RootOptions
forall {k} {k} (r :: k) (f :: k).
ConfigRootOptions r f =>
RootOptions
configRootOptions @r @f) KeyTree Text Text
keyTree