conferer 0.2.0.0 → 0.3.0.0

raw patch · 11 files changed

+511/−309 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +114/−26
• conferer.cabal +5/−5
• src/Conferer.hs +5/−5
• src/Conferer/Core.hs +52/−7
• src/Conferer/FetchFromConfig/Basics.hs +0/−133
• src/Conferer/FromConfig/Basics.hs +206/−0
• src/Conferer/Provider/Files.hs +2/−2
• src/Conferer/Types.hs +18/−22
• test/Conferer/FetchFromConfig/BasicsSpec.hs +0/−90
• test/Conferer/FromConfig/BasicsSpec.hs +88/−0
• test/Conferer/GenericsSpec.hs +21/−19

@@ -1,45 +1,134 @@-# Conferer--## what, why and a bit of how+<h1 align="center">Conferer</h1>+<p align="center">+    <a href="https://img.shields.io/travis/ludat/conferer" alt="Travis CI">+        <img src="https://img.shields.io/travis/ludat/conferer" />+    </a>+    <a href="https://img.shields.io/hackage/v/conferer" alt="Hackage version">+        <img src="https://img.shields.io/hackage/v/conferer" />+    </a>+    <a href="https://img.shields.io/hackage-deps/v/conferer" alt="Hackage deps">+        <img src="https://img.shields.io/hackage-deps/v/conferer" />+    </a>+</p> -VERY UNSTABLE DON'T USE IN PRODUCTION JUST YET+## The problem -Conferer is a library that defines ways to get configuration for your Haskell-application and the libraries it uses, which is at heart string keys which map-to other strings.+Have you ever tried configuring a Haskell application? If you are not the author+you are usually out of luck and the only way to configure it is recompiling, and+even if you are the author you have to write that logic yourself (reading env vars,+files or cli params), what about partial updates? and environments? or error handling? -To get this map we use `Providers` which define a way to get a key (eg.-`db.username`) that may or may not exist, we then use a list of providers for-getting the value for that key (position on the list defines priority). This-allows adding new providers easily (for example a dhall file provider,-a git repo or a etcd database)+## One solution: Conferer -The other side of this is that we have the `FromConfig` which gets some value-from a `Config` at a certain key possibly using only keys under some namespacing-key+Conferer is a library that defines ways of getting configuration for your+Haskell application and the libraries it uses in a very ergonomical way. -## Example (not implemented)+## Example: one Settings -Let's say I want to configure warp. Let's say we wrote this program.+Let's say I want to configure a warp server, then we'd do:  ```haskell main = do-  -- by default gets cli parameters, envvars and json file-  config <- getDefaultConfigFor "awesomeapp"-  warpConfig :: Warp.Settings <- getKey "warp" config+  -- First we create a Config, which defines which sources our config will be+  -- reading, by default cli params, env vars and .properties files+  config <- defaultConfig "awesomeapp"+  -- Then we use getFromConfig with some arbitrary key (to scope the server+  -- config) and we use our Config to generate a Warp Settings+  warpConfig :: Warp.Settings <- getFromConfig "server" config +  -- Afterwards we use the Settings as usual   Warp.runSettings warpConfig myApp ```  Now I need to chage the port of the app, I can change it by either: -* Setting cli params like `./myApp -Cwarp.port=5555`-* Setting an environment variable called `AWESOMEAPP_WARP_PORT=5555`-* In a json file you can have `{"warp": {"port": 5555}}`+* Setting cli params like `./myApp --server.port=5555`+* Setting an environment variable called `AWESOMEAPP_SERVER_PORT=5555`+* In a `config/dev.properties` file, you can have `server.port=5555`  And you may also get that value from different configuration providers like-redis or etc or whichever you may need.+redis, json file, dhall file or whichever you may need. +## Example 2: many different values with defaults++Let's say I want to configure a warp server and a redis db (using hedis), To +do that we'd do:++```haskell++-- First we create our configuration record which holds all the configurations+-- our app needs+data AppConfig = AppConfig+  { appConfigWarp :: Settings+  -- ^- From Warp+  , appConfigHedis :: ConnectionInfo+  -- ^- From Hedis+  , appConfigSecret :: Text+  -- ^- Some custom value we need+  } deriving (Generic)+  -- ^- We need to derive Generic to derive FromConfig++-- This typeclass defines how to create our type from a bunch of string based+-- key/values, (which our Config is), for records we can derive it using+-- Generics+instance FromConfig AppConfig++-- Now we need a default value for our app, all apps should be able to work+-- at least somewhat stupidly even if the user doens't supply configurations+-- at all+instance DefaultConfig AppConfig where+  configDef = AppConfig+    { appConfigWarp = setPort 2222 configDef+    -- ^- We want the default Warp config but the port should be 2222+    --    if the config doesn't mention it+    , appConfigHedis = configDef +    -- ^- defaults for hedis are ok+    , appConfigSecret = "very secret... shhh"+    -- ^- we decide some random default, notice that Text has no default+    --    so using configDef here won't compile+    }+++main = do+  -- Like last time we create the config+  config <- defaultConfig "awesomeapp"+  -- Then we use getFromRootConfig without a key since Generics on AppConfig+  -- already scoped everything inside itself and we use our Config to+  -- generate an AppConfig+  warpConfig :: AppConfig <- getFromRootConfig config++  -- Afterwards we use the Settings as usual+  Warp.runSettings warpConfig myApp+```++Now to configure our app we can use the same sources as before (env vars, cli,+files, etc) but using the following flags we can configure:++* `--warp.port=5555`: set warp's server port to 5555+* `--secret=real_secrets`: set our custom secret to `"real_secrets"`+* `--hedis=redis://username:password@host:42/2`: set hedis' connection to that+* `--hedis.host=redis.example.com`: set hedis' connection host to `redis.example.com`+++## Existing providers++Providers usually incur in many dependencies so they are split into different+packages++* *[Json](https://hackage.haskell.org/package/conferer-provider-json)* (depends on `aeson`)+* *[Dhall](https://hackage.haskell.org/package/conferer-provider-dhall)* (depends on `dhall`)+* *[Yaml](https://hackage.haskell.org/package/conferer-provider-yaml)* (depends on `yaml`) ++## Existing FromConfig instances++Default instances for fetching a values from a config (usually a config value+for some library)++* *[snap-server](https://hackage.haskell.org/package/conferer-snap)*+* *[warp](https://hackage.haskell.org/package/conferer-warp)*+* *[hedis](https://hackage.haskell.org/package/conferer-hedis)*+* *[hspec](https://hackage.haskell.org/package/conferer-hspec)*+ ## Utilities  There are as well some utilities to change providers:@@ -53,7 +142,6 @@ ## Future maybe things  * Interpolate keys with other keys: `{a: "db", b: "${a}_thing"}`, getting `b`-  will give `"db_thing"` (maybe)+  will give `"db_thing"` (maybe) even in different levels of configuration * A LOT of providers * A LOT of `FromConfig` implementations-* Docs

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 1f741ccac642f7efeeebac945b43d38c5662447adc1d2396aae94def3780aabb+-- hash: e9e6edef27397421e3ed20cd7b4269e086ded2fc7fd679dac79be16cf923d188  name:           conferer-version:        0.2.0.0+version:        0.3.0.0 synopsis:       Configuration management library  description:    Library to abstract the parsing of many haskell config values from different config sources@@ -27,7 +27,7 @@   exposed-modules:       Conferer       Conferer.Core-      Conferer.FetchFromConfig.Basics+      Conferer.FromConfig.Basics       Conferer.Provider.CLIArgs       Conferer.Provider.Env       Conferer.Provider.Files@@ -50,11 +50,11 @@     , text >=1.1 && <1.3   default-language: Haskell2010 -test-suite spec+test-suite specs   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Conferer.FetchFromConfig.BasicsSpec+      Conferer.FromConfig.BasicsSpec       Conferer.GenericsSpec       Conferer.Provider.ArgsSpec       Conferer.Provider.EnvSpec

@@ -18,7 +18,7 @@   --   -- @   -- import Conferer-  -- import Conferer.FetchFromConfig.Warp () -- from package conferer-warp+  -- import Conferer.FromConfig.Warp () -- from package conferer-warp   --   -- main = do   --   config <- 'defaultConfig' \"awesomeapp\"@@ -37,7 +37,7 @@   -- json files, properties files, env vars, etc.    -- ** Getting configuration for existing libraries-  -- | There is a typeclass 'FetchFromConfig' that defines how to get a type+  -- | There is a typeclass 'FromConfig' that defines how to get a type   --   from a config, they are implemented in different packages since the   --   weight of the dependencies would be too high, the package is usually   --   named as @conferer-DEPENDENCY@ where DEPENDENCY is the name of the dependency (@@ -47,7 +47,7 @@    -- ** Providing key value pairs for configuration   -- | There is one important type in conferer: 'Config' from which, given a key-  -- (eg: @warp@) you can get anything that implements 'FetchFromConfig' (like+  -- (eg: @warp@) you can get anything that implements 'FromConfig' (like   -- 'Warp.Settings')   --   -- Internally a 'Config' is made of many 'Provider's which have a simpler@@ -90,8 +90,8 @@ import           Data.Text (Text) import           Data.Function ((&)) -import           Conferer.Core (emptyConfig, addProvider, getFromConfig, getKey, unsafeGetKey, (/.), withDefaults)-import           Conferer.Types (Config, Key(..), ProviderCreator, Provider(..), FetchFromConfig(..))+import           Conferer.Core (emptyConfig, addProvider, getFromConfig, getFromRootConfig, getFromConfigWithDefault, safeGetFromConfig, safeGetFromConfigWithDefault, getKey, unsafeGetKey, (/.), withDefaults)+import           Conferer.Types (Config, Key(..), ProviderCreator, Provider(..), DefaultConfig(..), FromConfig(..)) import           Conferer.Provider.Env import           Conferer.Provider.Simple import           Conferer.Provider.Namespaced

@@ -1,3 +1,5 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-} module Conferer.Core where  import           Data.Text (Text)@@ -6,7 +8,7 @@ import qualified Data.Map as Map import           Data.Maybe (fromMaybe) import           Data.Typeable (Typeable, Proxy(..), typeRep)-import           Control.Exception (throw)+import           Control.Exception (try, throw, throwIO, evaluate)  import           Conferer.Provider.Simple import           Conferer.Types@@ -26,14 +28,57 @@         Nothing -> go providers  --- | Fetch a value from a config key that's parsed using the FetchFromConfig---   instance.+-- | Fetch a value from a config under some specific key that's parsed using the 'FromConfig'+--   instance, and as a default it uses the value from 'DefaultConfig'. -----   This function throws an exception if the key is not found.-getFromConfig :: forall a. (Typeable a, FetchFromConfig a) => Key -> Config -> IO a+--   Notes:+--     - This function may throw an exception if parsing fails for any subkey+getFromConfig :: forall a. (Typeable a, FromConfig a, DefaultConfig a) => Key -> Config -> IO a getFromConfig key config =-  fromMaybe (throw $ FailedToFetchError key (typeRep (Proxy :: Proxy a)))-    <$> fetch key config+  getFromConfigWithDefault key config configDef++-- | Same as 'getFromConfig' using the root key+--+--   Notes:+--     - This function may throw an exception if parsing fails for any subkey+getFromRootConfig :: forall a. (Typeable a, FromConfig a, DefaultConfig a) => Config -> IO a+getFromRootConfig config =+  getFromConfig "" config+++-- | Same as 'getFromConfig' but with a user defined default (instead of 'DefaultConfig' instance)+--+--   Useful for fetching primitive types+getFromConfigWithDefault :: forall a. (Typeable a, FromConfig a) => Key -> Config -> a -> IO a+getFromConfigWithDefault key config configDefault =+  safeGetFromConfigWithDefault key config configDefault+    >>= \case+      Just value -> do+        evaluate value+      Nothing ->+        throwIO $ FailedToFetchError key (typeRep (Proxy :: Proxy a))++-- | Fetch a value from a config key that's parsed using the FromConfig instance.+--+--   Note: This function does not use default so the value must be fully defined by the config only,+--   meaning using this function for many records will always result in 'Nothing' (if the record contains+--   a value that can never be retrieved like a function)+safeGetFromConfig :: forall a. (Typeable a, FromConfig a, DefaultConfig a) => Key -> Config -> IO (Maybe a)+safeGetFromConfig key config =+  safeGetFromConfigWithDefault key config configDef++-- | Same as 'safeGetFromConfig' but with a user defined default+safeGetFromConfigWithDefault :: forall a. (Typeable a, FromConfig a) => Key -> Config -> a -> IO (Maybe a)+safeGetFromConfigWithDefault key config configDefault = do+  totalValue <- evaluate =<< fetchFromConfig key config+  case totalValue of+    Just value -> do+      Just <$> evaluate value+    Nothing -> do+      result :: Either FailedToFetchError a <- try . (evaluate =<<) . updateFromConfig key config $ configDefault+      case result of+        Right a -> Just <$> evaluate a+        Left e -> return Nothing  -- | Create a new 'Key' by concatenating two existing keys. (/.) :: Key -> Key -> Key

@@ -1,133 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators #-}--module Conferer.FetchFromConfig.Basics where--import           Conferer.Types-import           Conferer.Core (getKey, (/.))-import           Control.Monad (join)-import           Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import           Data.ByteString (ByteString)-import           Data.Maybe (fromMaybe)-import           Control.Exception-import           Data.Char (toLower)-import           Data.Typeable (Typeable, typeRep, Proxy(..))-import           GHC.Generics--import           Data.String (IsString, fromString)--import           Text.Read (readMaybe)--instance FetchFromConfig Int where-  fetch = fetchFromConfigByRead--instance FetchFromConfig Integer where-  fetch = fetchFromConfigByRead--instance FetchFromConfig Float where-  fetch = fetchFromConfigByRead--instance FetchFromConfig ByteString where-  fetch = fetchFromConfigWith (Just . Text.encodeUtf8)--instance FetchFromConfig a => FetchFromConfig (Maybe a)  where-  fetch k config =-    fmap return <$> fetch k config--instance FetchFromConfig String where-  fetch = fetchFromConfigWith (Just . Text.unpack)--instance FetchFromConfig Text where-  fetch = fetchFromConfigWith (Just)--instance FetchFromConfig Bool where-  fetch = fetchFromConfigWith parseBool-      where-        parseBool text =-          case Text.toLower text of-            "false" -> Just False-            "true" -> Just True-            _ -> Nothing--fetchFromConfigByRead :: (Typeable a, Read a) => Key -> Config -> IO (Maybe a)-fetchFromConfigByRead = fetchFromConfigWith (readMaybe . Text.unpack)--fromValueWith :: (Text -> Maybe a) -> Text -> Maybe a-fromValueWith parseValue valueAsText = parseValue valueAsText--fetchFromConfigWith :: forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO (Maybe a)-fetchFromConfigWith parseValue key config = do-  getKey key config >>=-    \case-      Just value ->-        return $-          Just $-          fromMaybe (throw $ ConfigParsingError key value (typeRep (Proxy :: Proxy a))) $-          fromValueWith parseValue value-      Nothing -> return Nothing---- | Concatenate many transformations to the config based on keys and functions-findKeyAndApplyConfig ::-  forall newvalue config.-  FetchFromConfig newvalue-  => Config -- ^ Complete config-  -> Key -- ^ Key that indicates the part of the config that we care about-  -> Key -- ^ Key that we use to find the config (usually concatenating with the-         -- other key)-  -> (newvalue -> config -> config) -- ^ Function that knows how to use the-                                    -- value to update the config-  -> config -- ^ Result of the last config updating-  -> IO config -- ^ Updated config-findKeyAndApplyConfig config k relativeKey f customConfig = do-  t <- fetch @newvalue (k /. relativeKey) config-  case t of-    Nothing -> return customConfig-    Just a -> return $ f a customConfig--instance UpdateFromConfigG inner =>-    UpdateFromConfigG (D1 metadata inner) where-  updateFromConfigG key config (M1 inner) =-    M1 <$> updateFromConfigG key config inner--instance (UpdateFromConfigWithConNameG inner, Constructor constructor) =>-    UpdateFromConfigG (C1 constructor inner) where-  updateFromConfigG key config (M1 inner) =-    M1 <$> updateFromConfigWithConNameG @inner (conName @constructor undefined) key config inner--class UpdateFromConfigWithConNameG f where-  updateFromConfigWithConNameG :: String -> Key -> Config -> f a -> IO (f a)--instance (UpdateFromConfigWithConNameG left, UpdateFromConfigWithConNameG right) =>-    UpdateFromConfigWithConNameG (left :*: right) where-  updateFromConfigWithConNameG s key config (left :*: right) = do-    leftValue <- updateFromConfigWithConNameG @left s key config left-    rightValue <- updateFromConfigWithConNameG @right s key config right-    return (leftValue :*: rightValue)--instance (UpdateFromConfigG inner, Selector selector) =>-    UpdateFromConfigWithConNameG (S1 selector inner) where-  updateFromConfigWithConNameG s key config (M1 inner) =-    let-      applyFirst :: (Char -> Char) -> Text -> Text-      applyFirst f t = case Text.uncons t of-        Just (c, ts) -> Text.cons (f c) ts-        Nothing -> t--      fieldName = Text.pack $ selName @selector undefined-      prefix = applyFirst toLower $ Text.pack  s-      scopedKey =-        case Text.stripPrefix prefix fieldName of-          Just stripped -> applyFirst toLower stripped-          Nothing -> fieldName-    in M1 <$> updateFromConfigG @inner (key /. Path [scopedKey]) config inner---- | Purely 'Generics' machinery, ignore...-instance (FetchFromConfig inner) => UpdateFromConfigG (Rec0 inner) where-  updateFromConfigG key config (K1 inner) = do-    fetch @inner key config-      >>= \case-            Just newInner -> return $ K1 newInner-            Nothing -> return $ K1 inner

@@ -0,0 +1,206 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.Basics where++import           Control.Monad (join)+import           Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import           Data.ByteString (ByteString)+import           Data.Maybe (fromMaybe)+import           Control.Exception+import           Data.Char (toLower)+import           Data.Typeable (Typeable, typeRep, Proxy(..))+import           Data.String (IsString, fromString)+import           Text.Read (readMaybe)+import           GHC.Generics++import           Conferer.Types+import           Conferer.Core (getKey, (/.), getFromConfig)++updateAllAtOnceUsingFetch :: forall a. (FromConfig a, Typeable a) => Key -> Config -> a -> IO a+updateAllAtOnceUsingFetch key config old = do+  fetchFromConfig key config+    >>= \case+      Just new -> do+        evaluate new+      Nothing -> do+        evaluate old++instance FromConfig Int where+  updateFromConfig = updateAllAtOnceUsingFetch+  fetchFromConfig = fetchFromConfigByRead++instance FromConfig Integer where+  updateFromConfig = updateAllAtOnceUsingFetch+  fetchFromConfig = fetchFromConfigByRead++instance FromConfig Float where+  updateFromConfig = updateAllAtOnceUsingFetch+  fetchFromConfig = fetchFromConfigByRead++instance FromConfig ByteString where+  updateFromConfig = updateAllAtOnceUsingFetch+  fetchFromConfig = fetchFromConfigWith (Just . Text.encodeUtf8)++instance DefaultConfig (Maybe a) where+  configDef = Nothing+instance (FromConfig a) => FromConfig (Maybe a) where+  updateFromConfig k config (Just a) = do+    res <- updateFromConfig k config a+    Just <$> evaluate res+  updateFromConfig k config Nothing = do+    fetchFromConfig k config+  fetchFromConfig k config = do+    fetchFromConfig @a k config+      >>= \case+        Just res -> Just <$> Just <$> evaluate res+        Nothing -> return $ Just Nothing+++instance FromConfig String where+  updateFromConfig = updateAllAtOnceUsingFetch+  fetchFromConfig = fetchFromConfigWith (Just . Text.unpack)++instance FromConfig Text where+  updateFromConfig = updateAllAtOnceUsingFetch+  fetchFromConfig = fetchFromConfigWith Just+++instance FromConfig Bool where+  updateFromConfig = updateAllAtOnceUsingFetch+  fetchFromConfig = fetchFromConfigWith parseBool++parseBool text =+  case Text.toLower text of+    "false" -> Just False+    "true" -> Just True+    _ -> Nothing++updateFromConfigByRead :: (Typeable a, Read a) => Key -> Config -> a -> IO (a)+updateFromConfigByRead = updateFromConfigWith (readMaybe . Text.unpack)++updateFromConfigByIsString :: (Typeable a, IsString a) => Key -> Config -> a -> IO (a)+updateFromConfigByIsString = updateFromConfigWith (Just . fromString . Text.unpack)++fetchFromConfigByRead :: (Typeable a, Read a) => Key -> Config -> IO (Maybe a)+fetchFromConfigByRead = fetchFromConfigWith (readMaybe . Text.unpack)++fetchFromConfigByIsString :: (Typeable a, IsString a) => Key -> Config -> IO (Maybe a)+fetchFromConfigByIsString = fetchFromConfigWith (Just . fromString . Text.unpack)++fromValueWith :: (Text -> Maybe a) -> Text -> Maybe a+fromValueWith parseValue valueAsText = parseValue valueAsText++fetchFromConfigWith :: forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO (Maybe a)+fetchFromConfigWith parseValue key config = do+  getKey key config >>=+    \case+      Just value ->+        return $ Just $+          fromMaybe (throw $ ConfigParsingError key value (typeRep (Proxy :: Proxy a))) $+          fromValueWith parseValue value+      Nothing ->+        return Nothing++updateFromConfigWith :: forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> a -> IO a+updateFromConfigWith parseValue key config a = do+  getKey key config >>=+    \case+      Just value ->+        return $+          fromMaybe (throw $ ConfigParsingError key value (typeRep (Proxy :: Proxy a))) $+          fromValueWith parseValue value+      Nothing -> return a++-- | Concatenate many transformations to the config based on keys and functions+findKeyAndApplyConfig ::+  forall newvalue config.+  FromConfig newvalue+  => Config -- ^ Complete config+  -> Key -- ^ Key that indicates the part of the config that we care about+  -> Key -- ^ Key that we use to find the config (usually concatenating with the+         -- other key)+  -> (config -> newvalue) -- ^ Function that knows how to use the+                                    -- value to update the config+  -> (newvalue -> config -> config) -- ^ Function that knows how to use the+                                    -- value to update the config+  -> config -- ^ Result of the last config updating+  -> IO config -- ^ Updated config+findKeyAndApplyConfig config k relativeKey get set customConfig = do+  newValue <- updateFromConfig @newvalue (k /. relativeKey) config (get customConfig)+  return $ set newValue customConfig++instance FromConfigG inner =>+    FromConfigG (D1 metadata inner) where+  updateFromConfigG key config (M1 inner) =+    M1 <$> updateFromConfigG key config inner+  fetchFromConfigG key config =+    fmap M1 <$> fetchFromConfigG key config++instance (FromConfigWithConNameG inner, Constructor constructor) =>+    FromConfigG (C1 constructor inner) where+  updateFromConfigG key config (M1 inner) =+    M1 <$> updateFromConfigWithConNameG @inner (conName @constructor undefined) key config inner+  fetchFromConfigG key config =+    fmap M1 <$> fetchFromConfigWithConNameG @inner (conName @constructor undefined) key config++class FromConfigWithConNameG f where+  updateFromConfigWithConNameG :: String -> Key -> Config -> f a -> IO (f a)+  fetchFromConfigWithConNameG :: String -> Key -> Config -> IO (Maybe (f a))++instance (FromConfigWithConNameG left, FromConfigWithConNameG right) =>+    FromConfigWithConNameG (left :*: right) where+  updateFromConfigWithConNameG s key config (left :*: right) = do+    leftValue <- updateFromConfigWithConNameG @left s key config left+    rightValue <- updateFromConfigWithConNameG @right s key config right+    return (leftValue :*: rightValue)++  fetchFromConfigWithConNameG s key config = do+    leftValue <- fetchFromConfigWithConNameG @left s key config+    rightValue <- fetchFromConfigWithConNameG @right s key config+    case (leftValue, rightValue) of+      (Just l, Just r) -> return $ Just (l :*: r)+      _ -> return Nothing++instance (FromConfigG inner, Selector selector) =>+    FromConfigWithConNameG (S1 selector inner) where+  updateFromConfigWithConNameG s key config (M1 inner) =+    let+      applyFirst :: (Char -> Char) -> Text -> Text+      applyFirst f t = case Text.uncons t of+        Just (c, ts) -> Text.cons (f c) ts+        Nothing -> t++      fieldName = Text.pack $ selName @selector undefined+      prefix = applyFirst toLower $ Text.pack  s+      scopedKey =+        case Text.stripPrefix prefix fieldName of+          Just stripped -> applyFirst toLower stripped+          Nothing -> fieldName+    in M1 <$> updateFromConfigG @inner (key /. Path [scopedKey]) config inner++  fetchFromConfigWithConNameG s key config =+    let+      applyFirst :: (Char -> Char) -> Text -> Text+      applyFirst f t = case Text.uncons t of+        Just (c, ts) -> Text.cons (f c) ts+        Nothing -> t++      fieldName = Text.pack $ selName @selector undefined+      prefix = applyFirst toLower $ Text.pack s+      scopedKey =+        case Text.stripPrefix prefix fieldName of+          Just stripped -> applyFirst toLower stripped+          Nothing -> fieldName+    in fmap M1 <$> fetchFromConfigG @inner (key /. Path [scopedKey]) config++-- | Purely 'Generics' machinery, ignore...+instance (FromConfig inner) => FromConfigG (Rec0 inner) where+  updateFromConfigG key config (K1 inner) = do+    K1 <$> updateFromConfig @inner key config inner+  fetchFromConfigG key config = do+    fmap K1 <$> fetchFromConfig @inner key config

@@ -4,7 +4,7 @@ import           Data.Maybe (fromMaybe)  import           Conferer.Types-import           Conferer.FetchFromConfig.Basics ()+import           Conferer.FromConfig.Basics ()  fromRight :: a -> Either e a -> a fromRight a (Left _) = a@@ -12,7 +12,7 @@  getFilePathFromEnv :: Config -> String -> IO FilePath getFilePathFromEnv config extension = do-  env <- fromMaybe "development" <$> fetch "env" config+  env <- updateFromConfig "env" config "development"   return $ mconcat     [ "config/"     , Text.unpack env

@@ -49,45 +49,40 @@ -- needs connection info to connect to the server) type ProviderCreator = Config -> IO Provider --- | Main typeclass for defining the way to get values from config, hiding the--- 'Text' based nature of the 'Provider's+keyNotPresentError :: forall a. (Typeable a) => Key -> Proxy a -> FailedToFetchError+keyNotPresentError key =+  throw $ FailedToFetchError key $ typeRep (Proxy :: Proxy a)++-- | Default defining instance -- -- Here a 'Nothing' means that the value didn't appear in the config, some -- instances never return a value since they have defaults that can never -- fail-class FetchFromConfig a where-  fetch :: Key -> Config -> IO (Maybe a)-  default fetch :: (DefaultConfig a, UpdateFromConfig a) => Key -> Config -> IO (Maybe a)-  fetch k config = Just <$> updateFromConfig k config configDef---- | Here implementing this typeclass means that this type has some kind of default--- that is both always valid and has always the same semantics, for example: Warp.Settings--- has a default since it's always use in the same way (to configure a warp server)--- but for example an Int could mean many things depending on the context so it doesn't--- really make sense to implement it for it------ It's also used for the 'Generic' implementation, if you have a Record made up from--- types that implement 'FetchFromConfig' you can derive the 'FetchFromConfig' automatically--- by implementing 'DefaultConfig' and deriving (using 'Generic') 'UpdateFromConfig' class DefaultConfig a where   configDef :: a --- | This class only exist for the 'Generics' machinery, it means that a value can get+-- | Main typeclass for defining the way to get values from config, hiding the+-- 'Text' based nature of the 'Provider's. -- updated using a config, so for example a Warp.Settings can get updated from a config, -- but that doesn't make much sense for something like an 'Int' -- -- You'd normally would never implement this typeclass, if you want to implement--- 'FetchFromConfig' you should implement that directly, and if you want to use--- 'DefaultConfig' and 'UpdateFromConfig' to implement 'FetchFromConfig' you should let+-- 'FromConfig' you should implement that directly, and if you want to use+-- 'DefaultConfig' and 'FromConfig' to implement 'FromConfig' you should let -- the default 'Generics' based implementation do it's thing-class Typeable a => UpdateFromConfig a where+class FromConfig a where   updateFromConfig :: Key -> Config -> a -> IO a-  default updateFromConfig :: (Generic a, UpdateFromConfigG (Rep a), DefaultConfig a) => Key -> Config -> a -> IO a+  default updateFromConfig :: (Generic a, Typeable a, FromConfigG (Rep a)) => Key -> Config -> a -> IO a   updateFromConfig k c a = to <$> updateFromConfigG k c (from a) +  fetchFromConfig :: Key -> Config -> IO (Maybe a)+  default fetchFromConfig :: (Generic a, FromConfigG (Rep a)) => Key -> Config -> IO (Maybe a)+  fetchFromConfig k c = fmap to <$> fetchFromConfigG k c+ -- | Purely 'Generics' machinery, ignore...-class UpdateFromConfigG f where+class FromConfigG f where   updateFromConfigG :: Key -> Config -> f a -> IO (f a)+  fetchFromConfigG :: Key -> Config -> IO (Maybe (f a))  data ConfigParsingError =   ConfigParsingError Key Text TypeRep@@ -117,6 +112,7 @@     , show typeRep     , " from key '"     , Text.unpack (keyName key)+    , "'"     ]  instance Exception FailedToFetchError

@@ -1,90 +0,0 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-module Conferer.FetchFromConfig.BasicsSpec where--import           Test.Hspec-import           Conferer.Types-import           Data.Text-import           Conferer-import           Conferer.FetchFromConfig.Basics ()-import           Control.Exception (evaluate)-import           Data.Typeable-import           Control.DeepSeq--configWith :: [(Key, Text)] -> IO Config-configWith keyValues = emptyConfig & addProvider (mkMapProvider keyValues)--configParserError_ :: ConfigParsingError -> Bool-configParserError_ = const True--configParserError :: Key -> ConfigParsingError -> Bool-configParserError key (ConfigParsingError k _ _) =-  key == k--spec :: Spec-spec = context "Basics" $ do-  describe "fetching an Int from config" $ do-    it "getting a value that can't be parsed as an int returns an error message" $ do-      config <- configWith [ ("anInt", "50A") ]-      fetchedValue <- fetch @Int "anInt" config--      evaluate (force fetchedValue) `shouldThrow` configParserError_-      -- evaluate (force fetchedValue) `shouldThrow` anyErrorCall--    it "getting a value that can be parsed correctly returns the int" $ do-      config <- configWith [ ("anInt", "50") ]-      fetchedValue <- fetch @Int "anInt" config-      fetchedValue `shouldBe` Just 50--  describe "fetching a Bool from config" $ do-    it "getting a value that can't be parsed as a bool returns an error message" $ do-      config <- configWith [ ("aBool", "nope") ]-      fetchedValue <- fetch @Bool "aBool" config-      evaluate (force fetchedValue) `shouldThrow` configParserError_--    it "getting a value that can be parsed as a bool returns the bool" $ do-      config <- configWith [ ("aBool", "True"), ("anotherBool", "False") ]-      fetchedValue <- fetch "aBool" config-      fetchedValue `shouldBe` Just True-      anotherFetchedValue <- fetch "anotherBool" config-      anotherFetchedValue `shouldBe` Just False--    it "the parsing of the bool value is case insensitive" $ do-      config <- configWith [ ("aBool", "TRUE"), ("anotherBool", "fAlSe") ]-      fetchedValue <- fetch "aBool" config-      fetchedValue `shouldBe` Just True-      anotherFetchedValue <- fetch "anotherBool" config-      anotherFetchedValue `shouldBe` Just False--  describe "fetching a String from config" $ do-    it "getting a value returns the value as a string" $ do-      config <- configWith [ ("aString", "Bleh") ]-      fetchedValue <- fetch @String "aString" config-      fetchedValue `shouldBe` Just "Bleh"--  describe "fetching a Float from config" $ do-    it "if the value can be parsed as float, it returns that float" $ do-      config <- configWith [ ("aFloat", "9.5") ]-      fetchedValue <- fetch @Float "aFloat" config-      fetchedValue `shouldBe` Just 9.5--    it "if the value cannot be parsed as float, it fails" $ do-      config <- configWith [ ("aFloat", "ASD") ]-      fetchedValue <- fetch @Float "aFloat" config-      evaluate (force fetchedValue) `shouldThrow` configParserError_--  describe "fetching a String from config" $ do-    it "getting a value returns the value as a Just" $ do-      config <- configWith [ ("anInt", "17") ]-      fetchedValue <- fetch @(Maybe Int) "anInt" config-      fetchedValue `shouldBe` Just (Just 17)-    context "when the key is there but has a wrong value" $ do-      it "returns Nothing" $ do-        config <- configWith [ ("anInt", "Bleh") ]-        fetchedValue <- fetch @(Maybe Int) "anInt" config-        evaluate (force fetchedValue) `shouldThrow` configParserError_-    context "when the key is not there" $ do-      it "returns Nothing" $ do-        config <- configWith [ ]-        fetchedValue <- fetch @(Maybe Int) "anInt" config-        fetchedValue `shouldBe` Nothing

@@ -0,0 +1,88 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.BasicsSpec where++import           Test.Hspec+import           Conferer.Types+import           Data.Text+import           Conferer+import           Control.Exception (evaluate)+import           Data.Typeable+import           Control.DeepSeq++configWith :: [(Key, Text)] -> IO Config+configWith keyValues = emptyConfig & addProvider (mkMapProvider keyValues)++configParserError_ :: ConfigParsingError -> Bool+configParserError_ = const True++configParserError :: Key -> Text -> ConfigParsingError -> Bool+configParserError key txt (ConfigParsingError k t _) =+  key == k && t == txt++fetch :: (FromConfig a, Show a, Typeable a) => Key -> Config -> IO (Maybe a)+fetch = getFromConfig++spec :: Spec+spec = context "Basics" $ do+  describe "fetching an Int from config" $ do+    it "getting a value that can't be parsed as an int returns an error message" $ do+      config <- configWith [ ("anInt", "50A") ]+      fetch @Int "anInt" config `shouldThrow` configParserError "anInt" "50A"++    it "getting a value that can be parsed correctly returns the int" $ do+      config <- configWith [ ("anInt", "50") ]+      fetchedValue <- fetch @Int "anInt" config+      fetchedValue `shouldBe` Just 50++  describe "fetching a Bool from config" $ do+    it "getting a value that can't be parsed as a bool returns an error message" $ do+      config <- configWith [ ("aBool", "nope") ]+      fetch @Bool "aBool" config `shouldThrow` configParserError_++    it "getting a value that can be parsed as a bool returns the bool" $ do+      config <- configWith [ ("aBool", "True"), ("anotherBool", "False") ]+      fetchedValue <- fetch "aBool" config+      fetchedValue `shouldBe` Just True+      anotherFetchedValue <- fetch "anotherBool" config+      anotherFetchedValue `shouldBe` Just False++    it "the parsing of the bool value is case insensitive" $ do+      config <- configWith [ ("aBool", "TRUE"), ("anotherBool", "fAlSe") ]+      fetchedValue <- fetch "aBool" config+      fetchedValue `shouldBe` Just True+      anotherFetchedValue <- fetch "anotherBool" config+      anotherFetchedValue `shouldBe` Just False++  describe "fetching a String from config" $ do+    it "getting a value returns the value as a string" $ do+      config <- configWith [ ("aString", "Bleh") ]+      fetchedValue <- fetch @String "aString" config+      fetchedValue `shouldBe` Just "Bleh"++  describe "fetching a Float from config" $ do+    it "if the value can be parsed as float, it returns that float" $ do+      config <- configWith [ ("aFloat", "9.5") ]+      fetchedValue <- fetch @Float "aFloat" config+      fetchedValue `shouldBe` Just 9.5++    it "if the value cannot be parsed as float, it fails" $ do+      config <- configWith [ ("aFloat", "ASD") ]+      fetch @Float "aFloat" config `shouldThrow` configParserError_++  describe "fetching a String from config" $ do+    context "when the key is there but has a wrong value" $ do+      it "returns Nothing" $ do+        config <- configWith [ ("anInt", "Bleh") ]+        fetch @Int "anInt" config `shouldThrow` configParserError_+    context "when the key is not there" $ do+      it "returns Nothing" $ do+        config <- configWith [ ]+        fetchedValue <- fetch @Int "anInt" config+        fetchedValue `shouldBe` Nothing+      it "returns Nothing" $ do+        config <- configWith [ ]+        fetchedValue <- fetch @(Maybe Int) "anInt" config+        fetchedValue `shouldBe` Just Nothing

@@ -5,29 +5,31 @@ import Test.Hspec  import Conferer-import Conferer.Types (UpdateFromConfig, DefaultConfig, configDef)+import Conferer.Types (FromConfig, DefaultConfig, configDef) +import Data.Typeable import GHC.Generics +fetch :: (FromConfig a, Show a, Typeable a, DefaultConfig a) => Key -> Config -> IO a+fetch k c = getFromConfig k c+ data Thing = Thing   { thingA :: Int   , thingB :: Int   } deriving (Generic, Show, Eq) -instance UpdateFromConfig Thing+instance FromConfig Thing instance DefaultConfig Thing where   configDef = Thing 0 0-instance FetchFromConfig Thing  data Bigger = Bigger   { biggerThing :: Thing   , biggerB :: Int   } deriving (Generic, Show, Eq) -instance UpdateFromConfig Bigger+instance FromConfig Bigger instance DefaultConfig Bigger where-  configDef = Bigger configDef 1-instance FetchFromConfig Bigger+  configDef = Bigger (configDef { thingA = 27}) 1  spec :: Spec spec = do@@ -39,66 +41,66 @@                 & addProvider (mkMapProvider [ ])            res <- fetch @Thing "somekey" c-          res `shouldBe` Just Thing { thingA = 0, thingB = 0 }+          res `shouldBe` Thing { thingA = 0, thingB = 0 }       context "when all keys are set" $ do         it "return the keys set" $ do           c <- emptyConfig-                & addProvider (mkMapProvider +                & addProvider (mkMapProvider                   [ ("somekey.a", "1")                   , ("somekey.b", "2")                   ])            res <- fetch @Thing "somekey" c-          res `shouldBe` Just Thing { thingA = 1, thingB = 2 }+          res `shouldBe` Thing { thingA = 1, thingB = 2 }        context "when some keys are set" $ do         it "uses the default and returns the keys set" $ do           c <- emptyConfig-                & addProvider (mkMapProvider +                & addProvider (mkMapProvider                   [ ("somekey.b", "2")                   ])            res <- fetch @Thing "somekey" c-          res `shouldBe` Just Thing { thingA = 0, thingB = 2 }+          res `shouldBe` Thing { thingA = 0, thingB = 2 }      context "with a nested record" $ do       context "when none of the keys are set" $ do         it "returns the default of both records" $ do           c <- emptyConfig-                & addProvider (mkMapProvider +                & addProvider (mkMapProvider                   [ ])            res <- fetch @Bigger "somekey" c-          res `shouldBe` Just Bigger { biggerThing = Thing { thingA = 0, thingB = 0 }, biggerB = 1}+          res `shouldBe` Bigger { biggerThing = Thing { thingA = 27, thingB = 0 }, biggerB = 1}        context "when some keys of the top record are set" $ do         it "returns the default for the inner record" $ do           c <- emptyConfig-                & addProvider (mkMapProvider +                & addProvider (mkMapProvider                   [ ("somekey.b", "30")                   ])            res <- fetch @Bigger "somekey" c-          res `shouldBe` Just Bigger { biggerThing = Thing { thingA = 0, thingB = 0 }, biggerB = 30}+          res `shouldBe` Bigger { biggerThing = Thing { thingA = 27, thingB = 0 }, biggerB = 30}        context "when some keys of the inner record are set" $ do         it "returns the inner record updated" $ do           c <- emptyConfig-                & addProvider (mkMapProvider +                & addProvider (mkMapProvider                   [ ("somekey.thing.a", "30")                   ])            res <- fetch @Bigger "somekey" c-          res `shouldBe` Just Bigger { biggerThing = Thing { thingA = 30, thingB = 0 }, biggerB = 1}+          res `shouldBe` Bigger { biggerThing = Thing { thingA = 30, thingB = 0 }, biggerB = 1}        context "when every key is set" $ do         it "returns everything with the right values" $ do           c <- emptyConfig-                & addProvider (mkMapProvider +                & addProvider (mkMapProvider                   [ ("somekey.thing.a", "10")                   , ("somekey.thing.b", "20")                   , ("somekey.b", "30")                   ])            res <- fetch @Bigger "somekey" c-          res `shouldBe` Just Bigger { biggerThing = Thing { thingA = 10, thingB = 20 }, biggerB = 30}+          res `shouldBe` Bigger { biggerThing = Thing { thingA = 10, thingB = 20 }, biggerB = 30}