diff options
author | Joris | 2016-03-13 21:26:03 +0100 |
---|---|---|
committer | Joris | 2016-03-13 21:26:03 +0100 |
commit | 47623ec732ec19c765c0a1ebffd9b234f81e0d01 (patch) | |
tree | a52969d730e64d1303e62efa8c36b03a7be7f1a5 /Data/ConfigManager |
Initial commit
Diffstat (limited to 'Data/ConfigManager')
-rw-r--r-- | Data/ConfigManager/Config.hs | 11 | ||||
-rw-r--r-- | Data/ConfigManager/Parser.hs | 60 | ||||
-rw-r--r-- | Data/ConfigManager/Types.hs | 13 |
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 |