diff options
Diffstat (limited to 'haddock-api/src')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs | 14 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Utils.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 4 |
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]. |