From bf804f73ce3494be430054499c5ce18f232f68ca Mon Sep 17 00:00:00 2001
From: Joris
Date: Fri, 18 Mar 2016 09:50:39 +0100
Subject: Add optional imports

---
 Data/ConfigManager.hs                | 72 ++++++++++++++++++++++++++++++++++--
 Data/ConfigManager/Config.hs         | 11 ------
 Data/ConfigManager/Expr.hs           | 16 --------
 Data/ConfigManager/Parser.hs         | 15 +++++---
 Data/ConfigManager/Reader.hs         | 33 +++++++++++------
 Data/ConfigManager/Types.hs          | 17 +++++++++
 Data/ConfigManager/Types/Internal.hs | 39 +++++++++++++++++++
 7 files changed, 155 insertions(+), 48 deletions(-)
 delete mode 100644 Data/ConfigManager/Config.hs
 delete mode 100644 Data/ConfigManager/Expr.hs
 create mode 100644 Data/ConfigManager/Types.hs
 create mode 100644 Data/ConfigManager/Types/Internal.hs

(limited to 'Data')

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)
-- 
cgit v1.2.3