diff --git a/conferer.cabal b/conferer.cabal --- a/conferer.cabal +++ b/conferer.cabal @@ -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 diff --git a/src/Conferer.hs b/src/Conferer.hs --- a/src/Conferer.hs +++ b/src/Conferer.hs @@ -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 diff --git a/src/Conferer/Core.hs b/src/Conferer/Core.hs --- a/src/Conferer/Core.hs +++ b/src/Conferer/Core.hs @@ -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 diff --git a/src/Conferer/FetchFromConfig/Basics.hs b/src/Conferer/FetchFromConfig/Basics.hs --- a/src/Conferer/FetchFromConfig/Basics.hs +++ b/src/Conferer/FetchFromConfig/Basics.hs @@ -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 diff --git a/src/Conferer/Provider/Files.hs b/src/Conferer/Provider/Files.hs --- a/src/Conferer/Provider/Files.hs +++ b/src/Conferer/Provider/Files.hs @@ -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 diff --git a/src/Conferer/Types.hs b/src/Conferer/Types.hs --- a/src/Conferer/Types.hs +++ b/src/Conferer/Types.hs @@ -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 diff --git a/test/Conferer/FetchFromConfig/BasicsSpec.hs b/test/Conferer/FetchFromConfig/BasicsSpec.hs --- a/test/Conferer/FetchFromConfig/BasicsSpec.hs +++ b/test/Conferer/FetchFromConfig/BasicsSpec.hs @@ -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 diff --git a/test/Conferer/GenericsSpec.hs b/test/Conferer/GenericsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Conferer/GenericsSpec.hs @@ -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} diff --git a/test/Conferer/Provider/ArgsSpec.hs b/test/Conferer/Provider/ArgsSpec.hs --- a/test/Conferer/Provider/ArgsSpec.hs +++ b/test/Conferer/Provider/ArgsSpec.hs @@ -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 diff --git a/test/Conferer/Provider/EnvSpec.hs b/test/Conferer/Provider/EnvSpec.hs --- a/test/Conferer/Provider/EnvSpec.hs +++ b/test/Conferer/Provider/EnvSpec.hs @@ -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" diff --git a/test/Conferer/Provider/MappingSpec.hs b/test/Conferer/Provider/MappingSpec.hs --- a/test/Conferer/Provider/MappingSpec.hs +++ b/test/Conferer/Provider/MappingSpec.hs @@ -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" diff --git a/test/Conferer/Provider/NamespacedSpec.hs b/test/Conferer/Provider/NamespacedSpec.hs --- a/test/Conferer/Provider/NamespacedSpec.hs +++ b/test/Conferer/Provider/NamespacedSpec.hs @@ -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" diff --git a/test/Conferer/Provider/NullSpec.hs b/test/Conferer/Provider/NullSpec.hs --- a/test/Conferer/Provider/NullSpec.hs +++ b/test/Conferer/Provider/NullSpec.hs @@ -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 diff --git a/test/Conferer/Provider/SimpleSpec.hs b/test/Conferer/Provider/SimpleSpec.hs --- a/test/Conferer/Provider/SimpleSpec.hs +++ b/test/Conferer/Provider/SimpleSpec.hs @@ -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" diff --git a/test/ConfererSpec.hs b/test/ConfererSpec.hs --- a/test/ConfererSpec.hs +++ b/test/ConfererSpec.hs @@ -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"