conferer 1.0.0.1 → 1.1.0.0

raw patch · 22 files changed

+271/−242 lines, 22 filesdep ~bytestringdep ~containersdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring, containers, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−2
• conferer.cabal +2/−2
• src/Conferer.hs +2/−1
• src/Conferer/Config.hs +1/−0
• src/Conferer/Config/Internal.hs +35/−12
• src/Conferer/Config/Internal/Types.hs +2/−2
• src/Conferer/FromConfig.hs +4/−4
• src/Conferer/FromConfig/Internal.hs +81/−103
• src/Conferer/Key.hs +2/−0
• src/Conferer/Key/Internal.hs +13/−1
• src/Conferer/Source/PropertiesFile.hs +9/−3
• test/Conferer/ConfigSpec.hs +13/−1
• test/Conferer/FromConfig/BoolSpec.hs +0/−1
• test/Conferer/FromConfig/Extended.hs +7/−21
• test/Conferer/FromConfig/FileSpec.hs +0/−2
• test/Conferer/FromConfig/ListSpec.hs +2/−3
• test/Conferer/FromConfig/NumbersSpec.hs +0/−2
• test/Conferer/FromConfig/StringLikeSpec.hs +0/−4
• test/Conferer/FromConfigSpec.hs +8/−2
• test/Conferer/GenericsSpec.hs +50/−74
• test/Conferer/KeySpec.hs +20/−1
• test/ConfererSpec.hs +1/−1

@@ -8,6 +8,22 @@  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@@ -27,6 +43,7 @@  First release -[Unreleased]: https://github.com/ludat/conferer/compare/conferer_v1.0.0.0...HEAD-[v1.0.0.0]: https://github.com/ludat/conferer/releases/tag/v0.0.0.0...conferer_v1.0.0.0+[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

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: e95018cf9b8ebe424a2926412853affcae168760a3b9ea0530fbf3a4c1d83b14+-- hash: 80fdd520360a49e55b6dfe3ff9e148c716a7af0b6cf3d0326f8ed3d4a8f67611  name:           conferer-version:        1.0.0.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

@@ -22,6 +22,7 @@   , fetch   , fetch'   , fetchKey+  , fetchFromConfig   , safeFetchKey   , unsafeFetchKey   , DefaultConfig(..)@@ -69,7 +70,7 @@ safeFetchKey c k = fetchFromConfig k c  -- | Same as 'fetchKey' but it throws when the value isn't present.-unsafeFetchKey :: forall a. (FromConfig a) => Config -> Key -> IO a+unsafeFetchKey :: forall a. (FromConfig a, Typeable a) => Config -> Key -> IO a unsafeFetchKey c k = fetchFromConfig k c  

@@ -21,6 +21,7 @@   , addDefault   , addDefaults   , addKeyMappings+  , removeDefault   , Defaults     -- * Re-Exports   , module Conferer.Key

@@ -1,3 +1,4 @@+{-# LANGUAGE TypeApplications #-} -- | -- Copyright: (c) 2019 Lucas David Traverso -- License: MPL-2.0@@ -17,6 +18,7 @@ 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@@ -155,7 +157,7 @@         Nothing -> go otherSources  -- | This function gets values from the defaults-getKeyFromDefaults :: Key -> Config -> Maybe Dynamic+getKeyFromDefaults :: Key -> Config -> Maybe [Dynamic] getKeyFromDefaults key Config{..} =   let     possibleKeys = fmap mappedKey $ getKeysFromMappings configKeyMappings key@@ -180,13 +182,41 @@ -- | 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.fromList configMap-      `Map.union`-      configDefaults config+      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@@ -194,14 +224,7 @@ addDefault :: (Typeable a) => Key -> a -> Config -> Config addDefault key value config =   config-  { configDefaults = Map.insert key (toDyn value) $ configDefaults config-  }---- | This function removes a key default from a 'Config'-removeDefault :: Key -> Config -> Config-removeDefault key config =-  config-  { configDefaults = Map.delete key $ configDefaults config+  { configDefaults = Map.insertWith (++) key [toDyn value] $ configDefaults config   }  -- | Instantiate a 'Source' using an 'SourceCreator' and a 'Config' and add

@@ -21,7 +21,7 @@ data Config =   Config   { configSources :: [Source]-  , configDefaults :: Map Key Dynamic+  , configDefaults :: Map Key [Dynamic]   , configKeyMappings :: [(Key, Key)]   } deriving (Show) @@ -29,7 +29,7 @@ data KeyLookupResult   = MissingKey [Key]   | FoundInSources Key Text-  | FoundInDefaults Key Dynamic+  | FoundInDefaults Key [Dynamic]   deriving (Show)  -- | The type for creating a source given a 'Config', some sources require a

@@ -7,7 +7,8 @@ -- -- Public API module providing FromConfig functionality module Conferer.FromConfig -  ( FromConfig(fetchFromConfig)+  ( FromConfig(fromConfig)+  , fetchFromConfig   , DefaultConfig(configDef)   , fetchFromConfigWithDefault   , fetchFromRootConfig@@ -26,13 +27,12 @@   , throwConfigParsingError   , configParsingError -  , TypeMismatchWithDefault-  , throwTypeMismatchWithDefault-  , typeMismatchWithDefault   , Key   , (/.)   , File(..)   , KeyLookupResult(..)+  , OverrideFromConfig(..)+  , overrideFetch    , fetchFromDefaults   , fetchRequiredFromDefaults

@@ -26,7 +26,7 @@ import Text.Read (readMaybe) import Data.Dynamic import GHC.Generics-import Data.Function (on, (&))+import Data.Function ((&))  import Conferer.Key import Conferer.Config.Internal.Types@@ -37,6 +37,7 @@ 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@@ -60,16 +61,22 @@   --   -- * Try desconstructing the value in as many keys as possible since is allows easier   -- partial overriding.-  fetchFromConfig :: Key -> Config -> IO a-  default fetchFromConfig :: (Typeable a, Generic a, IntoDefaultsG (Rep a), FromConfigG (Rep a)) => Key -> Config -> IO a-  fetchFromConfig k c = do-    defaultValue <- fetchFromDefaults @a k c-    let config =-          case defaultValue of-            Just d -> c & addDefaults (intoDefaultsG k $ from d)-            Nothing -> c-    to <$> fetchFromConfigG k config+  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 --@@ -78,26 +85,24 @@   configDef :: a  instance {-# OVERLAPPABLE #-} Typeable a => FromConfig a where-  fetchFromConfig key config = do-    fetchFromConfigWith (const Nothing) key config+  fromConfig = fetchRequiredFromDefaults  instance FromConfig () where-  fetchFromConfig _key _config = return ()+  fromConfig _key _config = return ()  instance FromConfig String where-  fetchFromConfig = fetchFromConfigWith (Just . Text.unpack)+  fromConfig = fetchFromConfigWith (Just . Text.unpack)  instance {-# OVERLAPPABLE #-} (Typeable a, FromConfig a) =>     FromConfig [a] where-  fetchFromConfig key config = do+  fromConfig key config = do     keysForItems <- getSubkeysForItems     case keysForItems of       Nothing -> do         fetchRequiredFromDefaults @[a] key config       Just subkeys -> do-        defaultsMay <- fetchFromDefaults @[a] key config         let configWithDefaults :: Config =-              case defaultsMay of+              case fetchFromDefaults @[a] key config of                 Just defaults ->                   foldl' (\c (index, value) ->                     c & addDefault (key /. "defaults" /. mkKey (show index)) value) config@@ -111,7 +116,7 @@               else                 configWithDefaults & addKeyMappings [(key /. k, key /. "prototype")])     where-    getSubkeysForItems ::IO (Maybe [Key])+    getSubkeysForItems :: IO (Maybe [Key])     getSubkeysForItems = do       fetchFromConfig @(Maybe Text) (key /. "keys") config         >>= \case@@ -135,40 +140,37 @@             return $ if null subelements then Nothing else Just subelements  instance FromConfig Int where-  fetchFromConfig = fetchFromConfigByRead+  fromConfig = fetchFromConfigByRead  instance FromConfig Integer where-  fetchFromConfig k c = do-    fetchFromConfigByRead k c+  fromConfig = fetchFromConfigByRead  instance FromConfig Float where-  fetchFromConfig = fetchFromConfigByRead+  fromConfig = fetchFromConfigByRead  instance FromConfig BS.ByteString where-  fetchFromConfig = fetchFromConfigWith (Just . Text.encodeUtf8)+  fromConfig = fetchFromConfigWith (Just . Text.encodeUtf8)  instance FromConfig LBS.ByteString where-  fetchFromConfig = fetchFromConfigWith (Just . LBS.fromStrict . Text.encodeUtf8)+  fromConfig = fetchFromConfigWith (Just . LBS.fromStrict . Text.encodeUtf8)  instance forall a. (Typeable a, FromConfig a) => FromConfig (Maybe a) where-  fetchFromConfig key config = do+  fromConfig key config = do     let-      newConfig =-        case getKeyFromDefaults key config >>= fromDynamic @(Maybe a) of-        Just (Just defaultThing) -> do-          config & addDefault key defaultThing-        Just Nothing -> do-          config & removeDefault key-        _ -> do-          config-    (Just <$> fetchFromConfig @a key newConfig)+      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-  fetchFromConfig = fetchFromConfigWith Just+  fromConfig = fetchFromConfigWith Just  instance FromConfig Bool where-  fetchFromConfig = fetchFromConfigWith parseBool+  fromConfig = fetchFromConfigWith parseBool  -- | A newtype wrapper for a 'FilePath' to allow implementing 'FromConfig' -- with something better than just a 'String'@@ -183,9 +185,8 @@   fromString s = File s  instance FromConfig File where-  fetchFromConfig key config' = do-    defaultPath <- fetchFromDefaults @File key config'-    let config = removeDefault key config'+  fromConfig key config = do+    let defaultPath = fetchFromDefaults @File key config      filepath <- fetchFromConfig @(Maybe String) key config @@ -222,6 +223,14 @@     "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)@@ -245,13 +254,16 @@           Nothing -> do             throwConfigParsingError @a k value -      FoundInDefaults k dynamic ->-        case fromDynamic dynamic of+      FoundInDefaults k dynamics ->+        case fromDynamics dynamics of           Just a -> do             return a           Nothing -> do-            throwTypeMismatchWithDefault @a k dynamic+            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'.@@ -266,8 +278,7 @@   Config ->   IO Config addDefaultsAfterDeconstructingToDefaults destructureValue key config = do-  fetchFromDefaults @a key config-    >>= \case+  case fetchFromDefaults @a key config of     Just value -> do       let newDefaults =             ((\(k, d) -> (key /. k, d)) <$> destructureValue value)@@ -276,6 +287,14 @@     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@@ -343,63 +362,23 @@ missingRequiredKeys keys =   MissingRequiredKey keys (typeRep (Proxy :: Proxy a)) --- | Exception to show that the provided default had the wrong type, this is usually a--- programmer error and a user that configures the library can not do much to fix it.-data TypeMismatchWithDefault =-  TypeMismatchWithDefault Key Dynamic TypeRep-  deriving (Typeable)--instance Eq TypeMismatchWithDefault where-  (==) = (==) `on`-    (\(TypeMismatchWithDefault k dyn t) -> (k, show dyn, t))-instance Exception TypeMismatchWithDefault-instance Show TypeMismatchWithDefault where-  show (TypeMismatchWithDefault key dyn aTypeRep) =-    concat-    [ "Couldn't parse the default from key "-    , show key-    , " since there is a type mismatch. "-    , "Expected type is "-    , show aTypeRep-    , " but the actual type is '"-    , show dyn-    , "'"-    ]---- | Helper function to throw a 'TypeMismatchWithDefault'-throwTypeMismatchWithDefault :: forall a b. (Typeable a) => Key -> Dynamic -> IO b-throwTypeMismatchWithDefault key dynamic =-  throwIO $ typeMismatchWithDefault @a  key dynamic---- | Helper function to create a 'TypeMismatchWithDefault'-typeMismatchWithDefault :: forall a. (Typeable a) => Key -> Dynamic -> TypeMismatchWithDefault-typeMismatchWithDefault key dynamic =-  TypeMismatchWithDefault key dynamic $ 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 =-  fetchFromDefaults key config >>=-    \case+  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 -> IO (Maybe a)+fetchFromDefaults :: forall a. (Typeable a) => Key -> Config -> Maybe a fetchFromDefaults key config =-  case getKeyFromDefaults key config of-    Nothing -> do-      return Nothing-    Just dyn ->-      case fromDynamic @a dyn of-        Nothing ->-          throwTypeMismatchWithDefault @a key dyn-        Just a -> return $ Just a+  getKeyFromDefaults key config+    >>= fromDynamics @a  -- | Same as 'fetchFromConfig' using the root key-fetchFromRootConfig :: forall a. (FromConfig a) => Config -> IO a+fetchFromRootConfig :: forall a. (FromConfig a, Typeable a) => Config -> IO a fetchFromRootConfig =   fetchFromConfig "" @@ -416,32 +395,32 @@  -- | Purely 'Generic's machinery, ignore... class FromConfigG f where-  fetchFromConfigG :: Key -> Config -> IO (f a)+  fromConfigG :: Key -> Config -> IO (f a)  instance FromConfigG inner =>     FromConfigG (D1 metadata inner) where-  fetchFromConfigG key config = do-    M1 <$> fetchFromConfigG key config+  fromConfigG key config = do+    M1 <$> fromConfigG key config  instance (FromConfigWithConNameG inner, Constructor constructor) =>     FromConfigG (C1 constructor inner) where-  fetchFromConfigG key config =-    M1 <$> fetchFromConfigWithConNameG @inner (conName @constructor undefined) key config+  fromConfigG key config =+    M1 <$> fromConfigWithConNameG @inner (conName @constructor undefined) key config  -- | Purely 'Generic's machinery, ignore... class FromConfigWithConNameG f where-  fetchFromConfigWithConNameG :: String -> Key -> Config -> IO (f a)+  fromConfigWithConNameG :: String -> Key -> Config -> IO (f a)  instance (FromConfigWithConNameG left, FromConfigWithConNameG right) =>     FromConfigWithConNameG (left :*: right) where-  fetchFromConfigWithConNameG s key config = do-    leftValue <- fetchFromConfigWithConNameG @left s key config-    rightValue <- fetchFromConfigWithConNameG @right s key config+  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-  fetchFromConfigWithConNameG s key config =+  fromConfigWithConNameG s key config =     let       applyFirst :: (Char -> Char) -> Text -> Text       applyFirst f t = case Text.uncons t of@@ -454,10 +433,10 @@         case Text.stripPrefix prefix fieldName of           Just stripped -> applyFirst Char.toLower stripped           Nothing -> fieldName-    in M1 <$> fetchFromConfigG @inner (key /. fromText scopedKey) config+    in M1 <$> fromConfigG @inner (key /. fromText scopedKey) config -instance (FromConfig inner) => FromConfigG (Rec0 inner) where-  fetchFromConfigG key config = do+instance (FromConfig inner, Typeable inner) => FromConfigG (Rec0 inner) where+  fromConfigG key config = do     K1 <$> fetchFromConfig @inner key config  -- | Purely 'Generic's machinery, ignore...@@ -487,7 +466,6 @@  instance (IntoDefaultsG inner, Selector selector) =>     IntoDefaultsWithConNameG (S1 selector inner) where-   intoDefaultsWithConNameG s key (M1 inner) =     let       applyFirst :: (Char -> Char) -> Text -> Text

@@ -15,6 +15,8 @@   , (/.)   , stripKeyPrefix   , isKeyPrefixOf+  , isValidKeyFragment+  , isKeyCharacter   -- * Introspecting 'Key's   , rawKeyComponents   , unconsKey

@@ -45,7 +45,7 @@ mkKey s =   Key .   filter (/= mempty) .-  fmap (Text.filter Char.isAlphaNum . Text.toLower) .+  fmap (Text.filter isKeyCharacter . Text.toLower) .   Text.split (== '.') .   fromString   $ s@@ -89,3 +89,15 @@ 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

@@ -39,12 +39,18 @@ fromConfig :: Key -> SourceCreator fromConfig key config = do   filePath <- getFilePathFromEnv key "properties" config-  fromFilePath filePath+  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+fromFilePath' :: FilePath -> IO Source+fromFilePath' filePath = do   fileExists <- doesFileExist filePath   if fileExists     then do

@@ -7,6 +7,7 @@  import Conferer.Config import Conferer.Source.InMemory+import Conferer.FromConfig.Internal (fromDynamics)  missingKey :: Key -> KeyLookupResult -> Bool  missingKey expectedKey (MissingKey k) = [expectedKey] == k@@ -21,7 +22,7 @@ foundInDefaults :: forall expected. (Eq expected, Typeable expected)   => Key -> expected -> KeyLookupResult -> Bool  foundInDefaults expectedKey expected (FoundInDefaults k d) =  -  Just expected == fromDynamic @expected d && expectedKey == k+  Just expected == fromDynamics @expected d && expectedKey == k foundInDefaults _expctedKey _expected _ =     False @@ -197,3 +198,14 @@                   [ ]             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)

@@ -12,7 +12,6 @@   context "Basic fetching" $ do     describe "fetching a Bool from config" $ do       ensureEmptyConfigThrows @Bool-      ensureWrongTypeDefaultThrows @Bool        ensureUsingDefaultReturnsSameValue @Bool True       ensureUsingDefaultReturnsSameValue @Bool False

@@ -11,9 +11,7 @@   , aConfigParserError   , aMissingRequiredKey   , aMissingRequiredKeys-  , aTypeMismatchWithDefaultError   , ensureEmptyConfigThrows-  , ensureWrongTypeDefaultThrows   , ensureUsingDefaultReturnsSameValue   , ensureSingleConfigParsesTheRightThing   , ensureSingleConfigThrowsParserError@@ -38,12 +36,12 @@   , ConfigParsingError(..)   ) import Conferer.FromConfig-import Conferer.Source.InMemory+import qualified Conferer.Source.InMemory as InMemory  configWith :: [(Key, Text)] -> IO Config configWith keyValues =   emptyConfig-  & addSource (fromConfig keyValues)+  & addSource (InMemory.fromConfig keyValues)  anyConfigParserError :: ConfigParsingError -> Bool anyConfigParserError _ = True@@ -60,11 +58,6 @@ aMissingRequiredKeys keys (MissingRequiredKey k t) =   keys == k && typeRep (Proxy :: Proxy t) == t -aTypeMismatchWithDefaultError :: forall a dyn. (Typeable dyn, Typeable a) =>-  Key -> dyn -> TypeMismatchWithDefault -> Bool-aTypeMismatchWithDefaultError key dyn e =-  e == typeMismatchWithDefault @a key (toDyn dyn)- data InvalidThing = InvalidThing deriving (Show, Eq)  ensureEmptyConfigThrows :: forall a. (Typeable a, FromConfig a) => SpecWith ()@@ -75,17 +68,8 @@       fetchFromConfig @a "some.key" config         `shouldThrow` aMissingRequiredKey @a "some.key" -ensureWrongTypeDefaultThrows :: forall a. (Typeable a, FromConfig a) => SpecWith ()-ensureWrongTypeDefaultThrows =-  context "with invalid types in the defaults"  $ do-    it "throws an exception" $ do-      config <- configWith []-      fetchFromConfig @a "some.key"-          (config & addDefault "some.key" InvalidThing)-        `shouldThrow` aTypeMismatchWithDefaultError @a "some.key" InvalidThing- ensureSingleConfigThrowsParserError ::-    forall a. (FromConfig a) =>+    forall a. (FromConfig a, Typeable a) =>     Text -> SpecWith () ensureSingleConfigThrowsParserError keyContent =   context "with invalid types in the defaults"  $ do@@ -106,7 +90,7 @@       fetchedValue `shouldBe` value  ensureSingleConfigParsesTheRightThing ::-    forall a. (Eq a, Show a, FromConfig a) =>+    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@@ -116,7 +100,7 @@       fetchedValue `shouldBe` value  ensureSingleConfigThrows ::-    forall a e. (FromConfig a, Exception e) =>+    forall a e. (FromConfig a, Typeable a, Exception e) =>     Text -> (e -> Bool) -> SpecWith () ensureSingleConfigThrows keyContent checkException =   it "gets the right value" $ do@@ -127,6 +111,7 @@ ensureFetchParses ::     forall a.     ( FromConfig a+    , Typeable a     , Eq a     , Show a     )@@ -146,6 +131,7 @@ ensureFetchThrows ::     forall a e.     ( FromConfig a+    , Typeable a     , Exception e     )     => [(Key, Text)]

@@ -22,8 +22,6 @@           , "some.key.filename"           ] -      ensureFetchThrows @File [] [("", toDyn False)] $-        aTypeMismatchWithDefaultError @File "some.key" False       context "with whole path in root" $ do         ensureFetchParses @File           [ ("", pack $ "some" </> "file.png")

@@ -20,7 +20,6 @@ spec = do   describe "list parsing" $ do     ensureEmptyConfigThrows @[Int]-    ensureWrongTypeDefaultThrows @[Int]     ensureUsingDefaultReturnsSameValue @[Int] [7]      context "with an empty keys it always gets an empty list" $ do@@ -165,8 +164,8 @@             \fromconfig uses listSubkeys" $ do       ensureFetchParses         @[[Int]]-        [ ("1.first", "0")+        [ ("1.0", "0")         ]-        [ ("prototype.second", toDyn @Int 8)+        [ ("prototype.1", toDyn @Int 8)         ]         [[0, 8]]

@@ -14,7 +14,6 @@   context "Numbers fetching" $ do     describe "fetching an Int from config" $ do       ensureEmptyConfigThrows @Int-      ensureWrongTypeDefaultThrows @Int       ensureUsingDefaultReturnsSameValue @Int 7       ensureSingleConfigParsesTheRightThing @Int "7" 7       ensureSingleConfigParsesTheRightThing @Int "-7" (-7)@@ -22,7 +21,6 @@      describe "fetching a Float from config" $ do       ensureEmptyConfigThrows @Float-      ensureWrongTypeDefaultThrows @Float       ensureUsingDefaultReturnsSameValue @Float 7.5       ensureSingleConfigParsesTheRightThing @Float "9.5" 9.5       ensureSingleConfigParsesTheRightThing @Float "-9.5" (-9.5)

@@ -12,21 +12,17 @@ spec = do     describe "fetching a String from config" $ do       ensureEmptyConfigThrows @String-      ensureWrongTypeDefaultThrows @String       ensureUsingDefaultReturnsSameValue @String "aaa"       ensureSingleConfigParsesTheRightThing @String "thing" "thing"     describe "fetching text from config" $ do       ensureEmptyConfigThrows @Text-      ensureWrongTypeDefaultThrows @Text       ensureUsingDefaultReturnsSameValue @Text "aaa"       ensureSingleConfigParsesTheRightThing @Text "thing" "thing"     describe "fetching bytestring from config" $ do       ensureEmptyConfigThrows @BS.ByteString-      ensureWrongTypeDefaultThrows @BS.ByteString       ensureUsingDefaultReturnsSameValue @BS.ByteString "aaa"       ensureSingleConfigParsesTheRightThing @BS.ByteString "thing" "thing"     describe "fetching lazy bytestring from config" $ do       ensureEmptyConfigThrows @LBS.ByteString-      ensureWrongTypeDefaultThrows @LBS.ByteString       ensureUsingDefaultReturnsSameValue @LBS.ByteString "aaa"       ensureSingleConfigParsesTheRightThing @LBS.ByteString "thing" "thing"

@@ -1,8 +1,14 @@+{-# LANGUAGE TypeApplications #-} module Conferer.FromConfigSpec (spec) where  import Test.Hspec+import Conferer.FromConfig+import Conferer.FromConfig.Extended  spec :: Spec spec = do-  context "Basic fetching" $ do-    return ()+  describe "Override FromConfig" $ do+    ensureFetchParses @Int+      []+      [ ("", overrideFetch @Int $ \_k _c -> pure 42) ]+      42

@@ -5,10 +5,9 @@ import Test.Hspec  import Conferer.FromConfig-import Conferer.Config-import Conferer.Source.InMemory  import GHC.Generics+import Conferer.FromConfig.Extended  data Thing = Thing   { thingA :: Int@@ -35,88 +34,65 @@   describe "Generics" $ do     context "with a simple record" $ do       context "without a default but with all of the keys defined" $ do-        it "returns the default" $ do-          c <- emptyConfig-                & addSource (fromConfig-                  [ ("somekey.a", "0")-                  , ("somekey.b", "0")-                  ])--          res <- fetchFromConfig @Thing "somekey" c-          res `shouldBe` Thing { thingA = 0, thingB = 0 }+        ensureFetchParses+          [ ("a", "0")+          , ("b", "0")+          ]+          []+          Thing { thingA = 0, thingB = 0 }       context "when no keys are set" $ do-        it "returns the default" $ do-          c <- emptyConfig-                & addDefault "somekey" (configDef @Thing)-                & addSource (fromConfig [ ])--          res <- fetchFromConfig @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-                & addDefault "somekey" (configDef @Thing)-                & addSource (fromConfig-                  [ ("somekey.a", "1")-                  , ("somekey.b", "2")-                  ])--          res <- fetchFromConfig @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-                & addDefault "somekey" (configDef @Thing)-                & addSource (fromConfig-                  [ ("somekey.b", "2")-                  ])--          res <- fetchFromConfig @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-                & addDefault "somekey" (configDef @Bigger)-                & addSource (fromConfig-                  [ ])--          res <- fetchFromConfig @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-                & addDefault "somekey" (configDef @Bigger)-                & addSource (fromConfig-                  [ ("somekey.b", "30")-                  ])--          res <- fetchFromConfig @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-                & addDefault "somekey" (configDef @Bigger)-                & addSource (fromConfig-                  [ ("somekey.thing.a", "30")-                  ])--          res <- fetchFromConfig @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-                & addDefault "somekey" (configDef @Bigger)-                & addSource (fromConfig-                  [ ("somekey.thing.a", "10")-                  , ("somekey.thing.b", "20")-                  , ("somekey.b", "30")-                  ])--          res <- fetchFromConfig @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}

@@ -7,7 +7,7 @@  spec :: Spec spec = do-  describe "keys" $ 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@@ -18,3 +18,22 @@       "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

@@ -7,7 +7,7 @@ import Test.Hspec  import Data.Text (Text)-import Conferer.FromConfig ( FromConfig(fetchFromConfig) )+import Conferer.FromConfig (fetchFromConfig) import Conferer.Source.InMemory (fromConfig) import Data.Dynamic (toDyn) import Conferer.Config (Config)