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 +4/−2
- src/Conferer.hs +1/−2
- src/Conferer/Core.hs +13/−9
- src/Conferer/FetchFromConfig/Basics.hs +87/−30
- src/Conferer/Provider/Files.hs +2/−1
- src/Conferer/Types.hs +78/−6
- test/Conferer/FetchFromConfig/BasicsSpec.hs +49/−26
- test/Conferer/GenericsSpec.hs +104/−0
- test/Conferer/Provider/ArgsSpec.hs +5/−5
- test/Conferer/Provider/EnvSpec.hs +3/−3
- test/Conferer/Provider/MappingSpec.hs +4/−4
- test/Conferer/Provider/NamespacedSpec.hs +2/−2
- test/Conferer/Provider/NullSpec.hs +1/−1
- test/Conferer/Provider/SimpleSpec.hs +2/−2
- test/ConfererSpec.hs +3/−3
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"