blob: b49f586193da5be02eca22f57eede3a1fe88209d (
plain)
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
61
62
63
64
65
66
67
68
69
70
71
72
73
|
{-# LANGUAGE OverloadedStrings #-}
module Data.ConfigManager.Parser
( parseConfig
) where
import Data.Text (Text)
import qualified Data.Text as T
import Data.Char (isSpace, isAlphaNum)
import Text.ParserCombinators.Parsec
import Data.ConfigManager.Types
parseConfig :: Text -> Either Text [Expr]
parseConfig input =
case parse exprsParser "" (T.unpack (T.concat [input, "\n"])) of
Right exprs -> Right exprs
Left parserError -> Left . T.pack . show $ parserError
exprsParser :: Parser [Expr]
exprsParser = skip *> many (exprParser <* restOfLine <* skip) <* eof
exprParser :: Parser Expr
exprParser =
(try bindingParser)
<|> (try $ importParser "import" (Import Required))
<|> (try $ importParser "importMaybe" (Import Optional))
bindingParser :: Parser Expr
bindingParser = do
name <- nameParser
_ <- spaces
_ <- char '='
_ <- spaces
value <- valueParser
return $ Binding name value
importParser :: String -> (FilePath -> Expr) -> Parser Expr
importParser name exprFromPath = do
_ <- string name
_ <- spaces
_ <- char '"'
path <- many (noneOf "\"")
_ <- char '"'
return $ exprFromPath path
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 ()
|
