packages feed

conferer 0.1.0.4 → 0.2.0.0

raw patch · 15 files changed

+358/−96 lines, 15 filesdep +deepseqPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq

API changes (from Hackage documentation)

+ Conferer.FetchFromConfig.Basics: class UpdateFromConfigWithConNameG f
+ Conferer.FetchFromConfig.Basics: instance (Conferer.FetchFromConfig.Basics.UpdateFromConfigWithConNameG inner, GHC.Generics.Constructor constructor) => Conferer.Types.UpdateFromConfigG (GHC.Generics.C1 constructor inner)
+ Conferer.FetchFromConfig.Basics: instance (Conferer.FetchFromConfig.Basics.UpdateFromConfigWithConNameG left, Conferer.FetchFromConfig.Basics.UpdateFromConfigWithConNameG right) => Conferer.FetchFromConfig.Basics.UpdateFromConfigWithConNameG (left GHC.Generics.:*: right)
+ Conferer.FetchFromConfig.Basics: instance (Conferer.Types.UpdateFromConfigG inner, GHC.Generics.Selector selector) => Conferer.FetchFromConfig.Basics.UpdateFromConfigWithConNameG (GHC.Generics.S1 selector inner)
+ Conferer.FetchFromConfig.Basics: instance Conferer.Types.FetchFromConfig inner => Conferer.Types.UpdateFromConfigG (GHC.Generics.Rec0 inner)
+ Conferer.FetchFromConfig.Basics: instance Conferer.Types.UpdateFromConfigG inner => Conferer.Types.UpdateFromConfigG (GHC.Generics.D1 metadata inner)
+ Conferer.FetchFromConfig.Basics: updateFromConfigWithConNameG :: UpdateFromConfigWithConNameG f => String -> Key -> Config -> f a -> IO (f a)
+ Conferer.Types: ConfigParsingError :: Key -> Text -> TypeRep -> ConfigParsingError
+ Conferer.Types: FailedToFetchError :: Key -> TypeRep -> FailedToFetchError
+ Conferer.Types: class DefaultConfig a
+ Conferer.Types: class Typeable a => UpdateFromConfig a
+ Conferer.Types: class UpdateFromConfigG f
+ Conferer.Types: configDef :: DefaultConfig a => a
+ Conferer.Types: data ConfigParsingError
+ Conferer.Types: data FailedToFetchError
+ Conferer.Types: instance GHC.Classes.Eq Conferer.Types.ConfigParsingError
+ Conferer.Types: instance GHC.Classes.Eq Conferer.Types.FailedToFetchError
+ Conferer.Types: instance GHC.Exception.Type.Exception Conferer.Types.ConfigParsingError
+ Conferer.Types: instance GHC.Exception.Type.Exception Conferer.Types.FailedToFetchError
+ Conferer.Types: instance GHC.Show.Show Conferer.Types.ConfigParsingError
+ Conferer.Types: instance GHC.Show.Show Conferer.Types.FailedToFetchError
+ Conferer.Types: updateFromConfig :: (UpdateFromConfig a, Generic a, UpdateFromConfigG (Rep a), DefaultConfig a) => Key -> Config -> a -> IO a
+ Conferer.Types: updateFromConfigG :: UpdateFromConfigG f => Key -> Config -> f a -> IO (f a)
- Conferer: fetch :: FetchFromConfig a => Key -> Config -> IO (Either Text a)
+ Conferer: fetch :: (FetchFromConfig a, DefaultConfig a, UpdateFromConfig a) => Key -> Config -> IO (Maybe a)
- Conferer: getFromConfig :: FetchFromConfig a => Key -> Config -> IO a
+ Conferer: getFromConfig :: forall a. (Typeable a, FetchFromConfig a) => Key -> Config -> IO a
- Conferer: getKey :: Key -> Config -> IO (Either Text Text)
+ Conferer: getKey :: Key -> Config -> IO (Maybe Text)
- Conferer.Core: getFromConfig :: FetchFromConfig a => Key -> Config -> IO a
+ Conferer.Core: getFromConfig :: forall a. (Typeable a, FetchFromConfig a) => Key -> Config -> IO a
- Conferer.Core: getKey :: Key -> Config -> IO (Either Text Text)
+ Conferer.Core: getKey :: Key -> Config -> IO (Maybe Text)
- Conferer.FetchFromConfig.Basics: fetchFromConfigByRead :: Read a => Key -> Config -> IO (Either Text a)
+ Conferer.FetchFromConfig.Basics: fetchFromConfigByRead :: (Typeable a, Read a) => Key -> Config -> IO (Maybe a)
- Conferer.FetchFromConfig.Basics: fetchFromConfigWith :: (Text -> Maybe a) -> Key -> Config -> IO (Either Text a)
+ Conferer.FetchFromConfig.Basics: fetchFromConfigWith :: forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO (Maybe a)
- Conferer.FetchFromConfig.Basics: findKeyAndApplyConfig :: FetchFromConfig newvalue => Config -> Key -> Key -> (newvalue -> config -> config) -> Either Text config -> IO (Either Text config)
+ Conferer.FetchFromConfig.Basics: findKeyAndApplyConfig :: forall newvalue config. FetchFromConfig newvalue => Config -> Key -> Key -> (newvalue -> config -> config) -> config -> IO config
- Conferer.FetchFromConfig.Basics: fromValueWith :: (Text -> Maybe a) -> Key -> Text -> Either Text a
+ Conferer.FetchFromConfig.Basics: fromValueWith :: (Text -> Maybe a) -> Text -> Maybe a
- Conferer.Types: fetch :: FetchFromConfig a => Key -> Config -> IO (Either Text a)
+ Conferer.Types: fetch :: (FetchFromConfig a, DefaultConfig a, UpdateFromConfig a) => Key -> Config -> IO (Maybe a)

Files

conferer.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 998c1dffa6a5fb2effd27e4a50c6b60f419580bc17d495a886912a829575eb93+-- hash: 1f741ccac642f7efeeebac945b43d38c5662447adc1d2396aae94def3780aabb  name:           conferer-version:        0.1.0.4+version:        0.2.0.0 synopsis:       Configuration management library  description:    Library to abstract the parsing of many haskell config values from different config sources@@ -55,6 +55,7 @@   main-is: Spec.hs   other-modules:       Conferer.FetchFromConfig.BasicsSpec+      Conferer.GenericsSpec       Conferer.Provider.ArgsSpec       Conferer.Provider.EnvSpec       Conferer.Provider.MappingSpec@@ -72,6 +73,7 @@     , bytestring >=0.10 && <0.11     , conferer     , containers >=0.5 && <0.7+    , deepseq     , directory >=1.2 && <2.0     , hspec     , text >=1.1 && <1.3
src/Conferer.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} -- | -- Module:      Conferer -- Copyright:   (c) 2019 Lucas David Traverso@@ -98,8 +99,6 @@ import           Conferer.Provider.CLIArgs import           Conferer.Provider.Null import           Conferer.Provider.PropertiesFile--  -- | Default config which reads from command line arguments, env vars and -- property files
src/Conferer/Core.hs view
@@ -4,7 +4,9 @@ import qualified Data.Text as Text import           Data.Map (Map) import qualified Data.Map as Map-import           Data.Either (either)+import           Data.Maybe (fromMaybe)+import           Data.Typeable (Typeable, Proxy(..), typeRep)+import           Control.Exception (throw)  import           Conferer.Provider.Simple import           Conferer.Types@@ -12,15 +14,15 @@ -- | Most Basic function to interact directly with a 'Config'. It always returns --   'Text' in the case of success and implements the logic to traverse --   providers inside the 'Config'.-getKey :: Key -> Config -> IO (Either Text Text)+getKey :: Key -> Config -> IO (Maybe Text) getKey k config =   go $ providers config ++ [mkPureMapProvider (defaults config)]   where-    go [] = return $ Left ("Key '" `Text.append` keyName k `Text.append` "' was not found")+    go [] = return Nothing     go (provider:providers) = do       res <- getKeyInProvider provider k       case res of-        Just t -> return $ Right t+        Just t -> return $ Just t         Nothing -> go providers  @@ -28,9 +30,10 @@ --   instance. -- --   This function throws an exception if the key is not found.-getFromConfig :: FetchFromConfig a => Key -> Config -> IO a-getFromConfig k config =-  either (error . Text.unpack) id <$> fetch k config+getFromConfig :: forall a. (Typeable a, FetchFromConfig a) => Key -> Config -> IO a+getFromConfig key config =+  fromMaybe (throw $ FailedToFetchError key (typeRep (Proxy :: Proxy a)))+    <$> fetch key config  -- | Create a new 'Key' by concatenating two existing keys. (/.) :: Key -> Key -> Key@@ -63,5 +66,6 @@  -- | Same as 'getKey' but it throws if the 'Key' isn't found unsafeGetKey :: Key -> Config -> IO Text-unsafeGetKey k config =-  either (error . Text.unpack) id <$> getKey k config+unsafeGetKey key config =+  fromMaybe (throw $ FailedToFetchError key (typeRep (Proxy :: Proxy Text)))+    <$> getKey key config
src/Conferer/FetchFromConfig/Basics.hs view
@@ -1,12 +1,21 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+ module Conferer.FetchFromConfig.Basics where  import           Conferer.Types import           Conferer.Core (getKey, (/.))+import           Control.Monad (join) import           Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import           Data.ByteString (ByteString)+import           Data.Maybe (fromMaybe)+import           Control.Exception+import           Data.Char (toLower)+import           Data.Typeable (Typeable, typeRep, Proxy(..))+import           GHC.Generics  import           Data.String (IsString, fromString) @@ -21,18 +30,12 @@ instance FetchFromConfig Float where   fetch = fetchFromConfigByRead -fetchFromConfigByRead :: Read a => Key -> Config -> IO (Either Text a)-fetchFromConfigByRead = fetchFromConfigWith (readMaybe . Text.unpack)- instance FetchFromConfig ByteString where   fetch = fetchFromConfigWith (Just . Text.encodeUtf8)  instance FetchFromConfig a => FetchFromConfig (Maybe a)  where-  fetch k c = do-    v <- getKey k c-    if v == Right ""-      then return (Right Nothing)-      else fmap Just <$> fetch k c+  fetch k config =+    fmap return <$> fetch k config  instance FetchFromConfig String where   fetch = fetchFromConfigWith (Just . Text.unpack)@@ -41,24 +44,34 @@   fetch = fetchFromConfigWith (Just)  instance FetchFromConfig Bool where-    fetch = fetchFromConfigWith parseBool-        where-          parseBool text =-            case Text.toLower text of-              "false" -> Just False-              "true" -> Just True-              _ -> Nothing-fromValueWith :: (Text -> Maybe a) -> Key -> Text -> Either Text a-fromValueWith parseValue key valueAsText = case parseValue valueAsText of-    Just value -> Right value-    Nothing -> Left ("Key " `Text.append` keyName key `Text.append` " could not be parsed correctly")+  fetch = fetchFromConfigWith parseBool+      where+        parseBool text =+          case Text.toLower text of+            "false" -> Just False+            "true" -> Just True+            _ -> Nothing -fetchFromConfigWith :: (Text -> Maybe a) -> Key -> Config -> IO (Either Text a)-fetchFromConfigWith parseValue key config =-  (fromValueWith parseValue key =<<) <$> getKey key config+fetchFromConfigByRead :: (Typeable a, Read a) => Key -> Config -> IO (Maybe a)+fetchFromConfigByRead = fetchFromConfigWith (readMaybe . Text.unpack) +fromValueWith :: (Text -> Maybe a) -> Text -> Maybe a+fromValueWith parseValue valueAsText = parseValue valueAsText++fetchFromConfigWith :: forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO (Maybe a)+fetchFromConfigWith parseValue key config = do+  getKey key config >>=+    \case+      Just value ->+        return $+          Just $+          fromMaybe (throw $ ConfigParsingError key value (typeRep (Proxy :: Proxy a))) $+          fromValueWith parseValue value+      Nothing -> return Nothing+ -- | Concatenate many transformations to the config based on keys and functions findKeyAndApplyConfig ::+  forall newvalue config.   FetchFromConfig newvalue   => Config -- ^ Complete config   -> Key -- ^ Key that indicates the part of the config that we care about@@ -66,11 +79,55 @@          -- other key)   -> (newvalue -> config -> config) -- ^ Function that knows how to use the                                     -- value to update the config-  -> Either Text config -- ^ Result of the last config updating-  -> IO (Either Text config) -- ^ Updated config-findKeyAndApplyConfig config k relativeKey f (Right customConfig) =-  fetch (k /. relativeKey) config-    >>= \case-      Left a -> return $ Right customConfig-      Right a -> return $ Right $ f a customConfig-findKeyAndApplyConfig config k relativeKey f (Left e) = return $ Left e+  -> config -- ^ Result of the last config updating+  -> IO config -- ^ Updated config+findKeyAndApplyConfig config k relativeKey f customConfig = do+  t <- fetch @newvalue (k /. relativeKey) config+  case t of+    Nothing -> return customConfig+    Just a -> return $ f a customConfig++instance UpdateFromConfigG inner =>+    UpdateFromConfigG (D1 metadata inner) where+  updateFromConfigG key config (M1 inner) =+    M1 <$> updateFromConfigG key config inner++instance (UpdateFromConfigWithConNameG inner, Constructor constructor) =>+    UpdateFromConfigG (C1 constructor inner) where+  updateFromConfigG key config (M1 inner) =+    M1 <$> updateFromConfigWithConNameG @inner (conName @constructor undefined) key config inner++class UpdateFromConfigWithConNameG f where+  updateFromConfigWithConNameG :: String -> Key -> Config -> f a -> IO (f a)++instance (UpdateFromConfigWithConNameG left, UpdateFromConfigWithConNameG right) =>+    UpdateFromConfigWithConNameG (left :*: right) where+  updateFromConfigWithConNameG s key config (left :*: right) = do+    leftValue <- updateFromConfigWithConNameG @left s key config left+    rightValue <- updateFromConfigWithConNameG @right s key config right+    return (leftValue :*: rightValue)++instance (UpdateFromConfigG inner, Selector selector) =>+    UpdateFromConfigWithConNameG (S1 selector inner) where+  updateFromConfigWithConNameG s key config (M1 inner) =+    let+      applyFirst :: (Char -> Char) -> Text -> Text+      applyFirst f t = case Text.uncons t of+        Just (c, ts) -> Text.cons (f c) ts+        Nothing -> t++      fieldName = Text.pack $ selName @selector undefined+      prefix = applyFirst toLower $ Text.pack  s+      scopedKey =+        case Text.stripPrefix prefix fieldName of+          Just stripped -> applyFirst toLower stripped+          Nothing -> fieldName+    in M1 <$> updateFromConfigG @inner (key /. Path [scopedKey]) config inner++-- | Purely 'Generics' machinery, ignore...+instance (FetchFromConfig inner) => UpdateFromConfigG (Rec0 inner) where+  updateFromConfigG key config (K1 inner) = do+    fetch @inner key config+      >>= \case+            Just newInner -> return $ K1 newInner+            Nothing -> return $ K1 inner
src/Conferer/Provider/Files.hs view
@@ -1,6 +1,7 @@ module Conferer.Provider.Files where  import qualified Data.Text as Text+import           Data.Maybe (fromMaybe)  import           Conferer.Types import           Conferer.FetchFromConfig.Basics ()@@ -11,7 +12,7 @@  getFilePathFromEnv :: Config -> String -> IO FilePath getFilePathFromEnv config extension = do-  env <- fromRight "development" <$> fetch "env" config+  env <- fromMaybe "development" <$> fetch "env" config   return $ mconcat     [ "config/"     , Text.unpack env
src/Conferer/Types.hs view
@@ -1,11 +1,19 @@+{-# 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@@ -21,6 +29,9 @@   = 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@@ -41,10 +52,71 @@ -- | Main typeclass for defining the way to get values from config, hiding the -- 'Text' based nature of the 'Provider's ----- Here an error means that the value couldn't be parsed and that a reasonable--- default was not possible.+-- Here a 'Nothing' means that the value didn't appear in the config, some+-- instances never return a value since they have defaults that can never+-- fail class FetchFromConfig a where-  fetch :: Key -> Config -> IO (Either Text a)+  fetch :: Key -> Config -> IO (Maybe a)+  default fetch :: (DefaultConfig a, UpdateFromConfig a) => Key -> Config -> IO (Maybe a)+  fetch k config = Just <$> updateFromConfig k config configDef -instance IsString Key where-  fromString s = Path $ filter (/= mempty) $ Text.split (== '.') $ fromString s+-- | Here implementing this typeclass means that this type has some kind of default+-- that is both always valid and has always the same semantics, for example: Warp.Settings+-- has a default since it's always use in the same way (to configure a warp server)+-- but for example an Int could mean many things depending on the context so it doesn't+-- really make sense to implement it for it+--+-- It's also used for the 'Generic' implementation, if you have a Record made up from+-- types that implement 'FetchFromConfig' you can derive the 'FetchFromConfig' automatically+-- by implementing 'DefaultConfig' and deriving (using 'Generic') 'UpdateFromConfig'+class DefaultConfig a where+  configDef :: a++-- | This class only exist for the 'Generics' machinery, it means that a value can get+-- updated using a config, so for example a Warp.Settings can get updated from a config,+-- but that doesn't make much sense for something like an 'Int'+--+-- You'd normally would never implement this typeclass, if you want to implement+-- 'FetchFromConfig' you should implement that directly, and if you want to use+-- 'DefaultConfig' and 'UpdateFromConfig' to implement 'FetchFromConfig' you should let+-- the default 'Generics' based implementation do it's thing+class Typeable a => UpdateFromConfig a where+  updateFromConfig :: Key -> Config -> a -> IO a+  default updateFromConfig :: (Generic a, UpdateFromConfigG (Rep a), DefaultConfig a) => Key -> Config -> a -> IO a+  updateFromConfig k c a = to <$> updateFromConfigG k c (from a)++-- | Purely 'Generics' machinery, ignore...+class UpdateFromConfigG f where+  updateFromConfigG :: Key -> Config -> f a -> IO (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/FetchFromConfig/BasicsSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-} module Conferer.FetchFromConfig.BasicsSpec where  import           Test.Hspec@@ -5,63 +7,84 @@ import           Data.Text import           Conferer import           Conferer.FetchFromConfig.Basics ()+import           Control.Exception (evaluate)+import           Data.Typeable+import           Control.DeepSeq  configWith :: [(Key, Text)] -> IO Config configWith keyValues = emptyConfig & addProvider (mkMapProvider keyValues) +configParserError_ :: ConfigParsingError -> Bool+configParserError_ = const True++configParserError :: Key -> ConfigParsingError -> Bool+configParserError key (ConfigParsingError k _ _) =+  key == k+ spec :: Spec-spec = do+spec = context "Basics" $ do   describe "fetching an Int from config" $ do     it "getting a value that can't be parsed as an int returns an error message" $ do       config <- configWith [ ("anInt", "50A") ]-      fetchedValue <- fetch "anInt" config-      fetchedValue `shouldBe` (Left "Key anInt could not be parsed correctly" :: Either Text Int)+      fetchedValue <- fetch @Int "anInt" config++      evaluate (force fetchedValue) `shouldThrow` configParserError_+      -- evaluate (force fetchedValue) `shouldThrow` anyErrorCall+     it "getting a value that can be parsed correctly returns the int" $ do       config <- configWith [ ("anInt", "50") ]-      fetchedValue <- fetch "anInt" config-      fetchedValue `shouldBe` (Right 50 :: Either Text Int)+      fetchedValue <- fetch @Int "anInt" config+      fetchedValue `shouldBe` Just 50    describe "fetching a Bool from config" $ do     it "getting a value that can't be parsed as a bool returns an error message" $ do       config <- configWith [ ("aBool", "nope") ]-      fetchedValue <- fetch "aBool" config-      fetchedValue `shouldBe` (Left "Key aBool could not be parsed correctly" :: Either Text Bool)+      fetchedValue <- fetch @Bool "aBool" config+      evaluate (force fetchedValue) `shouldThrow` configParserError_+     it "getting a value that can be parsed as a bool returns the bool" $ do       config <- configWith [ ("aBool", "True"), ("anotherBool", "False") ]       fetchedValue <- fetch "aBool" config-      fetchedValue `shouldBe` (Right True :: Either Text Bool)+      fetchedValue `shouldBe` Just True       anotherFetchedValue <- fetch "anotherBool" config-      anotherFetchedValue `shouldBe` (Right False :: Either Text Bool)+      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` (Right True :: Either Text Bool)+      fetchedValue `shouldBe` Just True       anotherFetchedValue <- fetch "anotherBool" config-      anotherFetchedValue `shouldBe` (Right False :: Either Text Bool)+      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 "aString" config-      fetchedValue `shouldBe` (Right "Bleh" :: Either Text String)+      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 "aFloat" config-      fetchedValue `shouldBe` (Right 9.5 :: Either Text Float)+      fetchedValue <- fetch @Float "aFloat" config+      fetchedValue `shouldBe` Just 9.5+     it "if the value cannot be parsed as float, it fails" $ do       config <- configWith [ ("aFloat", "ASD") ]-      fetchedValue <- fetch "aFloat" config-      fetchedValue `shouldBe` (Left "Key aFloat could not be parsed correctly" :: Either Text Float)+      fetchedValue <- fetch @Float "aFloat" config+      evaluate (force fetchedValue) `shouldThrow` configParserError_ -  describe "fetching a Maybe from config" $ do-    it "getting a value returns the value as a Just string" $ do-      config <- configWith [ ("aString", "Bleh") ]-      fetchedValue <- fetch "aString" config-      fetchedValue `shouldBe` (Right (Just "Bleh") :: Either Text (Maybe String))-    context "with an empty value that's present" $ do+  describe "fetching a String from config" $ do+    it "getting a value returns the value as a Just" $ do+      config <- configWith [ ("anInt", "17") ]+      fetchedValue <- fetch @(Maybe Int) "anInt" config+      fetchedValue `shouldBe` Just (Just 17)+    context "when the key is there but has a wrong value" $ do       it "returns Nothing" $ do-        config <- configWith [ ("aString", "") ]-        fetchedValue <- fetch "aString" config-        fetchedValue `shouldBe` (Right Nothing :: Either Text (Maybe String))+        config <- configWith [ ("anInt", "Bleh") ]+        fetchedValue <- fetch @(Maybe Int) "anInt" config+        evaluate (force fetchedValue) `shouldThrow` configParserError_+    context "when the key is not there" $ do+      it "returns Nothing" $ do+        config <- configWith [ ]+        fetchedValue <- fetch @(Maybe Int) "anInt" config+        fetchedValue `shouldBe` Nothing
+ test/Conferer/GenericsSpec.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+module Conferer.GenericsSpec where++import Test.Hspec++import Conferer+import Conferer.Types (UpdateFromConfig, DefaultConfig, configDef)++import GHC.Generics++data Thing = Thing+  { thingA :: Int+  , thingB :: Int+  } deriving (Generic, Show, Eq)++instance UpdateFromConfig Thing+instance DefaultConfig Thing where+  configDef = Thing 0 0+instance FetchFromConfig Thing++data Bigger = Bigger+  { biggerThing :: Thing+  , biggerB :: Int+  } deriving (Generic, Show, Eq)++instance UpdateFromConfig Bigger+instance DefaultConfig Bigger where+  configDef = Bigger configDef 1+instance FetchFromConfig Bigger++spec :: Spec+spec = do+  describe "Generics" $ do+    context "with a simple record" $ do+      context "when no keys are set" $ do+        it "returns the default" $ do+          c <- emptyConfig+                & addProvider (mkMapProvider [ ])++          res <- fetch @Thing "somekey" c+          res `shouldBe` Just Thing { thingA = 0, thingB = 0 }+      context "when all keys are set" $ do+        it "return the keys set" $ do+          c <- emptyConfig+                & addProvider (mkMapProvider +                  [ ("somekey.a", "1")+                  , ("somekey.b", "2")+                  ])++          res <- fetch @Thing "somekey" c+          res `shouldBe` Just Thing { thingA = 1, thingB = 2 }++      context "when some keys are set" $ do+        it "uses the default and returns the keys set" $ do+          c <- emptyConfig+                & addProvider (mkMapProvider +                  [ ("somekey.b", "2")+                  ])++          res <- fetch @Thing "somekey" c+          res `shouldBe` Just Thing { thingA = 0, thingB = 2 }++    context "with a nested record" $ do+      context "when none of the keys are set" $ do+        it "returns the default of both records" $ do+          c <- emptyConfig+                & addProvider (mkMapProvider +                  [ ])++          res <- fetch @Bigger "somekey" c+          res `shouldBe` Just Bigger { biggerThing = Thing { thingA = 0, thingB = 0 }, biggerB = 1}++      context "when some keys of the top record are set" $ do+        it "returns the default for the inner record" $ do+          c <- emptyConfig+                & addProvider (mkMapProvider +                  [ ("somekey.b", "30")+                  ])++          res <- fetch @Bigger "somekey" c+          res `shouldBe` Just Bigger { biggerThing = Thing { thingA = 0, thingB = 0 }, biggerB = 30}++      context "when some keys of the inner record are set" $ do+        it "returns the inner record updated" $ do+          c <- emptyConfig+                & addProvider (mkMapProvider +                  [ ("somekey.thing.a", "30")+                  ])++          res <- fetch @Bigger "somekey" c+          res `shouldBe` Just Bigger { biggerThing = Thing { thingA = 30, thingB = 0 }, biggerB = 1}++      context "when every key is set" $ do+        it "returns everything with the right values" $ do+          c <- emptyConfig+                & addProvider (mkMapProvider +                  [ ("somekey.thing.a", "10")+                  , ("somekey.thing.b", "20")+                  , ("somekey.b", "30")+                  ])++          res <- fetch @Bigger "somekey" c+          res `shouldBe` Just Bigger { biggerThing = Thing { thingA = 10, thingB = 20 }, biggerB = 30}
test/Conferer/Provider/ArgsSpec.hs view
@@ -15,24 +15,24 @@     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` Left "Key 'some.key' was not found"+      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` Right "value"+      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` Right "different value"+      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` Left "Key 'some.key' was not found"+      res `shouldBe` Nothing      it "after encountering a -- it stops parsing parameters" $ do       c <- mkConf ["--", "--some.key=value"]       res <- getKey "some.key" c-      res `shouldBe` Left "Key 'some.key' was not found"+      res `shouldBe` Nothing
test/Conferer/Provider/EnvSpec.hs view
@@ -28,14 +28,14 @@        \children)" $ do       c <- mkEnvConfig       res <- getKey "." c-      res `shouldBe` Right "/tmp/tmux-1000/default,2822,0"+      res `shouldBe` Just "/tmp/tmux-1000/default,2822,0"      it "getting an existent key for a child gets that value" $ do       c <- mkEnvConfig       res <- getKey "pane" c-      res `shouldBe` Right "%1"+      res `shouldBe` Just "%1"      it "keys should always be consistent as to how the words are separated" $ do       c <- mkEnvConfig       res <- getKey "pane" c-      res `shouldBe` Right "%1"+      res `shouldBe` Just "%1"
test/Conferer/Provider/MappingSpec.hs view
@@ -15,7 +15,7 @@            & addProvider (mkMappingProvider Map.empty                           $ mkMapProvider [("some.key", "some value")])       res <- getKey "some.key" c-      res `shouldBe` Left "Key 'some.key' was not found"+      res `shouldBe` Nothing      it "getting a non existent key isn't there" $ do       c <- emptyConfig@@ -23,7 +23,7 @@                           $ mkMapProvider [("key", "75")])        res <- getKey "xxxx" c-      res `shouldBe` Left "Key 'xxxx' was not found"+      res `shouldBe` Nothing      it "getting an existent key that's mapped but doesn't exist on the \        \inner provider isn't there" $ do@@ -32,7 +32,7 @@                           $ mkMapProvider [])        res <- getKey "another.key" c-      res `shouldBe` Left "Key 'another.key' was not found"+      res `shouldBe` Nothing      it "getting an existent key that's mapped properly gets it and exists on \        \the inner provider gets it" $ do@@ -40,4 +40,4 @@            & addProvider (mkMappingProvider (Map.fromList [("another.key", "some.key")])                           $ mkMapProvider [("some.key", "some value")])       res <- getKey "another.key" c-      res `shouldBe` Right "some value"+      res `shouldBe` Just "some value"
test/Conferer/Provider/NamespacedSpec.hs view
@@ -12,10 +12,10 @@            & addProvider (mkNamespacedProvider "postgres"                           $ mkMapProvider [("url", "some url")])       res <- getKey "url" c-      res `shouldBe` Left "Key 'url' was not found"+      res `shouldBe` Nothing     it "returns the wrapped value" $ do       c <- emptyConfig            & addProvider (mkNamespacedProvider "postgres"                           $ mkMapProvider [("url", "some url")])       res <- getKey "postgres.url" c-      res `shouldBe` Right "some url"+      res `shouldBe` Just "some url"
test/Conferer/Provider/NullSpec.hs view
@@ -10,4 +10,4 @@     c <- emptyConfig          & addProvider mkNullProvider     res <- getKey "some.key" c-    res `shouldBe` Left "Key 'some.key' was not found"+    res `shouldBe` Nothing
test/Conferer/Provider/SimpleSpec.hs view
@@ -14,9 +14,9 @@     it "getting a non existent key returns an empty config" $ do       c <- creator       res <- getKey "some.key" c-      res `shouldBe` Left "Key 'some.key' was not found"+      res `shouldBe` Nothing      it "getting an existent key returns unwraps the original map" $ do       c <- creator       res <- getKey "postgres.url" c-      res `shouldBe` Right "some url"+      res `shouldBe` Just "some url"
test/ConfererSpec.hs view
@@ -20,14 +20,14 @@     it "getting a non existent key returns an empty config" $ do       c <- mkConfig       res <- getKey "aaa" c-      res `shouldBe` Left "Key 'aaa' was not found"+      res `shouldBe` Nothing      it "getting an existent key returns unwraps the original map" $ do       c <- mkConfig       res <- getKey "postgres.url" c-      res `shouldBe` Right "some url"+      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` Right "4000"+      res `shouldBe` Just "4000"