From 1c8c2f249d4e9ef6eed93721876f9e7a65b09a77 Mon Sep 17 00:00:00 2001 From: Niklas Haas <git@nand.wakku.to> Date: Thu, 13 Mar 2014 08:53:41 +0100 Subject: [PATCH] Display minimal complete definitions for type classes This corresponds to the new {-# MINIMAL #-} pragma present in GHC 7.8+. I also cleaned up some of the places in which ExportDecl is used to make adding fields easier in the future. Lots of test cases have been updated since they now render with minimality information. --- html-test/ref/DeprecatedClass.html | 16 ++ html-test/ref/Hash.html | 8 + html-test/ref/Minimal.html | 273 +++++++++++++++++++++++++++ html-test/ref/Test.html | 14 ++ html-test/ref/Ticket61.html | 8 + html-test/src/Test.hs | 1 + src/Haddock/Backends/Hoogle.hs | 6 +- src/Haddock/Backends/LaTeX.hs | 6 +- src/Haddock/Backends/Xhtml.hs | 6 +- src/Haddock/Backends/Xhtml/Decl.hs | 28 ++- src/Haddock/Backends/Xhtml/Layout.hs | 4 + src/Haddock/Convert.hs | 5 +- src/Haddock/GhcUtils.hs | 11 +- src/Haddock/Interface/Create.hs | 41 ++-- src/Haddock/Interface/Rename.hs | 1 + 15 files changed, 398 insertions(+), 30 deletions(-) create mode 100644 html-test/ref/Minimal.html diff --git a/html-test/ref/DeprecatedClass.html b/html-test/ref/DeprecatedClass.html index ecd162b03b..a9e03e8f5b 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 3be7c6e0ae..66449f7ea8 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 0000000000..f062dc8cc8 --- /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 7d229b5246..e4dc552775 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 31ffa62d9d..e327b72227 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 677106c64b..e94cc4146c 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 6405861d5c..628e1cd010 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 44b3fc3524..7b72c03089 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 5e728108f4..9628a33dbf 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 cd504d8eb4..39276441b1 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 6784fb303f..d3d9442438 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 1245b2b964..1bf02e3c89 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 bf6436d118..c06b34a653 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 aef2cd8f98..f1262d9fb7 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 4160f4f755..748e0210a6 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" -- GitLab