aboutsummaryrefslogtreecommitdiff
path: root/Data
diff options
context:
space:
mode:
Diffstat (limited to 'Data')
-rw-r--r--Data/ConfigManager.hs72
-rw-r--r--Data/ConfigManager/Config.hs11
-rw-r--r--Data/ConfigManager/Expr.hs16
-rw-r--r--Data/ConfigManager/Parser.hs15
-rw-r--r--Data/ConfigManager/Reader.hs33
-rw-r--r--Data/ConfigManager/Types.hs17
-rw-r--r--Data/ConfigManager/Types/Internal.hs39
7 files changed, 155 insertions, 48 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)