-- |
--  Module      : Cfg
--  Copyright   : © Jonathan Lorimer, 2023
--  License     : MIT
--  Maintainer  : jonathanlorimer@pm.me
--  Stability   : stable
--
-- @since 0.0.1.0 
--
-- This package provides an api for representing configuration as a haskell
-- type. This entails three general considerations: a simplified
-- representation our haskell type so that it maps better to existing
-- configuration tools, an adapter to translate between the simplified
-- representation and a concrete configuration "source" (i.e. environment
-- variables, yaml files, etc.), and a parser that can translate between the
-- abstract representation and the concrete haskell type.
--
-- While this package provides a default source (environment variables), the
-- intention is that other packages will provide additional sources.

module Cfg (
-- * Concepts
--
-- |
--
-- The core concepts in this package are:
--
--    * __A simplified type representation:__ The type chosen to represent our
--    underlying haskell type is 'Data.Tree.Tree'. This reflects the
--    potentially nested structure of configuration, and makes it easy to nest
--    keys and then simply append values as leaf nodes. 
--
--    * __Sources:__ These represent a way to build a simplified representation
--    from as Haskell type. Source may seem like an odd name, but other names
--    like \"Rep\", or \"Representation\" are taken and overloaded. The tree
--    structures created by the typeclasses in "Cfg.Source" are what is used to
--    request values from a configuration source.
--
--    * __Parsers:__ Once a request for configuration values has been made to a
--    source, and the actual values are appended as leaf nodes on the tree
--    representation we require a parser to pull that information out and
--    construct a Haskell type. The parser traverses the tree and makes sure
--    that it structurally matches our Haskell type, and then it will parse the
--    'Data.Text.Text' values at the leaves into actual actual Haskell types.
--    The api that corresponds to this part can be found in "Cfg.Parser".
--
--    * __Deriving:__ It is a design principle of this library that the vast
--    majority (if not all) functionality should be derivable. For this we use
--    "GHC.Generics", and deriving via. You can always hand write instances for
--    custom functionality, but there are also a handful of options that can be
--    specified using the deriving machinery. Documentation on those options
--    can be found in "Cfg.Deriving".
--
--    * __Roots and nesting__: In general there is a distinction between the
--    "Root" type for a configuration, and then subtypes that are arbitrarily
--    nested under the root type (or other nested configurations). This makes
--    some parts of the Generic machinery easier, but also serves some
--    practical purposes (i.e. subconfig keys are picked from record field
--    names, while the root key is picked from the root type's type name).

-- * Quickstart guide
--
-- |
--
-- Here we will introduce some sample code that should get you up and running
-- quickly. We will also explain some of the internals so you can see how
-- things are wired together

-- ** Sample configuration
--
-- |
--
-- Let's start out with a couple types that represent some imaginary
-- configuration for an imaginary application. You will probably notice that we
-- derive the 'RootConfig' class for our top level config @AppConfig@ and we do
-- this via the 'ConfigRoot' type. We derive the 'NestedConfig' class for all
-- the nested product types via the 'SubConfig' type. Finally, for
-- @Environment@, which is not really a configuration, but rather a value that
-- can be configured, we derive 'NestedConfig' via 'ConfigValue'.
--
-- This is all probably a bit opaque, to understand the 'RootConfig' and
-- 'NestedConfig' class better you can read the "Cfg.Source" module. To
-- understand the deriving mechanisms better you can read the "Cfg.Deriving"
-- module.
--
-- @
-- {-# LANGUAGE DeriveGeneric #-}
-- {-# LANGUAGE DerivingVia #-}
--
-- import "Cfg.Deriving" (ConfigValue, ConfigRoot, SubConfig)
-- import "Cfg.Source" (RootConfig, NestedConfig)
-- import Data.ByteString (ByteString)
-- import Data.Text (Text)
-- import GHC.Generics
--
-- data Environment = Development | Production
--   deriving stock (Generic, Show)
--   deriving ('NestedConfig') via ('ConfigValue' Environment)
--
-- data WarpConfig = WarpConfig
--   { warpConfigPort :: Int
--   , warpConfigTimeout :: Int
--   , warpConfigHTTP2Enabled :: Bool
--   , warpConfigServerName :: ByteString
--   }
--   deriving (Generic, Show)
--   deriving ('NestedConfig') via ('SubConfig' WarpConfig)
--
-- data RedisConfig = RedisConfig
--   { redisConfigHost :: Text
--   , redisConfigPort :: Int
--   , redisConfigConnectAuth :: Maybe ByteString
--   }
--   deriving (Generic, Show)
--   deriving ('NestedConfig') via ('SubConfig' RedisConfig)
--
-- data AppConfig = AppConfig
--   { appConfigWarpSettings :: WarpConfig
--   , appConfigRedisSettings :: RedisConfig
--   , appConfigEnvironment :: Environment
--   }
--   deriving stock (Generic, Show)
--   deriving ('RootConfig') via ('ConfigRoot' AppConfig)
-- @

-- ** Generated representation
--
-- |
--
-- Below we can see a doctest example that shows the internal \"simplified
-- representation\" that this library uses.
--
-- >>> import Text.Pretty.Simple (pPrint) 
-- >>> import Cfg.Source () -- Pulls in the RootConfig instance for 'toRootConfig'
-- >>> pPrint $ toRootConfig @AppConfig
-- Node
--     { rootLabel = "AppConfig"
--     , subForest =
--         [ Node
--             { rootLabel = "appConfigWarpSettings"
--             , subForest =
--                 [ Node
--                     { rootLabel = "warpConfigPort"
--                     , subForest = []
--                     }
--                 , Node
--                     { rootLabel = "warpConfigTimeout"
--                     , subForest = []
--                     }
--                 , Node
--                     { rootLabel = "warpConfigHTTP2Enabled"
--                     , subForest = []
--                     }
--                 , Node
--                     { rootLabel = "warpConfigServerName"
--                     , subForest = []
--                     }
--                 ]
--             }
--         , Node
--             { rootLabel = "appConfigRedisSettings"
--             , subForest =
--                 [ Node
--                     { rootLabel = "redisConfigHost"
--                     , subForest = []
--                     }
--                 , Node
--                     { rootLabel = "redisConfigPort"
--                     , subForest = []
--                     }
--                 , Node
--                     { rootLabel = "redisConfigConnectAuth"
--                     , subForest = []
--                     }
--                 ]
--             }
--         , Node
--             { rootLabel = "appConfigEnvironment"
--             , subForest = []
--             }
--         ]
--     }

-- ** Parsing a representation
--
-- |
--
-- Below we are deriving just the parsers for our example data type from above.
-- Just like the above example we use the 'RootConfig', 'SubConfig', and
-- 'ConfigValue' types to derive the appropriate parsing classes. This time,
-- however, there are 3 classes: 'RootParser' which should be placed on the top
-- level configuration record, 'NestedParser' which should be derived for
-- nested configuration product type, 'ValueParser' is derived for leaf level
-- configuration values (you also need to derive 'NestedParser' for these, but
-- there is a default method that just uses the 'ValueParser' so you can derive
-- it without any strategy)
--
-- More information on the parsers can be found at "Cfg.Parser".
--
-- In the example below there is a term called @sample@ and this represents a
-- tree that may have been retrieved from a source, and should be parsable
-- given our type and derived instances.
--
-- @
-- {-# LANGUAGE DeriveGeneric #-}
-- {-# LANGUAGE DerivingVia #-}
--
-- import "Cfg.Deriving" (ConfigValue(..), SubConfig(..), ConfigRoot(..))
-- import "Cfg.Parser" (RootParser(..), ConfigParseError, NestedParser, ValueParser)
-- import Data.ByteString (ByteString)
-- import Data.Text (Text)
-- import GHC.Generics
--
-- data Environment = Development | Production
--   deriving stock (Generic, Show)
--   deriving ('ValueParser') via ('ConfigValue' Environment)
--   deriving 'NestedParser'
--
-- data WarpConfig = WarpConfig
--   { warpConfigPort :: Int
--   , warpConfigTimeout :: Int
--   , warpConfigHTTP2Enabled :: Bool
--   , warpConfigServerName :: ByteString
--   }
--   deriving (Generic, Show)
--   deriving ('NestedParser') via ('SubConfig' WarpConfig)
--
-- data RedisConfig = RedisConfig
--   { redisConfigHost :: Text
--   , redisConfigPort :: Int
--   , redisConfigConnectAuth :: Maybe ByteString
--   }
--   deriving (Generic, Show)
--   deriving ('NestedParser') via ('SubConfig' RedisConfig)
--
-- data AppConfig = AppConfig
--   { appConfigWarpSettings :: WarpConfig
--   , appConfigRedisSettings :: RedisConfig
--   , appConfigEnvironment :: Environment
--   }
--   deriving stock (Generic, Show)
--   deriving ('RootParser') via ('ConfigRoot' AppConfig)
--
-- sample :: Tree Text
-- sample = Node
--     { rootLabel = \"AppConfig\"
--     , subForest =
--         [ Node
--             { rootLabel = "appConfigWarpSettings"
--             , subForest =
--                 [ Node
--                     { rootLabel = "warpConfigPort"
--                     , subForest = [ Node "8080" [] ]
--                     }
--                 , Node
--                     { rootLabel = "warpConfigTimeout"
--                     , subForest = [ Node "30" [] ]
--                     }
--                 , Node
--                     { rootLabel = "warpConfigHTTP2Enabled"
--                     , subForest = [ Node \"True\" [] ]
--                     }
--                 , Node
--                     { rootLabel = "warpConfigServerName"
--                     , subForest = [ Node \"MyServer\" [] ]
--                     }
--                 ]
--             }
--         , Node
--             { rootLabel = "appConfigRedisSettings"
--             , subForest =
--                 [ Node
--                     { rootLabel = "redisConfigHost"
--                     , subForest = [ Node "https://localhost" [] ]
--                     }
--                 , Node
--                     { rootLabel = "redisConfigPort"
--                     , subForest = [ Node "6379" [] ]
--                     }
--                 , Node
--                     { rootLabel = "redisConfigConnectAuth"
--                     , subForest = [ Node "Just password" [] ]
--                     }
--                 ]
--             }
--         , Node
--             { rootLabel = "appConfigEnvironment"
--             , subForest = [ Node \"Development\" [] ]
--             }
--         ]
--     }
-- @
--
-- Here is a demonstration of running the parser on the sample tree structure
-- shown above.
--
-- >>> import Text.Pretty.Simple (pPrint) 
-- >>> import Cfg.Parser () -- Pulls in the RootParser instance for 'parseRootConfig'
-- >>> pPrint $ parseRootConfig @AppConfig sample
-- Right
--     ( AppConfig
--         { appConfigWarpSettings = WarpConfig
--             { warpConfigPort = 8080
--             , warpConfigTimeout = 30
--             , warpConfigHTTP2Enabled = True
--             , warpConfigServerName = "MyServer"
--             }
--         , appConfigRedisSettings = RedisConfig
--             { redisConfigHost = "https://localhost"
--             , redisConfigPort = 6379
--             , redisConfigConnectAuth = Just "password"
--             }
--         , appConfigEnvironment = Development
--         }
--     )

-- ** Manipulating key format
--
-- |
--
-- The last thing we will go over is manipulating the way that we format
-- configuration keys. Certain configuration sources have stylistic standards
-- that may not be the same as Haskell. Therefore we offer some options for
-- configuring their representation. 
--
-- In the example below we will say that we are using environment variables as
-- our configuration source. It is pretty standard to have env vars in
-- SCREAMING_SNAKE_CASE, therefore we will apply a modifier that does that.
--
-- We will also use a convenience function from "Cfg.Env.Keys" to print out
-- the expected shape of the keys after all the formatters have been applied.
--
-- @
-- {-# LANGUAGE DeriveGeneric #-}
-- {-# LANGUAGE DerivingVia #-}
--
-- import "Cfg.Deriving" (ConfigValue(..), SubConfig(..), ConfigRoot(..))
-- import "Cfg.Parser" (RootParser(..), ConfigParseError, NestedParser, ValueParser)
-- import "Cfg.Deriving.LabelModifier" (ToUpper)
-- import "Cfg.Deriving.ConfigRoot" (ConfigRootOpts(..))
-- import "Cfg.Deriving.SubConfig" (SubConfigOpts(..))
-- import Data.Text (Text)
-- import Data.ByteString (ByteString)
-- import GHC.Generics
--
-- data Environment = Development | Production
--   deriving stock (Generic, Show)
--   deriving ('ValueParser') via ('ConfigValue' Environment)
--   deriving 'NestedParser'
--
-- data EnvWarpConfig = EnvWarpConfig
--   { envWarpConfigPort :: Int
--   , envWarpConfigTimeout :: Int
--   , envWarpConfigHTTP2Enabled :: Bool
--   , envWarpConfigServerName :: ByteString
--   }
--   deriving (Generic, Show)
--   deriving ('NestedConfig') via ('SubConfigOpts' 'ToUpper' EnvWarpConfig)
--   deriving ('NestedParser') via ('SubConfigOpts' 'ToUpper' EnvWarpConfig)
--
-- data EnvRedisConfig = EnvRedisConfig
--   { envRedisConfigHost :: Text
--   , envRedisConfigPort :: Int
--   , envRedisConfigConnectAuth :: Maybe ByteString
--   }
--   deriving (Generic, Show)
--   deriving ('NestedConfig') via ('SubConfigOpts' 'ToUpper' EnvRedisConfig)
--   deriving ('NestedParser') via ('SubConfigOpts' 'ToUpper' EnvRedisConfig)
--
-- data EnvAppConfig = EnvAppConfig
--   { envAppConfigWarpSettings :: EnvWarpConfig
--   , envAppConfigRedisSettings :: EnvRedisConfig
--   , envAppConfigEnvironment :: Environment
--   }
--   deriving stock (Generic, Show)
--   deriving ('RootConfig') via ('ConfigRootOpts' 'ToUpper' 'ToUpper' EnvAppConfig)
--   deriving ('RootParser') via ('ConfigRootOpts' 'ToUpper' 'ToUpper' EnvAppConfig)
-- @
--
-- >>> import Cfg
-- >>> import Text.Pretty.Simple
-- >>> import Cfg.Env.Keys
-- >>> pPrint $ showEnvKeys @EnvAppConfig "_"
-- [ "ENVAPPCONFIG_ENVAPPCONFIGWARPSETTINGS_ENVWARPCONFIGPORT"
-- , "ENVAPPCONFIG_ENVAPPCONFIGWARPSETTINGS_ENVWARPCONFIGTIMEOUT"
-- , "ENVAPPCONFIG_ENVAPPCONFIGWARPSETTINGS_ENVWARPCONFIGHTTP2ENABLED"
-- , "ENVAPPCONFIG_ENVAPPCONFIGWARPSETTINGS_ENVWARPCONFIGSERVERNAME"
-- , "ENVAPPCONFIG_ENVAPPCONFIGREDISSETTINGS_ENVREDISCONFIGHOST"
-- , "ENVAPPCONFIG_ENVAPPCONFIGREDISSETTINGS_ENVREDISCONFIGPORT"
-- , "ENVAPPCONFIG_ENVAPPCONFIGREDISSETTINGS_ENVREDISCONFIGCONNECTAUTH"
-- , "ENVAPPCONFIG_ENVAPPCONFIGENVIRONMENT"
-- ]

-- * Exports
--
-- |
--

  getConfigRaw,
  getConfig,
) where


import Data.Text (Text)
import Data.Tree (Tree (..))
import Cfg.Source (RootConfig(..), FetchSource, NestedConfig)
import Cfg.Parser (RootParser(..), ConfigParseError, NestedParser, ValueParser)
import Cfg.Deriving (ConfigValue(..), ConfigRoot(..))

-- Imports for examples
import GHC.Generics
import Data.ByteString (ByteString)
import Cfg.Deriving.SubConfig (SubConfig(..))
import Cfg.Deriving.LabelModifier (ToUpper)
import Cfg.Deriving.ConfigRoot (ConfigRootOpts(..))
import Cfg.Deriving.SubConfig (SubConfigOpts(..))

-- | @since 0.0.1.0
getConfigRaw ::
    Monad m =>
    Tree Text ->
    (Tree Text -> m (Tree Text)) ->
    (Tree Text -> Either e a) ->
    m (Either e a)
getConfigRaw :: forall (m :: * -> *) e a.
Monad m =>
Tree Text
-> (Tree Text -> m (Tree Text))
-> (Tree Text -> Either e a)
-> m (Either e a)
getConfigRaw Tree Text
keyTree Tree Text -> m (Tree Text)
source Tree Text -> Either e a
parser = Tree Text -> Either e a
parser (Tree Text -> Either e a) -> m (Tree Text) -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree Text -> m (Tree Text)
source Tree Text
keyTree

-- | @since 0.0.1.0
getConfig :: forall a m . (Monad m, RootConfig a, RootParser a) => FetchSource m -> m (Either ConfigParseError a)
getConfig :: forall a (m :: * -> *).
(Monad m, RootConfig a, RootParser a) =>
FetchSource m -> m (Either ConfigParseError a)
getConfig FetchSource m
fetch = forall a. RootParser a => Tree Text -> Either ConfigParseError a
parseRootConfig @a (Tree Text -> Either ConfigParseError a)
-> m (Tree Text) -> m (Either ConfigParseError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FetchSource m
fetch (forall a. RootConfig a => Tree Text
toRootConfig @a)


-------------------------------------------------------
-- Examples for haddocks
-------------------------------------------------------
data Environment = Development | Production
  deriving stock ((forall x. Environment -> Rep Environment x)
-> (forall x. Rep Environment x -> Environment)
-> Generic Environment
forall x. Rep Environment x -> Environment
forall x. Environment -> Rep Environment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Environment -> Rep Environment x
from :: forall x. Environment -> Rep Environment x
$cto :: forall x. Rep Environment x -> Environment
to :: forall x. Rep Environment x -> Environment
Generic, Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
(Int -> Environment -> ShowS)
-> (Environment -> String)
-> ([Environment] -> ShowS)
-> Show Environment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Environment -> ShowS
showsPrec :: Int -> Environment -> ShowS
$cshow :: Environment -> String
show :: Environment -> String
$cshowList :: [Environment] -> ShowS
showList :: [Environment] -> ShowS
Show)
  deriving ([Tree Text]
[Tree Text] -> NestedConfig Environment
forall a. [Tree Text] -> NestedConfig a
$ctoNestedConfig :: [Tree Text]
toNestedConfig :: [Tree Text]
NestedConfig) via ConfigValue Environment
  deriving (Parser Environment
Parser Environment -> ValueParser Environment
forall a. Parser a -> ValueParser a
$cparser :: Parser Environment
parser :: Parser Environment
ValueParser) via ConfigValue Environment
  deriving Tree Text -> Either ConfigParseError Environment
(Tree Text -> Either ConfigParseError Environment)
-> NestedParser Environment
forall a.
(Tree Text -> Either ConfigParseError a) -> NestedParser a
$cparseNestedConfig :: Tree Text -> Either ConfigParseError Environment
parseNestedConfig :: Tree Text -> Either ConfigParseError Environment
NestedParser

data WarpConfig = WarpConfig
  { WarpConfig -> Int
warpConfigPort :: Int
  , WarpConfig -> Int
warpConfigTimeout :: Int
  , WarpConfig -> Bool
warpConfigHTTP2Enabled :: Bool
  , WarpConfig -> ByteString
warpConfigServerName :: ByteString
  }
  deriving ((forall x. WarpConfig -> Rep WarpConfig x)
-> (forall x. Rep WarpConfig x -> WarpConfig) -> Generic WarpConfig
forall x. Rep WarpConfig x -> WarpConfig
forall x. WarpConfig -> Rep WarpConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WarpConfig -> Rep WarpConfig x
from :: forall x. WarpConfig -> Rep WarpConfig x
$cto :: forall x. Rep WarpConfig x -> WarpConfig
to :: forall x. Rep WarpConfig x -> WarpConfig
Generic, Int -> WarpConfig -> ShowS
[WarpConfig] -> ShowS
WarpConfig -> String
(Int -> WarpConfig -> ShowS)
-> (WarpConfig -> String)
-> ([WarpConfig] -> ShowS)
-> Show WarpConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WarpConfig -> ShowS
showsPrec :: Int -> WarpConfig -> ShowS
$cshow :: WarpConfig -> String
show :: WarpConfig -> String
$cshowList :: [WarpConfig] -> ShowS
showList :: [WarpConfig] -> ShowS
Show)
  deriving ([Tree Text]
[Tree Text] -> NestedConfig WarpConfig
forall a. [Tree Text] -> NestedConfig a
$ctoNestedConfig :: [Tree Text]
toNestedConfig :: [Tree Text]
NestedConfig) via (SubConfig WarpConfig)
  deriving (Tree Text -> Either ConfigParseError WarpConfig
(Tree Text -> Either ConfigParseError WarpConfig)
-> NestedParser WarpConfig
forall a.
(Tree Text -> Either ConfigParseError a) -> NestedParser a
$cparseNestedConfig :: Tree Text -> Either ConfigParseError WarpConfig
parseNestedConfig :: Tree Text -> Either ConfigParseError WarpConfig
NestedParser) via (SubConfig WarpConfig)

data RedisConfig = RedisConfig
  { RedisConfig -> Text
redisConfigHost :: Text
  , RedisConfig -> Int
redisConfigPort :: Int
  , RedisConfig -> Maybe ByteString
redisConfigConnectAuth :: Maybe ByteString
  }
  deriving ((forall x. RedisConfig -> Rep RedisConfig x)
-> (forall x. Rep RedisConfig x -> RedisConfig)
-> Generic RedisConfig
forall x. Rep RedisConfig x -> RedisConfig
forall x. RedisConfig -> Rep RedisConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RedisConfig -> Rep RedisConfig x
from :: forall x. RedisConfig -> Rep RedisConfig x
$cto :: forall x. Rep RedisConfig x -> RedisConfig
to :: forall x. Rep RedisConfig x -> RedisConfig
Generic, Int -> RedisConfig -> ShowS
[RedisConfig] -> ShowS
RedisConfig -> String
(Int -> RedisConfig -> ShowS)
-> (RedisConfig -> String)
-> ([RedisConfig] -> ShowS)
-> Show RedisConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RedisConfig -> ShowS
showsPrec :: Int -> RedisConfig -> ShowS
$cshow :: RedisConfig -> String
show :: RedisConfig -> String
$cshowList :: [RedisConfig] -> ShowS
showList :: [RedisConfig] -> ShowS
Show)
  deriving ([Tree Text]
[Tree Text] -> NestedConfig RedisConfig
forall a. [Tree Text] -> NestedConfig a
$ctoNestedConfig :: [Tree Text]
toNestedConfig :: [Tree Text]
NestedConfig) via (SubConfig RedisConfig)
  deriving (Tree Text -> Either ConfigParseError RedisConfig
(Tree Text -> Either ConfigParseError RedisConfig)
-> NestedParser RedisConfig
forall a.
(Tree Text -> Either ConfigParseError a) -> NestedParser a
$cparseNestedConfig :: Tree Text -> Either ConfigParseError RedisConfig
parseNestedConfig :: Tree Text -> Either ConfigParseError RedisConfig
NestedParser) via (SubConfig RedisConfig)

data AppConfig = AppConfig
  { AppConfig -> WarpConfig
appConfigWarpSettings :: WarpConfig
  , AppConfig -> RedisConfig
appConfigRedisSettings :: RedisConfig
  , AppConfig -> Environment
appConfigEnvironment :: Environment
  }
  deriving stock ((forall x. AppConfig -> Rep AppConfig x)
-> (forall x. Rep AppConfig x -> AppConfig) -> Generic AppConfig
forall x. Rep AppConfig x -> AppConfig
forall x. AppConfig -> Rep AppConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AppConfig -> Rep AppConfig x
from :: forall x. AppConfig -> Rep AppConfig x
$cto :: forall x. Rep AppConfig x -> AppConfig
to :: forall x. Rep AppConfig x -> AppConfig
Generic, Int -> AppConfig -> ShowS
[AppConfig] -> ShowS
AppConfig -> String
(Int -> AppConfig -> ShowS)
-> (AppConfig -> String)
-> ([AppConfig] -> ShowS)
-> Show AppConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AppConfig -> ShowS
showsPrec :: Int -> AppConfig -> ShowS
$cshow :: AppConfig -> String
show :: AppConfig -> String
$cshowList :: [AppConfig] -> ShowS
showList :: [AppConfig] -> ShowS
Show)
  deriving (Tree Text
Tree Text -> RootConfig AppConfig
forall a. Tree Text -> RootConfig a
$ctoRootConfig :: Tree Text
toRootConfig :: Tree Text
RootConfig) via (ConfigRoot AppConfig)
  deriving (Tree Text -> Either ConfigParseError AppConfig
(Tree Text -> Either ConfigParseError AppConfig)
-> RootParser AppConfig
forall a. (Tree Text -> Either ConfigParseError a) -> RootParser a
$cparseRootConfig :: Tree Text -> Either ConfigParseError AppConfig
parseRootConfig :: Tree Text -> Either ConfigParseError AppConfig
RootParser) via (ConfigRoot AppConfig)

sample :: Tree Text
sample :: Tree Text
sample = Node
    { rootLabel :: Text
rootLabel = Text
"AppConfig"
    , subForest :: [Tree Text]
subForest =
        [ Node
            { rootLabel :: Text
rootLabel = Text
"appConfigWarpSettings"
            , subForest :: [Tree Text]
subForest =
                [ Node
                    { rootLabel :: Text
rootLabel = Text
"warpConfigPort"
                    , subForest :: [Tree Text]
subForest = [ Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"8080" [] ]
                    }
                , Node
                    { rootLabel :: Text
rootLabel = Text
"warpConfigTimeout"
                    , subForest :: [Tree Text]
subForest = [ Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"30" [] ]
                    }
                , Node
                    { rootLabel :: Text
rootLabel = Text
"warpConfigHTTP2Enabled"
                    , subForest :: [Tree Text]
subForest = [ Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"True" [] ]
                    }
                , Node
                    { rootLabel :: Text
rootLabel = Text
"warpConfigServerName"
                    , subForest :: [Tree Text]
subForest = [ Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"MyServer" [] ]
                    }
                ]
            }
        , Node
            { rootLabel :: Text
rootLabel = Text
"appConfigRedisSettings"
            , subForest :: [Tree Text]
subForest =
                [ Node
                    { rootLabel :: Text
rootLabel = Text
"redisConfigHost"
                    , subForest :: [Tree Text]
subForest = [ Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"https://localhost" [] ]
                    }
                , Node
                    { rootLabel :: Text
rootLabel = Text
"redisConfigPort"
                    , subForest :: [Tree Text]
subForest = [ Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"6379" [] ]
                    }
                , Node
                    { rootLabel :: Text
rootLabel = Text
"redisConfigConnectAuth"
                    , subForest :: [Tree Text]
subForest = [ Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"Just password" [] ]
                    }
                ]
            }
        , Node
            { rootLabel :: Text
rootLabel = Text
"appConfigEnvironment"
            , subForest :: [Tree Text]
subForest = [ Text -> [Tree Text] -> Tree Text
forall a. a -> [Tree a] -> Tree a
Node Text
"Development" [] ]
            }
        ]
    }

data EnvWarpConfig = EnvWarpConfig
  { EnvWarpConfig -> Int
envWarpConfigPort :: Int
  , EnvWarpConfig -> Int
envWarpConfigTimeout :: Int
  , EnvWarpConfig -> Bool
envWarpConfigHTTP2Enabled :: Bool
  , EnvWarpConfig -> ByteString
envWarpConfigServerName :: ByteString
  }
  deriving ((forall x. EnvWarpConfig -> Rep EnvWarpConfig x)
-> (forall x. Rep EnvWarpConfig x -> EnvWarpConfig)
-> Generic EnvWarpConfig
forall x. Rep EnvWarpConfig x -> EnvWarpConfig
forall x. EnvWarpConfig -> Rep EnvWarpConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnvWarpConfig -> Rep EnvWarpConfig x
from :: forall x. EnvWarpConfig -> Rep EnvWarpConfig x
$cto :: forall x. Rep EnvWarpConfig x -> EnvWarpConfig
to :: forall x. Rep EnvWarpConfig x -> EnvWarpConfig
Generic, Int -> EnvWarpConfig -> ShowS
[EnvWarpConfig] -> ShowS
EnvWarpConfig -> String
(Int -> EnvWarpConfig -> ShowS)
-> (EnvWarpConfig -> String)
-> ([EnvWarpConfig] -> ShowS)
-> Show EnvWarpConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvWarpConfig -> ShowS
showsPrec :: Int -> EnvWarpConfig -> ShowS
$cshow :: EnvWarpConfig -> String
show :: EnvWarpConfig -> String
$cshowList :: [EnvWarpConfig] -> ShowS
showList :: [EnvWarpConfig] -> ShowS
Show)
  deriving ([Tree Text]
[Tree Text] -> NestedConfig EnvWarpConfig
forall a. [Tree Text] -> NestedConfig a
$ctoNestedConfig :: [Tree Text]
toNestedConfig :: [Tree Text]
NestedConfig) via (SubConfigOpts ToUpper EnvWarpConfig)
  deriving (Tree Text -> Either ConfigParseError EnvWarpConfig
(Tree Text -> Either ConfigParseError EnvWarpConfig)
-> NestedParser EnvWarpConfig
forall a.
(Tree Text -> Either ConfigParseError a) -> NestedParser a
$cparseNestedConfig :: Tree Text -> Either ConfigParseError EnvWarpConfig
parseNestedConfig :: Tree Text -> Either ConfigParseError EnvWarpConfig
NestedParser) via (SubConfigOpts ToUpper EnvWarpConfig)

data EnvRedisConfig = EnvRedisConfig
  { EnvRedisConfig -> Text
envRedisConfigHost :: Text
  , EnvRedisConfig -> Int
envRedisConfigPort :: Int
  , EnvRedisConfig -> Maybe ByteString
envRedisConfigConnectAuth :: Maybe ByteString
  }
  deriving ((forall x. EnvRedisConfig -> Rep EnvRedisConfig x)
-> (forall x. Rep EnvRedisConfig x -> EnvRedisConfig)
-> Generic EnvRedisConfig
forall x. Rep EnvRedisConfig x -> EnvRedisConfig
forall x. EnvRedisConfig -> Rep EnvRedisConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnvRedisConfig -> Rep EnvRedisConfig x
from :: forall x. EnvRedisConfig -> Rep EnvRedisConfig x
$cto :: forall x. Rep EnvRedisConfig x -> EnvRedisConfig
to :: forall x. Rep EnvRedisConfig x -> EnvRedisConfig
Generic, Int -> EnvRedisConfig -> ShowS
[EnvRedisConfig] -> ShowS
EnvRedisConfig -> String
(Int -> EnvRedisConfig -> ShowS)
-> (EnvRedisConfig -> String)
-> ([EnvRedisConfig] -> ShowS)
-> Show EnvRedisConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvRedisConfig -> ShowS
showsPrec :: Int -> EnvRedisConfig -> ShowS
$cshow :: EnvRedisConfig -> String
show :: EnvRedisConfig -> String
$cshowList :: [EnvRedisConfig] -> ShowS
showList :: [EnvRedisConfig] -> ShowS
Show)
  deriving ([Tree Text]
[Tree Text] -> NestedConfig EnvRedisConfig
forall a. [Tree Text] -> NestedConfig a
$ctoNestedConfig :: [Tree Text]
toNestedConfig :: [Tree Text]
NestedConfig) via (SubConfigOpts ToUpper EnvRedisConfig)
  deriving (Tree Text -> Either ConfigParseError EnvRedisConfig
(Tree Text -> Either ConfigParseError EnvRedisConfig)
-> NestedParser EnvRedisConfig
forall a.
(Tree Text -> Either ConfigParseError a) -> NestedParser a
$cparseNestedConfig :: Tree Text -> Either ConfigParseError EnvRedisConfig
parseNestedConfig :: Tree Text -> Either ConfigParseError EnvRedisConfig
NestedParser) via (SubConfigOpts ToUpper EnvRedisConfig)

data EnvAppConfig = EnvAppConfig
  { EnvAppConfig -> EnvWarpConfig
envAppConfigWarpSettings :: EnvWarpConfig
  , EnvAppConfig -> EnvRedisConfig
envAppConfigRedisSettings :: EnvRedisConfig
  , EnvAppConfig -> Environment
envAppConfigEnvironment :: Environment
  }
  deriving stock ((forall x. EnvAppConfig -> Rep EnvAppConfig x)
-> (forall x. Rep EnvAppConfig x -> EnvAppConfig)
-> Generic EnvAppConfig
forall x. Rep EnvAppConfig x -> EnvAppConfig
forall x. EnvAppConfig -> Rep EnvAppConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnvAppConfig -> Rep EnvAppConfig x
from :: forall x. EnvAppConfig -> Rep EnvAppConfig x
$cto :: forall x. Rep EnvAppConfig x -> EnvAppConfig
to :: forall x. Rep EnvAppConfig x -> EnvAppConfig
Generic, Int -> EnvAppConfig -> ShowS
[EnvAppConfig] -> ShowS
EnvAppConfig -> String
(Int -> EnvAppConfig -> ShowS)
-> (EnvAppConfig -> String)
-> ([EnvAppConfig] -> ShowS)
-> Show EnvAppConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvAppConfig -> ShowS
showsPrec :: Int -> EnvAppConfig -> ShowS
$cshow :: EnvAppConfig -> String
show :: EnvAppConfig -> String
$cshowList :: [EnvAppConfig] -> ShowS
showList :: [EnvAppConfig] -> ShowS
Show)
  deriving (Tree Text
Tree Text -> RootConfig EnvAppConfig
forall a. Tree Text -> RootConfig a
$ctoRootConfig :: Tree Text
toRootConfig :: Tree Text
RootConfig) via (ConfigRootOpts ToUpper ToUpper EnvAppConfig)
  deriving (Tree Text -> Either ConfigParseError EnvAppConfig
(Tree Text -> Either ConfigParseError EnvAppConfig)
-> RootParser EnvAppConfig
forall a. (Tree Text -> Either ConfigParseError a) -> RootParser a
$cparseRootConfig :: Tree Text -> Either ConfigParseError EnvAppConfig
parseRootConfig :: Tree Text -> Either ConfigParseError EnvAppConfig
RootParser) via (ConfigRootOpts ToUpper ToUpper EnvAppConfig)