From 553c719236972f3a1d445146352ec94614979b63 Mon Sep 17 00:00:00 2001
From: Thomas Winant <thomas.winant@cs.kuleuven.be>
Date: Mon, 8 Jun 2015 23:47:28 -0500
Subject: Update after wild card renaming refactoring in D613
Summary:
* Move `Post*` type instances to `Haddock.Types` as other modules than
`Haddock.Interface.Rename` will rely on these type instances.
* Update after wild card renaming refactoring in D613.
Reviewers: simonpj, austin
Reviewed By: austin
Differential Revision: https://phabricator.haskell.org/D954
GHC Trac Issues: #10098
---
haddock-api/src/Haddock/Backends/LaTeX.hs | 12 +++++++-----
haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 12 +++++++-----
2 files changed, 14 insertions(+), 10 deletions(-)
(limited to 'haddock-api/src/Haddock/Backends')
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index c9262c7e..e1090a0e 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -898,9 +898,11 @@ ppr_mono_ty :: Int -> HsType DocName -> Bool -> LaTeX
ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode
= maybeParen ctxt_prec pREC_FUN $
hsep [ppForAll expl tvs ctxt' unicode, ppr_mono_lty pREC_TOP ty unicode]
- where ctxt' = case extra of
- Just loc -> (++ [L loc HsWildcardTy]) `fmap` ctxt
- Nothing -> ctxt
+ where
+ anonWC = HsWildCardTy (AnonWildCard PlaceHolder)
+ ctxt'
+ | Just loc <- extra = (++ [L loc anonWC]) `fmap` ctxt
+ | otherwise = ctxt
ppr_mono_ty _ (HsBangTy b ty) u = ppBang b <> ppLParendType u ty
ppr_mono_ty _ (HsTyVar name) _ = ppDocName name
@@ -939,9 +941,9 @@ ppr_mono_ty ctxt_prec (HsParTy ty) unicode
ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode
= ppr_mono_lty ctxt_prec ty unicode
-ppr_mono_ty _ HsWildcardTy _ = char '_'
+ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ = char '_'
-ppr_mono_ty _ (HsNamedWildcardTy name) _ = ppDocName name
+ppr_mono_ty _ (HsWildCardTy (NamedWildCard name)) _ = ppDocName name
ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 88aa966c..c0be9735 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -852,9 +852,11 @@ ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> Html
ppr_mono_ty ctxt_prec (HsForAllTy expl extra tvs ctxt ty) unicode qual
= maybeParen ctxt_prec pREC_FUN $ ppForAllCon expl tvs ctxt' unicode qual
<+> ppr_mono_lty pREC_TOP ty unicode qual
- where ctxt' = case extra of
- Just loc -> (++ [L loc HsWildcardTy]) `fmap` ctxt
- Nothing -> ctxt
+ where
+ anonWC = HsWildCardTy (AnonWildCard PlaceHolder)
+ ctxt'
+ | Just loc <- extra = (++ [L loc anonWC]) `fmap` ctxt
+ | otherwise = ctxt
-- UnicodeSyntax alternatives
ppr_mono_ty _ (HsTyVar name) True _
@@ -899,9 +901,9 @@ ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual
ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual
= ppr_mono_lty ctxt_prec ty unicode qual
-ppr_mono_ty _ HsWildcardTy _ _ = char '_'
+ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ = char '_'
-ppr_mono_ty _ (HsNamedWildcardTy name) _ q = ppDocName q Prefix True name
+ppr_mono_ty _ (HsWildCardTy (NamedWildCard name)) _ q = ppDocName q Prefix True name
ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n
--
cgit v1.2.3