@@ -123,13 +123,13 @@ commitIf check p =
123123 try (lookAhead check) >> p
124124
125125
126−anyUntil :: IParser String -> IParser String
126+anyUntil :: IParser () -> IParser ()
127127anyUntil end =
128− go
129− where
128+ let
130129 go =
131− end <|> (:) <$> anyChar <*> go
132−
130+ end <|> (anyChar >> go)
131+ in
132+ go
133133
134134
135135followedBy :: IParser a -> IParser b -> IParser a
@@ -194,7 +194,7 @@ spacePrefix p =
194194 constrainedSpacePrefix p (\_ -> return ())
195195
196196
197−constrainedSpacePrefix :: IParser a -> (String -> IParser ()) -> IParser [a]
197+constrainedSpacePrefix :: IParser a -> (Bool -> IParser ()) -> IParser [a]
198198constrainedSpacePrefix parser constraint =
199199 many $ choice
200200 [ try (spacing >> lookAhead (oneOf "[({\"'")) >> parser
@@ -202,8 +202,8 @@ constrainedSpacePrefix parser constraint =
202202 ]
203203 where
204204 spacing = do
205− n <- whitespace
206− constraint n <?> Syntax.whitespace
205+ bool <- whitespace
206+ constraint bool
207207 indented
208208
209209
@@ -212,26 +212,28 @@ constrainedSpacePrefix parser constraint =
212212
213213
214214surround :: Char -> Char -> String -> IParser a -> IParser a
215−surround a z name p = do
216− char a
217− v <- padded p
218− char z <?> unwords ["a closing", name, show z]
219− return v
215+surround start end name parser =
216+ do char start
217+ whitespace
218+ value <- parser
219+ whitespace
220+ char end <?> unwords ["a closing", name, show end]
221+ return value
220222
221223
222224braces :: IParser a -> IParser a
223−braces =
224− surround '[' ']' "brace"
225+braces parser =
226+ surround '[' ']' "brace" parser
225227
226228
227229parens :: IParser a -> IParser a
228−parens =
229− surround '(' ')' "paren"
230+parens parser =
231+ surround '(' ')' "paren" parser
230232
231233
232234brackets :: IParser a -> IParser a
233−brackets =
234− surround '{' '}' "bracket"
235+brackets parser =
236+ surround '{' '}' "bracket" parser
235237
236238
237239
@@ -300,22 +302,37 @@ padded p =
300302 return out
301303
302304
303−spaces :: IParser String
305+plus :: IParser a -> IParser ()
306+plus parser =
307+ parser >> star parser
308+
309+
310+star :: IParser a -> IParser ()
311+star parser =
312+ choice
313+ [ parser >> star parser
314+ , return ()
315+ ]
316+
317+
318+spaces :: IParser ()
304319spaces =
305− let space = string " " <|> multiComment <?> Syntax.whitespace
306− in
307− concat <$> many1 space
320+ plus $ expecting Syntax.whitespace $
321+ choice
322+ [ string " " >> return ()
323+ , multiComment
324+ ]
308325
309326
310−forcedWS :: IParser String
327+forcedWS :: IParser ()
311328forcedWS =
312329 do failIfTabFound
313− ws <- many1 (spaces <|> newline)
330+ plus (spaces <|> newline)
314331 failIfTabFound
315332 column <- sourceColumn <$> getPosition
316333 if column == 1
317334 then fail badWhiteSpaceMessage
318− else return (concat ws)
335+ else return ()
319336
320337
321338badWhiteSpaceMessage :: String
@@ -335,25 +352,27 @@ failIfTabFound =
335352
336353
337354-- Just eats whitespace until the next meaningful character.
338−dumbWhitespace :: IParser String
355+dumbWhitespace :: IParser ()
339356dumbWhitespace =
340− concat <$> many (spaces <|> newline)
357+ star (spaces <|> newline)
341358
342359
343−whitespace :: IParser String
360+whitespace :: IParser Bool
344361whitespace =
345− option "" forcedWS
362+ choice
363+ [ forcedWS >> return True
364+ , return False
365+ ]
346366
347367
348−freshLine :: IParser String
368+freshLine :: IParser ()
349369freshLine =
350− try (
351− do ws <- many1 (spaces <|> newline)
352− column <- sourceColumn <$> getPosition
353− if column == 1
354− then return (concat ws)
355− else fail badFreshLineMessage
356− ) <?> Syntax.freshLine
370+ expecting Syntax.freshLine $ try $
371+ do plus (spaces <|> newline)
372+ column <- sourceColumn <$> getPosition
373+ if column == 1
374+ then return ()
375+ else fail badFreshLineMessage
357376
358377
359378badFreshLineMessage :: String
@@ -362,39 +381,59 @@ badFreshLineMessage =
362381 ++ "starts with stuff, not with spaces or comments."
363382
364383
365−newline :: IParser String
384+newline :: IParser ()
366385newline =
367386 simpleNewline <|> lineComment <?> Syntax.newline
368387
369388
370−simpleNewline :: IParser String
389+simpleNewline :: IParser ()
371390simpleNewline =
372− try (string "\r\n") <|> string "\n"
391+ do try (string "\r\n") <|> string "\n"
392+ return ()
373393
374394
375−lineComment :: IParser String
395+lineComment :: IParser ()
376396lineComment =
377397 do try (string "--")
378− comment <- anyUntil $ simpleNewline <|> (eof >> return "\n")
379− return ("--" ++ comment)
380−
381−
382−docComment :: IParser String
383−docComment =
384− do try (string "{-|")
385− contents <- closeComment
386− return (init (init contents))
398+ anyUntil (simpleNewline <|> eof)
387399
388400
389−multiComment :: IParser String
401+multiComment :: IParser ()
390402multiComment =
391− (++) <$> try (string "{-" <* notFollowedBy (string "|")) <*> closeComment
403+ do try (string "{-" >> notFollowedBy (string "|"))
404+ closeComment
392405
393406
394−closeComment :: IParser String
407+closeComment :: IParser ()
395408closeComment =
396− anyUntil $
397− choice $
398− [ try (string "-}") <?> "the end of a comment -}"
399− , concat <$> sequence [ try (string "{-"), closeComment, closeComment ]
400− ]
409+ choice
410+ [ expecting "the end of a comment -}" $
411+ do try (string "-}")
412+ return ()
413+ , do try (string "{-")
414+ closeComment
415+ closeComment
416+ , do anyChar
417+ closeComment
418+ ]
419+
420+
421+docComment :: IParser String
422+docComment =
423+ do try (string "{-|")
424+ builder <- closeDocComment id
425+ return (builder "")
426+
427+
428+closeDocComment :: (String -> String) -> IParser (String -> String)
429+closeDocComment builder =
430+ choice
431+ [ expecting "the end of a comment -}" $
432+ do try (string "-}")
433+ return builder
434+ , do try (string "{-")
435+ addComment <- closeDocComment (\end -> "{-" ++ end)
436+ closeDocComment (\end -> builder (addComment ("-}" ++ end)))
437+ , do c <- anyChar
438+ closeDocComment (\end -> builder (c:end))
439+ ]