Add optional imports

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)
diff --git a/README.md b/README.md
index 7e6e266..9f92c56 100644
--- a/README.md
+++ b/README.md
@@ -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)