This repository has been archived by the owner on Aug 28, 2018. It is now read-only.
/
Parse.hs
98 lines (81 loc) · 2.68 KB
/
Parse.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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
module NginxLint.Parse where
import Text.ParserCombinators.Parsec hiding (spaces)
import Text.ParserCombinators.Parsec.Language (emptyDef)
import qualified Text.ParserCombinators.Parsec.Token as T
import NginxLint.Data
parseFile :: Parser NgFile
parseFile = do whiteSpace
pos <- getPosition
ds <- many decl
eof
return $ NgFile (sourceName pos) ds
decl :: Parser Decl
decl = try ifDecl <|> nonIfDecl
nonIfDecl :: Parser Decl
nonIfDecl = try blockDecl <|> oneDecl
oneDecl :: Parser Decl
oneDecl = do whiteSpace
pos <- getPosition
name <- identifier
args <- many argument
_ <- lexeme (char ';')
return $ Decl pos name args
<?> "directive"
blockDecl :: Parser Decl
blockDecl = do whiteSpace
pos <- getPosition
name <- identifier
args <- try (many argument)
ds <- braces (many decl)
return $ Block pos name args ds
ifDecl :: Parser Decl
ifDecl = do whiteSpace
pos <- getPosition
reserved "if"
_ <- symbol "("
args <- argument `manyTill` try (symbol ")")
ds <- braces (many nonIfDecl)
return $ Block pos "if" args ds
argument :: Parser Arg
argument = parseInteger <|> quotedString <|> plainString
<?> "directive argument"
parseInteger :: Parser Arg
parseInteger = do pos <- getPosition
n <- integer
return $ Integer pos n
quotedString :: Parser Arg
quotedString = do pos <- getPosition
_ <- symbol "\""
s <- many (noneOf "\"")
_ <- symbol "\""
return $ QuotedString pos s
plainString :: Parser Arg
plainString = do pos <- getPosition
s <- lexeme ps
return $ RawString pos s
<?> "plain string"
where ps = many1 (noneOf " \"\v\t\r\n(){};")
lexer :: T.TokenParser ()
lexer = T.makeTokenParser nginxDef
nginxDef = emptyDef
{ T.commentLine = "#"
, T.nestedComments = False
, T.opLetter = oneOf "<=>"
, T.reservedNames = ["if"]
}
braces = T.braces lexer
--comma = T.comma lexer
--commaSep = T.commaSep lexer
--commaSep1 = T.commaSep1 lexer
--dot = T.dot lexer
--float = T.float lexer
identifier = T.identifier lexer
integer = T.natural lexer
lexeme = T.lexeme lexer
--natural = T.natural lexer
--parens = T.parens lexer
reserved = T.reserved lexer
--semi = T.semi lexer
--semiSep = T.semiSep lexer
symbol = T.symbol lexer
whiteSpace = T.whiteSpace lexer