diff options
| author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2020-06-17 15:04:59 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-06-17 16:09:07 -0400 |
| commit | 02a1def8d147da88a0433726590f8586f486c760 (patch) | |
| tree | 6aee10b7822ba5effbab1ee58d61660eef8ec816 /haddock-api/src/Haddock/Backends/LaTeX.hs | |
| parent | e37911553bfe6804d3903f750261f758569b4a26 (diff) | |
Adapt Haddock to LinearTypes
See ghc/ghc!852.
Diffstat (limited to 'haddock-api/src/Haddock/Backends/LaTeX.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 17 |
1 files changed, 9 insertions, 8 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 0c323ae5..badb1914 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -41,6 +41,7 @@ import Control.Monad import Data.Maybe import Data.List import Prelude hiding ((<>)) +import GHC.Core.Multiplicity import Haddock.Doc (combineDocumentation) @@ -483,13 +484,13 @@ ppSubSigLike unicode typ argDocs subdocs leader = do_args 0 leader typ = (decltt leader, ppLContextNoArrow lctxt unicode <+> nl) : 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) = [ (decltt ldr, latex <+> nl) | (L _ field, ldr) <- zip fields (leader <+> gadtOpen : repeat gadtComma) , let latex = ppSideBySideField subdocs unicode field ] ++ do_largs (n+1) (gadtEnd <+> arrow unicode) r - do_args n leader (HsFunTy _ lt r) + do_args n leader (HsFunTy _ _w lt r) = (decltt leader, decltt (ppLFunLhType unicode lt) <-> arg_doc n <+> nl) : do_largs (n+1) (arrow unicode) r do_args n leader t @@ -773,7 +774,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = | hasArgDocs -> header_ <+> ppOcc | otherwise -> hsep [ header_ , ppOcc - , hsep (map (ppLParendType unicode) args) + , hsep (map ((ppLParendType unicode) . hsScaledThing) args) ] -- Record constructor, e.g. 'Identity { runIdentity :: a }' @@ -783,9 +784,9 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = InfixCon arg1 arg2 | hasArgDocs -> header_ <+> ppOcc | otherwise -> hsep [ header_ - , ppLParendType unicode arg1 + , ppLParendType unicode (hsScaledThing arg1) , ppOccInfix - , ppLParendType unicode arg2 + , ppLParendType unicode (hsScaledThing arg2) ] ConDeclGADT{} @@ -804,10 +805,10 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = (_, RecCon (L _ fields)) -> doRecordFields fields -- Any GADT or a regular H98 prefix data constructor - (_, PrefixCon args) | hasArgDocs -> doConstrArgsWithDocs args + (_, PrefixCon args) | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args) -- An infix H98 data constructor - (_, InfixCon arg1 arg2) | hasArgDocs -> doConstrArgsWithDocs [arg1,arg2] + (_, InfixCon arg1 arg2) | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing [arg1,arg2]) _ -> empty @@ -1047,7 +1048,7 @@ ppr_mono_ty (HsForAllTy _ tele ty) unicode ppr_mono_ty (HsQualTy _ ctxt ty) unicode = sep [ ppLContext ctxt unicode , ppr_mono_lty ty unicode ] -ppr_mono_ty (HsFunTy _ ty1 ty2) u +ppr_mono_ty (HsFunTy _ _ ty1 ty2) u = sep [ ppr_mono_lty ty1 u , arrow u <+> ppr_mono_lty ty2 u ] |