diff options
Diffstat (limited to 'Data/ConfigManager/Parser.hs')
-rw-r--r-- | Data/ConfigManager/Parser.hs | 60 |
1 files changed, 60 insertions, 0 deletions
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 () |