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 -------------
 6 files changed, 81 insertions(+), 28 deletions(-)
 create mode 100644 Data/ConfigManager/Expr.hs
 create mode 100644 Data/ConfigManager/Reader.hs
 delete mode 100644 Data/ConfigManager/Types.hs

(limited to 'Data')

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