From 0c34ec0ae515d88437e04a49ca0131205be096e5 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Wed, 29 Jul 2015 12:07:13 +0200
Subject: Attach associated types information to instance header.

---
 haddock-api/src/Haddock/Backends/LaTeX.hs   | 2 +-
 haddock-api/src/Haddock/Convert.hs          | 3 +++
 haddock-api/src/Haddock/Interface/Rename.hs | 9 +++++----
 haddock-api/src/Haddock/Types.hs            | 1 +
 4 files changed, 10 insertions(+), 5 deletions(-)

(limited to 'haddock-api')

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 47087911..24779a94 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -562,7 +562,7 @@ ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
 
 ppInstHead :: Bool -> InstHead DocName -> LaTeX
 ppInstHead unicode (InstHead {..}) = case ihdInstType of
-    ClassInst ctx _ _ -> ppContextNoLocs ctx unicode <+> typ
+    ClassInst ctx _ _ _ -> ppContextNoLocs ctx unicode <+> typ
     TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs
     DataInst _ -> error "data instances not supported by --latex yet"
   where
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 00a90e97..a2716d92 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -398,6 +398,9 @@ synifyInstHead (_, preds, cls, types) = InstHead
         { clsiCtx = map (unLoc . synifyType WithinType) preds
         , clsiTyVars = synifyTyVars $ classTyVars cls
         , clsiSigs = map synifyClsIdSig $ classMethods cls
+        , clsiAssocTys = do
+            (Right (FamDecl fam)) <- map (synifyTyCon Nothing) $ classATs cls
+            pure fam
         }
     }
   where
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 4e4d3ed9..82d14a2c 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -264,10 +264,11 @@ renameInstHead InstHead {..} = do
   kinds <- mapM renameType ihdKinds
   types <- mapM renameType ihdTypes
   itype <- case ihdInstType of
-    ClassInst ctx bndrs sigs -> ClassInst
-        <$> mapM renameType ctx
-        <*> renameLTyVarBndrs bndrs
-        <*> mapM renameSig sigs
+    ClassInst { .. } -> ClassInst
+        <$> mapM renameType clsiCtx
+        <*> renameLTyVarBndrs clsiTyVars
+        <*> mapM renameSig clsiSigs
+        <*> mapM renameFamilyDecl clsiAssocTys
     TypeInst  ts -> TypeInst  <$> traverse renameType ts
     DataInst  dd -> DataInst  <$> renameTyClD dd
   return InstHead
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index b4a41020..ac073036 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -328,6 +328,7 @@ data InstType name
       { clsiCtx :: [HsType name]
       , clsiTyVars :: LHsTyVarBndrs name
       , clsiSigs :: [Sig name]
+      , clsiAssocTys :: [FamilyDecl name]
       }
   | TypeInst  (Maybe (HsType name)) -- ^ Body (right-hand side)
   | DataInst (TyClDecl name)        -- ^ Data constructors
-- 
cgit v1.2.3