blob: f2cc7634c0f4e9d2c5c85d991dad101e5409c067 (
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
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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
module buildclient.config.BuildParser where
import Data.MicroParsec as MP
-- <section>
-- </section>
data Token =
BareWord {bval::String}
| Number {nval::String}
| BraceOpen
| BraceClose
| NewLine
| QuotedString {sval::String}
| ERROR {position::Int, message:: String}
derive Eq Token
derive Show Token
protected type Parser = MP.Parser [] Token
protected isIdentifierStartChar :: Char -> Bool
protected isIdentifierStartChar char = ('A' <= char && char <= 'Z') || ('a' <= char && char <= 'z') || char == '_'
protected isDigit :: Char -> Bool
protected isDigit char = ('0' <= char && char <= '9')
protected isIdentifierChar :: Char -> Bool
protected isIdentifierChar char = isIdentifierStartChar char || isDigit char
lexer :: String -> [Token]
lexer s = lex s 0
private lex :: String -> Int -> [Token]
private lex !cs !start
| endOfSeq = []
| ch == '\n' = Token.NewLine : lex cs (start + 1)
| ch.isWhitespace = lex cs (start + 1)
| ch == '"' = string 1 []
| ch == '{' = Token.BraceOpen : lex cs (start + 1)
| ch == '}' = Token.BraceClose : lex cs (start + 1)
| isDigit ch = takeWhile isDigit Token.Number 0 []
| isIdentifierStartChar ch = takeWhile isIdentifierChar Token.BareWord 0 []
| otherwise -> [Token.ERROR{position=start, message="Unexpected character"}]
where
endOfSeq = start >= cs.length
ch = at 0
at i = if start + i >= cs.length then '\0' else cs.charAt (start + i)
takeWhile charTest mapper off !acc
| charTest $ at off = takeWhile charTest mapper (off + 1) (at off : acc)
| otherwise = (mapper $ packed $ reverse acc) : lex cs (start + off)
string off !acc
| start + off >= cs.length = [Token.ERROR{position=start + off, message="Unterminated string literal"}]
| ch == '"' -> (Token.QuotedString $ packed (reverse acc)) : lex cs (start + off + 1)
| ch >= ' ' || ch == '\n' || ch == '\t' -> string (off + 1) (ch : acc)
| otherwise -> [Token.ERROR{position=start+off, message="Unknown string character"}]
where
ch = at off
runParser :: Parser a -> [Token] -> (String | a)
runParser p ts = case MP.runid p ts of
(Left msg, ts) → Left (MP.reporterror ts msg)
(right, _) → right
protected parseNewLine :: Parser ()
protected parseNewLine = const () <$> expect Token.NewLine <?> "newline expected"
protected parseLBrace :: Parser ()
protected parseLBrace = const () <$> expect Token.BraceOpen <?> "opening braces expected"
protected parseRBrace :: Parser ()
protected parseRBrace = const () <$> expect Token.BraceClose <?> "closing braces expected"
protected parseEndOfStatement :: Parser ()
protected parseEndOfStatement = (parseNewLine <|> parseRBrace <|> eos) <?> "expected end of statement"
protected parseBareWord :: Parser String
protected parseBareWord = (_.bval) <$> satisfy _.{bval?} <?> "bareword expected"
protected parseQuotedString :: Parser String
protected parseQuotedString = (_.sval) <$> satisfy _.{sval?} <?> "string expected"
protected parseNumber :: Parser String
protected parseNumber = (_.nval) <$> satisfy _.{nval?} <?> "number expected"
data ASTValue = ASTString String | ASTWord String | ASTNumber Int
data ASTDirective = ASTDirective {name::String, arguments:: [ASTValue], block:: [ASTDirective]}
derive Show ASTValue
derive Show ASTDirective
protected parseValue :: Parser ASTValue
protected parseValue = ASTString <$> parseQuotedString <|> ASTWord <$> parseBareWord <|> (ASTNumber . read) <$> parseNumber
protected parseShortDirective :: Parser ASTDirective
protected parseShortDirective = do
skip parseNewLine
name <- parseBareWord <?> "directive name expected"
args <- many parseValue
cond (parseEndOfStatement)
(return $ ASTDirective name args [])
do
parseLBrace
subdirectives <- many parseShortDirective
skip parseNewLine
parseRBrace
return $ ASTDirective name args subdirectives
parseFile :: Parser [ASTDirective]
parseFile = (many parseShortDirective) <* (skip parseNewLine) <* eos
findDirective :: String -> [ASTDirective] -> Maybe ASTDirective
findDirective name (directive:ds)
| directive.name == name = Just directive
| otherwise = findDirective name ds
findDirective _ [] = Nothing
|
