diff options
| -rw-r--r-- | haddock-api/src/Haddock.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Org.hs | 19 |
2 files changed, 11 insertions, 10 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index f4bc355e..6cdac62f 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -512,7 +512,7 @@ render log' dflags unit_state flags sinceQual qual ifaces packages extSrcMap = d libDir return () when (Flag_Org `elem` flags) $ do - withTiming logger dflags' "ppOrg" (const ()) $ do + withTiming logger "ppOrg" (const ()) $ do _ <- {-# SCC ppOrg #-} ppOrg title pkgStr odir (_doc <$> prologue) visibleIfaces return () diff --git a/haddock-api/src/Haddock/Backends/Org.hs b/haddock-api/src/Haddock/Backends/Org.hs index 76924210..73989615 100644 --- a/haddock-api/src/Haddock/Backends/Org.hs +++ b/haddock-api/src/Haddock/Backends/Org.hs @@ -724,7 +724,7 @@ ppConDeclGADTDetailsRec -> ModPath -> Int -> [OrgBlock] -ppConDeclGADTDetailsRec (RecConGADT (L _ args)) resTy subdocs path level = +ppConDeclGADTDetailsRec (RecConGADT (L _ args) _) resTy subdocs path level = concatMap (\arg -> ppConDeclField (unLoc arg) subdocs path level) args ++ [Heading level (plaintext "} -> " : ppLHsType resTy) []] ppConDeclGADTDetailsRec _ _ _ _ _ = [] @@ -837,17 +837,17 @@ ppHsOuterSigTyVarBndrs bndrs = case bndrs of ppHsSigTypeDoc :: HsSigType DocNameI -> FnArgsDoc DocName -> [OrgBlock] ppHsSigTypeDoc (HsSig _ bndrs (L _ ty)) adoc = - [Paragraph [plaintext "Arguments:"], DefList (forall ++ ppHsTypeDoc ty 0)] + [Paragraph [plaintext "Arguments:"], DefList (forAll ++ ppHsTypeDoc ty 0)] where ppHsTypeDoc :: HsType DocNameI -> Int -> [DefListItem] ppHsTypeDoc (HsFunTy _ _ (L _ lTy) (L _ rTy)) i = ppHsTypeDoc lTy i ++ ppHsTypeDoc rTy (i + 1) - ppHsTypeDoc (HsQualTy _ mbCtxt (L _ body)) i = - (ppMbLHsContext mbCtxt, []) : ppHsTypeDoc body i + ppHsTypeDoc (HsQualTy _ ctxt (L _ body)) i = + (ppMbLHsContext (Just ctxt), []) : ppHsTypeDoc body i ppHsTypeDoc (HsForAllTy _ tele (L _ body)) i = (ppHsForAllTelescope tele ++ [plaintext "."], []) : ppHsTypeDoc body i ppHsTypeDoc typ i = [(ppHsType typ, ppADoc adoc i)] - forall = case ppHsOuterSigTyVarBndrs bndrs of + forAll = case ppHsOuterSigTyVarBndrs bndrs of [] -> [] is -> [(is, [])] @@ -864,8 +864,8 @@ ppHsType :: HsType DocNameI -> [OrgInline] ppHsType (HsForAllTy _ tele (L _ body)) = ppHsForAllTelescope tele ++ [plaintext ".", Whitespace] ++ ppHsType body -- e.g. forall a. Ord a => a -ppHsType (HsQualTy _ mbCtxt (L _ body)) = - interNotNull [Whitespace] [ppMbLHsContext mbCtxt, ppHsType body] +ppHsType (HsQualTy _ ctxt (L _ body)) = + interNotNull [Whitespace] [ppMbLHsContext (Just ctxt), ppHsType body] -- e.g. Bool ppHsType (HsTyVar _ promo (L _ docName)) = ppPromoted promo ++ ppDocName docName @@ -889,8 +889,9 @@ ppHsType (HsTupleTy _ sort tys) = orgParens $ maybeUnbox $ intercalate -- e.g. (# a | b #) ppHsType (HsSumTy _ tys) = orgParens . orgUnbox $ intercalate [plaintext " | "] (map ppLHsType tys) -ppHsType (HsOpTy _ (L _ lTy) (L _ docName) (L _ rTy)) = - intercalate [Whitespace] [ppHsType lTy, ppDocName docName, ppHsType rTy] +ppHsType (HsOpTy _ promo (L _ lTy) (L _ docName) (L _ rTy)) = intercalate + [Whitespace] + [ppHsType lTy, ppPromoted promo ++ ppDocName docName, ppHsType rTy] -- e.g. (a -> a) ppHsType (HsParTy _ (L _ t)) = orgParens $ ppHsType t -- e.g. ?callStack :: CallStack |