aboutsummaryrefslogtreecommitdiff
path: root/Data/ConfigManager
diff options
context:
space:
mode:
Diffstat (limited to 'Data/ConfigManager')
-rw-r--r--Data/ConfigManager/Config.hs11
-rw-r--r--Data/ConfigManager/Parser.hs60
-rw-r--r--Data/ConfigManager/Types.hs13
3 files changed, 84 insertions, 0 deletions
diff --git a/Data/ConfigManager/Config.hs b/Data/ConfigManager/Config.hs
new file mode 100644
index 0000000..a98dbbb
--- /dev/null
+++ b/Data/ConfigManager/Config.hs
@@ -0,0 +1,11 @@
+module Data.ConfigManager.Config
+ ( Config(..)
+ ) where
+
+import Data.HashMap.Strict
+
+import Data.ConfigManager.Types
+
+data Config = Config
+ { hashMap :: HashMap Name Value
+ } deriving (Eq, Read, Show)
diff --git a/Data/ConfigManager/Parser.hs b/Data/ConfigManager/Parser.hs
new file mode 100644
index 0000000..e2329b6
--- /dev/null
+++ b/Data/ConfigManager/Parser.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.ConfigManager.Parser
+ ( parseConfig
+ ) where
+
+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
+
+parseConfig :: Text -> Either Text Config
+parseConfig input =
+ case parse bindingsParser "" (T.unpack (T.concat [input, "\n"])) of
+ Right bindings -> Right . Config . M.fromList $ bindings
+ Left parserError -> Left . T.pack . show $ parserError
+
+bindingsParser :: Parser [Binding]
+bindingsParser = skip *> many (bindingParser <* restOfLine <* skip) <* eof
+
+bindingParser :: Parser Binding
+bindingParser = do
+ name <- nameParser
+ _ <- spaces
+ _ <- char '='
+ _ <- spaces
+ value <- valueParser
+ return (name, value)
+
+nameParser :: Parser Name
+nameParser = do
+ first <- letter
+ rest <- many (satisfy (\c -> isAlphaNum c || c == '-' || c == '_'))
+ return . T.pack $ first : rest
+
+valueParser :: Parser Value
+valueParser = T.strip . T.pack <$> many (noneOf "\n#")
+
+skip :: Parser ()
+skip =
+ (satisfy isSpace *> skip)
+ <|> (comment *> skip)
+ <|> (return ())
+
+comment :: Parser ()
+comment = do
+ _ <- char '#' *> (many $ noneOf "\n") >> return ()
+ return ()
+
+restOfLine :: Parser ()
+restOfLine = do
+ _ <- many (char ' ')
+ _ <- optional comment
+ _ <- newline
+ return ()
diff --git a/Data/ConfigManager/Types.hs b/Data/ConfigManager/Types.hs
new file mode 100644
index 0000000..2f2f00e
--- /dev/null
+++ b/Data/ConfigManager/Types.hs
@@ -0,0 +1,13 @@
+module Data.ConfigManager.Types
+ ( Binding
+ , Name
+ , Value
+ ) where
+
+import Data.Text (Text)
+
+type Binding = (Name, Value)
+
+type Name = Text
+
+type Value = Text