diff options
| -rw-r--r-- | Data/ConfigManager.hs | 17 | ||||
| -rw-r--r-- | config-manager.cabal | 8 | ||||
| -rw-r--r-- | tests/Helper.hs | 1 | ||||
| -rw-r--r-- | tests/Test.hs | 46 |
4 files changed, 40 insertions, 32 deletions
diff --git a/Data/ConfigManager.hs b/Data/ConfigManager.hs index 038276e..aa92554 100644 --- a/Data/ConfigManager.hs +++ b/Data/ConfigManager.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + -- | -- Module: Data.ConfigManager -- License: GPL-3 @@ -30,12 +32,10 @@ module Data.ConfigManager import Prelude hiding (lookup) import Text.Read (readMaybe) -import Control.Monad (join) import Data.Text (Text) import qualified Data.Text as T import qualified Data.HashMap.Strict as M -import Data.Maybe (fromMaybe) import qualified Data.ConfigManager.Reader as R import Data.ConfigManager.Types @@ -47,14 +47,21 @@ readConfig = R.readConfig Required -- | Lookup for the value associated to a name. -lookup :: Read a => Name -> Config -> Maybe a -lookup name config = join . fmap (readMaybe . T.unpack) $ M.lookup name (hashMap config) +lookup :: Read a => Name -> Config -> Either Text a +lookup name config = + case M.lookup name (hashMap config) of + Nothing -> + Left . T.concat $ ["Value not found for Key ", name] + Just value -> + case readMaybe . T.unpack $ value of + Nothing -> Left . T.concat $ ["Reading error for key ", name] + Just result -> Right result -- | Lookup for the value associated to a name and return the default value if -- no binding exists with the given name. lookupDefault :: Read a => a -> Name -> Config -> a -lookupDefault defaultValue name config = fromMaybe defaultValue $ lookup name config +lookupDefault defaultValue name config = foldl (flip const) defaultValue $ lookup name config -- $format -- diff --git a/config-manager.cabal b/config-manager.cabal index 0d4f710..9f5efdc 100644 --- a/config-manager.cabal +++ b/config-manager.cabal @@ -1,5 +1,5 @@ name: config-manager -version: 0.0.0.2 +version: 0.1.0.0 synopsis: Configuration management description: A configuration management library which supports: @@ -8,7 +8,7 @@ description: . * required or optional imports, . - * and comments. + * comments. homepage: https://gitlab.com/guyonvarch/config-manager bug-reports: https://gitlab.com/guyonvarch/config-manager/issues license: GPL-3 @@ -27,7 +27,7 @@ library other-modules: Data.ConfigManager.Reader Data.ConfigManager.Parser Data.ConfigManager.Types.Internal - ghc-options: -Wall + ghc-options: -Wall -Werror build-depends: base < 5, text, unordered-containers, @@ -43,7 +43,7 @@ Test-Suite test-config-manager type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Test.hs - ghc-options: -Wall + ghc-options: -Wall -Werror -fno-warn-type-defaults build-depends: base, text, config-manager, diff --git a/tests/Helper.hs b/tests/Helper.hs index 00bccc9..fe2aadc 100644 --- a/tests/Helper.hs +++ b/tests/Helper.hs @@ -26,7 +26,6 @@ getConfig input = T.writeFile filePath input config <- readConfig filePath removeFile filePath - -- putStrLn . show $ config return $ eitherToMaybe config ) diff --git a/tests/Test.hs b/tests/Test.hs index 03f9d39..641e1e6 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -8,6 +8,8 @@ import Prelude hiding (lookup) import qualified Data.HashMap.Strict as M import Data.Maybe (fromJust) +import Data.Either (isLeft) +import Data.Text (Text) import Test.Framework import Test.Framework.Providers.HUnit @@ -38,8 +40,8 @@ bindingAssertion = do assertEqual "empty" (M.fromList []) (hashMap empty) oneBinding <- forceGetConfig "x = \"foo\"" - assertEqual "one binding present" (Just "foo") (lookup "x" oneBinding :: Maybe String) - assertEqual "one binding missing" Nothing (lookup "y" oneBinding :: Maybe String) + assertEqual "one binding present" (Right "foo") (lookup "x" oneBinding) + assertBool "one binding missing" (isLeft $ (lookup "y" oneBinding :: Either Text Int)) assertEqual "one binding count" 1 (M.size . hashMap $ oneBinding) multipleBindings <- forceGetConfig $ T.unlines @@ -48,7 +50,7 @@ bindingAssertion = do , "z = \"baz\"" ] assertEqual "multiple bindings count" 3 (M.size . hashMap $ multipleBindings) - assertEqual "multiple bindings last" (Just "baz") (lookup "z" multipleBindings :: Maybe String) + assertEqual "multiple bindings last" (Right "baz") (lookup "z" multipleBindings) overlappingBindings <- forceGetConfig $ T.unlines [ "x = \"foo\"" @@ -56,7 +58,7 @@ bindingAssertion = do , "x = \"baz\"" ] assertEqual "overlapping bindings count" 2 (M.size . hashMap $ overlappingBindings) - assertEqual "overlapping bindings redefinition" (Just "baz") (lookup "x" overlappingBindings :: Maybe String) + assertEqual "overlapping bindings redefinition" (Right "baz") (lookup "x" overlappingBindings) lookupDefaultAssertion :: Assertion lookupDefaultAssertion = do @@ -71,9 +73,9 @@ nameAssertion = do , "valid_ident = \"foo\"" , "valid-ident = \"foo\"" ] - assertEqual "validIdent" (Just "foo") (lookup "validIdent" validNames :: Maybe String) - assertEqual "valid_ident" (Just "foo") (lookup "valid_ident" validNames :: Maybe String) - assertEqual "valid-ident" (Just "foo") (lookup "valid-ident" validNames :: Maybe String) + assertEqual "validIdent" (Right "foo") (lookup "validIdent" validNames) + assertEqual "valid_ident" (Right "foo") (lookup "valid_ident" validNames) + assertEqual "valid-ident" (Right "foo") (lookup "valid-ident" validNames) invalid1 <- getConfig "-invalid_ident = \"foo\"" assertEqual "-invalid" Nothing invalid1 @@ -89,12 +91,12 @@ valueAssertion = do , "c = 5.0 " , "d = True " ] - assertEqual "string" (Just "lorem ipsum sir dolor emet") (lookup "a" config :: Maybe String) - assertEqual "integer" (Just 4) (lookup "b" config :: Maybe Int) - assertEqual "double 1" (Just 4.0) (lookup "b" config :: Maybe Double) - assertEqual "double 2" (Just 5.0) (lookup "c" config :: Maybe Double) - assertEqual "integer fail" Nothing (lookup "c" config :: Maybe Int) - assertEqual "boolean" (Just True) (lookup "d" config :: Maybe Bool) + assertEqual "string" (Right "lorem ipsum sir dolor emet") (lookup "a" config) + assertEqual "integer" (Right 4) (lookup "b" config) + assertEqual "double 1" (Right 4.0) (lookup "b" config) + assertEqual "double 2" (Right 5.0) (lookup "c" config) + assertBool "integer fail" (isLeft $ (lookup "c" config :: Either Text Int)) + assertEqual "boolean" (Right True) (lookup "d" config) return () skipAssertion :: Assertion @@ -110,18 +112,18 @@ skipAssertion = do , " " ] assertEqual "bindings count" 2 (M.size . hashMap $ config) - assertEqual "bindings x" (Just "foo") (lookup "x" config :: Maybe String) - assertEqual "bindings y" (Just "bar") (lookup "y" config :: Maybe String) + assertEqual "bindings x" (Right "foo") (lookup "x" config) + assertEqual "bindings y" (Right "bar") (lookup "y" config) importAssertion :: Assertion importAssertion = do config <- fromJust . eitherToMaybe <$> readConfig "tests/resources/a.conf" - assertEqual "a" (Just "foo") (lookup "a" config :: Maybe String) - assertEqual "b" (Just 15) (lookup "b" config :: Maybe Int) - assertEqual "c" (Just "re baz") (lookup "c" config :: Maybe String) - assertEqual "d" (Just "zap") (lookup "d" config :: Maybe String) - assertEqual "e" (Just "re nam") (lookup "e" config :: Maybe String) - assertEqual "f" (Just 8.5) (lookup "f" config :: Maybe Double) + assertEqual "a" (Right "foo") (lookup "a" config) + assertEqual "b" (Right 15) (lookup "b" config) + assertEqual "c" (Right "re baz") (lookup "c" config) + assertEqual "d" (Right "zap") (lookup "d" config) + assertEqual "e" (Right "re nam") (lookup "e" config) + assertEqual "f" (Right 8.5) (lookup "f" config) missingConfig <- getConfig "import \"required.conf\"" assertEqual "missing config" Nothing missingConfig @@ -130,4 +132,4 @@ importAssertion = do [ "importMaybe \"required.conf\"" , "x = 4" ] - assertEqual "missing optional config" (Just 4) (lookup "x" missingOptionalConfig :: Maybe Int) + assertEqual "missing optional config" (Right 4) (lookup "x" missingOptionalConfig) |