aboutsummaryrefslogtreecommitdiff
path: root/Data
diff options
context:
space:
mode:
authorJoris2016-03-16 21:09:44 +0100
committerJoris2016-03-16 22:09:54 +0100
commitc6c01d7c248bca1078285c4afeaa25493e9974b3 (patch)
tree7b060664b16ffcae25cb62089dfbeed5a0b7c69a /Data
parentf2dc23683ceae93135223713e4ca7fa3a12edbea (diff)
Add import expression
Diffstat (limited to 'Data')
-rw-r--r--Data/ConfigManager.hs7
-rw-r--r--Data/ConfigManager/Config.hs2
-rw-r--r--Data/ConfigManager/Expr.hs16
-rw-r--r--Data/ConfigManager/Parser.hs30
-rw-r--r--Data/ConfigManager/Reader.hs41
-rw-r--r--Data/ConfigManager/Types.hs13
6 files changed, 81 insertions, 28 deletions
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