@@ -212,16 +212,45 @@ simpleNewline = try (string "\r\n") <|> string "\n"
212212lineComment :: IParser String
213213lineComment = do
214214 try (string "--")
215− comment <- manyTill anyChar $ simpleNewline <|> (eof >> return "\n")
215+ comment <- anyUntil $ simpleNewline <|> (eof >> return "\n")
216216 return ("--" ++ comment)
217217
218218multiComment :: IParser String
219−multiComment = do { try (string "{-"); closeComment }
219+multiComment = (++) <$> try (string "{-") <*> closeComment
220220
221221closeComment :: IParser String
222−closeComment = do
223− comment <- manyTill anyChar . choice $
224− [ try (string "-}") <?> "close comment"
225− , do { try $ string "{-"; closeComment; closeComment }
226− ]
227− return ("{-" ++ comment ++ "-}")
222+closeComment =
223+ anyUntil . choice $
224+ [ try (string "-}") <?> "close comment"
225+ , concat <$> sequence [ try (string "{-"), closeComment, closeComment ]
226+ ]
227+
228+anyUntil :: IParser String -> IParser String
229+anyUntil end = go
230+ where
231+ go = end <|> (:) <$> anyChar <*> go
232+
233+anyThen :: IParser a -> IParser a
234+anyThen end = go
235+ where
236+ ignore p = const () <$> p
237+ go = end <|> do ignore multiComment <|> ignore anyChar
238+ go
239+
240+withSource :: IParser a -> IParser (String, a)
241+withSource p = do
242+ start <- getParserState
243+ result <- p
244+ endPos <- getPosition
245+ setParserState start
246+ raw <- anyUntilPos endPos
247+ return (raw, result)
248+
249+anyUntilPos :: SourcePos -> IParser String
250+anyUntilPos pos = go
251+ where
252+ go = do currentPos <- getPosition
253+ case currentPos == pos of
254+ True -> return []
255+ False -> (:) <$> anyChar <*> go
256+