Create stub functions for sugaring specialized types.

2 files changed, 14 insertions, 1 deletions

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 2a820531..f54b7c22 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -540,7 +540,7 @@ ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
 ppInstanceSigs links splice unicode qual (InstSpec {..}) (InstHead {..}) = do
     TypeSig lnames (L sspan typ) _ <- ispecSigs
     let names = map unLoc lnames
-    let typ' = specializeTyVarBndrs ispecTyVars ihdTypes typ
+    let typ' = sugar $ specializeTyVarBndrs ispecTyVars ihdTypes typ
     return $ ppFunSig False links sspan noDocForDecl names typ' []
         splice unicode qual
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
index fa5ba536..c10c7e6e 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
@@ -4,6 +4,7 @@
 module Haddock.Backends.Xhtml.Specialize
     ( specialize, specialize'
     , specializeTyVarBndrs
+    , sugar
     ) where
 
 
@@ -40,3 +41,15 @@ specializeTyVarBndrs bndrs typs =
     bndrs' = map (bname . unLoc) . hsq_tvs $ bndrs
     bname (UserTyVar name) = name
     bname (KindedTyVar (L _ name) _) = name
+
+
+sugar :: HsType name -> HsType name
+sugar = sugarTuples . sugarLists
+
+
+sugarLists :: HsType name -> HsType name
+sugarLists = id
+
+
+sugarTuples :: HsType name -> HsType name
+sugarTuples = id