diff --git a/html-test/ref/DeprecatedClass.html b/html-test/ref/DeprecatedClass.html
index ecd162b03bff4a5686cf160fdac14ea837140f31..a9e03e8f5b78f8a6dcf7681d88165b425625fde8 100644
--- a/html-test/ref/DeprecatedClass.html
+++ b/html-test/ref/DeprecatedClass.html
@@ -95,6 +95,14 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedClass.html")
><p
>some class</p
></div
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ ><a href="DeprecatedClass.html#v:foo"
+ >foo</a
+ ></p
+ ></div
><div class="subs methods"
><p class="caption"
>Methods</p
@@ -127,6 +135,14 @@ window.onload = function () {pageLoad();setSynopsis("mini_DeprecatedClass.html")
>Deprecated: SomeOtherClass</p
></div
></div
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ ><a href="DeprecatedClass.html#v:bar"
+ >bar</a
+ ></p
+ ></div
><div class="subs methods"
><p class="caption"
>Methods</p
diff --git a/html-test/ref/Hash.html b/html-test/ref/Hash.html
index 3be7c6e0aeda3b08e9261d636ac8df90eaaafb4f..66449f7ea80af10ee7337a44391f27fb36577fae 100644
--- a/html-test/ref/Hash.html
+++ b/html-test/ref/Hash.html
@@ -250,6 +250,14 @@ window.onload = function () {pageLoad();setSynopsis("mini_Hash.html");};
><p
>A class of types which can be hashed.</p
></div
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ ><a href="Hash.html#v:hash"
+ >hash</a
+ ></p
+ ></div
><div class="subs methods"
><p class="caption"
>Methods</p
diff --git a/html-test/ref/Minimal.html b/html-test/ref/Minimal.html
new file mode 100644
index 0000000000000000000000000000000000000000..f062dc8cc8293d587d9248a5da69e67e4d4348a8
--- /dev/null
+++ b/html-test/ref/Minimal.html
@@ -0,0 +1,273 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+ ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+ /><title
+ >Minimal</title
+ ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean"
+ /><script src="haddock-util.js" type="text/javascript"
+ ></script
+ ><script type="text/javascript"
+ >//<![CDATA[
+window.onload = function () {pageLoad();setSynopsis("mini_Minimal.html");};
+//]]>
+</script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href=""
+ >Contents</a
+ ></li
+ ><li
+ ><a href=""
+ >Index</a
+ ></li
+ ></ul
+ ><p class="caption empty"
+ > </p
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >Safe-Inferred</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >Minimal</p
+ ></div
+ ><div id="description"
+ ><p class="caption"
+ >Description</p
+ ><div class="doc"
+ ><p
+ >This tests the new MINIMAL pragma present in GHC 7.8</p
+ ></div
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >class</span
+ > <a name="t:Foo" class="def"
+ >Foo</a
+ > a <span class="keyword"
+ >where</span
+ ></p
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ ><a href=""
+ >foo</a
+ >, <a href=""
+ >bar</a
+ > | <a href=""
+ >bar</a
+ >, <a href=""
+ >bat</a
+ > | <a href=""
+ >foo</a
+ >, <a href=""
+ >bat</a
+ > | <a href=""
+ >fooBarBat</a
+ ></p
+ ></div
+ ><div class="subs methods"
+ ><p class="caption"
+ >Methods</p
+ ><p class="src"
+ ><a name="v:foo" class="def"
+ >foo</a
+ >, <a name="v:bat" class="def"
+ >bat</a
+ >, <a name="v:bar" class="def"
+ >bar</a
+ > :: a</p
+ ><div class="doc"
+ ><p
+ >Any two of these are required...</p
+ ></div
+ ><p class="src"
+ ><a name="v:fooBarBat" class="def"
+ >fooBarBat</a
+ > :: (a, a, a)</p
+ ><div class="doc"
+ ><p
+ >.. or just this</p
+ ></div
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >class</span
+ > <a name="t:Weird" class="def"
+ >Weird</a
+ > a <span class="keyword"
+ >where</span
+ ></p
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ ><a href=""
+ >a</a
+ >, <a href=""
+ >b</a
+ >, <a href=""
+ >c</a
+ > | <a href=""
+ >d</a
+ > | <a href=""
+ >e</a
+ >, (<a href=""
+ >f</a
+ > | <a href=""
+ >g</a
+ >)</p
+ ></div
+ ><div class="subs methods"
+ ><p class="caption"
+ >Methods</p
+ ><p class="src"
+ ><a name="v:a" class="def"
+ >a</a
+ >, <a name="v:g" class="def"
+ >g</a
+ >, <a name="v:f" class="def"
+ >f</a
+ >, <a name="v:e" class="def"
+ >e</a
+ >, <a name="v:d" class="def"
+ >d</a
+ >, <a name="v:c" class="def"
+ >c</a
+ >, <a name="v:b" class="def"
+ >b</a
+ > :: a</p
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >class</span
+ > <a name="t:NoMins" class="def"
+ >NoMins</a
+ > a <span class="keyword"
+ >where</span
+ ></p
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ ><a href=""
+ >x</a
+ >, <a href=""
+ >y</a
+ ></p
+ ></div
+ ><div class="subs methods"
+ ><p class="caption"
+ >Methods</p
+ ><p class="src"
+ ><a name="v:x" class="def"
+ >x</a
+ >, <a name="v:z" class="def"
+ >z</a
+ >, <a name="v:y" class="def"
+ >y</a
+ > :: a</p
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >class</span
+ > <a name="t:FullMin" class="def"
+ >FullMin</a
+ > a <span class="keyword"
+ >where</span
+ ></p
+ ><div class="subs methods"
+ ><p class="caption"
+ >Methods</p
+ ><p class="src"
+ ><a name="v:aaa" class="def"
+ >aaa</a
+ >, <a name="v:bbb" class="def"
+ >bbb</a
+ > :: a</p
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >class</span
+ > <a name="t:PartialMin" class="def"
+ >PartialMin</a
+ > a <span class="keyword"
+ >where</span
+ ></p
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ ><a href=""
+ >ccc</a
+ >, ddd</p
+ ></div
+ ><div class="subs methods"
+ ><p class="caption"
+ >Methods</p
+ ><p class="src"
+ ><a name="v:ccc" class="def"
+ >ccc</a
+ > :: a</p
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >class</span
+ > <a name="t:EmptyMin" class="def"
+ >EmptyMin</a
+ > a <span class="keyword"
+ >where</span
+ ></p
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ >Nothing</p
+ ></div
+ ><div class="subs methods"
+ ><p class="caption"
+ >Methods</p
+ ><p class="src"
+ ><a name="v:eee" class="def"
+ >eee</a
+ >, <a name="v:fff" class="def"
+ >fff</a
+ > :: a</p
+ ></div
+ ></div
+ ></div
+ ></div
+ ><div id="footer"
+ ><p
+ >Produced by <a href=""
+ >Haddock</a
+ > version 2.15.0</p
+ ></div
+ ></body
+ ></html
+>
diff --git a/html-test/ref/Test.html b/html-test/ref/Test.html
index 7d229b52461ef12f25fe99c249ba04c27893cad9..e4dc5527755a3545bfebae58bb63bb9705acae38 100644
--- a/html-test/ref/Test.html
+++ b/html-test/ref/Test.html
@@ -1583,6 +1583,12 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");};
><p
>This is a class declaration with no methods (or no methods exported)</p
></div
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ >ee</p
+ ></div
></div
><div class="top"
><p class="src"
@@ -1593,6 +1599,14 @@ window.onload = function () {pageLoad();setSynopsis("mini_Test.html");};
> a <span class="keyword"
>where</span
></p
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ ><a href="Test.html#v:ff"
+ >ff</a
+ ></p
+ ></div
><div class="subs methods"
><p class="caption"
>Methods</p
diff --git a/html-test/ref/Ticket61.html b/html-test/ref/Ticket61.html
index 31ffa62d9d0866203a3bda05f69c51f62bdef716..e327b72227b774da7a32e4e7a4505c2c649c3207 100644
--- a/html-test/ref/Ticket61.html
+++ b/html-test/ref/Ticket61.html
@@ -53,6 +53,14 @@ window.onload = function () {pageLoad();setSynopsis("mini_Ticket61.html");};
> a <span class="keyword"
>where</span
></p
+ ><div class="subs minimal"
+ ><p class="caption"
+ >Minimal complete definition</p
+ ><p class="src"
+ ><a href="Ticket61.html#v:f"
+ >f</a
+ ></p
+ ></div
><div class="subs methods"
><p class="caption"
>Methods</p
diff --git a/html-test/src/Test.hs b/html-test/src/Test.hs
index 677106c64bcfcb1a3c63402d9da572ff1daf2821..e94cc4146c8af83c7f673e895ede807a11df6adf 100644
--- a/html-test/src/Test.hs
+++ b/html-test/src/Test.hs
@@ -171,6 +171,7 @@ class (D a) => C a where
b :: [a]
-- ^ this is a description of the 'b' method
c :: a -- c is hidden in the export list
+ c = undefined
-- ^ This comment applies to the /previous/ declaration (the 'C' class)
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 6405861d5c268d6f63e90dfbc0803288eba71813..628e1cd01025a133af4720a7198d7a2a31ef7e5a 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -110,7 +110,10 @@ operator x = x
-- How to print each export
ppExport :: DynFlags -> ExportItem Name -> [String]
-ppExport dflags (ExportDecl decl dc subdocs _ _ _) = ppDocumentation dflags (fst dc) ++ f (unL decl)
+ppExport dflags ExportDecl { expItemDecl = L _ decl
+ , expItemMbDoc = (dc, _)
+ , expItemSubDocs = subdocs
+ } = ppDocumentation dflags dc ++ f decl
where
f (TyClD d@DataDecl{}) = ppData dflags d subdocs
f (TyClD d@SynDecl{}) = ppSynonym dflags d
@@ -139,6 +142,7 @@ ppClass dflags x = out dflags x{tcdSigs=[]} :
concatMap (ppSig dflags . addContext . unL) (tcdSigs x)
where
addContext (TypeSig name (L l sig)) = TypeSig name (L l $ f sig)
+ addContext (MinimalSig sig) = MinimalSig sig
addContext _ = error "expected TypeSig"
f (HsForAllTy a b con d) = HsForAllTy a b (reL (context : unLoc con)) d
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 44b3fc35246d11763fc9029d53ae9d69914d7d21..7b72c0308988f882df82a46938085f06ffeb24ca 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -177,7 +177,7 @@ string_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2
exportListItem :: ExportItem DocName -> LaTeX
-exportListItem (ExportDecl decl _doc subdocs _insts _fixities _splice)
+exportListItem ExportDecl { expItemDecl = decl, expItemSubDocs = subdocs }
= sep (punctuate comma . map ppDocBinder $ declNames decl) <>
case subdocs of
[] -> empty
@@ -211,8 +211,8 @@ processExports (e : es) =
isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName)
-isSimpleSig (ExportDecl (L _ (SigD (TypeSig lnames (L _ t))))
- (Documentation Nothing Nothing, argDocs) _ _ _ _)
+isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames (L _ t)))
+ , expItemMbDoc = (Documentation Nothing Nothing, argDocs) }
| Map.null argDocs = Just (map unLoc lnames, t)
isSimpleSig _ = Nothing
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 5e728108f4c5d05dcb7bc00846489ede271fd737..9628a33dbf6f9a3734ccd5425ad2027f51e106db 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -533,7 +533,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
-- todo: if something has only sub-docs, or fn-args-docs, should
-- it be measured here and thus prevent omitting the synopsis?
- has_doc (ExportDecl _ (Documentation mDoc mWarning, _) _ _ _ _) = isJust mDoc || isJust mWarning
+ has_doc ExportDecl { expItemMbDoc = (Documentation mDoc mWarning, _) } = isJust mDoc || isJust mWarning
has_doc (ExportNoDecl _ _) = False
has_doc (ExportModule _) = False
has_doc _ = True
@@ -578,7 +578,7 @@ miniSynopsis mdl iface unicode qual =
processForMiniSynopsis :: Module -> Bool -> Qualification -> ExportItem DocName
-> [Html]
-processForMiniSynopsis mdl unicode qual (ExportDecl (L _loc decl0) _doc _ _insts _fixities _splice) =
+processForMiniSynopsis mdl unicode qual ExportDecl { expItemDecl = L _loc decl0 } =
((divTopDecl <<).(declElem <<)) <$> case decl0 of
TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of
(FamDecl decl) -> [ppTyFamHeader True False decl unicode qual]
@@ -648,7 +648,7 @@ numberSectionHeadings = go 1
processExport :: Bool -> LinksInfo -> Bool -> Qualification
-> ExportItem DocName -> Maybe Html
-processExport _ _ _ _ (ExportDecl (L _ (InstD _)) _ _ _ _ _) = Nothing -- Hide empty instances
+processExport _ _ _ _ ExportDecl { expItemDecl = L _ (InstD _) } = Nothing -- Hide empty instances
processExport summary _ _ qual (ExportGroup lev id0 doc)
= nothingIf summary $ groupHeading lev id0 << docToHtml qual doc
processExport summary links unicode qual (ExportDecl decl doc subdocs insts fixities splice)
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index cd504d8eb4f2d9dc1e14cb2158341177dac4022a..39276441b1cffcf878043233834c895eaf10a347 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -28,7 +28,7 @@ import Haddock.GhcUtils
import Haddock.Types
import Haddock.Doc (combineDocumentation)
-import Data.List ( intersperse )
+import Data.List ( intersperse, sort )
import qualified Data.Map as Map
import Data.Maybe
import Data.Monoid ( mempty )
@@ -37,6 +37,7 @@ import Text.XHtml hiding ( name, title, p, quote )
import GHC
import GHC.Exts
import Name
+import BooleanFormula
ppDecl :: Bool -> LinksInfo -> LHsDecl DocName
@@ -406,7 +407,7 @@ ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = tvs
, tcdFDs = fds, tcdSigs = sigs, tcdATs = ats }) loc
subdocs splice unicode qual =
- if null sigs && null ats
+ if not (any isVanillaLSig sigs) && null ats
then (if summary then id else topDeclElem links loc splice [nm]) hdr
else (if summary then id else topDeclElem links loc splice [nm]) (hdr <+> keyword "where")
+++ shortSubDecls
@@ -441,11 +442,11 @@ ppClassDecl summary links instances fixities loc d subdocs
splice unicode qual
| summary = ppShortClassDecl summary links decl loc subdocs splice unicode qual
| otherwise = classheader +++ docSection qual d
- +++ atBit +++ methodBit +++ instancesBit
+ +++ minimalBit +++ atBit +++ methodBit +++ instancesBit
where
classheader
- | null lsigs = topDeclElem links loc splice [nm] (hdr unicode qual <+> fixs)
- | otherwise = topDeclElem links loc splice [nm] (hdr unicode qual <+> keyword "where" <+> fixs)
+ | any isVanillaLSig lsigs = topDeclElem links loc splice [nm] (hdr unicode qual <+> keyword "where" <+> fixs)
+ | otherwise = topDeclElem links loc splice [nm] (hdr unicode qual <+> fixs)
-- Only the fixity relevant to the class header
fixs = ppFixities [ f | f@(n,_) <- fixities, n == unLoc lname ] qual
@@ -472,6 +473,23 @@ ppClassDecl summary links instances fixities loc d subdocs
-- there are different subdocs for different names in a single
-- type signature?
+ minimalBit = case [ s | L _ (MinimalSig s) <- lsigs ] of
+ -- Miminal complete definition = every method
+ And xs : _ | sort [getName n | Var (L _ n) <- xs] ==
+ sort [getName n | L _ (TypeSig ns _) <- lsigs, L _ n <- ns]
+ -> noHtml
+
+ -- Minimal complete definition = nothing
+ And [] : _ -> subMinimal $ toHtml "Nothing"
+
+ m : _ -> subMinimal $ ppMinimal False m
+ _ -> noHtml
+
+ ppMinimal _ (Var (L _ n)) = ppDocName qual Prefix True n
+ ppMinimal _ (And fs) = foldr1 (\a b -> a+++", "+++b) $ map (ppMinimal True) fs
+ ppMinimal p (Or fs) = wrap $ foldr1 (\a b -> a+++" | "+++b) $ map (ppMinimal False) fs
+ where wrap | p = parens | otherwise = id
+
instancesBit = ppInstances instances nm unicode qual
ppClassDecl _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 6784fb303fd1a16698c36061c1a9f88fed9d5e24..d3d9442438c00d3bdb65ff30df4565720b184f5c 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -33,6 +33,7 @@ module Haddock.Backends.Xhtml.Layout (
subFields,
subInstances,
subMethods,
+ subMinimal,
topDeclElem, declElem,
) where
@@ -182,6 +183,9 @@ subInstances qual nm = maybe noHtml wrap . instTable
subMethods :: [Html] -> Html
subMethods = divSubDecls "methods" "Methods" . subBlock
+subMinimal :: Html -> Html
+subMinimal = divSubDecls "minimal" "Minimal complete definition" . Just . declElem
+
-- a box for displaying code
declElem :: Html -> Html
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 1245b2b964c952c79abc5888c6615b1d4980c3a1..1bf02e3c8938457dc0f5e2e1a493137a2af801d0 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -73,8 +73,9 @@ tyThingToLHsDecl t = noLoc $ case t of
, tcdFDs = map (\ (l,r) -> noLoc
(map getName l, map getName r) ) $
snd $ classTvsFds cl
- , tcdSigs = map (noLoc . synifyIdSig DeleteTopLevelQuantification)
- (classMethods cl)
+ , tcdSigs = noLoc (MinimalSig . fmap noLoc $ classMinimalDef cl) :
+ map (noLoc . synifyIdSig DeleteTopLevelQuantification)
+ (classMethods cl)
, tcdMeths = emptyBag --ignore default method definitions, they don't affect signature
-- class associated-types are a subset of TyCon:
, tcdATs = atFamDecls
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index bf6436d118587ed75b0dd46034a1750de3c46c65..c06b34a653126866089ca25d12746f26e13d0358 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
@@ -35,6 +35,7 @@ import GhcMonad (withSession)
import HscTypes
import UniqFM
import GHC
+import Class
moduleString :: Module -> String
@@ -114,6 +115,7 @@ filterSigNames :: (name -> Bool) -> Sig name -> Maybe (Sig name)
filterSigNames p orig@(SpecSig n _ _) = ifTrueJust (p $ unLoc n) orig
filterSigNames p orig@(InlineSig n _) = ifTrueJust (p $ unLoc n) orig
filterSigNames p orig@(FixSig (FixitySig n _)) = ifTrueJust (p $ unLoc n) orig
+filterSigNames _ orig@(MinimalSig _) = Just orig
filterSigNames p (TypeSig ns ty) =
case filter (p . unLoc) ns of
[] -> Nothing
@@ -279,6 +281,13 @@ modifySessionDynFlags f = do
gbracket_ :: ExceptionMonad m => m a -> m b -> m c -> m c
gbracket_ before_ after thing = gbracket before_ (const after) (const thing)
+-- Extract the minimal complete definition of a Name, if one exists
+minimalDef :: GhcMonad m => Name -> m (Maybe ClassMinimalDef)
+minimalDef n = do
+ mty <- lookupGlobalName n
+ case mty of
+ Just (ATyCon (tyConClass_maybe -> Just c)) -> return . Just $ classMinimalDef c
+ _ -> return Nothing
-------------------------------------------------------------------------------
-- * DynFlags
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index aef2cd8f9822abfb8a958323620ad89156f063ec..f1262d9fb720010fc397b947baad1f16245531d5 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -437,7 +437,7 @@ filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x
| x@(L loc d, doc) <- decls ]
where
filterClass (TyClD c) =
- TyClD $ c { tcdSigs = filter isVanillaLSig $ tcdSigs c }
+ TyClD $ c { tcdSigs = filter (liftA2 (||) isVanillaLSig isMinimalLSig) $ tcdSigs c }
filterClass _ = error "expected TyClD"
@@ -547,17 +547,23 @@ mkExportItems
return []
-- normal case
- | otherwise -> return [ mkExportDecl t newDecl docs_ ]
- where
- -- A single signature might refer to many names, but we
- -- create an export item for a single name only. So we
- -- modify the signature to contain only that single name.
- newDecl = case decl of
- (L loc (SigD sig)) ->
- L loc . SigD . fromJust $ filterSigNames (== t) sig
- -- fromJust is safe since we already checked in guards
- -- that 't' is a name declared in this declaration.
- _ -> decl
+ | otherwise -> case decl of
+ -- A single signature might refer to many names, but we
+ -- create an export item for a single name only. So we
+ -- modify the signature to contain only that single name.
+ L loc (SigD sig) ->
+ -- fromJust is safe since we already checked in guards
+ -- that 't' is a name declared in this declaration.
+ let newDecl = L loc . SigD . fromJust $ filterSigNames (== t) sig
+ in return [ mkExportDecl t newDecl docs_ ]
+
+ L loc (TyClD cl@ClassDecl{}) -> do
+ mdef <- liftGhcToErrMsgGhc $ minimalDef t
+ let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+ return [ mkExportDecl t
+ (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_ ]
+
+ _ -> return [ mkExportDecl t decl docs_ ]
-- Declaration from another package
([], _) -> do
@@ -737,15 +743,20 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
| Just name <- M.lookup (getInstLoc d) instMap =
let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+ mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do
+ mdef <- liftGhcToErrMsgGhc $ minimalDef name
+ let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+ expDecl (L l (TyClD cl { tcdSigs = sig ++ sigs })) l name
mkExportItem decl@(L l d)
- | name:_ <- getMainDeclBinder d =
- let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
- return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+ | name:_ <- getMainDeclBinder d = expDecl decl l name
| otherwise = return Nothing
fixities name subs = [ (n,f) | n <- name : map fst subs
, Just f <- [M.lookup n fixMap] ]
+ expDecl decl l name = return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
+ where (doc, subs) = lookupDocs name warnings docMap argMap subMap
+
-- | Sometimes the declaration we want to export is not the "main" declaration:
-- it might be an individual record selector or a class method. In these
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 4160f4f75531c787eed8794bf7eca72fb3101728..748e0210a60161aa8601455f2851f84a5cbd0bdb 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -414,6 +414,7 @@ renameSig sig = case sig of
FixSig (FixitySig lname fixity) -> do
lname' <- renameL lname
return $ FixSig (FixitySig lname' fixity)
+ MinimalSig s -> MinimalSig <$> traverse renameL s
-- we have filtered out all other kinds of signatures in Interface.Create
_ -> error "expected TypeSig"