Data/ConfigManager/Parser.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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 ()