packages feed

conferer 0.4.1.1 → 1.1.0.0

raw patch · 49 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,49 @@+# Changelog+All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to [PVP](https://pvp.haskell.org/).++## [Unreleased]++Nothing++## [v1.1.0.0] - 2021-03-01++### Changed++* Rename `fromFilePath` to `fromFilePath'`.+* Define a new `fromFilePath` whose type is `FilePath -> SourceCreator` instaed of `FilePath -> IO Source`.+* (Internal) Remove the mismatched type exception since it's not actionable by the user+* (Internal) Use a list for default values so that many different defaults are available,+  possible point of extension in the future.+* Constraint valid key names to lowercase ascii and numbers (previously some non ascii characters were allowed)++### Added++* `isValidKeyFragment` and `isKeyCharacter` to validate `Key`s+* Added an overriding method based on type and key (details in the docs)++## [v1.0.0.1] - 2021-01-17++### Fixed++* In the `File`'s `FromConfig` instance, if the default is present and it's type+is `File`, it throws, which doesn't follow the rest of the library.++### Added++* Add `mkConfig'` which allows creating a config by passing a list of defaults and+a list of source creators.+* Add `addSources`, which allows to add several sources to a config.+* Define the type `Defaults`, which is a list of associations from `Key` to+`Dynamic`.++## [v1.0.0.0] - 2020-12-29++First release++[Unreleased]: https://github.com/ludat/conferer/compare/conferer_v1.1.0.0...HEAD+[v1.1.0.0]: https://github.com/ludat/conferer/releases/tag/conferer_v1.0.0.1...conferer_v1.1.0.0+[v1.0.0.1]: https://github.com/ludat/conferer/releases/tag/conferer_v1.0.0.0...conferer_v1.0.0.1+[v1.0.0.0]: https://github.com/ludat/conferer/releases/tag/v0.0.0.0...conferer_v1.0.0.0
conferer.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 41b921ef11b0981ed712b7e72a531f123613815eb7b3ebe4f9e0778a998118c6+-- hash: 80fdd520360a49e55b6dfe3ff9e148c716a7af0b6cf3d0326f8ed3d4a8f67611  name:           conferer-version:        0.4.1.1+version:        1.1.0.0 synopsis:       Configuration management library  description:    Library to abstract the parsing of many haskell config values from different config sources@@ -15,65 +15,91 @@ homepage:       https://conferer.ludat.io author:         Lucas David Traverso maintainer:     lucas6246@gmail.com+copyright:      (c) 2020 Lucas David Traverso license:        MPL-2.0 license-file:   LICENSE build-type:     Simple extra-doc-files:     README.md+    CHANGELOG.md     LICENSE  library   exposed-modules:       Conferer-      Conferer.Core-      Conferer.FromConfig.Basics+      Conferer.Config+      Conferer.Config.Internal+      Conferer.Config.Internal.Types+      Conferer.FromConfig+      Conferer.FromConfig.Internal+      Conferer.Key+      Conferer.Key.Internal+      Conferer.Source       Conferer.Source.CLIArgs       Conferer.Source.Env       Conferer.Source.Files-      Conferer.Source.Mapping+      Conferer.Source.InMemory+      Conferer.Source.Internal       Conferer.Source.Namespaced       Conferer.Source.Null       Conferer.Source.PropertiesFile-      Conferer.Source.Simple-      Conferer.Types+      Conferer.Test   other-modules:       Paths_conferer   hs-source-dirs:       src-  default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables+  default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables RecordWildCards StrictData+  ghc-options: -Wall -Wredundant-constraints -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns   build-depends:       base >=4.3 && <5     , bytestring >=0.10 && <0.11     , containers >=0.5 && <0.7     , directory >=1.2 && <2.0+    , filepath >=1.0 && <2.0     , text >=1.1 && <1.3+  if impl(ghc >= 8.4.1)+    ghc-options: -Wpartial-fields   default-language: Haskell2010  test-suite specs   type: exitcode-stdio-1.0-  main-is: Spec.hs+  main-is: ConfererSpecMain.hs   other-modules:-      Conferer.FromConfig.BasicsSpec+      Conferer.ConfigSpec+      Conferer.FromConfig.BoolSpec+      Conferer.FromConfig.Extended+      Conferer.FromConfig.FileSpec+      Conferer.FromConfig.ListSpec+      Conferer.FromConfig.MaybeSpec+      Conferer.FromConfig.NumbersSpec+      Conferer.FromConfig.StringLikeSpec+      Conferer.FromConfigSpec       Conferer.GenericsSpec-      Conferer.Source.ArgsSpec+      Conferer.KeySpec+      Conferer.Source.CLIArgsSpec       Conferer.Source.EnvSpec-      Conferer.Source.MappingSpec+      Conferer.Source.InMemorySpec       Conferer.Source.NamespacedSpec       Conferer.Source.NullSpec       Conferer.Source.PropertiesFileSpec-      Conferer.Source.SimpleSpec       ConfererSpec+      Spec       Paths_conferer   hs-source-dirs:       test-  default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables+  default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables RecordWildCards StrictData+  ghc-options: -Wall -Wredundant-constraints -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -main-is ConfererSpecMain   build-depends:-      base >=4.3 && <5+      QuickCheck+    , base >=4.3 && <5     , bytestring >=0.10 && <0.11     , conferer     , containers >=0.5 && <0.7     , deepseq     , directory >=1.2 && <2.0+    , filepath >=1.0 && <2.0     , hspec     , text >=1.1 && <1.3+  if impl(ghc >= 8.4.1)+    ghc-options: -Wpartial-fields   default-language: Haskell2010
src/Conferer.hs view
@@ -1,117 +1,92 @@-{-# LANGUAGE DeriveGeneric #-} -- |--- Module:      Conferer--- Copyright:   (c) 2019 Lucas David Traverso--- License:     MIT--- Maintainer:  Lucas David Traverso <lucas6246@gmail.com>--- Stability:   experimental+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable -- Portability: portable ----- Types and functions for managing configuration effectively+-- Public and stable API for the most basic usage of this library module Conferer   ( -  -- * How to use this library-  -- | This is the most basic example: which uses the default configuration-  --   to get a configuration for warp, which can be overriden via env vars,-  --   command line arguments of @.properties@ files-  ---  -- @-  -- import Conferer-  -- import Conferer.FromConfig.Warp () -- from package conferer-warp-  ---  -- main = do-  --   config <- 'defaultConfig' \"awesomeapp\"-  --   warpSettings <- 'getFromConfig' \"warp\" config-  --   runSettings warpSettings application-  -- @-  ---  -- In the above example we see that we are getting a configuration value for-  -- warp under the key warp, so for example to override it's default value-  -- provided by warp the config keys for warp will always look like-  -- @warp.something@, for example to override the port for warp (3000 by-  -- default) we could call our program as @./my_program --warp.port=8000@.-  ---  -- There are two sides to conferer: Getting configuration for other libraries-  -- like warp, hspec, snap, etc. and the way we choose to provide values like-  -- json files, properties files, env vars, etc.+  -- * How to use this doc+  -- | This doc is mostly for reference, so you probably won't learn how to+  --   use conferer by reading it. For more detailed and guided documentation+  --   the best place is the webpage: <https://conferer.ludat.io/docs> -  -- ** Getting configuration for existing libraries-  -- | 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 (-  --   for example: conferer-snap, conferer-warp, conferer-hspec), if you find-  --   a library without a conferer port for its config you can create an issue-  --   or maybe even create the library yourself!+  -- * Creating a Config+  mkConfig+  , mkConfig'+  -- * Getting values from a config+  -- | These functions allow you to get any type that implements 'FromConfig'+  , fetch+  , fetch'+  , fetchKey+  , fetchFromConfig+  , safeFetchKey+  , unsafeFetchKey+  , DefaultConfig(..)+  , FromConfig+  -- * Some useful types+  , Config+  , Key+  ) where -  -- ** 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 'FromConfig' (like-  -- 'Warp.Settings')-  ---  -- Internally a 'Config' is made of many 'Source's which have a simpler-  -- interface:-  ---  -- @-  -- 'getKeyInSource' :: Source -> Key -> IO (Maybe Text)-  -- @-  ---  -- Most configuration sources can be abstracted away as Map String String,-  -- and they can use whatever logic they want to turn conferer keys (a list of-  -- strings) into a place to look for a string, (for example the env source-  -- requires a string to namespace the env vars that can affect the-  -- configuration)-  ---  -- Once you have your 'Source' you can add it to a 'Config' using the-  -- 'addSource' function. One final note: each source has a different-  -- priority, which depends on when is was added to the config ('Source's-  -- added later have lower priority) so the config searches keys in sources-  -- in the same order they were added.+import Data.Text (Text)+import Data.Typeable (Typeable) -  module Conferer.Types-  , module Conferer.Core-  , defaultConfig-  , defaultConfigWithDefaults-  , Key(..)+import Conferer.Config.Internal+import Conferer.Config.Internal.Types+import Conferer.FromConfig.Internal+import Conferer.Key+import qualified Conferer.Source.Env as Env+import qualified Conferer.Source.CLIArgs as Cli+import qualified Conferer.Source.PropertiesFile as PropertiesFile+import Conferer.Config (Defaults) -  -- * Sources-  , module Conferer.Source.Env-  , module Conferer.Source.Simple-  , module Conferer.Source.Namespaced-  , module Conferer.Source.Mapping-  , module Conferer.Source.CLIArgs-  , module Conferer.Source.Null-  , module Conferer.Source.PropertiesFile-  -- * Re-Exports-  , (&)-  ) where+-- | Use the 'FromConfig' instance to get a value of type @a@ from the config+--   using some default fallback. The most common use for this is creating a custom+--   record and using this function to fetch it at initialization time.+--+--   This function throws only parsing exceptions when the values are present+--   but malformed somehow (@"abc"@ as an Int) but that depends on the 'FromConfig'+--   implementation for the type.+fetch :: forall a. (FromConfig a, Typeable a, DefaultConfig a) => Config -> IO a+fetch c = fetchFromRootConfigWithDefault c configDef -import           Data.Text (Text)-import           Data.Function ((&))+-- | Same as 'fetch' but it accepts the default as a parameter instead of using+--   the default from 'configDef'+fetch' :: forall a. (FromConfig a, Typeable a) => Config -> a -> IO a+fetch' = fetchFromRootConfigWithDefault -import           Conferer.Core (emptyConfig, addSource, getFromConfig, getFromRootConfig, getFromConfigWithDefault, safeGetFromConfig, safeGetFromConfigWithDefault, getKey, unsafeGetKey, (/.), withDefaults)-import           Conferer.Types (Config, Key(..), SourceCreator, Source(..), DefaultConfig(..), FromConfig(..))-import           Conferer.Source.Env-import           Conferer.Source.Simple-import           Conferer.Source.Namespaced-import           Conferer.Source.Mapping-import           Conferer.Source.CLIArgs-import           Conferer.Source.Null-import           Conferer.Source.PropertiesFile+-- | Same as 'fetch'' but you can specify a 'Key' instead of the root key which allows+--   you to fetch smaller values when you need them instead of a big one at+--   initialization time.+fetchKey :: forall a. (FromConfig a, Typeable a) => Config -> Key -> a -> IO a+fetchKey = fetchFromConfigWithDefault --- | Default config which reads from command line arguments, env vars and--- property files-defaultConfig :: Text -> IO Config-defaultConfig appName =-  defaultConfigWithDefaults appName []+-- | Same as 'fetchKey' but it returns a 'Nothing' when the value isn't present+safeFetchKey :: forall a. (FromConfig a, Typeable a) => Config -> Key -> IO (Maybe a)+safeFetchKey c k = fetchFromConfig k c --- | Default config which reads from command line arguments, env vars,--- property files and some default key/values-defaultConfigWithDefaults :: Text -> [(Key, Text)] -> IO Config-defaultConfigWithDefaults appName configMap =-  pure (emptyConfig & withDefaults configMap)-  >>= addSource (mkCLIArgsSource)-  >>= addSource (mkEnvSource appName)-  >>= addSource (mkPropertiesFileSource)+-- | Same as 'fetchKey' but it throws when the value isn't present.+unsafeFetchKey :: forall a. (FromConfig a, Typeable a) => Config -> Key -> IO a+unsafeFetchKey c k = fetchFromConfig k c ++-- | Create a 'Config' which reads from command line arguments, env vars and+--   property files that depend on the environment (@config/development.properties@)+--   by default+mkConfig :: Text -> IO Config+mkConfig appName =+  pure emptyConfig+  >>= addSource (Cli.fromConfig)+  >>= addSource (Env.fromConfig appName)+  >>= addSource (PropertiesFile.fromConfig "config.file")++-- | Create a 'Config' with the given defaults and source creators.+--   The sources will take precedence by the order they have in the list (earlier in+--   the list means it's tried first).+--   If the requested key is not found in any source it'll be looked up in the defaults.+mkConfig' :: Defaults -> [SourceCreator] -> IO Config+mkConfig' defaults sources = addSources sources . addDefaults defaults $ emptyConfig
+ src/Conferer/Config.hs view
@@ -0,0 +1,37 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Public API providing Config functionality+module Conferer.Config+  (+    -- * Data+    Config+    -- * Querying a config+  , getKey+  , KeyLookupResult(..)+  , listSubkeys+    -- * Config creation and initialization+  , emptyConfig+  , addSource+  , addSources+  , addDefault+  , addDefaults+  , addKeyMappings+  , removeDefault+  , Defaults+    -- * Re-Exports+  , module Conferer.Key+  , (&)+  ) where++import Conferer.Config.Internal+import Conferer.Config.Internal.Types+import Conferer.Key+import Data.Function+import Data.Dynamic (Dynamic)++type Defaults = [(Key, Dynamic)]
+ src/Conferer/Config/Internal.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE TypeApplications #-}+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: unstable+-- Portability: portable+--+-- Internal module providing Config functionality+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module Conferer.Config.Internal where++import Control.Monad (foldM, forM, msum)+import Data.Dynamic+import Data.List (sort, nub, union)+import Data.Text (Text)+import Data.Maybe (isJust)+import qualified Data.Map as Map++import Conferer.Key+import Conferer.Source.Internal+import Conferer.Config.Internal.Types++-- | This function runs lookups on the 'Config', first in 'Source's in order and+--   then on the 'Dynamic' based defaults.+getKey :: Key -> Config -> IO KeyLookupResult+getKey key config = do+  let possibleKeys = getKeysFromMappings (configKeyMappings config) key+  untilJust (fmap (\MappedKey{..} -> getRawKeyInSources mappedKey config) possibleKeys)+    >>= \case+        Just (k, textResult) ->+          return $ FoundInSources k textResult+        Nothing ->+          case msum $ fmap (\MappedKey{..} -> fmap (mappedKey,) $ (getKeyFromDefaults mappedKey config)) possibleKeys of+            Just (k, dynResult) -> return $ FoundInDefaults k dynResult+            Nothing -> return $ MissingKey [key]++-- | Alias for a mapping from one key to another used for transforming keys+type KeyMapping = (Key, Key)++-- | A key that has been transformed using one or many 'KeyMapping's, so that+--   that process can be reversed.+data MappedKey = MappedKey+  { mappingsChain :: [KeyMapping]+  , mappedKey :: Key+  } deriving (Show, Eq)+++-- | This function lists all available keys under some key, that could be fetched+--   successfully.+listSubkeys :: Key -> Config -> IO [Key]+listSubkeys originalKey Config{..} = do+  let mappedKeys = getKeysFromMappings configKeyMappings originalKey+  subkeysFromSources <- forM mappedKeys $ \MappedKey{..} -> do+    subkeysFromSources <- listRawSubkeysInSources mappedKey configSources+    let subkeysFromDefaults =+          filter (mappedKey `isKeyPrefixOf`) $ Map.keys configDefaults+    return $ fmap (MappedKey mappingsChain) $ subkeysFromSources ++ subkeysFromDefaults+  let subkeys = mconcat subkeysFromSources+  return $ sort $ nub $ fmap undoMappings subkeys++-- | This function lists subkeys in some 'Source's and combines the results+listRawSubkeysInSources :: Key -> [Source] -> IO [Key]+listRawSubkeysInSources mappedKey configSources = go mappedKey [] configSources+  where+    go :: Key -> [Key] -> [Source] -> IO [Key]+    go _ result [] = return result+    go k result (source:otherSources) = do+      subkeys <- getSubkeysInSource source k+      go k (result `union` subkeys) otherSources++-- | This function reverses the mappings in a 'MappedKey' to retrieve the+--   original key.+--+--   Assumes that mappings were really used, otherwise it ignores bad values+undoMappings :: MappedKey -> Key+undoMappings MappedKey{..} =+  go (reverse mappingsChain) mappedKey+  where+    go [] key = key+    go ((src, dest):others) key =+      case stripKeyPrefix dest key of+        Just k -> go others (src /. k)+        Nothing -> go others key++-- | This utility function run a list of IO actions and returns the+--   first that return a 'Just', if no one does, returns 'Nothing'+untilJust :: [IO (Maybe a)] -> IO (Maybe a)+untilJust actions = go actions+  where+    go [] = return Nothing+    go (action:rest) = do+      action+        >>= \case+          Just res -> return $ Just res+          Nothing -> go rest++-- | This function tries to apply a list of mappings to a key meaning+-- replace the prefix with the new value from the mapping, if the mapping+-- isn't a prefix that mapping is ignored+--+-- This function always terminates even in presence of recursive mappings,+-- since it removes the mapping after it was first used, and that causes that+-- eventually the function will run out of keymappings and terminate.+getKeysFromMappings :: [KeyMapping] -> Key -> [MappedKey]+getKeysFromMappings originalKeyMappings originalKey =+  go (MappedKey [] originalKey) originalKeyMappings+  where+    go :: MappedKey -> [KeyMapping] -> [MappedKey]+    go k [] = [k]+    go currKey keyMappings =+      nub $+        currKey :+        mconcat (+        fmap generateDerivedKeys $+        findAndSplitList tryMappingKey+        keyMappings)+      where+        tryMappingKey :: (Key, Key) -> Maybe MappedKey+        tryMappingKey (source, dest) =+          case stripKeyPrefix source (mappedKey currKey) of+            Just aKey ->+              Just $ MappedKey (mappingsChain currKey ++ [(source, dest)]) (dest /. aKey)+            Nothing -> Nothing+        generateDerivedKeys :: ([KeyMapping], MappedKey, [KeyMapping]) -> [MappedKey]+        generateDerivedKeys (prevMappings, aKey, nextMappings) =+          go aKey $ prevMappings ++ nextMappings++-- | This utility function splits a list based on a @cond@ function and returns a tuple+--   of previous value, next values and the mapped found value.+findAndSplitList :: forall a b. (a -> Maybe b) -> [a] -> [([a], b, [a])]+findAndSplitList cond list = go [] list+  where+    go :: [a] -> [a] -> [([a], b, [a])]+    go _ [] = []+    go prevElems (curElem:nextElems) =+      case cond curElem of+        Just res ->+          (prevElems, res, nextElems) : go (curElem:prevElems) nextElems+        Nothing ->+          go (curElem:prevElems) nextElems++-- | This function gets a value from 'Source's but ignores mappings and defaults+getRawKeyInSources :: Key -> Config -> IO (Maybe (Key, Text))+getRawKeyInSources k Config{..} =+  go configSources+  where+    go [] = return Nothing+    go (source:otherSources) = do+      res <- getKeyInSource source k+      case res of+        Just t -> return $ Just (k, t)+        Nothing -> go otherSources++-- | This function gets values from the defaults+getKeyFromDefaults :: Key -> Config -> Maybe [Dynamic]+getKeyFromDefaults key Config{..} =+  let+    possibleKeys = fmap mappedKey $ getKeysFromMappings configKeyMappings key+  in msum $ fmap (\k -> Map.lookup k configDefaults) possibleKeys++-- | The empty configuration, this 'Config' is used as the base for+--   most config creating functions.+emptyConfig :: Config+emptyConfig = Config+  { configSources = []+  , configDefaults = Map.empty+  , configKeyMappings = []+  }++-- | This function adds some key mappings to a 'Config'+addKeyMappings :: [KeyMapping] -> Config -> Config+addKeyMappings keyMappings config =+  config+  { configKeyMappings = configKeyMappings config ++ keyMappings+  }++-- | This function adds defaults to a 'Config'+addDefaults :: [(Key, Dynamic)] -> Config -> Config+addDefaults configMap config =+  let+    constructedMap =+      Map.fromListWith (++)+      . fmap (\(k,v) -> (k, [v]))+      $ configMap+  in config+  { configDefaults =+    Map.unionWith (++) constructedMap+      $ configDefaults config+  }++-- | This function removes a default from a 'Config', this is the+-- oposite of 'addDefault', it deletes the first element of+-- matching type in a certain 'Key'.+removeDefault :: forall t. Typeable t => Key -> Config -> Config+removeDefault key config =+  config+  { configDefaults =+      Map.update removeFirstDynamic key $ configDefaults config+  }+  where+    removeFirst :: (a -> Bool) -> [a] -> [a]+    removeFirst _ [] = []+    removeFirst condition (x:xs) =+      if condition x+        then xs+        else x : removeFirst condition xs++    removeFirstDynamic :: [Dynamic] -> Maybe [Dynamic]+    removeFirstDynamic dynamics =+      let result = removeFirst (isJust . fromDynamic @t) dynamics+      in if null result+          then Nothing +          else Just result++-- | This function adds one default of a custom type to a 'Config'+--+--   Note that unlike 'addDefaults' this function does the toDyn so+--   no need to do it on the user's side+addDefault :: (Typeable a) => Key -> a -> Config -> Config+addDefault key value config =+  config+  { configDefaults = Map.insertWith (++) key [toDyn value] $ configDefaults config+  }++-- | Instantiate a 'Source' using an 'SourceCreator' and a 'Config' and add+--   to the config+addSource :: SourceCreator -> Config -> IO Config+addSource mkSource config = do+  newSource <- mkSource config+  return $+    config+    { configSources = configSources config ++ [ newSource ]+    }++-- | Instantiate several 'Source's using a 'SourceCreator's and a 'Config' and add+--   them to the config in the order defined by the list+addSources :: [SourceCreator] -> Config -> IO Config+addSources sources config = foldM (flip addSource) config sources++-- orElse :: IO KeyLookupResult -> IO KeyLookupResult -> IO KeyLookupResult+-- orElse getKey1 getKey2 = do+--   result1 <- getKey1+--   case result1 of+--     MissingKey _ -> getKey2+--     FoundInSources _ _ -> return result1+--     FoundInDefaults _ _ -> do+--       result2 <- getKey2+--       case result2 of+--         MissingKey _ -> return result1+--         FoundInSources _ _ -> return result2+--         FoundInDefaults _ _ -> return result1
+ src/Conferer/Config/Internal/Types.hs view
@@ -0,0 +1,38 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: unstable+-- Portability: portable+--+-- Core types for Config (here because of depedency cycles)+module Conferer.Config.Internal.Types where++import Data.Map (Map)+import Conferer.Key (Key)+import Data.Dynamic ( Dynamic )+import Conferer.Source.Internal (Source)+import Data.Text (Text)++-- | This type acts as the entry point for most of the library, it's main purpouse+--   is to expose a uniform interface into multiple configuration sources (such as+--   env vars, cli args, and many others including use defined ones using the+--   'Source' interface)+data Config =+  Config+  { configSources :: [Source]+  , configDefaults :: Map Key [Dynamic]+  , configKeyMappings :: [(Key, Key)]+  } deriving (Show)++-- | Result of a key lookup in a 'Config'+data KeyLookupResult+  = MissingKey [Key]+  | FoundInSources Key Text+  | FoundInDefaults Key [Dynamic]+  deriving (Show)++-- | The type for creating a source given a 'Config', some sources require a+-- certain configuration to be initialized (for example: the redis source+-- needs connection info to connect to the server)+type SourceCreator = Config -> IO Source
− src/Conferer/Core.hs 
@@ -1,116 +0,0 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE FlexibleContexts #-}-module Conferer.Core where--import           Data.Text (Text)-import qualified Data.Text as Text-import           Data.Map (Map)-import qualified Data.Map as Map-import           Data.Maybe (fromMaybe)-import           Data.Typeable (Typeable, Proxy(..), typeRep)-import           Control.Exception (try, throw, throwIO, evaluate)--import           Conferer.Source.Simple-import           Conferer.Types---- | Most Basic function to interact directly with a 'Config'. It always returns---   'Text' in the case of success and implements the logic to traverse---   sources inside the 'Config'.-getKey :: Key -> Config -> IO (Maybe Text)-getKey k config =-  go $ sources config ++ [mkPureMapSource (defaults config)]-  where-    go [] = return Nothing-    go (source:sources) = do-      res <- getKeyInSource source k-      case res of-        Just t -> return $ Just t-        Nothing -> go sources----- | 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'.------   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 =-  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-parent /. child = Path (unKey parent ++ unKey child)---- | The empty configuration, this 'Config' is used as the base for---   most config creating functions.-emptyConfig :: Config-emptyConfig = Config [] Map.empty--withDefaults :: [(Key, Text)] -> Config -> Config-withDefaults configMap config =-  config { defaults = Map.fromList configMap }---- | Instantiate a 'SourceCreator' using the 'emptyConfig'-mkStandaloneSource :: SourceCreator -> IO Source-mkStandaloneSource mkSource =-  mkSource emptyConfig----- | Instantiate a 'Source' using an 'SourceCretor' and a 'Config' and add---   to the config-addSource :: SourceCreator -> Config -> IO Config-addSource mkSource config = do-  newSource <- mkSource config-  return $-    config-    { sources = sources config ++ [ newSource ]-    }---- | Same as 'getKey' but it throws if the 'Key' isn't found-unsafeGetKey :: Key -> Config -> IO Text-unsafeGetKey key config =-  fromMaybe (throw $ FailedToFetchError key (typeRep (Proxy :: Proxy Text)))-    <$> getKey key config
+ src/Conferer/FromConfig.hs view
@@ -0,0 +1,43 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Public API module providing FromConfig functionality+module Conferer.FromConfig +  ( FromConfig(fromConfig)+  , fetchFromConfig+  , DefaultConfig(configDef)+  , fetchFromConfigWithDefault+  , fetchFromRootConfig+  , fetchFromRootConfigWithDefault++  , fetchFromConfigByIsString+  , fetchFromConfigByRead+  , fetchFromConfigWith+  , addDefaultsAfterDeconstructingToDefaults++  , MissingRequiredKey+  , throwMissingRequiredKey+  , missingRequiredKey++  , ConfigParsingError+  , throwConfigParsingError+  , configParsingError++  , Key+  , (/.)+  , File(..)+  , KeyLookupResult(..)+  , OverrideFromConfig(..)+  , overrideFetch++  , fetchFromDefaults+  , fetchRequiredFromDefaults+  ) where++import Conferer.FromConfig.Internal+import Conferer.Config.Internal.Types+import Conferer.Key
− src/Conferer/FromConfig/Basics.hs 
@@ -1,215 +0,0 @@-{-# 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 () where-  updateFromConfig key config _ = do-    return ()-  fetchFromConfig key config = do-    return $ Just ()--instance DefaultConfig () where-  configDef = ()--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
+ src/Conferer/FromConfig/Internal.hs view
@@ -0,0 +1,486 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: unstable+-- Portability: portable+--+-- Internal module providing FromConfig functionality+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module Conferer.FromConfig.Internal where++import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Control.Exception+import Data.Typeable+import Text.Read (readMaybe)+import Data.Dynamic+import GHC.Generics+import Data.Function ((&))++import Conferer.Key+import Conferer.Config.Internal.Types+import Conferer.Config.Internal+import qualified Data.Char as Char+import Control.Monad (forM)+import Data.Maybe (fromMaybe, mapMaybe)+import qualified System.FilePath as FilePath+import Data.List (nub, foldl', sort)+import Data.String (IsString(..))+import Data.Foldable (msum)++-- | The typeclass for defining the way to get values from a 'Config', hiding the+-- 'Text' based nature of the 'Conferer.Source.Source's and parse whatever value+-- as the types sees fit+--+-- Some of these instances are provided in different packages to avoid the heavy+-- dependencies.+--+-- It provides a reasonable default using 'Generic's so most of the time user need+-- not to implement this typeclass.+class FromConfig a where+  -- | This function uses a 'Config' and a scoping 'Key' to get a value.+  --+  -- Some conventions:+  --+  -- * When some 'Key' is missing this function should throw 'MissingRequiredKey'+  --+  -- * For any t it should hold that @fetchFromConfig k (config & addDefault k t) == t@+  -- meaning that a default on the same key with the right type should be used as a+  -- default and with no configuration that value should be returned+  --+  -- * Try desconstructing the value in as many keys as possible since is allows easier+  -- partial overriding.+  fromConfig :: Key -> Config -> IO a+  default fromConfig :: (Typeable a, Generic a, IntoDefaultsG (Rep a), FromConfigG (Rep a)) => Key -> Config -> IO a+  fromConfig key config = do+    let configWithDefaults = case fetchFromDefaults @a key config of+          Just d -> config & addDefaults (intoDefaultsG key $ from d)+          Nothing -> config+    to <$> fromConfigG key configWithDefaults++fetchFromConfig :: forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a+fetchFromConfig key config =+  case fetchFromDefaults @(OverrideFromConfig a) key config of+    Just (OverrideFromConfig fetch) ->+      fetch key $ removeDefault @(OverrideFromConfig a) key config+    Nothing ->+      fromConfig key config++-- | Utility only typeclass to smooth the naming differences between default values for+-- external library settings+--+-- This typeclass is not used internally it's only here for convinience for users+class DefaultConfig a where+  configDef :: a++instance {-# OVERLAPPABLE #-} Typeable a => FromConfig a where+  fromConfig = fetchRequiredFromDefaults++instance FromConfig () where+  fromConfig _key _config = return ()++instance FromConfig String where+  fromConfig = fetchFromConfigWith (Just . Text.unpack)++instance {-# OVERLAPPABLE #-} (Typeable a, FromConfig a) =>+    FromConfig [a] where+  fromConfig key config = do+    keysForItems <- getSubkeysForItems+    case keysForItems of+      Nothing -> do+        fetchRequiredFromDefaults @[a] key config+      Just subkeys -> do+        let configWithDefaults :: Config =+              case fetchFromDefaults @[a] key config of+                Just defaults ->+                  foldl' (\c (index, value) ->+                    c & addDefault (key /. "defaults" /. mkKey (show index)) value) config+                  $ zip [0 :: Integer ..] defaults+                Nothing -> config+        forM subkeys $ \k -> do+          fetchFromConfig @a (key /. k)+            (if isKeyPrefixOf (key /. "defaults") (key /. k)+              then+                configWithDefaults+              else+                configWithDefaults & addKeyMappings [(key /. k, key /. "prototype")])+    where+    getSubkeysForItems :: IO (Maybe [Key])+    getSubkeysForItems = do+      fetchFromConfig @(Maybe Text) (key /. "keys") config+        >>= \case+          Just rawKeys -> do+            return $+              Just $+              nub $+              filter (/= "") $+              mkKey .+              Text.unpack <$>+              Text.split (== ',') rawKeys+          Nothing -> do+            subelements <-+              sort+              . nub+              . filter (not . (`elem` ["prototype", "keys", "defaults"]))+              . mapMaybe (\k -> case rawKeyComponents <$> stripKeyPrefix key k of+                    Just (subkey:_) -> Just $ fromText subkey+                    _ -> Nothing)+              <$> listSubkeys key config+            return $ if null subelements then Nothing else Just subelements++instance FromConfig Int where+  fromConfig = fetchFromConfigByRead++instance FromConfig Integer where+  fromConfig = fetchFromConfigByRead++instance FromConfig Float where+  fromConfig = fetchFromConfigByRead++instance FromConfig BS.ByteString where+  fromConfig = fetchFromConfigWith (Just . Text.encodeUtf8)++instance FromConfig LBS.ByteString where+  fromConfig = fetchFromConfigWith (Just . LBS.fromStrict . Text.encodeUtf8)++instance forall a. (Typeable a, FromConfig a) => FromConfig (Maybe a) where+  fromConfig key config = do+    let+      configWithUnwrappedDefault =+        case fetchFromDefaults @(Maybe a) key config of+          Just (Just defaultThing) -> do+            config & addDefault key defaultThing+          _ -> do+            config+    (Just <$> fetchFromConfig @a key configWithUnwrappedDefault)+      `catch` (\(_e :: MissingRequiredKey) -> return Nothing)++instance FromConfig Text where+  fromConfig = fetchFromConfigWith Just++instance FromConfig Bool where+  fromConfig = fetchFromConfigWith parseBool++-- | A newtype wrapper for a 'FilePath' to allow implementing 'FromConfig'+-- with something better than just a 'String'+newtype File =+  File FilePath+  deriving (Show, Eq, Ord, Read)++unFile :: File -> FilePath+unFile (File f) = f++instance IsString File where+  fromString s = File s++instance FromConfig File where+  fromConfig key config = do+    let defaultPath = fetchFromDefaults @File key config++    filepath <- fetchFromConfig @(Maybe String) key config++    extension <- fetchFromConfig @(Maybe String) (key /. "extension") config+    dirname <- fetchFromConfig @(Maybe String) (key /. "dirname") config+    basename <- fetchFromConfig @(Maybe String) (key /. "basename") config+    filename <- fetchFromConfig @(Maybe String) (key /. "filename") config++    let+      constructedFilePath =+        applyIfPresent FilePath.replaceDirectory dirname+        $ applyIfPresent FilePath.replaceBaseName basename+        $ applyIfPresent FilePath.replaceExtension extension+        $ applyIfPresent FilePath.replaceFileName filename+        $ fromMaybe (unFile $ fromMaybe "" defaultPath) filepath+    if FilePath.isValid constructedFilePath+      then return $ File constructedFilePath+      else throwMissingRequiredKeys @String+        [ key+        , key /. "extension"+        , key /. "dirname"+        , key /. "basename"+        , key /. "filename"+        ]+    where+      applyIfPresent f maybeComponent =+        (\fp -> maybe fp (f fp) maybeComponent)++-- | Helper function to parse a 'Bool' from 'Text'+parseBool :: Text -> Maybe Bool+parseBool text =+  case Text.toLower text of+    "false" -> Just False+    "true" -> Just True+    _ -> Nothing++data OverrideFromConfig a =+  OverrideFromConfig (Key -> Config -> IO a)++-- | Allow the programmer to override this 'FromConfig' instance by providing+-- a special 'OverrideFromConfig' value.+--+-- To avoid infinite recursion we remove the Override before calling the value++-- | Helper function to implement fetchFromConfig using the 'Read' instance+fetchFromConfigByRead :: (Typeable a, Read a) => Key -> Config -> IO a+fetchFromConfigByRead = fetchFromConfigWith (readMaybe . Text.unpack)++-- | Helper function to implement fetchFromConfig using the 'IsString' instance+fetchFromConfigByIsString :: (Typeable a, IsString a) => Key -> Config -> IO a+fetchFromConfigByIsString = fetchFromConfigWith (Just . fromString . Text.unpack)++-- | Helper function to implement fetchFromConfig using some parsing function+fetchFromConfigWith :: forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO a+fetchFromConfigWith parseValue key config = do+  getKey key config >>=+    \case+      MissingKey k -> do+        throwMissingRequiredKeys @a k++      FoundInSources k value ->+        case parseValue value of+          Just a -> do+            return a+          Nothing -> do+            throwConfigParsingError @a k value++      FoundInDefaults k dynamics ->+        case fromDynamics dynamics of+          Just a -> do+            return a+          Nothing -> do+            throwMissingRequiredKeys @a [k]++fromDynamics :: forall a. Typeable a => [Dynamic] -> Maybe a+fromDynamics =+  msum . fmap (fromDynamic @a)++-- | Helper function does the plumbing of desconstructing a default into smaller+-- defaults, which is usefull for nested 'fetchFromConfig'.+addDefaultsAfterDeconstructingToDefaults+  :: forall a.+  Typeable a =>+  -- | Function to deconstruct the value+  (a -> [(Key, Dynamic)]) ->+  -- | Key where to look for the value+  Key ->+  -- | The config+  Config ->+  IO Config+addDefaultsAfterDeconstructingToDefaults destructureValue key config = do+  case fetchFromDefaults @a key config of+    Just value -> do+      let newDefaults =+            ((\(k, d) -> (key /. k, d)) <$> destructureValue value)+      return $+        addDefaults newDefaults config+    Nothing -> do+      return config++-- | Helper function to override the fetching function for a certain key.+--+-- This function creates a 'Dynamic' that when added to the defaults allows+-- overriding the default 'FromConfig' instance.+overrideFetch :: forall a. Typeable a => (Key -> Config -> IO a) -> Dynamic+overrideFetch f =+  toDyn @(OverrideFromConfig a) $ OverrideFromConfig f++-- | Exception to show that a value couldn't be parsed properly+data ConfigParsingError =+  ConfigParsingError Key Text TypeRep+  deriving (Typeable, Eq)++instance Exception ConfigParsingError+instance Show ConfigParsingError where+  show (ConfigParsingError key value aTypeRep) =+    concat+    [ "Couldn't parse value '"+    , Text.unpack value+    , "' from key '"+    , show key+    , "' as "+    , show aTypeRep+    ]++-- | Helper function to throw 'ConfigParsingError'+throwConfigParsingError :: forall a b. (Typeable a) => Key -> Text -> IO b+throwConfigParsingError key text =+  throwIO $ configParsingError @a  key text++-- | Helper function to create a 'ConfigParsingError'+configParsingError :: forall a. (Typeable a) => Key -> Text -> ConfigParsingError+configParsingError key text =+  ConfigParsingError key text $ typeRep (Proxy :: Proxy a)++-- | Exception to show that some non optional 'Key' was missing while trying+-- to 'fetchFromConfig'+data MissingRequiredKey =+  MissingRequiredKey [Key] TypeRep+  deriving (Typeable, Eq)++instance Exception MissingRequiredKey+instance Show MissingRequiredKey where+  show (MissingRequiredKey keys aTypeRep) =+    concat+    [ "Failed to get a '"+    , show aTypeRep+    , "' from keys: "+    , Text.unpack+      $ Text.intercalate ", "+      $ fmap (Text.pack . show)+      $ keys++    ]++-- | Simplified helper function to throw a 'MissingRequiredKey'+throwMissingRequiredKey :: forall t a. Typeable t => Key -> IO a+throwMissingRequiredKey key =+  throwMissingRequiredKeys @t [key]++-- | Simplified helper function to create a 'MissingRequiredKey'+missingRequiredKey :: forall t. Typeable t => Key -> MissingRequiredKey+missingRequiredKey key =+  missingRequiredKeys @t [key]++-- | Helper function to throw a 'MissingRequiredKey'+throwMissingRequiredKeys :: forall t a. Typeable t => [Key] -> IO a+throwMissingRequiredKeys keys =+  throwIO $ missingRequiredKeys @t keys++-- | Helper function to create a 'MissingRequiredKey'+missingRequiredKeys :: forall a. (Typeable a) => [Key] -> MissingRequiredKey+missingRequiredKeys keys =+  MissingRequiredKey keys (typeRep (Proxy :: Proxy a))++-- | Fetch from value from the defaults map of a 'Config' or else throw+fetchRequiredFromDefaults :: forall a. (Typeable a) => Key -> Config -> IO a+fetchRequiredFromDefaults key config =+  case fetchFromDefaults key config of+    Nothing -> do+      throwMissingRequiredKey @a key+    Just a ->+      return a++-- | Fetch from value from the defaults map of a 'Config' or else return a 'Nothing'+fetchFromDefaults :: forall a. (Typeable a) => Key -> Config -> Maybe a+fetchFromDefaults key config =+  getKeyFromDefaults key config+    >>= fromDynamics @a++-- | Same as 'fetchFromConfig' using the root key+fetchFromRootConfig :: forall a. (FromConfig a, Typeable a) => Config -> IO a+fetchFromRootConfig =+  fetchFromConfig ""++-- | Same as 'fetchFromConfig' but adding a user defined default before 'fetchFromConfig'ing+-- so it doesn't throw a MissingKeyError+fetchFromConfigWithDefault :: forall a. (Typeable a, FromConfig a) => Config -> Key -> a -> IO a+fetchFromConfigWithDefault config key configDefault =+  fetchFromConfig key (config & addDefault key configDefault)++-- | Same as 'fetchFromConfigWithDefault' using the root key+fetchFromRootConfigWithDefault :: forall a. (Typeable a, FromConfig a) => Config -> a -> IO a+fetchFromRootConfigWithDefault config configDefault =+  fetchFromRootConfig (config & addDefault "" configDefault)++-- | Purely 'Generic's machinery, ignore...+class FromConfigG f where+  fromConfigG :: Key -> Config -> IO (f a)++instance FromConfigG inner =>+    FromConfigG (D1 metadata inner) where+  fromConfigG key config = do+    M1 <$> fromConfigG key config++instance (FromConfigWithConNameG inner, Constructor constructor) =>+    FromConfigG (C1 constructor inner) where+  fromConfigG key config =+    M1 <$> fromConfigWithConNameG @inner (conName @constructor undefined) key config++-- | Purely 'Generic's machinery, ignore...+class FromConfigWithConNameG f where+  fromConfigWithConNameG :: String -> Key -> Config -> IO (f a)++instance (FromConfigWithConNameG left, FromConfigWithConNameG right) =>+    FromConfigWithConNameG (left :*: right) where+  fromConfigWithConNameG s key config = do+    leftValue <- fromConfigWithConNameG @left s key config+    rightValue <- fromConfigWithConNameG @right s key config+    return (leftValue :*: rightValue)++instance (FromConfigG inner, Selector selector) =>+    FromConfigWithConNameG (S1 selector inner) where+  fromConfigWithConNameG 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 Char.toLower $ Text.pack s+      scopedKey =+        case Text.stripPrefix prefix fieldName of+          Just stripped -> applyFirst Char.toLower stripped+          Nothing -> fieldName+    in M1 <$> fromConfigG @inner (key /. fromText scopedKey) config++instance (FromConfig inner, Typeable inner) => FromConfigG (Rec0 inner) where+  fromConfigG key config = do+    K1 <$> fetchFromConfig @inner key config++-- | Purely 'Generic's machinery, ignore...+class IntoDefaultsG f where+  intoDefaultsG :: Key -> f a -> [(Key, Dynamic)]++instance IntoDefaultsG inner =>+    IntoDefaultsG (D1 metadata inner) where+  intoDefaultsG key (M1 inner) =+    intoDefaultsG key inner++instance (IntoDefaultsWithConNameG inner, Constructor constructor) =>+    IntoDefaultsG (C1 constructor inner) where+  intoDefaultsG key (M1 inner) =+    intoDefaultsWithConNameG @inner (conName @constructor undefined) key inner++-- | Purely 'Generic's machinery, ignore...+class IntoDefaultsWithConNameG f where+  intoDefaultsWithConNameG :: String -> Key -> f a -> [(Key, Dynamic)]++instance (IntoDefaultsWithConNameG left, IntoDefaultsWithConNameG right) =>+    IntoDefaultsWithConNameG (left :*: right) where+  intoDefaultsWithConNameG s key (left :*: right) = do+    intoDefaultsWithConNameG @left s key left+    +++    intoDefaultsWithConNameG @right s key right++instance (IntoDefaultsG inner, Selector selector) =>+    IntoDefaultsWithConNameG (S1 selector inner) where+  intoDefaultsWithConNameG s key (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 Char.toLower $ Text.pack s+      scopedKey =+        case Text.stripPrefix prefix fieldName of+          Just stripped -> applyFirst Char.toLower stripped+          Nothing -> fieldName+    in intoDefaultsG @inner (key /. fromText scopedKey) inner++instance (Typeable inner) => IntoDefaultsG (Rec0 inner) where+  intoDefaultsG key (K1 inner) = do+    [(key, toDyn inner)]
+ src/Conferer/Key.hs view
@@ -0,0 +1,25 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Public API for Key related features+module Conferer.Key+  ( Key+  -- * Creating 'Key's+  , mkKey+  , fromText+  -- * Maniputaing 'Key's+  , (/.)+  , stripKeyPrefix+  , isKeyPrefixOf+  , isValidKeyFragment+  , isKeyCharacter+  -- * Introspecting 'Key's+  , rawKeyComponents+  , unconsKey+  ) where++import Conferer.Key.Internal
+ src/Conferer/Key/Internal.hs view
@@ -0,0 +1,103 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: unstable+-- Portability: portable+--+-- Internal module for Key related features+module Conferer.Key.Internal where++import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Function (on)+import Data.List (stripPrefix, isPrefixOf)+import qualified Data.Char as Char+-- | This type is used extensivelly as a way to point into a 'Conferer.Source.Source'+--   and in turn into a 'Conferer.Config.Config'. The intended way to create them is+--   is using 'mkKey'.+--+--   It's a list of alphanumeric words and each 'Conferer.Source.Source' can interpret+--   it as it sees fit.+newtype Key = Key+  { unKey :: [Text]+  } deriving (Eq, Ord)++instance Show Key where+  show key = "\"" ++ Text.unpack (keyName key) ++ "\""++instance IsString Key where+  fromString = mkKey++-- | Helper function to create 'Key's, this function always works, but+--   since 'Key's reject some string this function transforms the input+--   to provide lawful 'Key's instead of throwing.+--+--   For example:+--+--   > 'mkKey' "sOmE.KEy" == "some.key"+--   > 'mkKey' "1.key" == "1.key"+--   > 'mkKey' "1_thing.key" == "1thing.key"+--   > 'mkKey' "some....key" == "some.key"+--   > 'mkKey' ".." == ""+mkKey :: String -> Key+mkKey s =+  Key .+  filter (/= mempty) .+  fmap (Text.filter isKeyCharacter . Text.toLower) .+  Text.split (== '.') .+  fromString+  $ s++-- | Same as 'mkKey' but for 'Text'+fromText :: Text -> Key+fromText = mkKey . Text.unpack++-- | Collapse a key into a textual representation+keyName :: Key -> Text+keyName = Text.intercalate "." . unKey++-- | This function tells if a key is a subkey of another key based+--   using key fragments instead of letters as units+--+-- > 'isKeyPrefixOf' "foo" "foo.bar" == True+-- > 'isKeyPrefixOf' "foo" "foo" == True+-- > 'isKeyPrefixOf' "foo" "fooa" == False+isKeyPrefixOf :: Key -> Key -> Bool+isKeyPrefixOf = isPrefixOf `on` unKey++-- | Given k1 and k2 this function drops k1 as a prefix from k2, if+--   k1 is not a prefix of k2 it returns 'Nothing'+--+-- > 'keyPrefixOf' "foo" "foo.bar" == Just "bar"+-- > 'keyPrefixOf' "foo" "foo" == Just ""+-- > 'keyPrefixOf' "foo" "fooa" == Nothing+-- > 'keyPrefixOf' "" k == Just k+stripKeyPrefix :: Key -> Key -> Maybe Key+stripKeyPrefix key1 key2 = Key <$> (stripPrefix `on` unKey) key1 key2++-- | Concatenate two keys+(/.) :: Key -> Key -> Key+parent /. child = Key (unKey parent ++ unKey child)++-- | Get raw components from a key, usually to do some manipulation+rawKeyComponents :: Key -> [Text]+rawKeyComponents = unKey++-- | Get first component of a key and the rest of the key+unconsKey :: Key -> Maybe (Text, Key)+unconsKey (Key []) = Nothing+unconsKey (Key (k:ks)) = Just (k, Key ks)++-- | Check if a 'Text' is a valid fragment of a 'Key', meaning+-- that each character 'isKeyCharacter'+isValidKeyFragment :: Text -> Bool+isValidKeyFragment t =+  (not $ Text.null t) && Text.all isKeyCharacter t++-- | Checks if the given 'Char' is a valid for a 'Key'.+-- Meaning it is a lower case ascii letter or a number.+isKeyCharacter :: Char -> Bool+isKeyCharacter c =+  Char.isAsciiLower c || Char.isDigit c
+ src/Conferer/Source.hs view
@@ -0,0 +1,18 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Public API module for Source related features+module Conferer.Source+  ( Source(..)+  , IsSource(..)+  , SourceCreator+  , module Conferer.Key+  ) where++import Conferer.Key+import Conferer.Config.Internal.Types+import Conferer.Source.Internal
src/Conferer/Source/CLIArgs.hs view
@@ -1,43 +1,76 @@-module Conferer.Source.CLIArgs-  (-    -- * Command line arguments Source-    -- | This source provides keys from the command line arguments passed into-    -- the program. It only accepts arguments with @--@ and an equals, for-    -- example: @./awesomeapp --warp.port=5000@-    mkCLIArgsSource-    , mkCLIArgsSource'-    , parseArgsIntoKeyValue-  )-where+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Command line arguments based source+module Conferer.Source.CLIArgs where -import           Data.Text (Text)+import Data.Text (Text) import qualified Data.Text as Text-import           Data.Maybe (mapMaybe)-import           Data.String (fromString)-import           System.Environment (getArgs)+import Data.Maybe (mapMaybe)+import System.Environment (getArgs) -import Conferer.Types-import Conferer.Source.Simple+import Conferer.Source+import qualified Conferer.Source.InMemory as InMemory  --- | Create a 'SourceCreator' for CLIArgs from a argument list-mkCLIArgsSource' :: [String] -> SourceCreator-mkCLIArgsSource' args = \config -> do-  let configMap = parseArgsIntoKeyValue args-  mkMapSource configMap config+-- | This source provides keys from the command line arguments passed into+-- the program. It only accepts arguments with @--@ and an equals, for+-- example: @./awesomeapp --warp.port=5000@+data CLIArgsSource =+  CLIArgsSource+  { originalCliArgs :: RawCLIArgs+  , innerSource :: Source+  } deriving (Show) --- | Same as 'mkCLIArgsSource'' but using 'getArgs' to provide the argument--- list-mkCLIArgsSource :: SourceCreator-mkCLIArgsSource = \config -> do+-- | Type alias for cli args+type RawCLIArgs = [String]++instance IsSource CLIArgsSource where+  getKeyInSource CLIArgsSource{..} key = do+    getKeyInSource innerSource key+  getSubkeysInSource CLIArgsSource{..} key = do+    getSubkeysInSource innerSource key+++-- | Create a 'SourceCreator' using 'fromEnv'+fromConfig :: SourceCreator+fromConfig = \_config ->+  fromEnv++-- | Create a 'Source' using 'fromArgs' but using real cli args+fromEnv :: IO Source+fromEnv = do   args <- getArgs-  mkCLIArgsSource' args config+  return $ fromArgs args +-- | Create a 'Source' using cli args passed as parameter+fromArgs :: RawCLIArgs -> Source+fromArgs originalCliArgs =+  let configMap = parseArgsIntoKeyValue originalCliArgs+      innerSource = InMemory.fromAssociations configMap+  in Source $ CLIArgsSource {..}+ -- | Parse an argument list into a dictionary suitable for a 'Source' parseArgsIntoKeyValue :: [String] -> [(Key, Text)] parseArgsIntoKeyValue =-  fmap (\(k, s) -> (fromString $ Text.unpack k, s)) .-  fmap (\s -> fmap (Text.drop 1) $ Text.breakOn "=" s).+  fmap (\s ->+    let (k, rawValue) = Text.breakOn "=" s+    in case Text.uncons rawValue of+         Nothing -> (fromText k, "true")+         (Just ('=', v)) -> (fromText k, v)+         -- Since rawValue comes from breaking on "=" the first character+         -- should always be '=' or none at all+         (Just (_, _)) ->+            error $ unlines+              [ "'"+              , Text.unpack rawValue+              , "' should always start with '='"+              ]+    ) .   mapMaybe (Text.stripPrefix "--") .   takeWhile (/= "--") .   fmap Text.pack
src/Conferer/Source/Env.hs view
@@ -1,67 +1,84 @@-module Conferer.Source.Env-  (--- * Env Source--- | This 'Source' provides config values from env vars given a prefix that's--- used to avoid colliding with different system configuration------ For example if you use the 'Prefix' "awesomeapp" and get the 'Key'--- "warp.port" this source will try to lookup the env var called--- @AWESOMEAPP_WARP_PORT@.---- * Usage--- | To use this source simply choose a prefix and add it using the--- 'addSource' function like:+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable ----- @--- config & 'addSource' ('mkEnvSource' "awesomeapp")--- @-    mkEnvSource-    , mkEnvSource'-    , Prefix-    , LookupEnvFunc-    , keyToEnvVar-  ) where-+-- Environment based source+{-# LANGUAGE RecordWildCards #-}+module Conferer.Source.Env where -import           Data.Text (Text)+import Data.Text (Text) import qualified Data.Text as Text import qualified System.Environment as System+import Data.Maybe (mapMaybe) -import           Conferer.Types+import Conferer.Source+import qualified Conferer.Source.InMemory as InMemory --- | 'SourceCreator' for env 'Source' that uses the real 'System.lookupEnv'--- function-mkEnvSource :: Prefix -> SourceCreator-mkEnvSource prefix =-  mkEnvSource' System.lookupEnv prefix+-- | Source that interfaces with the environment transforming keys+-- by uppercasing and interspersing underscores, and using a prefix+-- to avoid clashing with system env vars+--+-- so with "app" prefix, @"some.key"@ turns into @APP_SOME_KEY@+data EnvSource =+  EnvSource+  { environment :: RawEnvironment+  , keyPrefix :: Prefix+  , innerSource :: Source+  } deriving (Show) --- | 'SourceCreator' for env 'Source' that allows parameterizing the--- function used to lookup for testing-mkEnvSource' :: LookupEnvFunc -> Prefix -> SourceCreator-mkEnvSource' lookupEnv prefix = \_config ->-  return $-  Source-  { getKeyInSource = \k -> do-      let envVarName = Text.unpack $ keyToEnvVar prefix k-      fmap Text.pack <$> lookupEnv envVarName-  }+-- | Type alias for the environment+type RawEnvironment = [(String, String)] --- | Type alias for the function to lookup env vars-type LookupEnvFunc = String -> IO (Maybe String)+-- | Type alias for the env vars prefix+type Prefix = Text +instance IsSource EnvSource where+  getKeyInSource EnvSource{..} key = do+    getKeyInSource innerSource key+  getSubkeysInSource EnvSource{..} key = do+    getSubkeysInSource innerSource key --- | A text to namespace env vars-type Prefix = Text+-- | Create a 'SourceCreator' using 'fromEnv'+fromConfig :: Prefix -> SourceCreator+fromConfig prefix _config = do+  fromEnv prefix +-- | Create a 'Source' using the real environment+fromEnv :: Prefix -> IO Source+fromEnv prefix = do+  rawEnvironment <- System.getEnvironment+  return $ fromEnvList rawEnvironment prefix++-- | Create a 'Source' using a hardcoded list of env vars+fromEnvList :: RawEnvironment -> Prefix -> Source+fromEnvList environment keyPrefix =+  let+    mappings =+      mapMaybe (\(key, v) -> do+        k <- envVarToKey keyPrefix $ Text.pack key+        return (k, Text.pack v)+      )+      environment+    innerSource = InMemory.fromAssociations mappings+  in Source EnvSource {..}+ -- | Get the env name from a prefix and a key by uppercasing and -- intercalating underscores------ >>> keyToEnVar "awesomeapp" "warp.port"--- "AWESOMEAPP_WARP_PORT" keyToEnvVar :: Prefix -> Key -> Text-keyToEnvVar prefix (Path keys) =+keyToEnvVar prefix keys =   Text.toUpper   $ Text.intercalate "_"   $ filter (/= mempty)-  $ prefix : keys+  $ prefix : rawKeyComponents keys++-- | The opossite of 'keyToEnvVar'+envVarToKey :: Prefix -> Text -> Maybe Key+envVarToKey prefix envVar =+  let+    splitEnvVar = fromText $ Text.replace "_"  "." envVar+  in+    stripKeyPrefix (fromText prefix) splitEnvVar
src/Conferer/Source/Files.hs view
@@ -1,21 +1,25 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Public API module providing some helper functions related to files+{-# LANGUAGE TypeApplications #-} module Conferer.Source.Files where -import qualified Data.Text as Text-import           Data.Maybe (fromMaybe)--import           Conferer.Types-import           Conferer.FromConfig.Basics ()+import Data.Maybe (fromMaybe)+import System.FilePath -fromRight :: a -> Either e a -> a-fromRight a (Left _) = a-fromRight _ (Right a) = a+import Conferer.Config+import Conferer.FromConfig -getFilePathFromEnv :: Config -> String -> IO FilePath-getFilePathFromEnv config extension = do-  env <- updateFromConfig "env" config "development"-  return $ mconcat-    [ "config/"-    , Text.unpack env-    , "."-    , extension-    ]+-- | Helper function to get a file from the config specifying the extension and using+-- current env+getFilePathFromEnv :: Key -> String -> Config -> IO FilePath+getFilePathFromEnv key extension config = do+  env <- fromMaybe "development" <$> fetchFromConfig @(Maybe String) "env" config+  let defaultPath = "config" </> env <.> extension+  File filepath <- fetchFromConfigWithDefault @File config key $ File defaultPath+  return filepath
+ src/Conferer/Source/InMemory.hs view
@@ -0,0 +1,44 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- In memory source mostly used for testing+{-# LANGUAGE RecordWildCards #-}+module Conferer.Source.InMemory where++import Data.Map (Map)+import qualified Data.Map as Map+import Data.Text (Text)++import Conferer.Source++-- | A 'Source' mostly use for mocking which is configured directly using a+-- 'Map'+newtype InMemorySource =+  InMemorySource+  { configMap :: Map Key Text+  } deriving (Show, Eq)++instance IsSource InMemorySource where+  getKeyInSource InMemorySource {..} key =+    return $ Map.lookup key configMap+  getSubkeysInSource InMemorySource {..} key = do+    return $ filter (\k -> key `isKeyPrefixOf` k && key /= k) $ Map.keys configMap++-- | Create a 'SourceCreator' from a list of associations+fromConfig :: [(Key, Text)] -> SourceCreator+fromConfig configMap _config =+  return $ fromAssociations configMap++-- | Create a 'Source' from a 'Map'+fromMap :: Map Key Text -> Source+fromMap configMap =+  Source . InMemorySource $ configMap++-- | Create a 'Source' from a list of associations+fromAssociations :: [(Key, Text)] -> Source+fromAssociations =+  fromMap . Map.fromList
+ src/Conferer/Source/Internal.hs view
@@ -0,0 +1,35 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: unstable+-- Portability: portable+--+-- Internal module for Key related features+{-# LANGUAGE ExistentialQuantification #-}+module Conferer.Source.Internal where++import Data.Text (Text)+import Conferer.Key (Key)++-- | Concrete type for 'IsSource'+data Source = forall s. (IsSource s, Show s) => Source s++instance Show Source where+  show (Source s) = "Source " ++ show s++-- | Main interface for interacting with external systems that provide configuration+-- which will be used by 'Conferer.FromConfig.FromConfig' to fetch values.+class IsSource s where+  -- | This function is used by the 'Conferer.Config.Config' to get values from this+  -- 'Source'.+  getKeyInSource :: s ->  Key -> IO (Maybe Text)+  -- | This function is used by the 'Conferer.Config.Config' to list possible values+  -- from the 'Source' that if the user 'getKeyInSource', it will be found.+  getSubkeysInSource :: s -> Key -> IO [Key]++instance IsSource Source where+  getKeyInSource (Source source) =+    getKeyInSource source+  getSubkeysInSource (Source source) =+    getSubkeysInSource source
− src/Conferer/Source/Mapping.hs 
@@ -1,34 +0,0 @@-module Conferer.Source.Mapping-  (-    -- * Namespaced higher-order source-    -- | This source takes a source and returns a new source that-    -- always transforms the key according to either a function for-    -- 'mkMappingSource'' or a 'Map' for 'mkMappingSource'-    mkMappingSource-    , mkMappingSource'-  )-where--import           Data.Map (Map)-import qualified Data.Map as Map--import           Conferer.Types---- | Create a 'SourceCreator' using a function to transform the supplied keys--- and another 'SourceCreator'-mkMappingSource' :: (Key -> Maybe Key) -> SourceCreator -> SourceCreator-mkMappingSource' mapper sourceCreator config = do-  configSource <- sourceCreator config--  return $ Source-    { getKeyInSource = \k -> do-        case mapper k of-          Just newKey -> getKeyInSource configSource newKey-          Nothing -> return Nothing-    }---- | Create a 'SourceCreator' using a 'Map' 'Key' 'Key' to transform the supplied keys--- and another 'SourceCreator'-mkMappingSource :: Map Key Key -> SourceCreator -> SourceCreator-mkMappingSource configMap configSource =-  mkMappingSource' (`Map.lookup` configMap) configSource
src/Conferer/Source/Namespaced.hs view
@@ -1,23 +1,43 @@-module Conferer.Source.Namespaced-  (-    -- * Namespaced higher-order source-    -- | This source takes a source and returns a new source that-    -- always checks that the 'Key' given always starts with certain 'Key'-    -- and then strips that prefix before consulting its inner Source-    mkNamespacedSource-  ) where+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Source that namespaces an inner source+{-# LANGUAGE RecordWildCards #-}+module Conferer.Source.Namespaced where -import           Data.List (stripPrefix)+import Conferer.Source -import           Conferer.Types+-- | This source takes a source and returns a new source that+-- always checks that the 'Key' given always starts with certain 'Key'+-- and then strips that prefix before consulting its inner Source+data NamespacedSource =+  NamespacedSource+  { scopeKey :: Key+  , innerSource :: Source+  } deriving (Show) +instance IsSource NamespacedSource where+  getKeyInSource NamespacedSource{..} key = do+    case stripKeyPrefix scopeKey key of+      Just innerKey -> getKeyInSource innerSource innerKey+      Nothing -> return Nothing+  getSubkeysInSource NamespacedSource{..} key = do+    case stripKeyPrefix scopeKey key of+      Just innerKey -> do+        fmap (scopeKey /.) <$> getSubkeysInSource innerSource innerKey+      Nothing -> return []+ -- | Create a 'SourceCreator' from a prefix and another 'SourceCreator'-mkNamespacedSource :: Key -> SourceCreator -> SourceCreator-mkNamespacedSource (Path key) configCreator = \config -> do-  configSource <- configCreator config-  return $ Source-    { getKeyInSource = \(Path k) -> do-        case stripPrefix key k of-          Just newKey -> getKeyInSource configSource (Path newKey)-          Nothing -> return Nothing-    }+fromConfig :: Key -> SourceCreator -> SourceCreator+fromConfig scopeKey configCreator = \config -> do+  innerSource <- configCreator config+  return $ fromInner scopeKey innerSource++-- | Create a 'Source' from a prefix and another 'Source'+fromInner :: Key -> Source -> Source+fromInner scopeKey innerSource = do+  Source $ NamespacedSource{..}
src/Conferer/Source/Null.hs view
@@ -1,18 +1,32 @@-module Conferer.Source.Null-  (-    -- * Does Nothing Source-    -- | The stub source that never has a key-    mkNullSource-  )-where+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Do nothing source+module Conferer.Source.Null where -import           Conferer.Types+import Conferer.Source --- | Create a null 'Source'-mkNullSource :: SourceCreator-mkNullSource _config =-  return $ Source-  { getKeyInSource =-      \_k -> do-        return Nothing-  }+-- | Stub source that has no keys+data NullSource =+  NullSource+  deriving (Show, Eq)++instance IsSource NullSource where+  getKeyInSource _source _key =+    return Nothing+  getSubkeysInSource _source _key =+    return []++-- | Create 'SourceCreator'+fromConfig :: SourceCreator+fromConfig _config =+  return empty++-- | Create a 'Source'+empty :: Source+empty =+  Source $ NullSource
src/Conferer/Source/PropertiesFile.hs view
@@ -1,44 +1,74 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Properties file source module Conferer.Source.PropertiesFile where -import           Data.Text (Text)-import           Data.Function ((&))-import           System.Directory (doesFileExist)-import           Data.Maybe (catMaybes)+import Data.Text (Text)+import Data.Function ((&))+import System.Directory (doesFileExist)+import Data.Maybe (catMaybes) import qualified Data.Text as Text import qualified Data.Text.IO as Text -import           Conferer.Types-import           Conferer.Source.Files-import           Conferer.Source.Null-import           Conferer.Source.Simple+import Conferer.Source+import Conferer.Source.Files+import qualified Conferer.Source.Null as Null+import qualified Conferer.Source.InMemory as InMemory --- | 'SourceCreator' for properties file 'Source' that read from a--- config file in @config/{env}.properties@ and parses it as a properties--- file with @some.key=a value@ lines-mkPropertiesFileSource :: SourceCreator-mkPropertiesFileSource = \config -> do-  filePath <- getFilePathFromEnv config "properties"+-- | 'Source' that uses a config file in @config/{env}.properties@ and+-- parses it as a properties file with @some.key=a value@ lines+data PropertiesFileSource =+  PropertiesFileSource+  { originalFilePath :: FilePath+  , innerSource :: Source+  } deriving (Show)++instance IsSource PropertiesFileSource where+  getKeyInSource PropertiesFileSource{..} key = do+    getKeyInSource innerSource key+  getSubkeysInSource PropertiesFileSource{..} key = do+    getSubkeysInSource innerSource key++-- | Create a 'SourceCreator' using 'getFilePathFromEnv' to get the path to file+-- and 'fromFilePath'+fromConfig :: Key -> SourceCreator+fromConfig key config = do+  filePath <- getFilePathFromEnv key "properties" config+  fromFilePath' filePath++-- | Create a 'SourceCreator' reading the file and using that as a properties file, but+-- if the file doesn't exist do nothing.+fromFilePath :: FilePath -> SourceCreator+fromFilePath filepath _config =+  fromFilePath' filepath++-- | Create a 'Source' reading the file and using that as a properties file, but+-- if the file doesn't exist do nothing.+fromFilePath' :: FilePath -> IO Source+fromFilePath' filePath = do   fileExists <- doesFileExist filePath   if fileExists     then do       fileContent <- Text.readFile filePath-      mkPropertiesFileSource' fileContent config-    else do-      mkNullSource config----- | 'SourceCreator' for properties file 'Source' that only parses a--- given 'Text' as a properties file-mkPropertiesFileSource' :: Text -> SourceCreator-mkPropertiesFileSource' fileContent =-  \config -> do-    let keyValues =-          fileContent-          & Text.lines-          & fmap lineToKeyValue-          & catMaybes-    mkMapSource keyValues config+      return $ fromFileContent filePath fileContent+    else+      return Null.empty +-- | Create a 'Source' using some content as a properties file+fromFileContent :: FilePath -> Text -> Source+fromFileContent originalFilePath fileContent =+  let keyValues =+        fileContent+        & Text.lines+        & fmap lineToKeyValue+        & catMaybes+      innerSource = InMemory.fromAssociations keyValues+  in Source $ PropertiesFileSource {..}  -- | Transform a line into a key/value pair (or not) lineToKeyValue :: Text -> Maybe (Key, Text)@@ -47,7 +77,7 @@   & (\(rawKey, rawValue) ->       case Text.stripPrefix "=" rawValue of         Just value ->-          Just (Path $ Text.splitOn "." rawKey, value)+          Just (fromText rawKey, value)         Nothing ->           Nothing     )
− src/Conferer/Source/Simple.hs 
@@ -1,34 +0,0 @@-module Conferer.Source.Simple-  (-    -- * Simple Source-    -- | This source provides values from a hardcoded Map passed at creation-    -- time that can not be changed afterwards, it's mostly used as a necessary-    -- utility-    mkMapSource-  , mkMapSource'-  , mkPureMapSource-  ) where--import           Data.Map (Map)-import qualified Data.Map as Map-import           Data.Text (Text)--import           Conferer.Types---- | Make a 'SourceCreator' from a 'Map'-mkMapSource' :: Map Key Text -> SourceCreator-mkMapSource' configMap _config =-  return $ mkPureMapSource configMap---- | Make a 'Source' from a 'Map'-mkPureMapSource :: Map Key Text -> Source-mkPureMapSource configMap =-  Source-    { getKeyInSource =-      \k -> do-        return $ Map.lookup k configMap-    }---- | Make a 'Source' from 'List' of 'Key', 'Text' pairs-mkMapSource :: [(Key, Text)] -> SourceCreator-mkMapSource = mkMapSource' . Map.fromList
+ src/Conferer/Test.hs view
@@ -0,0 +1,24 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Some testing utilities+module Conferer.Test+  ( configWith+  ) where++import Conferer.Config+import qualified Conferer.Source.InMemory as InMemory+import Data.Text (Text)+import Data.Dynamic++-- | Create a Config mostly used for testing 'Conferer.FromConfig.FromConfig'+--   instances without having to create a full config+configWith :: [(Key, Dynamic)] -> [(Key, Text)] -> IO Config+configWith defaults keyValues =+  emptyConfig +  & addDefaults defaults+  & addSource (InMemory.fromConfig keyValues)
− src/Conferer/Types.hs 
@@ -1,118 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators #-}-module Conferer.Types where--import           Data.String-import           Data.Text (Text)-import qualified Data.Text as Text-import           Data.Map (Map)-import qualified Data.Map as Map-import           Control.Exception-import           Data.Typeable-import           GHC.Generics---- | Core interface for library provided configuration, basically consists of---   getting a 'Key' and informing returning a maybe signaling the value and---   if it's present in that specific source-data Source =-  Source-  { getKeyInSource :: Key -> IO (Maybe Text)-  }---- | The way to index 'Source's, basically list of names that will be adapted---   to whatever the source needs-newtype Key-  = Path { unKey :: [Text] }-  deriving (Show, Eq, Ord)--instance IsString Key where-  fromString s = Path $ filter (/= mempty) $ Text.split (== '.') $ fromString s---- | Collapse a key into a textual representation-keyName :: Key -> Text-keyName = Text.intercalate "." . unKey---- | Core type that the user of this library interact with, in the future it may---   contain more this besides a list of sources-data Config =-  Config-  { sources :: [Source]-  , defaults :: Map Key Text-  }---- | The type for creating a source given a 'Config', some sources require a--- certain configuration to be initialized (for example: the redis source--- needs connection info to connect to the server)-type SourceCreator = Config -> IO Source--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 DefaultConfig a where-  configDef :: a---- | Main typeclass for defining the way to get values from config, hiding the--- 'Text' based nature of the 'Source'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--- '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 FromConfig a where-  updateFromConfig :: 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 FromConfigG f where-  updateFromConfigG :: Key -> Config -> f a -> IO (f a)-  fetchFromConfigG :: Key -> Config -> IO (Maybe (f a))--data ConfigParsingError =-  ConfigParsingError Key Text TypeRep-  deriving (Typeable, Eq)--instance Show ConfigParsingError where-  show (ConfigParsingError key value typeRep) =-    concat-    [ "Couldn't parse value '"-    , Text.unpack value-    , "' from key '"-    , Text.unpack (keyName key)-    , "' as "-    , show typeRep-    ]--instance Exception ConfigParsingError--data FailedToFetchError =-  FailedToFetchError Key TypeRep-  deriving (Typeable, Eq)--instance Show FailedToFetchError where-  show (FailedToFetchError key typeRep) =-    concat-    [ "Couldn't get a "-    , show typeRep-    , " from key '"-    , Text.unpack (keyName key)-    , "'"-    ]--instance Exception FailedToFetchError
+ test/Conferer/ConfigSpec.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE TypeApplications #-}+module Conferer.ConfigSpec where++import Test.Hspec+import Data.Text (Text)+import Data.Dynamic++import Conferer.Config+import Conferer.Source.InMemory+import Conferer.FromConfig.Internal (fromDynamics)++missingKey :: Key -> KeyLookupResult -> Bool +missingKey expectedKey (MissingKey k) = [expectedKey] == k+missingKey _ _ = False++foundInSources :: Key -> Text -> KeyLookupResult -> Bool +foundInSources expectedKey expected (FoundInSources k t) =  +  expected == t && expectedKey == k+foundInSources _keyExpected _expected _ =  +  False++foundInDefaults :: forall expected. (Eq expected, Typeable expected)+  => Key -> expected -> KeyLookupResult -> Bool +foundInDefaults expectedKey expected (FoundInDefaults k d) =  +  Just expected == fromDynamics @expected d && expectedKey == k+foundInDefaults _expctedKey _expected _ =  +  False++spec :: Spec+spec = do+  describe "Config" $ do+    let mkConfig keyMappings defaults content = +          pure (emptyConfig+                  & addKeyMappings keyMappings+                  & addDefaults defaults)+              >>= addSource (fromConfig content)+    describe "#getKey" $ do+      it "getting a non existent key returns missing key" $ do+        c <- mkConfig [] [] []+        res <- getKey "aaa" c+        res `shouldSatisfy` missingKey "aaa"++      it "getting a key only present in the defaults" $ do+        c <- mkConfig [] [("some.key", toDyn @Int 1)] []+        res <- getKey "some.key" c+        res `shouldSatisfy` foundInDefaults "some.key" (1 :: Int)++      context "with multiple sources and defaults" $ do+        let mkConfig' defaults sourceWithPriority otherSource =+              pure (emptyConfig+                & addDefaults defaults)+              >>= addSource (fromConfig sourceWithPriority)+              >>= addSource (fromConfig otherSource)++        it "getting an key returns unwraps the original map" $ do+          c <- mkConfig' [] [] [("some.key", "1")]+          res <- getKey "some.key" c+          res `shouldSatisfy` foundInSources "some.key" "1"++        it "getting an existent key returns in the bottom maps gets it" $ do+          c <- mkConfig' [] [("some.key", "2")] [("some.key", "1")]+          res <- getKey "some.key" c+          res `shouldSatisfy` foundInSources "some.key" "2"+      describe "with some key mapping" $ do+        context "with basic one to one mapping" $ +          it "gets the value through a mapping" $ do+            c <- mkConfig+                  [ ("something", "server") ]+                  []+                  [ ("server", "aaa") ]+            res <- getKey "something" c+            res `shouldSatisfy` foundInSources "server" "aaa"+        context "with a nested key mapping" $ do+          it "goes through all the mappings and gets the right value" $ do+            c <- mkConfig+                  [ ("something", "else")+                  , ("else", "server")+                  ]+                  []+                  [ ("server", "aaa")+                  ]+            res <- getKey "something" c+            res `shouldSatisfy` foundInSources "server" "aaa"+        context "with circular mappings" $ do+          it "gets the first key" $ do+            c <- mkConfig+                  [ ("a", "b")+                  , ("b", "a")+                  , ("b", "c")+                  ]+                  []+                  [ ("c", "aaa")+                  ]+            res <- getKey "a" c+            res `shouldSatisfy` foundInSources "c" "aaa"+        context "with nested key" $ do+          it "maps the right upper key" $ do+            c <- mkConfig+                  [ ("a", "b")+                  ]+                  []+                  [ ("b.k", "aaa")+                  ]+            res <- getKey "a.k" c+            res `shouldSatisfy` foundInSources "b.k" "aaa"+        context "with some defaults" $ do+          it "maps and allows getting the default" $ do+            c <- mkConfig+                  [ ("a", "b")+                  ]+                  [ ("b", toDyn False)+                  ]+                  []+            res <- getKey "a" c+            res `shouldSatisfy` foundInDefaults "a" False+    describe "#listSubkeys" $ do+      it "return an empty list when nothing is configured" $ do+        c <- mkConfig [] [] []+        res <- listSubkeys "some" c+        res `shouldBe` []+      context "with some values in the config" $ do+        it "when nothing is configured" $ do+          c <- mkConfig [] [] [("some.key", "")]+          res <- listSubkeys "some" c+          res `shouldBe` ["some.key"]+      context "with a config that has a value configured and \+              \we get that same value" $ do+        it "returns that key in the list of subkeys" $ do+          c <- mkConfig [] [] [("some", "")]+          res <- listSubkeys "some" c+          res `shouldBe` []+      context "with a config that has a value configured but \+              \we get a different value" $ do+        it "returns an empty list" $ do+          c <- mkConfig [] [] [("some", "")]+          res <- listSubkeys "other" c+          res `shouldBe` []+      context "with a config with defaults" $ do+        it "returns those defaults in the list" $ do+          c <- mkConfig [] [("some.key", toDyn @Int 7)] []+          res <- listSubkeys "some" c+          res `shouldBe` ["some.key"]+      context "with configs in both defaults and sources" $ do+        it "returns both results combined" $ do+          c <- mkConfig [] [("some.key", toDyn @Int 7)] [("some.other", "")]+          res <- listSubkeys "some" c+          res `shouldBe` ["some.key", "some.other"]+      context "mappings" $ do+        context "with a simple mapping and a configured value" $ do+          it "returns the keys that are present based on the mapping" $ do+            c <- mkConfig+                  [ ("a", "b")+                  ]+                  []+                  [ ("b.k", "aaa")+                  ]+            res <- listSubkeys "a" c+            res `shouldBe` ["a.k"]+        context "with a multiple mappings and a configured value" $ do+          it "returns the right keys" $ do+            c <- mkConfig+                  [ ("a", "b")+                  , ("b", "c")+                  ]+                  []+                  [ ("c.k", "aaa")+                  ]+            res <- listSubkeys "a" c+            res `shouldBe` ["a.k"]+        context "with circular mappings" $ do+          it "returns the right keys" $ do+            c <- mkConfig+                  [ ("a", "b")+                  , ("b", "a")+                  ]+                  []+                  [ ("a.k", "aaa")+                  ]+            res <- listSubkeys "a" c+            res `shouldBe` ["a.k"]+        context "with reducing mappings" $ do+          xit "returns the right keys" $ do+            c <- mkConfig+                  [ ("a.k", "a")+                  ]+                  []+                  [ ("a.k", "aaa")+                  ]+            res <- listSubkeys "a" c+            -- getKey "a.k.k" c >>= print+            res `shouldBe` ["a.k", "a.k.k"]+        it "keys that are present based on the mapping" $ do+            c <- mkConfig+                  [ ("a", "b")+                  ]+                  [ ("b.k", toDyn @String "aaa")+                  ]+                  [ ]+            res <- listSubkeys "a" c+            res `shouldBe` ["a.k"]++    describe "#addDefaults" $ do+      context "with multiple defaults on the same key" $ do+        it "the last one has more priority" $ do+          let c = emptyConfig+                & addDefaults+                  [ ("some.key", toDyn @Int 1)+                  , ("some.key", toDyn @Int 2)+                  ]+          res <- getKey "some.key" c+          res `shouldSatisfy` foundInDefaults "some.key" (2 :: Int)
− test/Conferer/FromConfig/BasicsSpec.hs 
@@ -1,88 +0,0 @@-{-# 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 & addSource (mkMapSource 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
+ test/Conferer/FromConfig/BoolSpec.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.BoolSpec (spec) where++import Test.Hspec+import Conferer.FromConfig.Extended++spec :: Spec+spec = do+  context "Basic fetching" $ do+    describe "fetching a Bool from config" $ do+      ensureEmptyConfigThrows @Bool++      ensureUsingDefaultReturnsSameValue @Bool True+      ensureUsingDefaultReturnsSameValue @Bool False++      ensureSingleConfigParsesTheRightThing @Bool "true" True+      ensureSingleConfigParsesTheRightThing @Bool "false" False++      context "parsing is case insensitive" $ do+        ensureSingleConfigParsesTheRightThing @Bool "faLSe" False+        ensureSingleConfigParsesTheRightThing @Bool "TRUE" True++      ensureSingleConfigThrowsParserError @Bool "nope"
+ test/Conferer/FromConfig/Extended.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.Extended+  ( module Conferer.FromConfig+  , module GHC.Generics+  , configWith+  , anyConfigParserError+  , aConfigParserError+  , aMissingRequiredKey+  , aMissingRequiredKeys+  , ensureEmptyConfigThrows+  , ensureUsingDefaultReturnsSameValue+  , ensureSingleConfigParsesTheRightThing+  , ensureSingleConfigThrowsParserError+  , ensureSingleConfigThrows+  , ensureFetchParses+  , ensureFetchThrows+  , toDyn+  , module Conferer.Config+  ) where++import Data.Text+import Data.Typeable+import Test.Hspec+import GHC.Generics+import Control.Exception+import Data.Dynamic+import Data.Function++import Conferer.Config+import Conferer.FromConfig.Internal+  ( MissingRequiredKey(..)+  , ConfigParsingError(..)+  )+import Conferer.FromConfig+import qualified Conferer.Source.InMemory as InMemory++configWith :: [(Key, Text)] -> IO Config+configWith keyValues =+  emptyConfig+  & addSource (InMemory.fromConfig keyValues)++anyConfigParserError :: ConfigParsingError -> Bool+anyConfigParserError _ = True++aConfigParserError :: Key -> Text -> ConfigParsingError -> Bool+aConfigParserError key txt (ConfigParsingError k t _) =+  key == k && t == txt++aMissingRequiredKey :: forall t. Typeable t => Key -> MissingRequiredKey -> Bool+aMissingRequiredKey key (MissingRequiredKey k t) =+  [key] == k && typeRep (Proxy :: Proxy t) == t++aMissingRequiredKeys :: forall t. Typeable t => [Key] -> MissingRequiredKey -> Bool+aMissingRequiredKeys keys (MissingRequiredKey k t) =+  keys == k && typeRep (Proxy :: Proxy t) == t++data InvalidThing = InvalidThing deriving (Show, Eq)++ensureEmptyConfigThrows :: forall a. (Typeable a, FromConfig a) => SpecWith ()+ensureEmptyConfigThrows =+  context "with empty config"  $ do+    it "throws an exception" $ do+      config <- configWith []+      fetchFromConfig @a "some.key" config+        `shouldThrow` aMissingRequiredKey @a "some.key"++ensureSingleConfigThrowsParserError ::+    forall a. (FromConfig a, Typeable a) =>+    Text -> SpecWith ()+ensureSingleConfigThrowsParserError keyContent =+  context "with invalid types in the defaults"  $ do+    it "throws an exception" $ do+      config <- configWith [("some.key", keyContent)]+      fetchFromConfig @a "some.key" config+        `shouldThrow` aConfigParserError "some.key" keyContent++ensureUsingDefaultReturnsSameValue ::+    forall a. (Typeable a, Eq a, Show a, FromConfig a) =>+    a -> SpecWith ()+ensureUsingDefaultReturnsSameValue value =+  context ("with a default of '" ++ show value ++ "'") $ do+    it "gets that same value" $ do+      config <- configWith []+      fetchedValue <- fetchFromConfig @a "some.key"+        (config & addDefault "some.key" value)+      fetchedValue `shouldBe` value++ensureSingleConfigParsesTheRightThing ::+    forall a. (Eq a, Show a, FromConfig a, Typeable a) =>+    Text -> a -> SpecWith ()+ensureSingleConfigParsesTheRightThing keyContent value =+  context ("with a config value of '" ++ unpack keyContent ++ "'" ) $ do+    it "gets the right value" $ do+      config <- configWith [("some.key", keyContent)]+      fetchedValue <- fetchFromConfig @a "some.key" config+      fetchedValue `shouldBe` value++ensureSingleConfigThrows ::+    forall a e. (FromConfig a, Typeable a, Exception e) =>+    Text -> (e -> Bool) -> SpecWith ()+ensureSingleConfigThrows keyContent checkException =+  it "gets the right value" $ do+    config <- configWith [("some.key", keyContent)]+    fetchFromConfig @a "some.key" config+      `shouldThrow` checkException++ensureFetchParses ::+    forall a.+    ( FromConfig a+    , Typeable a+    , Eq a+    , Show a+    )+    => [(Key, Text)]+    -> [(Key, Dynamic)]+    -> a+    -> SpecWith ()+ensureFetchParses configs defaults expectedValue =+  it "gets the right value" $ do+    config <- addDefaults (mapKeys defaults) <$> configWith (mapKeys configs)+    fetchedValue <- fetchFromConfig @a "some.key" config+    fetchedValue `shouldBe` expectedValue+  where+    mapKeys :: [(Key, any)] -> [(Key, any)]+    mapKeys = fmap (\(k, x) -> ("some.key" /. k, x))++ensureFetchThrows ::+    forall a e.+    ( FromConfig a+    , Typeable a+    , Exception e+    )+    => [(Key, Text)]+    -> [(Key, Dynamic)]+    -> (e -> Bool)+    -> SpecWith ()+ensureFetchThrows configs defaults exceptionCheck =+  it "throws an exception" $ do+    config <- addDefaults (mapKeys defaults) <$> configWith (mapKeys configs)+    fetchFromConfig @a "some.key" config+      `shouldThrow` exceptionCheck+  where+    mapKeys :: forall x. [(Key, x)] -> [(Key, x)]+    mapKeys = fmap (\(k, x) -> ("some.key" /. k, x))
+ test/Conferer/FromConfig/FileSpec.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE TypeApplications #-}+module Conferer.FromConfig.FileSpec (spec) where++import Test.Hspec+import Conferer.FromConfig.Extended+import Conferer.FromConfig ()+import System.FilePath ((</>))+import Data.Text (pack)++spec :: Spec+spec = do+  context "File fromConfig" $ do+    describe "fetching a File from config" $ do+      ensureFetchParses @File [] [("", toDyn $ File "file.png")] $+        File "file.png"+      ensureFetchThrows @File [] [] $+        aMissingRequiredKeys @String+          [ "some.key"+          , "some.key.extension"+          , "some.key.dirname"+          , "some.key.basename"+          , "some.key.filename"+          ]++      context "with whole path in root" $ do+        ensureFetchParses @File+          [ ("", pack $ "some" </> "file.png")+          ]+          []+          $ File $ "some" </> "file.png"++      context "with whole path in root and overriding extension" $ do+        ensureFetchParses @File+          [ ("", pack $ "some" </> "file.png")+          , ("extension", "jpg")+          ]+          []+          $ File $ "some" </> "file.jpg"++      context "with whole path in root and overriding extension and basename" $ do+        ensureFetchParses @File+          [ ("", pack $ "some" </> "file.png")+          , ("extension", "jpg")+          , ("basename", "somefile")+          ]+          []+          $ File $ "some" </> "somefile.jpg"++      context "with whole path in root and overriding dirname" $ do+        ensureFetchParses @File+          [ ("", pack $ "some" </> "file.png")+          , ("dirname", "dir")+          ]+          []+          $ File $ "dir" </> "file.png"++      context "with both filename and basename the most specific takes priority" $ do+        ensureFetchParses @File+          [ ("", pack $ "some" </> "file.png")+          , ("filename", "somefile.jpg")+          , ("basename", "coolfile")+          ]+          []+          $ File $ "some" </> "coolfile.jpg"++      context "with both filename and extension the most specific takes priority" $ do+        ensureFetchParses @File+          [ ("", pack $ "some" </> "file.png")+          , ("filename", "somefile.jpg")+          , ("extension", "gif")+          ]+          []+          $ File $ "some" </> "somefile.gif"++      context "without root path specificied, with subcomponents that complete a path" $ do+        ensureFetchParses @File+          [ ("filename", "somefile.jpg")+          , ("dirname", pack $ "some" </> "path")+          ]+          []+          $ File $ "some" </> "path" </> "somefile.jpg"
+ test/Conferer/FromConfig/ListSpec.hs view
@@ -0,0 +1,171 @@++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.ListSpec (spec) where++import Test.Hspec+import Conferer.FromConfig.Extended++data Thing = Thing+  { thingA :: Int+  , thingB :: String+  } deriving (Generic, Show, Eq)++instance FromConfig Thing++spec :: Spec+spec = do+  describe "list parsing" $ do+    ensureEmptyConfigThrows @[Int]+    ensureUsingDefaultReturnsSameValue @[Int] [7]++    context "with an empty keys it always gets an empty list" $ do+      ensureFetchParses+        @[Int]+        [ ("keys", "")+        ]+        [ ("", toDyn @[Int] [1, 2, 3]) ]+        []+    context "with a fully defined list without a default" $ do+      ensureFetchParses+        @[Int]+        [ ("0", "2")+        ]+        []+        [2]++    context "with a non number key" $ do+      ensureFetchParses+        @[Int]+        [ ("a", "0")+        , ("b", "1")+        ]+        []+        [0, 1]++    context "orders the values lexicographically" $ do+      ensureFetchParses+        @[Int]+        [ ("09", "0")+        , ("10", "1")+        ]+        []+        [0, 1]+    context "with a prototype as default" $ do+      ensureFetchParses+        @[Thing]+        [ ("0.a", "0")+        , ("1.b", "aaa")+        ]+        [ ("prototype", toDyn (Thing 7 "lala"))+        ]+        [ Thing { thingA = 0, thingB = "lala"}+        , Thing { thingA = 7, thingB = "aaa"}+        ]++    context "with a partial prototype that gets completed later" $ do+      ensureFetchParses+        @[Thing]+        [ ("0.a", "0")+        , ("prototype.b", "lala")+        ]+        []+        [ Thing { thingA = 0, thingB = "lala"}+        ]++    context "when the user updates the prototype via config" $ do+      ensureFetchParses+        @[Thing]+        [ ("0.a", "0")+        , ("prototype.b", "aaa")+        ]+        [("prototype", toDyn Thing {thingA = 7, thingB = "lala"})+        ]+        [ Thing { thingA = 0, thingB = "aaa"}+        ]+    context "listing keys explicitly uses keys in that order" $ do+      ensureFetchParses+        @[Thing]+        [ ("1.a", "0")+        , ("1.b", "a")+        , ("a.a", "1")+        , ("a.b", "b")+        , ("keys", "1,a")+        ]+        [ ]+        [ Thing 0 "a"+        , Thing 1 "b"+        ]+    context "listing keys explicitly uses the prototype if the key is not complete" $ do+      ensureFetchParses+        @[Thing]+        [ ("1.a", "0")+        , ("keys", "1")+        ]+        [ ("prototype", toDyn $ Thing 7 "lele")+        ]+        [ Thing 0 "lele"+        ]+    context "listing keys explicitly I can use values from the default" $ do+      ensureFetchParses+        @[Thing]+        [ ("keys", "defaults.0")+        ]+        [ ("", toDyn+            [ Thing {thingA = 0, thingB = "a"}+            , Thing {thingA = 1, thingB = "b"}+            ])+        ]+        [ Thing 0 "a"+        ]+    context "listing keys explicitly I can use values from the default \+            \ and override some of the values" $ do+      ensureFetchParses+        @[Thing]+        [ ("keys", "defaults.0")+        , ("defaults.0.a", "7")+        ]+        [ ("", toDyn+            [ Thing {thingA = 0, thingB = "a"}+            , Thing {thingA = 1, thingB = "b"}+            ])+        ]+        [ Thing 7 "a"+        ]+    context "listing keys explicitly and using a default from an index \+            \that's not present" $ do+      ensureFetchThrows+        @[Thing]+        [ ("keys", "defaults.5")+        ]+        [ ("", toDyn+            [ Thing {thingA = 0, thingB = "a"}+            , Thing {thingA = 1, thingB = "b"}+            ])+        ]+        $ aMissingRequiredKey @Int "some.key.defaults.5.a"+    context "listing a default keys that's not present ignores the \+            \prototype" $ do+      ensureFetchThrows+        @[Thing]+        [ ("keys", "defaults.5")+        ]+        [ ("prototype", toDyn $ Thing 7 "lele")+        , ("", toDyn+            [ Thing {thingA = 0, thingB = "a"}+            , Thing {thingA = 1, thingB = "b"}+            ])+        ]+        $ aMissingRequiredKey @Int "some.key.defaults.5.a"+    context "fetching maps every key (and they can be used if the lower \+            \fromconfig uses listSubkeys" $ do+      ensureFetchParses+        @[[Int]]+        [ ("1.0", "0")+        ]+        [ ("prototype.1", toDyn @Int 8)+        ]+        [[0, 8]]
+ test/Conferer/FromConfig/MaybeSpec.hs view
@@ -0,0 +1,33 @@++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.MaybeSpec (spec) where++import Test.Hspec+import Conferer.FromConfig.Extended++data Thing = Thing+  { thingA :: Int+  , thingB :: String+  } deriving (Generic, Show, Eq)++instance FromConfig Thing++spec :: Spec+spec = do+  describe "fetching a Maybe from config" $ do+    context "when the key is there and has a valid value" $ do+      ensureFetchParses @(Maybe Int) [("", "7")] [] $ Just 7+    context "when the key is missing" $ do+      ensureFetchParses @(Maybe Int) [] [] Nothing+    context "when the key is there but has a wrong value" $ do+      ensureFetchThrows @(Maybe Int) [("", "Bleh")] [] anyConfigParserError+    context "with default of the inner type" $ do+      ensureFetchParses @(Maybe Int) [] [("", toDyn @Int 7)] $ Just 7+    context "with default of a Just inner type" $ do+      ensureFetchParses @(Maybe Int) [] [("", toDyn @(Maybe Int) $ Just 7)] $ Just 7+    context "with default of a Nothing and no configuration" $ do+      ensureFetchParses @(Maybe Int) [] [("", toDyn @(Maybe Int) $ Nothing)] $ Nothing
+ test/Conferer/FromConfig/NumbersSpec.hs view
@@ -0,0 +1,29 @@++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.NumbersSpec (spec) where++import Test.Hspec+import Conferer.FromConfig.Extended++spec :: Spec+spec = do+  context "Numbers fetching" $ do+    describe "fetching an Int from config" $ do+      ensureEmptyConfigThrows @Int+      ensureUsingDefaultReturnsSameValue @Int 7+      ensureSingleConfigParsesTheRightThing @Int "7" 7+      ensureSingleConfigParsesTheRightThing @Int "-7" (-7)+      ensureSingleConfigThrowsParserError  @Int "50A"++    describe "fetching a Float from config" $ do+      ensureEmptyConfigThrows @Float+      ensureUsingDefaultReturnsSameValue @Float 7.5+      ensureSingleConfigParsesTheRightThing @Float "9.5" 9.5+      ensureSingleConfigParsesTheRightThing @Float "-9.5" (-9.5)+      ensureSingleConfigThrowsParserError @Float "9.50J"+      ensureSingleConfigThrowsParserError @Float ".5"+      ensureSingleConfigThrowsParserError @Float "9."
+ test/Conferer/FromConfig/StringLikeSpec.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TypeApplications #-}++module Conferer.FromConfig.StringLikeSpec (spec) where++import Test.Hspec+import Data.Text (Text)+import Conferer.FromConfig.Extended+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS++spec :: Spec+spec = do+    describe "fetching a String from config" $ do+      ensureEmptyConfigThrows @String+      ensureUsingDefaultReturnsSameValue @String "aaa"+      ensureSingleConfigParsesTheRightThing @String "thing" "thing"+    describe "fetching text from config" $ do+      ensureEmptyConfigThrows @Text+      ensureUsingDefaultReturnsSameValue @Text "aaa"+      ensureSingleConfigParsesTheRightThing @Text "thing" "thing"+    describe "fetching bytestring from config" $ do+      ensureEmptyConfigThrows @BS.ByteString+      ensureUsingDefaultReturnsSameValue @BS.ByteString "aaa"+      ensureSingleConfigParsesTheRightThing @BS.ByteString "thing" "thing"+    describe "fetching lazy bytestring from config" $ do+      ensureEmptyConfigThrows @LBS.ByteString+      ensureUsingDefaultReturnsSameValue @LBS.ByteString "aaa"+      ensureSingleConfigParsesTheRightThing @LBS.ByteString "thing" "thing"
+ test/Conferer/FromConfigSpec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeApplications #-}+module Conferer.FromConfigSpec (spec) where++import Test.Hspec+import Conferer.FromConfig+import Conferer.FromConfig.Extended++spec :: Spec+spec = do+  describe "Override FromConfig" $ do+    ensureFetchParses @Int+      []+      [ ("", overrideFetch @Int $ \_k _c -> pure 42) ]+      42
test/Conferer/GenericsSpec.hs view
@@ -4,14 +4,10 @@  import Test.Hspec -import Conferer-import Conferer.Types (FromConfig, DefaultConfig, configDef)+import Conferer.FromConfig -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+import Conferer.FromConfig.Extended  data Thing = Thing   { thingA :: Int@@ -19,6 +15,7 @@   } deriving (Generic, Show, Eq)  instance FromConfig Thing+ instance DefaultConfig Thing where   configDef = Thing 0 0 @@ -28,79 +25,74 @@   } deriving (Generic, Show, Eq)  instance FromConfig Bigger+ instance DefaultConfig Bigger where-  configDef = Bigger (configDef { thingA = 27}) 1+  configDef = Bigger (configDef {thingA = 27}) 1  spec :: Spec spec = do   describe "Generics" $ do     context "with a simple record" $ do+      context "without a default but with all of the keys defined" $ do+        ensureFetchParses+          [ ("a", "0")+          , ("b", "0")+          ]+          []+          Thing { thingA = 0, thingB = 0 }       context "when no keys are set" $ do-        it "returns the default" $ do-          c <- emptyConfig-                & addSource (mkMapSource [ ])--          res <- fetch @Thing "somekey" c-          res `shouldBe` Thing { thingA = 0, thingB = 0 }+        ensureFetchParses+          []+          [ ("", toDyn $ configDef @Thing)+          ]+          Thing { thingA = 0, thingB = 0 }       context "when all keys are set" $ do-        it "return the keys set" $ do-          c <- emptyConfig-                & addSource (mkMapSource-                  [ ("somekey.a", "1")-                  , ("somekey.b", "2")-                  ])--          res <- fetch @Thing "somekey" c-          res `shouldBe` Thing { thingA = 1, thingB = 2 }+        ensureFetchParses+          [ ("a", "1")+          , ("b", "2")+          ]+          [ ("", toDyn $ configDef @Thing)+          ]+          Thing { thingA = 1, thingB = 2 }        context "when some keys are set" $ do-        it "uses the default and returns the keys set" $ do-          c <- emptyConfig-                & addSource (mkMapSource-                  [ ("somekey.b", "2")-                  ])--          res <- fetch @Thing "somekey" c-          res `shouldBe` Thing { thingA = 0, thingB = 2 }+        ensureFetchParses+          [ ("b", "2")+          ]+          [ ("", toDyn $ configDef @Thing)+          ]+          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-                & addSource (mkMapSource-                  [ ])--          res <- fetch @Bigger "somekey" c-          res `shouldBe` Bigger { biggerThing = Thing { thingA = 27, thingB = 0 }, biggerB = 1}+        ensureFetchParses+          [ ]+          [ ("", toDyn @Bigger configDef )+          ]+          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-                & addSource (mkMapSource-                  [ ("somekey.b", "30")-                  ])--          res <- fetch @Bigger "somekey" c-          res `shouldBe` Bigger { biggerThing = Thing { thingA = 27, thingB = 0 }, biggerB = 30}+        ensureFetchParses+          [ ("b", "30")+          ]+          [ ("", toDyn @Bigger configDef)+          ]+          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-                & addSource (mkMapSource-                  [ ("somekey.thing.a", "30")-                  ])--          res <- fetch @Bigger "somekey" c-          res `shouldBe` Bigger { biggerThing = Thing { thingA = 30, thingB = 0 }, biggerB = 1}+        ensureFetchParses+          [ ("thing.a", "30")+          ]+          [ ("", toDyn @Bigger configDef)+          ]+          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-                & addSource (mkMapSource-                  [ ("somekey.thing.a", "10")-                  , ("somekey.thing.b", "20")-                  , ("somekey.b", "30")-                  ])--          res <- fetch @Bigger "somekey" c-          res `shouldBe` Bigger { biggerThing = Thing { thingA = 10, thingB = 20 }, biggerB = 30}+        ensureFetchParses+          [ ("thing.a", "10")+          , ("thing.b", "20")+          , ("b", "30")+          ]+          [ ("", toDyn @Bigger configDef)+          ]+          Bigger { biggerThing = Thing { thingA = 10, thingB = 20 }, biggerB = 30}
+ test/Conferer/KeySpec.hs view
@@ -0,0 +1,39 @@+module Conferer.KeySpec where++import Test.Hspec++import Conferer.Key+import Conferer.Key.Internal++spec :: Spec+spec = do+  describe "#fromString" $ do+    it "parsing keys does the right thing" $ do+      "some.key" `shouldBe` Key ["some", "key"]+    it "an empty string is the empty list" $ do+      "" `shouldBe` Key []+    it "empty key fragments are removed" $ do+      "some..key" `shouldBe` Key ["some", "key"]+    it "are matched in a case insensitive way" $ do+      "some.key" `shouldBe` ("SoME.KeY" :: Key)+    it "'s true representation is case insensitive" $ do+      "somE.Key" `shouldBe` Key ["some", "key"]+  describe "#isValidKeyFragment" $ do+    context "with a all leters" $ do+      it "is valid" $+        isValidKeyFragment "fragment" `shouldBe` True+    context "with only numbers" $ do+      it "is valid" $+        isValidKeyFragment "000" `shouldBe` True+    context "with both numbers and letters" $ do+      it "is valid" $+        isValidKeyFragment "000" `shouldBe` True+    context "with a dot" $ do+      it "is not valid" $ do+        isValidKeyFragment "some.fragment" `shouldBe` False+    context "with an uppercase letter" $ do+      it "is not valid" $ do+        isValidKeyFragment "FRAGMENT" `shouldBe` False+    context "with an empty string" $ do+      it "is not valid" $ do+        isValidKeyFragment "" `shouldBe` False
− test/Conferer/Source/ArgsSpec.hs 
@@ -1,38 +0,0 @@-module Conferer.Source.ArgsSpec where--import           Test.Hspec--import           Conferer--spec :: Spec-spec = do-  describe "with a mapping source" $ do-    let mkConf args =-          emptyConfig-          & addSource-          (mkCLIArgsSource' args)--    it "gets a parameters with it's value if it starts with the right prefix" $ do-      c <- mkConf []-      res <- getKey "some.key" c-      res `shouldBe` Nothing--    it "with a value that begins with the right prefix it uses it" $ do-      c <- mkConf ["--some.key=value"]-      res <- getKey "some.key" c-      res `shouldBe` Just "value"--    it "with a reapeated value it uses the last one" $ do-      c <- mkConf ["--some.key=value", "--some.key=different value"]-      res <- getKey "some.key" c-      res `shouldBe` Just "different value"--    it "ignores values that don't start with the right prefix" $ do-      c <- mkConf ["some.key=value", "-some.key=value", "-Xsome.key=value", "some.key"]-      res <- getKey "some.key" c-      res `shouldBe` Nothing--    it "after encountering a -- it stops parsing parameters" $ do-      c <- mkConf ["--", "--some.key=value"]-      res <- getKey "some.key" c-      res `shouldBe` Nothing
+ test/Conferer/Source/CLIArgsSpec.hs view
@@ -0,0 +1,42 @@+module Conferer.Source.CLIArgsSpec where++import Test.Hspec++import Conferer.Source+import Conferer.Source.CLIArgs++spec :: Spec+spec = do+  describe "with a mapping source" $ do+    let mkConf args =+          return $ fromArgs args++    it "gets a parameters with it's value if it starts with the right prefix" $ do+      c <- mkConf []+      res <- getKeyInSource c "some.key"+      res `shouldBe` Nothing++    it "with a value that begins with the right prefix it uses it" $ do+      c <- mkConf ["--some.key=value"]+      res <- getKeyInSource c "some.key"+      res `shouldBe` Just "value"++    it "with a reapeated value it uses the last one" $ do+      c <- mkConf ["--some.key=value", "--some.key=different value"]+      res <- getKeyInSource c "some.key"+      res `shouldBe` Just "different value"++    it "ignores values that don't start with the right prefix" $ do+      c <- mkConf ["some.key=value", "-some.key=value", "-Xsome.key=value", "some.key"]+      res <- getKeyInSource c "some.key"+      res `shouldBe` Nothing++    it "after encountering a -- it stops parsing parameters" $ do+      c <- mkConf ["--", "--some.key=value"]+      res <- getKeyInSource c "some.key"+      res `shouldBe` Nothing++    it "with passed flag without a value it returns true" $ do+      c <- mkConf ["--some.key"]+      res <- getKeyInSource c "some.key"+      res `shouldBe` Just "true"
test/Conferer/Source/EnvSpec.hs view
@@ -1,41 +1,58 @@ module Conferer.Source.EnvSpec where -import           Test.Hspec-import qualified Data.Map as Map--import Conferer+import Test.Hspec+import Test.QuickCheck -fakeLookupEnv :: [(String, String)] -> LookupEnvFunc-fakeLookupEnv fakeEnv = \envName ->-  return $ Map.lookup envName $ Map.fromList fakeEnv+import Conferer.Source+import Conferer.Source.Env  spec :: Spec spec = do-  describe "with an env config" $ do+  describe "with an env source" $ do     let-      mkEnvConfig =-        emptyConfig-        & addSource-        (mkEnvSource'-         (fakeLookupEnv-          [ ("TMUX","/tmp/tmux-1000/default,2822,0")-          , ("TMUX_PANE","%1")-          , ("TMUX_PLUGIN_MANAGER_PATH","/home/user/.tmux/plugins/")-          ])-         "TMUX"-        )-    it "getting an existent key returns unwraps top level value (wihtout \+      mkEnvConfig envVars =+        return $ fromEnvList envVars "APP"++    it "getting an existent key returns unwraps top level value (without \        \children)" $ do       c <- mkEnvConfig-      res <- getKey "." c-      res `shouldBe` Just "/tmp/tmux-1000/default,2822,0"+            [ ("APP_THING","thing")+            , ("APP","root")+            , ("APP_PG_HOST","some host")+            , ("APP_PG_PORT","some port")+            , ("SOMETHING_ELSE","else")+            ]+      res <- getKeyInSource c ""+      res `shouldBe` Just "root"      it "getting an existent key for a child gets that value" $ do       c <- mkEnvConfig-      res <- getKey "pane" c-      res `shouldBe` Just "%1"+            [ ("APP_THING","thing")+            ]+      res <- getKeyInSource c "thing"+      res `shouldBe` Just "thing" -    it "keys should always be consistent as to how the words are separated" $ do+    it "listing some keys returns all the right values" $ do       c <- mkEnvConfig-      res <- getKey "pane" c-      res `shouldBe` Just "%1"+            [ ("APP_PG_HOST","some host")+            , ("APP_PG_PORT","some port")+            ]+      res <- getSubkeysInSource c "pg"+      res `shouldBe` ["pg.host", "pg.port"]++    it "listing the keys under the root list everything excluding ." $ do+      c <- mkEnvConfig+            [ ("APP_SOME","value")+            , ("APP","value")+            , ("SOMETHING_ELSE","else")+            ]+      res <- getSubkeysInSource c ""+      res `shouldBe` ["some"]++    it "key to env var and back be identity" $ property $+      forAll+        (elements ["a", "a.b", "", "a.b.c", "UPPER"])+        $ \k ->+            envVarToKey "theapp" (keyToEnvVar "theapp" k)+              == Just k+
+ test/Conferer/Source/InMemorySpec.hs view
@@ -0,0 +1,32 @@+module Conferer.Source.InMemorySpec where++import Test.Hspec++import Conferer.Source+import Conferer.Source.InMemory++spec :: Spec+spec = do+  describe "in memory source" $ do+    let source =+          fromAssociations [("postgres.url", "some url")]++    it "getting a non existent key returns an empty config" $ do+      res <- getKeyInSource source "some.key"+      res `shouldBe` Nothing++    it "getting an existent key returns unwraps the original map" $ do+      res <- getKeyInSource source "postgres.url"+      res `shouldBe` Just "some url"++    it "listing subkeys works" $ do+      res <- getSubkeysInSource source "postgres"+      res `shouldBe` ["postgres.url"]++    it "listing subkeys never returns the same key" $ do+      res <- getSubkeysInSource source "postgres.url"+      res `shouldBe` []++    it "listing subkeys that are not present" $ do+      res <- getSubkeysInSource source "stuff"+      res `shouldBe` []
− test/Conferer/Source/MappingSpec.hs 
@@ -1,43 +0,0 @@-module Conferer.Source.MappingSpec where--import           Test.Hspec-import qualified Data.Map as Map-import           Data.Function ((&))--import           Conferer--spec :: Spec-spec = do-  describe "with a mapping source" $ do-    it "getting an existent key in the original map but that's not mapped in the \-       \wrapper doesn't exist" $ do-      c <- emptyConfig-           & addSource (mkMappingSource Map.empty-                          $ mkMapSource [("some.key", "some value")])-      res <- getKey "some.key" c-      res `shouldBe` Nothing--    it "getting a non existent key isn't there" $ do-      c <- emptyConfig-           & addSource (mkMappingSource (Map.fromList [("k", "key")])-                          $ mkMapSource [("key", "75")])--      res <- getKey "xxxx" c-      res `shouldBe` Nothing--    it "getting an existent key that's mapped but doesn't exist on the \-       \inner source isn't there" $ do-      c <- emptyConfig-           & addSource (mkMappingSource (Map.fromList [("another.key", "some.key")])-                          $ mkMapSource [])--      res <- getKey "another.key" c-      res `shouldBe` Nothing--    it "getting an existent key that's mapped properly gets it and exists on \-       \the inner source gets it" $ do-      c <- emptyConfig-           & addSource (mkMappingSource (Map.fromList [("another.key", "some.key")])-                          $ mkMapSource [("some.key", "some value")])-      res <- getKey "another.key" c-      res `shouldBe` Just "some value"
test/Conferer/Source/NamespacedSpec.hs view
@@ -2,20 +2,24 @@  import Test.Hspec -import Conferer+import Conferer.Source +import qualified Conferer.Source.InMemory as InMemory+import Conferer.Source.Namespaced+ spec :: Spec spec = do   describe "namespaced config" $ do+    let source =+          fromInner "postgres" $+            InMemory.fromAssociations [("url", "some url")]     it "return nothing if the key doesn't match" $ do-      c <- emptyConfig-           & addSource (mkNamespacedSource "postgres"-                          $ mkMapSource [("url", "some url")])-      res <- getKey "url" c+      res <- getKeyInSource source "url"       res `shouldBe` Nothing     it "returns the wrapped value" $ do-      c <- emptyConfig-           & addSource (mkNamespacedSource "postgres"-                          $ mkMapSource [("url", "some url")])-      res <- getKey "postgres.url" c+      res <- getKeyInSource source "postgres.url"       res `shouldBe` Just "some url"+    it "listing subkeys" $ do+      res <- getSubkeysInSource source "postgres"+      res `shouldBe` ["postgres.url"]+
test/Conferer/Source/NullSpec.hs view
@@ -2,12 +2,11 @@  import           Test.Hspec -import           Conferer+import           Conferer.Source+import           Conferer.Source.Null  spec :: Spec spec = do   it "always fails to get a key" $ do-    c <- emptyConfig-         & addSource mkNullSource-    res <- getKey "some.key" c+    res <- getKeyInSource empty "some.key"     res `shouldBe` Nothing
test/Conferer/Source/PropertiesFileSpec.hs view
@@ -1,39 +1,32 @@ module Conferer.Source.PropertiesFileSpec where -import           Test.Hspec-import           Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Map as Map+import Test.Hspec -import Conferer-import Conferer.Core+import Conferer.Source import Conferer.Source.PropertiesFile -fakeLookupEnv :: [(String, String)] -> LookupEnvFunc-fakeLookupEnv fakeEnv = \envName ->-  return $ Map.lookup envName $ Map.fromList fakeEnv- spec :: Spec spec = do   describe "with a properties file config" $ do-    it "getting an existent key returns unwraps top level value (wihtout \+    let mk = return . fromFileContent "file.properties"+    it "getting an existent key returns unwraps top level value (without \        \children)" $ do-      c <- mkStandaloneSource $ mkPropertiesFileSource' "some.key=a value"+      c <- mk "some.key=a value"       res <- getKeyInSource c "some.key"       res `shouldBe` Just "a value"      it "getting an existent key for a child gets that value" $ do-      c <- mkStandaloneSource $ mkPropertiesFileSource' $ Text.unlines-                               [ "some.key=a value"-                               , "some.key=b"-                               ]+      c <- mk "some.key=b"       res <- getKeyInSource c "some.key"       res `shouldBe` Just "b"      it "keys should always be consistent as to how the words are separated" $ do-      c <- mkStandaloneSource $ mkPropertiesFileSource' $ Text.unlines-                               [ "some.key=a value"-                               , "some.key=b"-                               ]-      res <- getKeyInSource c "another.key"-      res `shouldBe` Nothing+      c <- mk "some.key=a value"+      res <- getKeyInSource c "some.key"+      res `shouldBe` Just "a value"++    it "respects leading spaces in values" $ do+      c <- mk "some.key= a value "+      res <- getKeyInSource c "some.key"+      res `shouldBe` Just " a value "+
− test/Conferer/Source/SimpleSpec.hs 
@@ -1,22 +0,0 @@-module Conferer.Source.SimpleSpec where--import Test.Hspec--import Conferer--spec :: Spec-spec = do-  describe "json source" $ do-    let creator =-          emptyConfig-          & addSource (mkMapSource [ ("postgres.url", "some url")])--    it "getting a non existent key returns an empty config" $ do-      c <- creator-      res <- getKey "some.key" c-      res `shouldBe` Nothing--    it "getting an existent key returns unwraps the original map" $ do-      c <- creator-      res <- getKey "postgres.url" c-      res `shouldBe` Just "some url"
test/ConfererSpec.hs view
@@ -1,33 +1,47 @@+{-# LANGUAGE TypeApplications #-}+-- {-# LANGUAGE DeriveGeneric #-}+-- {-# LANGUAGE TypeApplications #-}+ module ConfererSpec where  import Test.Hspec-import Conferer +import Data.Text (Text)+import Conferer.FromConfig (fetchFromConfig)+import Conferer.Source.InMemory (fromConfig)+import Data.Dynamic (toDyn)+import Conferer.Config (Config)+import Conferer (mkConfig', Key)+ spec :: Spec spec = do-  describe "keys" $ do-    it "parsing keys does the right thing" $ do-      "some.key" `shouldBe` Path ["some", "key"]-    it "an empty string is the empty list" $ do-      "" `shouldBe` Path []+  describe "mkConfig'" $ do+    let a = fromConfig [("keyPresentInBoth", "valueInA"), ("keyPresentOnlyInA", "valueInA")]+        b = fromConfig [("keyPresentInBoth", "valueInB"), ("keyPresentOnlyInB", "valueInB")]+        shouldHaveKeyWithValue :: Config -> Key -> Text -> Expectation+        shouldHaveKeyWithValue config key expected = do+          actual <- fetchFromConfig key config+          actual `shouldBe` expected+    describe "the precedence of the sources is defined by the order in the list" $ do+      it "if several sources have a value for the key, the first source in the list that has it is used" $ do+        config <- mkConfig' [] [a, b] -  describe "with a config with a nested value" $ do-    let mkConfig =-          pure emptyConfig-          >>= addSource (mkMapSource [ ("postgres.url", "some url")])-          >>= addSource (mkMapSource [ ("postgres.url", "different url") , ("server.port", "4000")])+        config `shouldHaveKeyWithValue` "keyPresentInBoth" $ "valueInA"+      it "if only one source has a value for the key, that source is used" $ do+        config <- mkConfig' [] [a, b] -    it "getting a non existent key returns an empty config" $ do-      c <- mkConfig-      res <- getKey "aaa" c-      res `shouldBe` Nothing+        config `shouldHaveKeyWithValue` "keyPresentOnlyInB" $ "valueInB"+      it "if the key is not present in any source, it doesn't retrieve any value" $ do+        config <- mkConfig' [] [a, b] -    it "getting an existent key returns unwraps the original map" $ do-      c <- mkConfig-      res <- getKey "postgres.url" c-      res `shouldBe` Just "some url"-    it "getting an existent key returns in the bottom maps gets it" $ do-      c <- mkConfig-      res <- getKey "server.port" c-      res `shouldBe` Just "4000"+        value <- fetchFromConfig "keyNotPresentInAnySource" config+        value `shouldBe` (Nothing :: Maybe Text)+    describe "adds the defaults to the config" $ do+      it "if the key is present in a source and in the default, it uses the first source that has it" $ do+        config <- mkConfig' [("keyPresentOnlyInA", toDyn @Text "defaultValue")] [a] +        config `shouldHaveKeyWithValue` "keyPresentOnlyInA" $ "valueInA"+      it "if the key is not present in any source but it's in a default, it uses the default" $ do+        config <- mkConfig' [("keyPresentOnlyInA", toDyn @Text "defaultValue")] [b]++        config `shouldHaveKeyWithValue` "keyPresentOnlyInA" $ "defaultValue"
+ test/ConfererSpecMain.hs view
@@ -0,0 +1,7 @@+module ConfererSpecMain where++import Test.Hspec.Runner+import qualified Spec++main :: IO ()+main = hspecWith defaultConfig Spec.spec
test/Spec.hs view
@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}