aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs14
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Layout.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Utils.hs2
-rw-r--r--haddock-api/src/Haddock/Interface.hs2
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs4
5 files changed, 14 insertions, 12 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index b2e2dadd..af7662f1 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -69,11 +69,11 @@ parse dflags fpath bs = case unP (go False []) initState of
-- | Like 'Lexer.lexer', but slower, with a better API, and filtering out empty tokens
wrappedLexer :: P (RealLocated Lexer.Token)
wrappedLexer = Lexer.lexer False andThen
- where andThen (L (RealSrcSpan s) t)
+ where andThen (L (RealSrcSpan s _) t)
| srcSpanStartLine s /= srcSpanEndLine s ||
srcSpanStartCol s /= srcSpanEndCol s
= pure (L s t)
- andThen (L (RealSrcSpan s) ITeof) = pure (L s ITeof)
+ andThen (L (RealSrcSpan s _) ITeof) = pure (L s ITeof)
andThen _ = wrappedLexer
-- | Try to parse a CPP line (can fail)
@@ -96,9 +96,9 @@ parse dflags fpath bs = case unP (go False []) initState of
(bEnd, _) <- lift getInput
case sp of
UnhelpfulSpan _ -> pure ([], False) -- pretend the token never existed
- RealSrcSpan rsp -> do
+ RealSrcSpan rsp _ -> do
let typ = if inPrag then TkPragma else classify tok
- RealSrcLoc lStart = srcSpanStart sp -- safe since @sp@ is real
+ RealSrcLoc lStart _ = srcSpanStart sp -- safe since @sp@ is real
(spaceBStr, bStart) = spanPosition lInit lStart bInit
inPragDef = inPragma inPrag tok
@@ -153,11 +153,13 @@ parse dflags fpath bs = case unP (go False []) initState of
-- | Get the input
getInput :: P (StringBuffer, RealSrcLoc)
-getInput = P $ \p@PState { buffer = buf, loc = srcLoc } -> POk p (buf, srcLoc)
+getInput = P $ \p@PState { buffer = buf, loc = srcLoc } -> POk p (buf, psRealLoc srcLoc)
-- | Set the input
setInput :: (StringBuffer, RealSrcLoc) -> P ()
-setInput (buf, srcLoc) = P $ \p -> POk (p { buffer = buf, loc = srcLoc }) ()
+setInput (buf, srcLoc) =
+ P $ \p@PState{ loc = PsLoc _ buf_loc } ->
+ POk (p { buffer = buf, loc = PsLoc srcLoc buf_loc }) ()
tryP :: P a -> MaybeT P a
tryP (P f) = MaybeT $ P $ \s -> case f s of
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 25d8b07a..a3c20aa7 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -166,7 +166,7 @@ subTableSrc pkg qual lnks splice decls = Just $ table << aboves (concatMap subRo
: map (cell . (td <<)) subs
linkHtml :: SrcSpan -> Maybe Module -> DocName -> Html
- linkHtml loc@(RealSrcSpan _) mdl dn = links lnks loc splice mdl dn
+ linkHtml loc@(RealSrcSpan _ _) mdl dn = links lnks loc splice mdl dn
linkHtml _ _ _ = noHtml
subBlock :: [Html] -> Maybe Html
@@ -309,6 +309,6 @@ links ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice mdl' docName@(D
origPkg = moduleUnitId origMod
fname = case loc of
- RealSrcSpan l -> unpackFS (srcSpanFile l)
+ RealSrcSpan l _ -> unpackFS (srcSpanFile l)
UnhelpfulSpan _ -> error "links: UnhelpfulSpan"
links _ _ _ _ _ = noHtml
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index c3acb6df..3e1312d5 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -75,7 +75,7 @@ spliceURL' maybe_file maybe_mod maybe_name maybe_loc = run
Nothing -> ""
Just span_ ->
case span_ of
- RealSrcSpan span__ ->
+ RealSrcSpan span__ _ ->
show $ srcSpanStartLine span__
UnhelpfulSpan _ -> ""
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index 008beb14..4489bd2a 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -187,7 +187,7 @@ processModule verbosity modsum flags modMap instIfaceMap = do
where
formatName :: SrcSpan -> HsDecl GhcRn -> String
formatName loc n = p (getMainDeclBinder n) ++ case loc of
- RealSrcSpan rss -> " (" ++ unpackFS (srcSpanFile rss) ++ ":" ++ show (srcSpanStartLine rss) ++ ")"
+ RealSrcSpan rss _ -> " (" ++ unpackFS (srcSpanFile rss) ++ ":" ++ show (srcSpanStartLine rss) ++ ")"
_ -> ""
p [] = ""
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 94443856..977fc9ca 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -377,7 +377,7 @@ mkMaps dflags pkgName gre instances decls = do
, [(Name, Map Int (MDoc Name))]
, [(Name, [LHsDecl GhcRn])]
)
- mappings (ldecl@(L (RealSrcSpan l) decl), docStrs) = do
+ mappings (ldecl@(L (RealSrcSpan l _) decl), docStrs) = do
let declDoc :: [HsDocString] -> Map Int HsDocString
-> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name))
declDoc strs m = do
@@ -409,7 +409,7 @@ mkMaps dflags pkgName gre instances decls = do
mappings (L (UnhelpfulSpan _) _, _) = pure ([], [], [])
instanceMap :: Map RealSrcSpan Name
- instanceMap = M.fromList [(l, n) | n <- instances, RealSrcSpan l <- [getSrcSpan n] ]
+ instanceMap = M.fromList [(l, n) | n <- instances, RealSrcSpan l _ <- [getSrcSpan n] ]
names :: RealSrcSpan -> HsDecl GhcRn -> [Name]
names _ (InstD _ d) = maybeToList (SrcLoc.lookupSrcSpan loc instanceMap) -- See note [2].