@@ -9,6 +9,7 @@
99-- Portability :
1010--
1111-- |
12+-- Constants, and utility functions to be used when parsing
1213--
1314-----------------------------------------------------------------------------
1415
@@ -25,6 +26,9 @@ import qualified Text.Parsec.Token as PT
2526
2627import Language.PureScript.Names
2728
29+-- |
30+-- A list of reserved identifiers
31+--
2832reservedNames :: [String]
2933reservedNames = [ "case"
3034 , "of"
@@ -76,28 +80,52 @@ reservedNames = [ "case"
7680 , "instance"
7781 , "where" ]
7882
83+-- |
84+-- A list of built-in operator names
85+--
7986builtInOperators :: [String]
8087builtInOperators = [ "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
8188 , "==", "!=", "&&", "||", "&", "^", "|", "!!", "!" ]
8289
90+-- |
91+-- A list of reserved operators
92+--
8393reservedOpNames :: [String]
8494reservedOpNames = builtInOperators ++ [ "=>", "->", "=", ".", "\\" ]
8595
96+-- |
97+-- Valid first characters for an identifier
98+--
8699identStart :: P.Parsec String u Char
87100identStart = P.lower <|> P.oneOf "_"
88101
102+-- |
103+-- Valid first characters for a proper name
104+--
89105properNameStart :: P.Parsec String u Char
90106properNameStart = P.upper
91107
108+-- |
109+-- Valid identifier characters
110+--
92111identLetter :: P.Parsec String u Char
93112identLetter = P.alphaNum <|> P.oneOf "_'"
94113
114+-- |
115+-- Valid first characters for an operator
116+--
95117opStart :: P.Parsec String u Char
96118opStart = P.oneOf ":!#$%&*+./<=>?@\\^|-~"
97119
120+-- |
121+-- Valid operators characters
122+--
98123opLetter :: P.Parsec String u Char
99124opLetter = P.oneOf ":!#$%&*+./<=>?@\\^|-~"
100125
126+-- |
127+-- The PureScript language definition
128+--
101129langDef :: PT.GenLanguageDef String u Identity
102130langDef = PT.LanguageDef
103131 { PT.reservedNames = reservedNames
@@ -113,104 +141,209 @@ langDef = PT.LanguageDef
113141 , PT.caseSensitive = True
114142 }
115143
144+-- |
145+-- A token parser based on the language definition
146+--
116147tokenParser :: PT.GenTokenParser String u Identity
117148tokenParser = PT.makeTokenParser langDef
118149
150+-- |
151+-- Parse a token
152+--
119153lexeme :: P.Parsec String u a -> P.Parsec String u a
120154lexeme = PT.lexeme tokenParser
121155
156+-- |
157+-- Parse an identifier
158+--
122159identifier :: P.Parsec String u String
123160identifier = PT.identifier tokenParser
124161
162+-- |
163+-- Parse a reserved word
164+--
125165reserved :: String -> P.Parsec String u ()
126166reserved = PT.reserved tokenParser
127167
168+-- |
169+-- Parse a reserved operator
170+--
128171reservedOp :: String -> P.Parsec String u ()
129172reservedOp = PT.reservedOp tokenParser
130173
174+-- |
175+-- Parse an operator
176+--
131177operator :: P.Parsec String u String
132178operator = PT.operator tokenParser
133179
180+-- |
181+-- Parse a string literal
182+--
134183stringLiteral :: P.Parsec String u String
135184stringLiteral = PT.stringLiteral tokenParser
136185
186+-- |
187+-- Parse whitespace
188+--
137189whiteSpace :: P.Parsec String u ()
138190whiteSpace = PT.whiteSpace tokenParser
139191
192+-- |
193+-- Semicolon
194+--
140195semi :: P.Parsec String u String
141196semi = PT.semi tokenParser
142197
198+-- |
199+-- Colon
200+--
143201colon :: P.Parsec String u String
144202colon = PT.colon tokenParser
145203
204+-- |
205+-- Period
206+--
146207dot :: P.Parsec String u String
147208dot = PT.dot tokenParser
148209
210+-- |
211+-- Comma
212+--
149213comma :: P.Parsec String u String
150214comma = PT.comma tokenParser
151215
216+-- |
217+-- Backtick
218+--
152219tick :: P.Parsec String u Char
153220tick = lexeme $ P.char '`'
154221
222+-- |
223+-- Pipe character
224+--
155225pipe :: P.Parsec String u Char
156226pipe = lexeme $ P.char '|'
157227
228+-- |
229+-- Natural number
230+--
158231natural :: P.Parsec String u Integer
159232natural = PT.natural tokenParser
160233
234+-- |
235+-- Parse a proper name
236+--
237+properName :: P.Parsec String u ProperName
238+properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")
239+
240+-- |
241+-- Parse a qualified name, i.e. M.name or just name
242+--
243+parseQualified :: P.Parsec String ParseState a -> P.Parsec String ParseState (Qualified a)
244+parseQualified parser = qual
245+ where
246+ qual = (Qualified <$> (Just . ModuleName <$> P.try (properName <* delimiter)) <*> parser)
247+ <|> (Qualified Nothing <$> P.try parser)
248+ delimiter = indented *> dot
249+
250+-- |
251+-- Parse an integer or floating point value
252+--
253+integerOrFloat :: P.Parsec String u (Either Integer Double)
254+integerOrFloat = (Left <$> P.try (PT.natural tokenParser) <|>
255+ Right <$> P.try (PT.float tokenParser)) P.<?> "number"
256+
257+-- |
258+-- Parse an operator or a built-in operator
259+--
260+operatorOrBuiltIn :: P.Parsec String u String
261+operatorOrBuiltIn = P.try operator <|> P.choice (map (\s -> P.try (reservedOp s) >> return s) builtInOperators)
262+
263+-- |
264+-- Parse an identifier or parenthesized operator
265+--
266+parseIdent :: P.Parsec String ParseState Ident
267+parseIdent = (Ident <$> identifier) <|> (Op <$> parens operatorOrBuiltIn)
268+
269+-- |
270+-- Parse a token inside square brackets
271+--
161272squares :: P.Parsec String ParseState a -> P.Parsec String ParseState a
162273squares = P.between (lexeme $ P.char '[') (lexeme $ indented *> P.char ']') . (indented *>)
163274
275+-- |
276+-- Parse a token inside parentheses
277+--
164278parens :: P.Parsec String ParseState a -> P.Parsec String ParseState a
165279parens = P.between (lexeme $ P.char '(') (lexeme $ indented *> P.char ')') . (indented *>)
166280
281+-- |
282+-- Parse a token inside braces
283+--
167284braces :: P.Parsec String ParseState a -> P.Parsec String ParseState a
168285braces = P.between (lexeme $ P.char '{') (lexeme $ indented *> P.char '}') . (indented *>)
169286
287+-- |
288+-- Parse a token inside angle brackets
289+--
170290angles :: P.Parsec String ParseState a -> P.Parsec String ParseState a
171291angles = P.between (lexeme $ P.char '<') (lexeme $ indented *> P.char '>') . (indented *>)
172292
293+-- |
294+-- Parse zero or more values separated by a separator token
295+--
173296sepBy :: P.Parsec String ParseState a -> P.Parsec String ParseState sep -> P.Parsec String ParseState [a]
174297sepBy p s = P.sepBy (indented *> p) (indented *> s)
175298
299+-- |
300+-- Parse one or more values separated by a separator token
301+--
176302sepBy1 :: P.Parsec String ParseState a -> P.Parsec String ParseState sep -> P.Parsec String ParseState [a]
177303sepBy1 p s = P.sepBy1 (indented *> p) (indented *> s)
178304
305+-- |
306+-- Parse zero or more values separated by semicolons
307+--
179308semiSep :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
180309semiSep = flip sepBy semi
181310
311+-- |
312+-- Parse one or more values separated by semicolons
313+--
182314semiSep1 :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
183315semiSep1 = flip sepBy1 semi
184316
317+-- |
318+-- Parse zero or more values separated by commas
319+--
185320commaSep :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
186321commaSep = flip sepBy comma
187322
323+-- |
324+-- Parse one or more values separated by commas
325+--
188326commaSep1 :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
189327commaSep1 = flip sepBy1 comma
190328
191−properName :: P.Parsec String u ProperName
192−properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")
193−
194−parseQualified :: P.Parsec String ParseState a -> P.Parsec String ParseState (Qualified a)
195−parseQualified parser = qual
196− where
197− qual = (Qualified <$> (Just . ModuleName <$> P.try (properName <* delimiter)) <*> parser)
198− <|> (Qualified Nothing <$> P.try parser)
199− delimiter = indented *> dot
200−
201−integerOrFloat :: P.Parsec String u (Either Integer Double)
202−integerOrFloat = (Left <$> P.try (PT.natural tokenParser) <|>
203− Right <$> P.try (PT.float tokenParser)) P.<?> "number"
204−
329+-- |
330+-- Run the first parser, then match the second if possible, applying the specified function on a successful match
331+--
205332augment :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a
206333augment p q f = flip (maybe id $ flip f) <$> p <*> P.optionMaybe q
207334
335+-- |
336+-- Run the first parser, then match the second zero or more times, applying the specified function for each match
337+--
208338fold :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a
209339fold first more combine = do
210340 a <- first
211341 bs <- P.many more
212342 return $ foldl combine a bs
213343
344+-- |
345+-- Build a parser from a smaller parser and a list of parsers for postfix operators
346+--
214347buildPostfixParser :: P.Stream s m t => [a -> P.ParsecT s u m a] -> P.ParsecT s u m a -> P.ParsecT s u m a
215348buildPostfixParser fs first = do
216349 a <- first
@@ -222,15 +355,15 @@ buildPostfixParser fs first = do
222355 Nothing -> return a
223356 Just a' -> go a'
224357
225−operatorOrBuiltIn :: P.Parsec String u String
226−operatorOrBuiltIn = P.try operator <|> P.choice (map (\s -> P.try (reservedOp s) >> return s) builtInOperators)
227−
228−parseIdent :: P.Parsec String ParseState Ident
229−parseIdent = (Ident <$> identifier) <|> (Op <$> parens operatorOrBuiltIn)
230−
358+-- |
359+-- Parse an identifier in backticks or an operator
360+--
231361parseIdentInfix :: P.Parsec String ParseState (Qualified Ident)
232362parseIdentInfix = (P.between tick tick (parseQualified (Ident <$> identifier))) <|> parseQualified (Op <$> operatorOrBuiltIn)
233363
364+-- |
365+-- Mark the current indentation level
366+--
234367mark :: P.Parsec String ParseState a -> P.Parsec String ParseState a
235368mark p = do
236369 current <- indentationLevel <$> P.getState
@@ -240,17 +373,29 @@ mark p = do
240373 P.modifyState $ \st -> st { indentationLevel = current }
241374 return a
242375
376+-- |
377+-- Check that the current identation level matches a predicate
378+--
243379checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String ParseState ()
244380checkIndentation rel = do
245381 col <- P.sourceColumn <$> P.getPosition
246382 current <- indentationLevel <$> P.getState
247383 guard (col `rel` current)
248384
385+-- |
386+-- Check that the current indentation level is past the current mark
387+--
249388indented :: P.Parsec String ParseState ()
250389indented = checkIndentation (>) P.<?> "indentation"
251390
391+-- |
392+-- Check that the current indentation level is at the same indentation as the current mark
393+--
252394same :: P.Parsec String ParseState ()
253395same = checkIndentation (==) P.<?> "no indentation"
254396
397+-- |
398+-- Run a parser which supports indentation
399+--
255400runIndentParser :: P.Parsec String ParseState a -> String -> Either P.ParseError a
256401runIndentParser p = P.runParser p (ParseState 0) ""