aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
authorAlfredo Di Napoli <alfredo@well-typed.com>2021-04-26 12:56:50 +0200
committerAlfredo Di Napoli <alfredo@well-typed.com>2021-05-24 13:53:00 +0200
commit40ba457f6436b7eb2c60e8824e1591526945df2a (patch)
treebc40cb0f077b10f0eeb7cb7cb65873d525e5377e /haddock-api/src/Haddock/Backends
parent3b6a8774bdb543dad59b2618458b07feab8a55e9 (diff)
New Parser diagnostics interface
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs8
1 files changed, 5 insertions, 3 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index e6748937..94395218 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -12,9 +12,10 @@ import qualified Data.ByteString as BS
import GHC.Types.SourceText
import GHC.Driver.Session
-import GHC.Utils.Error ( pprLocMsgEnvelope )
+import GHC.Utils.Error ( mkPlainMsgEnvelope, pprLocMsgEnvelope )
import GHC.Data.FastString ( mkFastString )
-import GHC.Parser.Errors.Ppr ( mkParserErr )
+import GHC.Parser.Errors.Ppr ()
+import qualified GHC.Types.Error as E
import GHC.Parser.Lexer as Lexer
( P(..), ParseResult(..), PState(..), Token(..)
, initParserState, lexer, mkParserOpts, getErrorMessages)
@@ -40,7 +41,7 @@ parse
parse dflags fpath bs = case unP (go False []) initState of
POk _ toks -> reverse toks
PFailed pst ->
- let err:_ = bagToList (fmap mkParserErr (getErrorMessages pst)) in
+ let err:_ = bagToList (E.getMessages $ getErrorMessages pst) in
panic $ showSDoc dflags $
text "Hyperlinker parse error:" $$ pprLocMsgEnvelope err
where
@@ -50,6 +51,7 @@ parse dflags fpath bs = case unP (go False []) initState of
start = mkRealSrcLoc (mkFastString fpath) 1 1
pflags = mkParserOpts (warningFlags dflags)
(extensionFlags dflags)
+ (mkPlainMsgEnvelope dflags)
(safeImportsOn dflags)
False -- lex Haddocks as comment tokens
True -- produce comment tokens