From c6c01d7c248bca1078285c4afeaa25493e9974b3 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 16 Mar 2016 21:09:44 +0100 Subject: Add import expression --- Data/ConfigManager.hs | 7 +++---- Data/ConfigManager/Config.hs | 2 +- Data/ConfigManager/Expr.hs | 16 ++++++++++++++++ Data/ConfigManager/Parser.hs | 30 ++++++++++++++++++++---------- Data/ConfigManager/Reader.hs | 41 +++++++++++++++++++++++++++++++++++++++++ Data/ConfigManager/Types.hs | 13 ------------- config-manager.cabal | 11 +++++++---- tests/Helper.hs | 3 ++- tests/Test.hs | 17 +++++++++++++++-- tests/resources/a.conf | 7 +++++++ tests/resources/b.conf | 6 ++++++ tests/resources/c.conf | 2 ++ 12 files changed, 120 insertions(+), 35 deletions(-) create mode 100644 Data/ConfigManager/Expr.hs create mode 100644 Data/ConfigManager/Reader.hs delete mode 100644 Data/ConfigManager/Types.hs create mode 100644 tests/resources/a.conf create mode 100644 tests/resources/b.conf create mode 100644 tests/resources/c.conf diff --git a/Data/ConfigManager.hs b/Data/ConfigManager.hs index d972cd8..eb15ddf 100644 --- a/Data/ConfigManager.hs +++ b/Data/ConfigManager.hs @@ -10,15 +10,14 @@ import Control.Monad (join) import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.IO as T import qualified Data.HashMap.Strict as M import Data.ConfigManager.Config -import Data.ConfigManager.Parser (parseConfig) -import Data.ConfigManager.Types +import qualified Data.ConfigManager.Reader as R +import Data.ConfigManager.Expr readConfig :: FilePath -> IO (Either Text Config) -readConfig path = parseConfig <$> T.readFile path +readConfig = R.readConfig lookup :: Read a => Name -> Config -> Maybe a lookup name config = join . fmap (readMaybe . T.unpack) $ M.lookup name (hashMap config) diff --git a/Data/ConfigManager/Config.hs b/Data/ConfigManager/Config.hs index a98dbbb..8c79956 100644 --- a/Data/ConfigManager/Config.hs +++ b/Data/ConfigManager/Config.hs @@ -4,7 +4,7 @@ module Data.ConfigManager.Config import Data.HashMap.Strict -import Data.ConfigManager.Types +import Data.ConfigManager.Expr data Config = Config { hashMap :: HashMap Name Value diff --git a/Data/ConfigManager/Expr.hs b/Data/ConfigManager/Expr.hs new file mode 100644 index 0000000..3aa8825 --- /dev/null +++ b/Data/ConfigManager/Expr.hs @@ -0,0 +1,16 @@ +module Data.ConfigManager.Expr + ( Expr(..) + , Name + , Value + ) where + +import Data.Text (Text) + +data Expr = + Binding Name Value + | Import FilePath + deriving (Eq, Read, Show) + +type Name = Text + +type Value = Text diff --git a/Data/ConfigManager/Parser.hs b/Data/ConfigManager/Parser.hs index e2329b6..856ccfd 100644 --- a/Data/ConfigManager/Parser.hs +++ b/Data/ConfigManager/Parser.hs @@ -6,31 +6,41 @@ module Data.ConfigManager.Parser import Data.Text (Text) import qualified Data.Text as T -import qualified Data.HashMap.Strict as M import Data.Char (isSpace, isAlphaNum) import Text.ParserCombinators.Parsec -import Data.ConfigManager.Config (Config(..)) -import Data.ConfigManager.Types +import Data.ConfigManager.Expr -parseConfig :: Text -> Either Text Config +parseConfig :: Text -> Either Text [Expr] parseConfig input = - case parse bindingsParser "" (T.unpack (T.concat [input, "\n"])) of - Right bindings -> Right . Config . M.fromList $ bindings + case parse exprsParser "" (T.unpack (T.concat [input, "\n"])) of + Right exprs -> Right exprs Left parserError -> Left . T.pack . show $ parserError -bindingsParser :: Parser [Binding] -bindingsParser = skip *> many (bindingParser <* restOfLine <* skip) <* eof +exprsParser :: Parser [Expr] +exprsParser = skip *> many (exprParser <* restOfLine <* skip) <* eof -bindingParser :: Parser Binding +exprParser :: Parser Expr +exprParser = (try bindingParser) <|> (try importParser) + +bindingParser :: Parser Expr bindingParser = do name <- nameParser _ <- spaces _ <- char '=' _ <- spaces value <- valueParser - return (name, value) + return $ Binding name value + +importParser :: Parser Expr +importParser = do + _ <- string "import" + _ <- spaces + _ <- char '"' + path <- many (noneOf "\"") + _ <- char '"' + return $ Import path nameParser :: Parser Name nameParser = do diff --git a/Data/ConfigManager/Reader.hs b/Data/ConfigManager/Reader.hs new file mode 100644 index 0000000..9f4cc3c --- /dev/null +++ b/Data/ConfigManager/Reader.hs @@ -0,0 +1,41 @@ +module Data.ConfigManager.Reader + ( readConfig + ) where + +import Control.Monad (foldM) + +import System.FilePath.Posix (dropFileName, ()) + +import qualified Data.HashMap.Strict as M +import Data.Text (Text) +import qualified Data.Text.IO as T + +import Data.ConfigManager.Parser (parseConfig) +import Data.ConfigManager.Expr +import Data.ConfigManager.Config + +readConfig :: FilePath -> IO (Either Text Config) +readConfig path = do + input <- T.readFile path + case parseConfig input of + Left errorMessage -> + return . Left $ errorMessage + Right exprs -> + foldM (go fileDir) (Right emptyConfig) exprs + where fileDir = dropFileName path + emptyConfig = Config $ M.fromList [] + +go :: String -> Either Text Config -> Expr -> IO (Either Text Config) +go _ errorMessage@(Left _) _ = return errorMessage +go fileDir (Right config) expr = + case expr of + Binding name value -> + return . Right . Config $ M.insert name value (hashMap config) + Import path -> do + eitherConfig <- readConfig (fileDir path) + case eitherConfig of + Left errorMessage -> + return . Left $ errorMessage + Right importedConfig -> + let unionConfig = (hashMap importedConfig) `M.union` (hashMap config) + in return . Right . Config $ unionConfig diff --git a/Data/ConfigManager/Types.hs b/Data/ConfigManager/Types.hs deleted file mode 100644 index 2f2f00e..0000000 --- a/Data/ConfigManager/Types.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Data.ConfigManager.Types - ( Binding - , Name - , Value - ) where - -import Data.Text (Text) - -type Binding = (Name, Value) - -type Name = Text - -type Value = Text diff --git a/config-manager.cabal b/config-manager.cabal index 43fc754..d6ed354 100644 --- a/config-manager.cabal +++ b/config-manager.cabal @@ -11,19 +11,22 @@ category: Configuration, Data build-type: Simple cabal-version: >=1.10 +data-files: tests/resources/*.conf + library exposed-modules: Data.ConfigManager, - Data.ConfigManager.Config, + Data.ConfigManager.Config + other-modules: Data.ConfigManager.Reader Data.ConfigManager.Parser - -- Modules included in this library but not exported. - -- other-modules: + Data.ConfigManager.Expr -- LANGUAGE extensions used by modules in this package. -- other-extensions: ghc-options: -Wall build-depends: base < 5, text, unordered-containers, - parsec + parsec, + filepath default-language: Haskell2010 Test-Suite test-config-manager diff --git a/tests/Helper.hs b/tests/Helper.hs index 5979ae2..3dcc267 100644 --- a/tests/Helper.hs +++ b/tests/Helper.hs @@ -1,6 +1,7 @@ module Helper ( forceGetConfig , getConfig + , eitherToMaybe ) where @@ -25,7 +26,7 @@ getConfig input = T.writeFile filePath input config <- readConfig filePath removeFile filePath - putStrLn . show $ config + -- putStrLn . show $ config return $ eitherToMaybe config ) diff --git a/tests/Test.hs b/tests/Test.hs index 51ced1f..957f3ae 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -7,6 +7,7 @@ module Main import Prelude hiding (lookup) import qualified Data.HashMap.Strict as M +import Data.Maybe (fromJust) import Test.Framework import Test.Framework.Providers.HUnit @@ -16,7 +17,7 @@ import Data.ConfigManager import Data.ConfigManager.Config import qualified Data.Text as T -import Helper (forceGetConfig, getConfig) +import Helper (forceGetConfig, getConfig, eitherToMaybe) main :: IO () main = defaultMain tests @@ -27,6 +28,7 @@ tests = , testCase "name" nameAssertion , testCase "value" valueAssertion , testCase "skip" skipAssertion + , testCase "import" importAssertion ] bindingAssertion :: Assertion @@ -78,13 +80,14 @@ valueAssertion = do [ "a = \"lorem ipsum sir dolor emet\"" , "b = 4 " , "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) return () skipAssertion :: Assertion @@ -102,3 +105,13 @@ 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) + +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) diff --git a/tests/resources/a.conf b/tests/resources/a.conf new file mode 100644 index 0000000..4a475f1 --- /dev/null +++ b/tests/resources/a.conf @@ -0,0 +1,7 @@ +a = "foo" +b = "bar" +c = "baz" + +import "b.conf" + +e = "re nam" diff --git a/tests/resources/b.conf b/tests/resources/b.conf new file mode 100644 index 0000000..c75a415 --- /dev/null +++ b/tests/resources/b.conf @@ -0,0 +1,6 @@ +import "c.conf" + +b = 15 +c = "re baz" +d = "zap" +e = "nam" diff --git a/tests/resources/c.conf b/tests/resources/c.conf new file mode 100644 index 0000000..c4f1642 --- /dev/null +++ b/tests/resources/c.conf @@ -0,0 +1,2 @@ +f = 8.5 +b = False -- cgit v1.2.3