Vladislav Zavialov pushed to branch wip/int-index/tyop at Glasgow Haskell Compiler / GHC
Commits:
-
cb514db5
by Vladislav Zavialov at 2026-03-02T11:26:22+03:00
2 changed files:
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
Changes:
| ... | ... | @@ -1345,17 +1345,15 @@ ppr_mono_ty (HsAppTy _ fun_ty arg_ty) unicode = |
| 1345 | 1345 | hsep [ppr_mono_lty fun_ty unicode, ppr_mono_lty arg_ty unicode]
|
| 1346 | 1346 | ppr_mono_ty (HsAppKindTy _ fun_ty arg_ki) unicode =
|
| 1347 | 1347 | hsep [ppr_mono_lty fun_ty unicode, atSign <> ppr_mono_lty arg_ki unicode]
|
| 1348 | -ppr_mono_ty (HsOpTy _ ty1 (L _ (HsTyVar _ prom op)) ty2) unicode =
|
|
| 1349 | - ppr_mono_lty ty1 unicode <+> ppr_op_prom <+> ppr_mono_lty ty2 unicode
|
|
| 1348 | +ppr_mono_ty (HsOpTy _ ty1 tyop ty2) unicode
|
|
| 1349 | + | Just pp_op <- ppr_infix_ty tyop
|
|
| 1350 | + = pp_ty1 <+> pp_op <+> pp_ty2
|
|
| 1351 | + | otherwise
|
|
| 1352 | + = let pp_op = ppr_mono_lty tyop unicode
|
|
| 1353 | + in hsep [hsep [pp_op, pp_ty1], pp_ty2]
|
|
| 1350 | 1354 | where
|
| 1351 | - ppr_op_prom
|
|
| 1352 | - | isPromoted prom =
|
|
| 1353 | - char '\'' <> ppr_op
|
|
| 1354 | - | otherwise =
|
|
| 1355 | - ppr_op
|
|
| 1356 | - ppr_op
|
|
| 1357 | - | isSymOcc (getOccName op) = ppLDocName op
|
|
| 1358 | - | otherwise = char '`' <> ppLDocName op <> char '`'
|
|
| 1355 | + pp_ty1 = ppr_mono_lty ty1 unicode
|
|
| 1356 | + pp_ty2 = ppr_mono_lty ty2 unicode
|
|
| 1359 | 1357 | ppr_mono_ty (HsParTy _ ty) unicode =
|
| 1360 | 1358 | parens (ppr_mono_lty ty unicode)
|
| 1361 | 1359 | -- = ppr_mono_lty ty unicode
|
| ... | ... | @@ -1367,6 +1365,18 @@ ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u |
| 1367 | 1365 | ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode)
|
| 1368 | 1366 | ppr_mono_ty (XHsType HsRedacted{}) _ = error "ppr_mono_ty: HsRedacted can't be used here"
|
| 1369 | 1367 | |
| 1368 | +ppr_infix_ty :: LHsType DocNameI -> Maybe LaTeX
|
|
| 1369 | +ppr_infix_ty (L _ (HsTyVar _ prom op)) = Just pp_op_prom
|
|
| 1370 | + where
|
|
| 1371 | + pp_op_prom
|
|
| 1372 | + | isPromoted prom = char '\'' <> pp_op
|
|
| 1373 | + | otherwise = pp_op
|
|
| 1374 | + pp_op
|
|
| 1375 | + | isSymOcc (getOccName op) = ppLDocName op
|
|
| 1376 | + | otherwise = char '`' <> ppLDocName op <> char '`'
|
|
| 1377 | +ppr_infix_ty (L _ (HsWildCardTy _)) = Just (text "`_`")
|
|
| 1378 | +ppr_infix_ty _ = Nothing
|
|
| 1379 | + |
|
| 1370 | 1380 | ppr_tylit :: HsLit DocNameI -> Bool -> LaTeX
|
| 1371 | 1381 | ppr_tylit (HsNatural _ n) _ = integer (il_value n)
|
| 1372 | 1382 | ppr_tylit (HsString _ s) _ = text (show s)
|
| ... | ... | @@ -1863,15 +1863,15 @@ ppr_mono_ty (HsAppKindTy _ fun_ty arg_ki) unicode qual _ = |
| 1863 | 1863 | [ ppr_mono_lty fun_ty unicode qual HideEmptyContexts
|
| 1864 | 1864 | , atSign <> ppr_mono_lty arg_ki unicode qual HideEmptyContexts
|
| 1865 | 1865 | ]
|
| 1866 | -ppr_mono_ty (HsOpTy _ ty1 (L _ (HsTyVar _ prom op)) ty2) unicode qual _ =
|
|
| 1867 | - ppr_mono_lty ty1 unicode qual HideEmptyContexts <+> ppr_op_prom <+> ppr_mono_lty ty2 unicode qual HideEmptyContexts
|
|
| 1866 | +ppr_mono_ty (HsOpTy _ ty1 tyop ty2) unicode qual _
|
|
| 1867 | + | Just pp_op <- ppr_infix_ty tyop qual
|
|
| 1868 | + = pp_ty1 <+> pp_op <+> pp_ty2
|
|
| 1869 | + | otherwise
|
|
| 1870 | + = let pp_op = ppr_mono_lty tyop unicode qual HideEmptyContexts
|
|
| 1871 | + in hsep [hsep [pp_op, pp_ty1], pp_ty2]
|
|
| 1868 | 1872 | where
|
| 1869 | - ppr_op_prom
|
|
| 1870 | - | isPromoted prom =
|
|
| 1871 | - promoQuote ppr_op
|
|
| 1872 | - | otherwise =
|
|
| 1873 | - ppr_op
|
|
| 1874 | - ppr_op = ppLDocName qual Infix op
|
|
| 1873 | + pp_ty1 = ppr_mono_lty ty1 unicode qual HideEmptyContexts
|
|
| 1874 | + pp_ty2 = ppr_mono_lty ty2 unicode qual HideEmptyContexts
|
|
| 1875 | 1875 | ppr_mono_ty (HsParTy _ ty) unicode qual emptyCtxts =
|
| 1876 | 1876 | parens (ppr_mono_lty ty unicode qual emptyCtxts)
|
| 1877 | 1877 | -- = parens (ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts)
|
| ... | ... | @@ -1882,6 +1882,16 @@ ppr_mono_ty (HsWildCardTy _) _ _ _ = char '_' |
| 1882 | 1882 | ppr_mono_ty (HsTyLit _ n) _ _ _ = ppr_tylit n
|
| 1883 | 1883 | ppr_mono_ty (XHsType HsRedacted{}) _ _ _ = error "ppr_mono_ty: HsRedacted can't be used here"
|
| 1884 | 1884 | |
| 1885 | +ppr_infix_ty :: LHsType DocNameI -> Qualification -> Maybe Html
|
|
| 1886 | +ppr_infix_ty (L _ (HsTyVar _ prom op)) qual = Just pp_op_prom
|
|
| 1887 | + where
|
|
| 1888 | + pp_op_prom
|
|
| 1889 | + | isPromoted prom = promoQuote pp_op
|
|
| 1890 | + | otherwise = pp_op
|
|
| 1891 | + pp_op = ppLDocName qual Infix op
|
|
| 1892 | +ppr_infix_ty (L _ (HsWildCardTy _)) _ = Just (toHtml ("`_`" :: LText))
|
|
| 1893 | +ppr_infix_ty _ _ = Nothing
|
|
| 1894 | + |
|
| 1885 | 1895 | ppr_tylit :: HsLit DocNameI -> Html
|
| 1886 | 1896 | ppr_tylit (HsNatural _ n) = toHtml (show (il_value n))
|
| 1887 | 1897 | ppr_tylit (HsString _ s) = toHtml (show s)
|