diff options
| -rw-r--r-- | Data/ConfigManager.hs | 72 | ||||
| -rw-r--r-- | Data/ConfigManager/Config.hs | 11 | ||||
| -rw-r--r-- | Data/ConfigManager/Expr.hs | 16 | ||||
| -rw-r--r-- | Data/ConfigManager/Parser.hs | 15 | ||||
| -rw-r--r-- | Data/ConfigManager/Reader.hs | 33 | ||||
| -rw-r--r-- | Data/ConfigManager/Types.hs | 17 | ||||
| -rw-r--r-- | Data/ConfigManager/Types/Internal.hs | 39 | ||||
| -rw-r--r-- | README.md | 1 | ||||
| -rw-r--r-- | config-manager.cabal | 35 | ||||
| -rw-r--r-- | tests/Helper.hs | 2 | ||||
| -rw-r--r-- | tests/Test.hs | 11 |
11 files changed, 187 insertions, 65 deletions
diff --git a/Data/ConfigManager.hs b/Data/ConfigManager.hs index eb15ddf..bd62f40 100644 --- a/Data/ConfigManager.hs +++ b/Data/ConfigManager.hs @@ -1,5 +1,29 @@ +-- | +-- Module: Data.ConfigManager +-- License: GPL-3 +-- Maintainer: Joris Guyonvarch <joris@guyonvarch.me> +-- Stability: experimental +-- +-- A configuration management library. + module Data.ConfigManager - ( readConfig + ( + -- * Configuration file format + -- $format + + -- ** Binding a name to a value + -- $bindings + + -- ** Import other files + -- $import + + -- ** Comments + -- $comments + + -- * Configuration loading + readConfig + + -- * Lookup functions , lookup , lookupDefault ) where @@ -12,15 +36,55 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.HashMap.Strict as M -import Data.ConfigManager.Config import qualified Data.ConfigManager.Reader as R -import Data.ConfigManager.Expr +import Data.ConfigManager.Types + +-- | Load a 'Config' from a given 'FilePath' readConfig :: FilePath -> IO (Either Text Config) -readConfig = R.readConfig +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 for the value associated to a name and return the default value if +-- no binding exists with the given name + lookupDefault :: Value -> Name -> Config -> Value lookupDefault defaultValue name config = M.lookupDefault defaultValue name (hashMap config) + +-- $format +-- +-- A configuration file consists of a series of: +-- +-- * bindings, +-- * imports, +-- * and comments. + +-- $bindings +-- +-- A binding associates a name to a value. +-- +-- > number = 1 +-- > my-string = "Hello" +-- > a_double = 4.0 +-- > thatIsABoolean = True +-- > a_double = 5.0 +-- +-- If two or more bindings have the same name, only the last one is kept. + +-- $import +-- +-- An import is either required or optional: +-- +-- > import "database.conf" +-- > importMaybe "local.conf" + +-- $comment +-- +-- A comment begins with '#' and continues to the end of the line. +-- +-- > # Comment +-- > x = 8 # Another comment diff --git a/Data/ConfigManager/Config.hs b/Data/ConfigManager/Config.hs deleted file mode 100644 index 8c79956..0000000 --- a/Data/ConfigManager/Config.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Data.ConfigManager.Config - ( Config(..) - ) where - -import Data.HashMap.Strict - -import Data.ConfigManager.Expr - -data Config = Config - { hashMap :: HashMap Name Value - } deriving (Eq, Read, Show) diff --git a/Data/ConfigManager/Expr.hs b/Data/ConfigManager/Expr.hs deleted file mode 100644 index 3aa8825..0000000 --- a/Data/ConfigManager/Expr.hs +++ /dev/null @@ -1,16 +0,0 @@ -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 856ccfd..b49f586 100644 --- a/Data/ConfigManager/Parser.hs +++ b/Data/ConfigManager/Parser.hs @@ -10,7 +10,7 @@ import Data.Char (isSpace, isAlphaNum) import Text.ParserCombinators.Parsec -import Data.ConfigManager.Expr +import Data.ConfigManager.Types parseConfig :: Text -> Either Text [Expr] parseConfig input = @@ -22,7 +22,10 @@ exprsParser :: Parser [Expr] exprsParser = skip *> many (exprParser <* restOfLine <* skip) <* eof exprParser :: Parser Expr -exprParser = (try bindingParser) <|> (try importParser) +exprParser = + (try bindingParser) + <|> (try $ importParser "import" (Import Required)) + <|> (try $ importParser "importMaybe" (Import Optional)) bindingParser :: Parser Expr bindingParser = do @@ -33,14 +36,14 @@ bindingParser = do value <- valueParser return $ Binding name value -importParser :: Parser Expr -importParser = do - _ <- string "import" +importParser :: String -> (FilePath -> Expr) -> Parser Expr +importParser name exprFromPath = do + _ <- string name _ <- spaces _ <- char '"' path <- many (noneOf "\"") _ <- char '"' - return $ Import path + return $ exprFromPath path nameParser :: Parser Name nameParser = do diff --git a/Data/ConfigManager/Reader.hs b/Data/ConfigManager/Reader.hs index 9f4cc3c..c2f75a7 100644 --- a/Data/ConfigManager/Reader.hs +++ b/Data/ConfigManager/Reader.hs @@ -1,38 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + module Data.ConfigManager.Reader ( readConfig ) where import Control.Monad (foldM) +import Control.Exception (catch, IOException) import System.FilePath.Posix (dropFileName, (</>)) import qualified Data.HashMap.Strict as M import Data.Text (Text) import qualified Data.Text.IO as T +import qualified Data.Text as T import Data.ConfigManager.Parser (parseConfig) -import Data.ConfigManager.Expr -import Data.ConfigManager.Config +import Data.ConfigManager.Types + +readConfig :: Requirement -> FilePath -> IO (Either Text Config) +readConfig requirement path = + catch + (T.readFile path >>= readConfigText (dropFileName path)) + (\(_ :: IOException) -> return $ + case requirement of + Required -> Left . T.concat $ ["File ", T.pack path, " not found."] + Optional -> Right . Config . M.fromList $ [] + ) -readConfig :: FilePath -> IO (Either Text Config) -readConfig path = do - input <- T.readFile path +readConfigText :: FilePath -> Text -> IO (Either Text Config) +readConfigText fileDir input = 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 [] + foldM (go fileDir) (Right . Config . M.fromList $ []) exprs -go :: String -> Either Text Config -> Expr -> IO (Either Text Config) +go :: FilePath -> 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) + Import requirement path -> do + eitherConfig <- readConfig requirement (fileDir </> path) case eitherConfig of Left errorMessage -> return . Left $ errorMessage diff --git a/Data/ConfigManager/Types.hs b/Data/ConfigManager/Types.hs new file mode 100644 index 0000000..ddc578f --- /dev/null +++ b/Data/ConfigManager/Types.hs @@ -0,0 +1,17 @@ +-- | +-- Module: Data.ConfigManager.Config +-- License: GPL-3 +-- Maintainer: Joris Guyonvarch <joris@guyonvarch.me> +-- Stability: experimental +-- +-- Types for working with configuration files. + +module Data.ConfigManager.Types + ( Config(..) + , Expr(..) + , Name + , Value + , Requirement(..) + ) where + +import Data.ConfigManager.Types.Internal diff --git a/Data/ConfigManager/Types/Internal.hs b/Data/ConfigManager/Types/Internal.hs new file mode 100644 index 0000000..5b91802 --- /dev/null +++ b/Data/ConfigManager/Types/Internal.hs @@ -0,0 +1,39 @@ +module Data.ConfigManager.Types.Internal + ( Config(..) + , Expr(..) + , Name + , Value + , Requirement(..) + ) where + +import Data.Text (Text) + +import Data.HashMap.Strict + +-- | Configuration data + +data Config = Config + { hashMap :: HashMap Name Value + } deriving (Eq, Read, Show) + +-- | An expression is either a binding or an import + +data Expr = + Binding Name Value + | Import Requirement FilePath + deriving (Eq, Read, Show) + +-- | A name is a text + +type Name = Text + +-- | A value is a text + +type Value = Text + +-- | A requirement is either required or optional + +data Requirement = + Required + | Optional + deriving (Eq, Read, Show) @@ -6,5 +6,6 @@ A configuration management library. TODO ---- +- Add group support - Show an error message when there is an import loop. - Support time durations: 5 minutes, 30 seconds, 1 hour… diff --git a/config-manager.cabal b/config-manager.cabal index d6ed354..6363865 100644 --- a/config-manager.cabal +++ b/config-manager.cabal @@ -1,24 +1,25 @@ -name: config-manager -version: 0.1.0.0 -synopsis: Configuration management -description: A configuration management library -homepage: https://gitlab.com/guyonvarch/config-manager -license: GPL-3 -license-file: LICENSE -author: Joris Guyonvarch -maintainer: joris@guyonvarch.me -category: Configuration, Data -build-type: Simple -cabal-version: >=1.10 +name: config-manager +version: 0.0.0.1 +synopsis: Configuration management +description: A configuration management library +homepage: https://gitlab.com/guyonvarch/config-manager +bug-reports: https://gitlab.com/guyonvarch/config-manager/issues +license: GPL-3 +license-file: LICENSE +author: Joris Guyonvarch +maintainer: joris@guyonvarch.me +category: Configuration, Data +build-type: Simple +cabal-version: >=1.10 -data-files: tests/resources/*.conf +data-files: tests/resources/*.conf library exposed-modules: Data.ConfigManager, - Data.ConfigManager.Config + Data.ConfigManager.Types other-modules: Data.ConfigManager.Reader Data.ConfigManager.Parser - Data.ConfigManager.Expr + Data.ConfigManager.Types.Internal -- LANGUAGE extensions used by modules in this package. -- other-extensions: ghc-options: -Wall @@ -29,6 +30,10 @@ library filepath default-language: Haskell2010 +source-repository head + type: git + location: https://gitlab.com/guyonvarch/config-manager + Test-Suite test-config-manager type: exitcode-stdio-1.0 hs-source-dirs: tests diff --git a/tests/Helper.hs b/tests/Helper.hs index 3dcc267..00bccc9 100644 --- a/tests/Helper.hs +++ b/tests/Helper.hs @@ -14,7 +14,7 @@ import qualified Data.Text.IO as T import Data.Maybe (fromJust) import Data.ConfigManager -import Data.ConfigManager.Config +import Data.ConfigManager.Types (Config) forceGetConfig :: Text -> IO Config forceGetConfig = (fmap fromJust) . getConfig diff --git a/tests/Test.hs b/tests/Test.hs index 957f3ae..03dc979 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -14,7 +14,7 @@ import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) import Data.ConfigManager -import Data.ConfigManager.Config +import Data.ConfigManager.Types (Config(..)) import qualified Data.Text as T import Helper (forceGetConfig, getConfig, eitherToMaybe) @@ -115,3 +115,12 @@ importAssertion = do 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) + + missingConfig <- getConfig "import \"required.conf\"" + assertEqual "missing config" Nothing missingConfig + + missingOptionalConfig <- forceGetConfig $ T.unlines + [ "importMaybe \"required.conf\"" + , "x = 4" + ] + assertEqual "missing optional config" (Just 4) (lookup "x" missingOptionalConfig :: Maybe Int) |