[commit: haddock] wip/ttg-2017-10-13, wip/ttg-2017-10-31: Work in actual TTG stuff for HsType (8a68723)

git at git.haskell.org git at git.haskell.org
Mon Nov 20 21:11:27 UTC 2017


Repository : ssh://git@git.haskell.org/haddock

On branches: wip/ttg-2017-10-13,wip/ttg-2017-10-31
Link       : http://git.haskell.org/haddock.git/commitdiff/8a68723536c32d6bd13388f8e1a22b150769175c

>---------------------------------------------------------------

commit 8a68723536c32d6bd13388f8e1a22b150769175c
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Sat Oct 21 20:21:58 2017 +0200

    Work in actual TTG stuff for HsType
    
    No more PostTc / PostRn


>---------------------------------------------------------------

8a68723536c32d6bd13388f8e1a22b150769175c
 haddock-api/src/Haddock/Backends/LaTeX.hs       |  8 ++++----
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs  |  8 ++++----
 haddock-api/src/Haddock/Interface/Rename.hs     |  8 ++++----
 haddock-api/src/Haddock/Interface/Specialize.hs | 12 ++++++------
 haddock-api/src/Haddock/Types.hs                |  2 +-
 5 files changed, 19 insertions(+), 19 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 50a5ba8..9c60144 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -979,9 +979,9 @@ ppr_mono_ty _         (HsIParamTy _ (L _ n) ty) u = brackets (ppIPName n <+> dco
 ppr_mono_ty _         (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
 ppr_mono_ty _         (HsRecTy {})        _ = error "ppr_mono_ty HsRecTy"
 ppr_mono_ty _         (NewHsType (NHsCoreTy {}))  _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _         (HsExplicitListTy _ Promoted _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
-ppr_mono_ty _         (HsExplicitListTy _ NotPromoted _ tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
-ppr_mono_ty _         (HsExplicitTupleTy _ _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
+ppr_mono_ty _         (HsExplicitListTy _ Promoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _         (HsExplicitListTy _ NotPromoted tys) u = brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _         (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
 
 ppr_mono_ty ctxt_prec (HsEqTy _ ty1 ty2) unicode
   = maybeParen ctxt_prec pREC_OP $
@@ -1005,7 +1005,7 @@ 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 _ (AnonWildCard _)) _ = char '_'
+ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ = char '_'
 
 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 364e9f0..f959c84 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -1052,9 +1052,9 @@ ppr_mono_ty _         (HsRecTy {})        _ _ _ = toHtml "{..}"
        -- placeholder in the signature, which is followed by the field
        -- declarations.
 ppr_mono_ty _         (NewHsType (NHsCoreTy {})) _ _ _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _         (HsExplicitListTy _ Promoted _ tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
-ppr_mono_ty _         (HsExplicitListTy _ NotPromoted _ tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
-ppr_mono_ty _         (HsExplicitTupleTy _ _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty _         (HsExplicitListTy _ Promoted tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty _         (HsExplicitListTy _ NotPromoted tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys
+ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys
 ppr_mono_ty _         (HsAppsTy {})       _ _ _ = error "ppr_mono_ty HsAppsTy"
 
 ppr_mono_ty ctxt_prec (HsEqTy _ ty1 ty2) unicode qual _
@@ -1083,7 +1083,7 @@ ppr_mono_ty ctxt_prec (HsParTy _ ty) unicode qual emptyCtxts
 ppr_mono_ty ctxt_prec (HsDocTy _ ty _) unicode qual emptyCtxts
   = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts
 
-ppr_mono_ty _ (HsWildCardTy _ (AnonWildCard _)) _ _ _ = char '_'
+ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ _ = char '_'
 ppr_mono_ty _ (HsTyLit _ n) _ _ _ = ppr_tylit n
 
 ppr_tylit :: HsTyLit -> Html
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 320747b..eeb84cb 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -262,10 +262,10 @@ renameType t = case t of
 
   HsRecTy _ a               -> HsRecTy PlaceHolder <$> mapM renameConDeclFieldField a
   (NewHsType (NHsCoreTy a)) -> pure (NewHsType (NHsCoreTy a))
-  HsExplicitListTy x i a b  -> HsExplicitListTy x i a <$> mapM renameLType b
-  HsExplicitTupleTy x a b   -> HsExplicitTupleTy x a <$> mapM renameLType b
-  HsSpliceTy _ _ _          -> error "renameType: HsSpliceTy"
-  HsWildCardTy x a          -> HsWildCardTy x <$> renameWildCardInfo a
+  HsExplicitListTy x i b    -> HsExplicitListTy x i <$> mapM renameLType b
+  HsExplicitTupleTy x b     -> HsExplicitTupleTy x <$> mapM renameLType b
+  HsSpliceTy _ _            -> error "renameType: HsSpliceTy"
+  HsWildCardTy a            -> HsWildCardTy <$> renameWildCardInfo a
   HsAppsTy _ _              -> error "renameType: HsAppsTy"
 
 renameLHsQTyVars :: LHsQTyVars GhcRn -> RnM (LHsQTyVars DocNameI)
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 2b249fb..663892c 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -261,17 +261,17 @@ renameType (HsParTy x lt) = HsParTy x <$> renameLType lt
 renameType (HsIParamTy x ip lt) = HsIParamTy x ip <$> renameLType lt
 renameType (HsEqTy x la lb) = HsEqTy x <$> renameLType la <*> renameLType lb
 renameType (HsKindSig x lt lk) = HsKindSig x <$> renameLType lt <*> pure lk
-renameType t@(HsSpliceTy _ _ _) = pure t
+renameType t@(HsSpliceTy _ _) = pure t
 renameType (HsDocTy x lt doc) = HsDocTy x <$> renameLType lt <*> pure doc
 renameType (HsBangTy x bang lt) = HsBangTy x bang <$> renameLType lt
 renameType t@(HsRecTy _ _) = pure t
 renameType t@(NewHsType (NHsCoreTy _)) = pure t
-renameType (HsExplicitListTy x ip ph ltys) =
-    HsExplicitListTy x ip ph <$> renameLTypes ltys
-renameType (HsExplicitTupleTy x phs ltys) =
-    HsExplicitTupleTy x phs <$> renameLTypes ltys
+renameType (HsExplicitListTy x ip ltys) =
+    HsExplicitListTy x ip <$> renameLTypes ltys
+renameType (HsExplicitTupleTy x ltys) =
+    HsExplicitTupleTy x <$> renameLTypes ltys
 renameType t@(HsTyLit _ _) = pure t
-renameType (HsWildCardTy x wc) = pure (HsWildCardTy x wc)
+renameType (HsWildCardTy wc) = pure (HsWildCardTy wc)
 renameType (HsAppsTy _ _) = error "HsAppsTy: Only used before renaming"
 
 
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 1ee7ba0..6de717a 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -698,5 +698,5 @@ type instance XRecTy           DocNameI = PlaceHolder
 type instance XExplicitListTy  DocNameI = PlaceHolder
 type instance XExplicitTupleTy DocNameI = PlaceHolder
 type instance XTyLit           DocNameI = PlaceHolder
-type instance XWildCardTy      DocNameI = PlaceHolder
+type instance XWildCardTy      DocNameI = HsWildCardInfo DocNameI
 type instance XNewType         DocNameI = NewHsTypeX



More information about the ghc-commits mailing list