diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 128 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 10 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Names.hs | 6 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Types.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Utils.hs | 8 |
6 files changed, 82 insertions, 74 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 30b8d43e..eeb9fa94 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -35,12 +35,13 @@ import Data.Maybe import Data.Void ( absurd ) import Text.XHtml hiding ( name, title, p, quote ) -import BasicTypes (PromotionFlag(..), isPromoted) +import GHC.Core.Type ( Specificity(..) ) +import GHC.Types.Basic (PromotionFlag(..), isPromoted) import GHC hiding (LexicalFixity(..)) import GHC.Exts -import Name -import BooleanFormula -import RdrName ( rdrNameOcc ) +import GHC.Types.Name +import GHC.Data.BooleanFormula +import GHC.Types.Name.Reader ( rdrNameOcc ) -- | Pretty print a declaration ppDecl :: Bool -- ^ print summary info only @@ -151,8 +152,10 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_args 0 sep typ do_largs n leader (L _ t) = do_args n leader t do_args :: Int -> Html -> HsType DocNameI -> [SubDecl] - do_args n leader (HsForAllTy _ fvf tvs ltype) - = do_largs n (leader <+> ppForAllPart unicode qual tvs fvf) ltype + do_args n leader (HsForAllTy _ tele ltype) + = do_largs n leader' ltype + where + leader' = leader <+> ppForAllPart unicode qual tele do_args n leader (HsQualTy _ lctxt ltype) | null (unLoc lctxt) @@ -161,14 +164,14 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_args 0 sep typ = (leader <+> ppLContextNoArrow lctxt unicode qual emptyCtxts, Nothing, []) : do_largs n (darrow unicode) ltype - do_args n leader (HsFunTy _ (L _ (HsRecTy _ fields)) r) + do_args n leader (HsFunTy _ _w (L _ (HsRecTy _ fields)) r) = [ (ldr <+> html, mdoc, subs) | (L _ field, ldr) <- zip fields (leader <+> gadtOpen : repeat gadtComma) , let (html, mdoc, subs) = ppSideBySideField subdocs unicode qual field ] ++ do_largs (n+1) (gadtEnd <+> arrow unicode) r - do_args n leader (HsFunTy _ lt r) + do_args n leader (HsFunTy _ _w lt r) = (leader <+> ppLFunLhType unicode qual emptyCtxts lt, argDoc n, []) : do_largs (n+1) (arrow unicode) r @@ -209,7 +212,8 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge -- | Pretty-print type variables. -ppTyVars :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html] +ppTyVars :: RenderableBndrFlag flag => + Unicode -> Qualification -> [LHsTyVarBndr flag DocNameI] -> [Html] ppTyVars unicode qual tvs = map (ppHsTyVarBndr unicode qual . unLoc) tvs @@ -305,8 +309,6 @@ ppFamDecl summary associated links instances fixities loc doc decl splice unicod , Nothing , [] ) - ppFamDeclEqn (XHsImplicitBndrs nec) = noExtCon nec - ppFamDeclEqn (HsIB { hsib_body = XFamEqn nec}) = noExtCon nec -- | Print a pseudo family declaration @@ -331,7 +333,6 @@ ppFamHeader :: Bool -- ^ is a summary -> Bool -- ^ is an associated type -> FamilyDecl DocNameI -- ^ family declaration -> Unicode -> Qualification -> Html -ppFamHeader _ _ (XFamilyDecl nec) _ _ = noExtCon nec ppFamHeader summary associated (FamilyDecl { fdInfo = info , fdResultSig = L _ result , fdInjectivityAnn = injectivity @@ -371,7 +372,6 @@ ppResultSig result unicode qual = case result of NoSig _ -> noHtml KindSig _ kind -> dcolon unicode <+> ppLKind unicode qual kind TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr - XFamilyResultSig nec -> noExtCon nec -------------------------------------------------------------------------------- @@ -390,7 +390,8 @@ ppAssocType summ links doc (L loc decl) fixities splice unicode pkg qual = -- * Type applications -------------------------------------------------------------------------------- -ppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [LHsTyVarBndr DocNameI] -> Html +ppAppDocNameTyVarBndrs :: RenderableBndrFlag flag => + Bool -> Unicode -> Qualification -> DocName -> [LHsTyVarBndr flag DocNameI] -> Html ppAppDocNameTyVarBndrs summ unicode qual n vs = ppTypeApp n vs ppDN (ppHsTyVarBndr unicode qual . unLoc) where @@ -492,7 +493,7 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t +++ shortSubDecls False ( [ ppAssocType summary links doc at [] splice unicode pkg qual | at <- ats - , let doc = lookupAnySubdoc (unLoc $ fdLName $ unLoc at) subdocs ] ++ + , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ] ++ -- ToDo: add associated type defaults @@ -517,9 +518,8 @@ ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity) -> [(DocName, DocForDecl DocName)] -> TyClDecl DocNameI -> Splice -> Unicode -> Maybe Package -> Qualification -> Html ppClassDecl summary links instances fixities loc d subdocs - decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname@(L _ nm) - , tcdTyVars = ltyvars, tcdFDs = lfds, tcdSigs = lsigs - , tcdATs = ats, tcdATDefs = atsDefs }) + decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars + , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = atsDefs }) splice unicode pkg qual | summary = ppShortClassDecl summary links decl loc subdocs splice unicode pkg qual | otherwise = classheader +++ docSection curname pkg qual d @@ -603,7 +603,7 @@ ppClassDecl summary links instances fixities loc d subdocs -- Minimal complete definition = the only shown method Var (L _ n) : _ | [getName n] == - [getName n' | ClassOpSig _ _ ns _ <- sigs, L _ n' <- ns] + [getName n' | L _ (ClassOpSig _ _ ns _) <- lsigs, L _ n' <- ns] -> noHtml -- Minimal complete definition = nothing @@ -768,7 +768,6 @@ ppShortDataDecl summary dataInst dataDecl pats unicode qual isH98 = case unLoc (head cons) of ConDeclH98 {} -> True ConDeclGADT{} -> False - XConDecl{} -> False pats1 = [ hsep [ keyword "pattern" , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames @@ -802,7 +801,6 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats isH98 = case unLoc (head cons) of ConDeclH98 {} -> True ConDeclGADT{} -> False - XConDecl{} -> False header_ = topDeclElem links loc splice [docname] $ ppDataHeader summary dataDecl unicode qual <+> whereBit <+> fix @@ -854,14 +852,14 @@ ppShortConstrParts summary dataInst con unicode qual -- Prefix constructor, e.g. 'Just a' PrefixCon args -> - ( header_ <+> hsep (ppOcc : map (ppLParendType unicode qual HideEmptyContexts) args) + ( header_ <+> hsep (ppOcc : map (ppLParendType unicode qual HideEmptyContexts . hsScaledThing) args) , noHtml , noHtml ) -- Record constructor, e.g. 'Identity { runIdentity :: a }' RecCon (L _ fields) -> - ( header_ <+> ppOcc <+> char '{' + ( header_ +++ ppOcc <+> char '{' , shortSubDecls dataInst [ ppShortField summary unicode qual field | L _ field <- fields ] @@ -870,9 +868,9 @@ ppShortConstrParts summary dataInst con unicode qual -- Infix constructor, e.g. 'a :| [a]' InfixCon arg1 arg2 -> - ( header_ <+> hsep [ ppLParendType unicode qual HideEmptyContexts arg1 + ( header_ <+> hsep [ ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg1) , ppOccInfix - , ppLParendType unicode qual HideEmptyContexts arg2 + , ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg2) ] , noHtml , noHtml @@ -884,7 +882,6 @@ ppShortConstrParts summary dataInst con unicode qual , noHtml , noHtml ) - XConDecl nec -> noExtCon nec where occ = map (nameOccName . getName . unLoc) $ getConNamesI con @@ -928,7 +925,7 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) PrefixCon args | hasArgDocs -> header_ <+> ppOcc <+> fixity | otherwise -> hsep [ header_ <+> ppOcc - , hsep (map (ppLParendType unicode qual HideEmptyContexts) args) + , hsep (map (ppLParendType unicode qual HideEmptyContexts . hsScaledThing) args) , fixity ] @@ -938,9 +935,9 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) -- Infix constructor, e.g. 'a :| [a]' InfixCon arg1 arg2 | hasArgDocs -> header_ <+> ppOcc <+> fixity - | otherwise -> hsep [ header_ <+> ppLParendType unicode qual HideEmptyContexts arg1 + | otherwise -> hsep [ header_ <+> ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg1) , ppOccInfix - , ppLParendType unicode qual HideEmptyContexts arg2 + , ppLParendType unicode qual HideEmptyContexts (hsScaledThing arg2) , fixity ] @@ -953,9 +950,8 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) , ppLType unicode qual HideEmptyContexts (getGADTConType con) , fixity ] - XConDecl nec -> noExtCon nec - fieldPart = case (con, getConArgs con) of + fieldPart = case (con, getConArgsI con) of -- Record style GADTs (ConDeclGADT{}, RecCon _) -> [ doConstrArgsWithDocs [] ] @@ -976,13 +972,12 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) doConstrArgsWithDocs args = subFields pkg qual $ case con of ConDeclH98{} -> [ (ppLParendType unicode qual HideEmptyContexts arg, mdoc, []) - | (i, arg) <- zip [0..] args + | (i, arg) <- zip [0..] (map hsScaledThing args) , let mdoc = Map.lookup i argDocs ] ConDeclGADT{} -> ppSubSigLike unicode qual (unLoc (getGADTConType con)) argDocs subdocs (dcolon unicode) HideEmptyContexts - XConDecl nec -> noExtCon nec -- don't use "con_doc con", in case it's reconstructed from a .hi file, -- or also because we want Haddock to do the doc-parsing, not GHC. @@ -993,7 +988,7 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) -- ppConstrHdr is for (non-GADT) existentials constructors' syntax ppConstrHdr :: Bool -- ^ print explicit foralls - -> [LHsTyVarBndr DocNameI] -- ^ type variables + -> [LHsTyVarBndr Specificity DocNameI] -- ^ type variables -> HsContext DocNameI -- ^ context -> Unicode -> Qualification -> Html @@ -1001,7 +996,7 @@ ppConstrHdr forall_ tvs ctxt unicode qual = ppForall +++ ppCtxt where ppForall | null tvs || not forall_ = noHtml - | otherwise = ppForAllPart unicode qual tvs ForallInvis + | otherwise = ppForAllPart unicode qual (HsForAllInvis noExtField tvs) ppCtxt | null ctxt = noHtml @@ -1026,14 +1021,12 @@ ppSideBySideField subdocs unicode qual (ConDeclField _ names ltype _) = -- don't use cd_fld_doc for same reason we don't use con_doc above -- Where there is more than one name, they all have the same documentation mbDoc = lookup (extFieldOcc $ unLoc $ head names) subdocs >>= combineDocumentation . fst -ppSideBySideField _ _ _ (XConDeclField nec) = noExtCon nec ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocNameI -> Html ppShortField summary unicode qual (ConDeclField _ names ltype _) = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts ltype -ppShortField _ _ _ (XConDeclField nec) = noExtCon nec -- | Pretty print an expanded pattern (for bundled patterns) @@ -1134,13 +1127,28 @@ ppLHsTypeArg unicode qual emptyCtxts (HsValArg ty) = ppLParendType unicode qual ppLHsTypeArg unicode qual emptyCtxts (HsTypeArg _ ki) = atSign unicode <> ppLParendType unicode qual emptyCtxts ki ppLHsTypeArg _ _ _ (HsArgPar _) = toHtml "" -ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocNameI -> Html -ppHsTyVarBndr _ qual (UserTyVar _ (L _ name)) = - ppDocName qual Raw False name -ppHsTyVarBndr unicode qual (KindedTyVar _ name kind) = - parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+> - ppLKind unicode qual kind) -ppHsTyVarBndr _ _ (XTyVarBndr nec) = noExtCon nec + +class RenderableBndrFlag flag where + ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr flag DocNameI -> Html + +instance RenderableBndrFlag () where + ppHsTyVarBndr _ qual (UserTyVar _ _ (L _ name)) = + ppDocName qual Raw False name + ppHsTyVarBndr unicode qual (KindedTyVar _ _ name kind) = + parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+> + ppLKind unicode qual kind) + +instance RenderableBndrFlag Specificity where + ppHsTyVarBndr _ qual (UserTyVar _ SpecifiedSpec (L _ name)) = + ppDocName qual Raw False name + ppHsTyVarBndr _ qual (UserTyVar _ InferredSpec (L _ name)) = + braces $ ppDocName qual Raw False name + ppHsTyVarBndr unicode qual (KindedTyVar _ SpecifiedSpec name kind) = + parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+> + ppLKind unicode qual kind) + ppHsTyVarBndr unicode qual (KindedTyVar _ InferredSpec name kind) = + braces (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+> + ppLKind unicode qual kind) ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html ppLKind unicode qual y = ppKind unicode qual (unLoc y) @@ -1155,16 +1163,16 @@ patSigContext typ | hasNonEmptyContext typ && isFirstContextEmpty typ = ShowEmp hasNonEmptyContext :: LHsType name -> Bool hasNonEmptyContext t = case unLoc t of - HsForAllTy _ _ _ s -> hasNonEmptyContext s - HsQualTy _ cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True - HsFunTy _ _ s -> hasNonEmptyContext s + HsForAllTy _ _ s -> hasNonEmptyContext s + HsQualTy _ cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True + HsFunTy _ _ _ s -> hasNonEmptyContext s _ -> False isFirstContextEmpty :: LHsType name -> Bool isFirstContextEmpty t = case unLoc t of - HsForAllTy _ _ _ s -> isFirstContextEmpty s - HsQualTy _ cxt _ -> null (unLoc cxt) - HsFunTy _ _ s -> isFirstContextEmpty s + HsForAllTy _ _ s -> isFirstContextEmpty s + HsQualTy _ cxt _ -> null (unLoc cxt) + HsFunTy _ _ _ s -> isFirstContextEmpty s _ -> False @@ -1175,21 +1183,21 @@ ppPatSigType unicode qual typ = let emptyCtxts = patSigContext typ in ppLType unicode qual emptyCtxts typ -ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> ForallVisFlag -> Html -ppForAllPart unicode qual tvs fvf = hsep (forallSymbol unicode : tvs') +++ fv - where - tvs' = ppTyVars unicode qual tvs - fv = case fvf of - ForallVis -> spaceHtml +++ arrow unicode - ForallInvis -> dot +ppForAllPart :: Unicode -> Qualification -> HsForAllTelescope DocNameI -> Html +ppForAllPart unicode qual tele = case tele of + HsForAllVis { hsf_vis_bndrs = bndrs } -> + hsep (forallSymbol unicode : ppTyVars unicode qual bndrs) +++ + spaceHtml +++ arrow unicode + HsForAllInvis { hsf_invis_bndrs = bndrs } -> + hsep (forallSymbol unicode : ppTyVars unicode qual bndrs) +++ dot ppr_mono_lty :: LHsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html ppr_mono_lty ty = ppr_mono_ty (unLoc ty) ppr_mono_ty :: HsType DocNameI -> Unicode -> Qualification -> HideEmptyContexts -> Html -ppr_mono_ty (HsForAllTy _ fvf tvs ty) unicode qual emptyCtxts - = ppForAllPart unicode qual tvs fvf <+> ppr_mono_lty ty unicode qual emptyCtxts +ppr_mono_ty (HsForAllTy _ tele ty) unicode qual emptyCtxts + = ppForAllPart unicode qual tele <+> ppr_mono_lty ty unicode qual emptyCtxts ppr_mono_ty (HsQualTy _ ctxt ty) unicode qual emptyCtxts = ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty ty unicode qual emptyCtxts @@ -1205,7 +1213,7 @@ ppr_mono_ty (HsTyVar _ prom (L _ name)) _ q _ | otherwise = ppDocName q Prefix True name ppr_mono_ty (HsStarTy _ isUni) u _ _ = toHtml (if u || isUni then "★" else "*") -ppr_mono_ty (HsFunTy _ ty1 ty2) u q e = +ppr_mono_ty (HsFunTy _ _ ty1 ty2) u q e = hsep [ ppr_mono_lty ty1 u q HideEmptyContexts , arrow u <+> ppr_mono_lty ty2 u q e ] diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs index 0d7accfc..378d0559 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs @@ -32,7 +32,7 @@ import Text.XHtml hiding ( name, p, quote ) import Data.Maybe (fromMaybe) import GHC -import Name +import GHC.Types.Name parHtmlMarkup :: Qualification -> Bool diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs index 4535b897..d61d6d9b 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs @@ -50,9 +50,9 @@ import qualified Data.Map as Map import Text.XHtml hiding ( name, title, quote ) import Data.Maybe (fromMaybe) -import FastString ( unpackFS ) +import GHC.Data.FastString ( unpackFS ) import GHC -import Name (nameOccName) +import GHC.Types.Name (nameOccName) -------------------------------------------------------------------------------- -- * Sections of the document @@ -167,7 +167,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 @@ -310,9 +310,9 @@ links ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice mdl' docName@(D -- 'mdl'' is a way of "overriding" the module. Without it, instances -- will point to the module defining the class/family, which is wrong. origMod = fromMaybe (nameModule n) mdl' - origPkg = moduleUnitId origMod + origPkg = moduleUnit 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/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs index 6a047747..8553cdfb 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs @@ -28,9 +28,9 @@ import qualified Data.Map as M import Data.List ( stripPrefix ) import GHC hiding (LexicalFixity(..)) -import Name -import RdrName -import FastString (unpackFS) +import GHC.Types.Name +import GHC.Types.Name.Reader +import GHC.Data.FastString (unpackFS) -- | Indicator of how to render a 'DocName' into 'Html' diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs index d1561791..e3fd2d5a 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs @@ -23,7 +23,7 @@ import GHC -- the base, module and entity URLs for the source code and wiki links. -type SourceURLs = (Maybe FilePath, Maybe FilePath, Map UnitId FilePath, Map UnitId FilePath) +type SourceURLs = (Maybe FilePath, Maybe FilePath, Map Unit FilePath, Map Unit FilePath) type WikiURLs = (Maybe FilePath, Maybe FilePath, Maybe FilePath) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs index c3acb6df..f5f64f51 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs @@ -38,9 +38,9 @@ import Data.Maybe import Text.XHtml hiding ( name, title, p, quote ) import qualified Text.XHtml as XHtml -import GHC ( SrcSpan(..), srcSpanStartLine, Name ) -import Module ( Module, ModuleName, moduleName, moduleNameString ) -import Name ( getOccString, nameOccName, isValOcc ) +import GHC ( SrcSpan(..), srcSpanStartLine, Name ) +import GHC.Unit.Module ( Module, ModuleName, moduleName, moduleNameString ) +import GHC.Types.Name ( getOccString, nameOccName, isValOcc ) -- | Replace placeholder string elements with provided values. @@ -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 _ -> "" |