aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--haddock-api/src/Haddock.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Org.hs19
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