Mon Nov 20 20:51:51 UTC 2017

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

On branches: 2.17.3.1-spanfix,alexbiehl-patch-1,ghc-8.0,ghc-8.0-facebook,ghc-head,ghc-head1,haddock-quick,headdock-library-1.4.5,ie_avails,issue-303,issue-475,master,pr-filter-maps,pr/cabal-desc,travis,v2.16,v2.17,v2.17.3,v2.18,wip-located-module-as,wip/D2418,wip/T11080-open-data-kinds,wip/T11258,wip/T11430,wip/T12105,wip/T12105-2,wip/T12942,wip/T13163,wip/T3384,wip/embelleshed-rdr,wip/new-tree-one-param,wip/rae,wip/remove-frames,wip/remove-frames1,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13
Link       : http://git.haskell.org/haddock.git/commitdiff/85dab3d6aacf867a381c8810deaf585a43d42d43

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

commit 85dab3d6aacf867a381c8810deaf585a43d42d43
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Thu Jul 23 19:15:13 2015 +0200

    Integrate instance specification type into class instance definition.


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

85dab3d6aacf867a381c8810deaf585a43d42d43
 haddock-api/src/Haddock/Backends/LaTeX.hs      |  2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs |  4 ++--
 haddock-api/src/Haddock/Convert.hs             |  8 ++++++--
 haddock-api/src/Haddock/Interface/Rename.hs    |  5 ++++-
 haddock-api/src/Haddock/Types.hs               | 13 ++++++++++---
 5 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 59e5af3..4708791 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/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 6740591..a894972 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -531,13 +531,13 @@ ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
            -> Html
 ppInstHead links splice unicode qual iid mspec ihead@(InstHead {..}) =
     case ihdInstType of
-        ClassInst cs | Just spec <- mspec ->
+        ClassInst cs _ _ | Just spec <- mspec ->
             subClsInstance (nameStr ++ "-" ++ show iid) hdr (mets spec ihead)
           where
             hdr = ppContextNoLocs cs unicode qual <+> typ
             mets = ppInstanceSigs links splice unicode qual
             nameStr = occNameString . nameOccName $ getName ihdClsName
-        ClassInst cs -> ppContextNoLocs cs unicode qual <+> typ
+        ClassInst cs _ _ -> ppContextNoLocs cs unicode qual <+> typ
         TypeInst rhs -> keyword "type" <+> typ
             <+> maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
         DataInst dd -> keyword "data" <+> typ
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index e51d9df..3479780 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -390,11 +390,15 @@ synifyKindSig :: Kind -> LHsKind Name
 synifyKindSig k = synifyType WithinType k
 
 synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name
-synifyInstHead (_, preds, cls, types) = InstHead
+synifyInstHead (tyvars, preds, cls, types) = InstHead
   { ihdClsName = getName cls
   , ihdKinds = map (unLoc . synifyType WithinType) ks
   , ihdTypes = map (unLoc . synifyType WithinType) ts
-  , ihdInstType = ClassInst $ map (unLoc . synifyType WithinType) preds
+  , ihdInstType = ClassInst
+      { clsiCtx = map (unLoc . synifyType WithinType) preds
+      , clsiTyVars = synifyTyVars tyvars
+      , clsiSigs = map (synifyIdSig WithinType) $ classMethods cls
+      }
   }
   where (ks,ts) = break (not . isKind) types
 
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 4463531..4e4d3ed 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -264,7 +264,10 @@ renameInstHead InstHead {..} = do
   kinds <- mapM renameType ihdKinds
   types <- mapM renameType ihdTypes
   itype <- case ihdInstType of
-    ClassInst cs -> ClassInst <$> mapM renameType cs
+    ClassInst ctx bndrs sigs -> ClassInst
+        <$> mapM renameType ctx
+        <*> renameLTyVarBndrs bndrs
+        <*> mapM renameSig sigs
     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 c5ca31c..0c130cb 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
@@ -324,12 +324,19 @@ instance SetName DocName where
 
 -- | The three types of instances
 data InstType name
-  = ClassInst [HsType name]         -- ^ Context
+  = ClassInst
+      { clsiCtx :: [HsType name]
+      , clsiTyVars :: LHsTyVarBndrs name
+      , clsiSigs :: [Sig name]
+      }
   | TypeInst  (Maybe (HsType name)) -- ^ Body (right-hand side)
   | DataInst (TyClDecl name)        -- ^ Data constructors
 
 instance OutputableBndr a => Outputable (InstType a) where
-  ppr (ClassInst a) = text "ClassInst" <+> ppr a
+  ppr (ClassInst { .. }) = text "ClassInst"
+      <+> ppr clsiCtx
+      <+> ppr clsiTyVars
+      <+> ppr clsiSigs
   ppr (TypeInst  a) = text "TypeInst"  <+> ppr a
   ppr (DataInst  a) = text "DataInst"  <+> ppr a
 

