diff options
author | Niklas Haas <git@nand.wakku.to> | 2014-03-13 08:53:41 +0100 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2014-03-13 19:18:10 +0000 |
commit | eaf0a0b51f452398f3c64882a334f90b920df794 (patch) | |
tree | e007ca9b2a8748ab9aeb135e813f91b673884f2f /src/Haddock/Backends/Xhtml | |
parent | 64175d6ade5717b7e0c7fa0a122d16cae6779031 (diff) |
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.
Diffstat (limited to 'src/Haddock/Backends/Xhtml')
-rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 28 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 4 |
2 files changed, 27 insertions, 5 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index cd504d8e..39276441 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 6784fb30..d3d94424 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 |