@@ -57,23 +57,24 @@ type Parsing m = (P.MonadParsec Void String m, MonadWriter FC m)
57runparser :: Parser st res -> st -> String -> String -> Either ParseError res
57runparser :: Parser st res -> st -> String -> String -> Either ParseError res
58runparser p i inputname s =
58runparser p i inputname s =
59 case P.parse (runWriterT (evalStateT p i)) inputname s of
59 case P.parse (runWriterT (evalStateT p i)) inputname s of
60− Left err -> Left $ ParseError s err
60+ Left err -> Left $ ParseError err
61 Right v -> Right $ fst v
61 Right v -> Right $ fst v
63{- * Parse errors -}
63{- * Parse errors -}
65−data ParseError = ParseError String (P.ParseError (P.Token String) Void)
65+newtype ParseError = ParseError (P.ParseErrorBundle String Void)
67instance Message ParseError where
67instance Message ParseError where
68− messageExtent (ParseError _ err) = sourcePositionFC pos
68+ messageExtent (ParseError err) = sourcePositionFC pos
70+ (pos, _) = P.reachOffsetNoLine (P.errorOffset err') (P.bundlePosState err)
70− (pos NonEmpty.:| _) = P.errorPos err
71+ err' = NonEmpty.head . P.bundleErrors $ err
71− messageText (ParseError _ err) = PP.text . init . P.parseErrorTextPretty $ err
72+ messageText (ParseError err) = PP.text . init . P.errorBundlePretty $ err
72− messageSource (ParseError src _) = Just src
73+ messageSource (ParseError err) = Just . P.sourceName . P.pstateSourcePos . P.bundlePosState $ err
74-- | A fully formatted parse error, with caret and bar, etc.
75-- | A fully formatted parse error, with caret and bar, etc.
75prettyError :: ParseError -> String
76prettyError :: ParseError -> String
76−prettyError (ParseError s err) = P.parseErrorPretty' s err
77+prettyError (ParseError err) = P.errorBundlePretty err
78{- * Mark and restore -}
79{- * Mark and restore -}