diff options
| author | Niklas Haas <git@nand.wakku.to> | 2014-03-08 09:42:00 +0100 |
|---|---|---|
| committer | Niklas Haas <git@nand.wakku.to> | 2014-03-08 09:43:26 +0100 |
| commit | 17970e6b6aa22962c498ce02ead8dbadad31a733 (patch) | |
| tree | 0c9232390bce92d8b393214a2d2131a17bc3f07e | |
| parent | e5bd27b5edf533054513871dc475a54a8b1bee23 (diff) | |
Render fixity information
Affects functions, type synonyms, type families, class names, data type
names, constructors, data families, associated TFs/DFs, type synonyms,
pattern synonyms and everything else I could think of.
| -rw-r--r-- | html-test/ref/Bug8.html | 6 | ||||
| -rw-r--r-- | html-test/ref/Operators.html | 379 | ||||
| -rw-r--r-- | html-test/src/Operators.hs | 56 | ||||
| -rw-r--r-- | src/Haddock/Backends/Hoogle.hs | 2 | ||||
| -rw-r--r-- | src/Haddock/Backends/LaTeX.hs | 11 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 10 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 175 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Utils.hs | 17 | ||||
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 53 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 10 | ||||
| -rw-r--r-- | src/Haddock/Types.hs | 6 |
11 files changed, 621 insertions, 104 deletions
diff --git a/html-test/ref/Bug8.html b/html-test/ref/Bug8.html index f3845cb2..7e5b5fee 100644 --- a/html-test/ref/Bug8.html +++ b/html-test/ref/Bug8.html @@ -84,7 +84,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug8.html");}; ></div ><div class="top" ><p class="src" - ><a name="v:-45--45--62-" class="def" + >infix 9 --><br + /><a name="v:-45--45--62-" class="def" >(-->)</a > :: t -> t1 -> <a href="" >Typ</a @@ -92,7 +93,8 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug8.html");}; ></div ><div class="top" ><p class="src" - ><a name="v:-45--45--45--62-" class="def" + >infix 9 ---><br + /><a name="v:-45--45--45--62-" class="def" >(--->)</a > :: [a] -> <a href="" >Typ</a diff --git a/html-test/ref/Operators.html b/html-test/ref/Operators.html new file mode 100644 index 00000000..89ebbbbf --- /dev/null +++ b/html-test/ref/Operators.html @@ -0,0 +1,379 @@ +<!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 + >Operators</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_Operators.html");}; +//]]> +</script + ></head + ><body + ><div id="package-header" + ><ul class="links" id="page-menu" + ><li + ><a href="index.html" + >Contents</a + ></li + ><li + ><a href="doc-index.html" + >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" + >Operators</p + ></div + ><div id="description" + ><p class="caption" + >Description</p + ><div class="doc" + ><p + >Test operators with or without fixity declarations</p + ></div + ></div + ><div id="synopsis" + ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')" + >Synopsis</p + ><ul id="section.syn" class="hide" onclick="toggleSection('syn')" + ><li class="src short" + ><a href="#v:-43--45-" + >(+-)</a + > :: a -> a -> a</li + ><li class="src short" + ><a href="#v:-42--47-" + >(*/)</a + > :: a -> a -> a</li + ><li class="src short" + ><a href="#v:foo" + >foo</a + > :: a -> a -> a</li + ><li class="src short" + ><span class="keyword" + >data</span + > <a href="#t:Foo" + >Foo</a + ><ul class="subs" + ><li + >= <a href="Operators.html#t:Foo" + >Foo</a + > <a href="#v:Bar" + >`Bar`</a + > <a href="Operators.html#t:Foo" + >Foo</a + ></li + ><li + >| <a href="Operators.html#t:Foo" + >Foo</a + > <a href="#v::-45-" + >:-</a + > <a href="Operators.html#t:Foo" + >Foo</a + ></li + ></ul + ></li + ><li class="src short" + >pattern <a href="#v::-43-" + >(:+)</a + > t t :: [t]</li + ><li class="src short" + ><span class="keyword" + >data</span + > a <a href="#t:-60--45--62-" + ><-></a + > b <span class="keyword" + >where</span + ><ul class="subs" + ><li + ><a href="#v::-60--45--62-" + >(:<->)</a + > :: a -> b -> a <a href="Operators.html#t:-60--45--62-" + ><-></a + > b</li + ></ul + ></li + ><li class="src short" + ><span class="keyword" + >type family</span + > a <a href="#t:-43--43-" + >++</a + > b</li + ><li class="src short" + ><span class="keyword" + >data family</span + > a <a href="#t:-42--42-" + >**</a + > b</li + ><li class="src short" + ><span class="keyword" + >class</span + > a <a href="#t:-62--60--62-" + >><></a + > b <span class="keyword" + >where</span + ><ul class="subs" + ><li + ><span class="keyword" + >type</span + > a <a href="#t:-60--62--60-" + ><><</a + > b :: *</li + ><li + ><span class="keyword" + >data</span + > a <a href="#t:-62--60--60-" + >><<</a + > b</li + ><li + ><a href="#v:-62--62--60-" + >(>><)</a + > :: a -> b -> ()</li + ></ul + ></li + ><li class="src short" + ><span class="keyword" + >type</span + > <a href="#t:-62--45--60-" + >(>-<)</a + > a b = a <a href="Operators.html#t:-60--45--62-" + ><-></a + > b</li + ></ul + ></div + ><div id="interface" + ><h1 + >Documentation</h1 + ><div class="top" + ><p class="src" + ><a name="v:-43--45-" class="def" + >(+-)</a + > :: a -> a -> a</p + ><div class="doc" + ><p + >Operator with no fixity</p + ></div + ></div + ><div class="top" + ><p class="src" + >infixr 7 */<br + /><a name="v:-42--47-" class="def" + >(*/)</a + > :: a -> a -> a</p + ><div class="doc" + ><p + >Operator with infixr 7</p + ></div + ></div + ><div class="top" + ><p class="src" + >infixl 3 `foo`<br + /><a name="v:foo" class="def" + >foo</a + > :: a -> a -> a</p + ><div class="doc" + ><p + >Named function with infixl 3</p + ></div + ></div + ><div class="top" + ><p class="src" + ><span class="keyword" + >data</span + > <a name="t:Foo" class="def" + >Foo</a + ></p + ><div class="doc" + ><p + >Data type with operator constructors</p + ></div + ><div class="subs constructors" + ><p class="caption" + >Constructors</p + ><table + ><tr + ><td class="src" + >infixl 3 `Bar`<br + /><a href="Operators.html#t:Foo" + >Foo</a + > <a name="v:Bar" class="def" + >`Bar`</a + > <a href="Operators.html#t:Foo" + >Foo</a + ></td + ><td class="doc" + ><p + >Has infixl 3</p + ></td + ></tr + ><tr + ><td class="src" + >infixr 5 :-<br + /><a href="Operators.html#t:Foo" + >Foo</a + > <a name="v::-45-" class="def" + >:-</a + > <a href="Operators.html#t:Foo" + >Foo</a + ></td + ><td class="doc" + ><p + >Has infixr 5</p + ></td + ></tr + ></table + ></div + ></div + ><div class="top" + ><p class="src" + >infixr 3 :+<br + />pattern <a name="v::-43-" class="def" + >(:+)</a + > t t :: [t]</p + ><div class="doc" + ><p + >Pattern synonym, infixr 3</p + ></div + ></div + ><div class="top" + ><p class="src" + >infixl 6 <-><br + /><span class="keyword" + >data</span + > a <a name="t:-60--45--62-" class="def" + ><-></a + > b <span class="keyword" + >where</span + ></p + ><div class="doc" + ><p + >Type name, infixl 6 and GADT constructor</p + ></div + ><div class="subs constructors" + ><p class="caption" + >Constructors</p + ><table + ><tr + ><td class="src" + >infixr 6 :<-><br + /><a name="v::-60--45--62-" class="def" + >(:<->)</a + > :: a -> b -> a <a href="Operators.html#t:-60--45--62-" + ><-></a + > b</td + ><td class="doc empty" + > </td + ></tr + ></table + ></div + ></div + ><div class="top" + ><p class="src" + >infix 3 ++<br + /><span class="keyword" + >type family</span + > a <a name="t:-43--43-" class="def" + >++</a + > b</p + ><div class="doc" + ><p + >Type family with fixity</p + ></div + ></div + ><div class="top" + ><p class="src" + >infix 9 **<br + /><span class="keyword" + >data family</span + > a <a name="t:-42--42-" class="def" + >**</a + > b</p + ><div class="doc" + ><p + >Data family with fixity</p + ></div + ></div + ><div class="top" + ><p class="src" + >infixr 1 ><><br + /><span class="keyword" + >class</span + > a <a name="t:-62--60--62-" class="def" + >><></a + > b <span class="keyword" + >where</span + ></p + ><div class="doc" + ><p + >Class with fixity, including associated types</p + ></div + ><div class="subs associated-types" + ><p class="caption" + >Associated Types</p + ><p class="src" + >infixl 2 <><<br + /><span class="keyword" + >type</span + > a <a name="t:-60--62--60-" class="def" + ><><</a + > b :: *</p + ><p class="src" + >infixl 3 ><<<br + /><span class="keyword" + >data</span + > a <a name="t:-62--60--60-" class="def" + >><<</a + > b</p + ></div + ><div class="subs methods" + ><p class="caption" + >Methods</p + ><p class="src" + >infixr 4 >><<br + /><a name="v:-62--62--60-" class="def" + >(>><)</a + > :: a -> b -> ()</p + ></div + ></div + ><div class="top" + ><p class="src" + >infixl 6 >-<<br + /><span class="keyword" + >type</span + > <a name="t:-62--45--60-" class="def" + >(>-<)</a + > a b = a <a href="Operators.html#t:-60--45--62-" + ><-></a + > b</p + ><div class="doc" + ><p + >Type synonym with fixity</p + ></div + ></div + ></div + ></div + ><div id="footer" + ><p + >Produced by <a href="http://www.haskell.org/haddock/" + >Haddock</a + > version 2.14.0</p + ></div + ></body + ></html +> diff --git a/html-test/src/Operators.hs b/html-test/src/Operators.hs new file mode 100644 index 00000000..a2e30c18 --- /dev/null +++ b/html-test/src/Operators.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE PatternSynonyms, TypeOperators, TypeFamilies, MultiParamTypeClasses, GADTs #-} +-- | Test operators with or without fixity declarations +module Operators where + +-- | Operator with no fixity +(+-) :: a -> a -> a +a +- _ = a + +-- | Operator with infixr 7 +(*/) :: a -> a -> a +_ */ b = b +infixr 7 */ + +-- | Named function with infixl 3 +foo :: a -> a -> a +foo a _ = a +infixl 3 `foo` + +-- | Data type with operator constructors +data Foo + = Foo `Bar` Foo -- ^ Has infixl 3 + | Foo :- Foo -- ^ Has infixr 5 +infixr 5 :- +infixl 3 `Bar` + +-- | Pattern synonym, infixr 3 +pattern (:+) a b <- [a,b] +infixr 3 :+ + +-- | Type name, infixl 6 and GADT constructor +data (a <-> b) where + (:<->) :: a -> b -> a <-> b +infixl 6 <-> +infixr 6 :<-> + +-- | Type family with fixity +type family a ++ b +infix 3 ++ + +-- | Data family with fixity +data family a ** b +infix 9 ** + +-- | Class with fixity, including associated types +class a ><> b where + type a <>< b :: * + data a ><< b + (>><) :: a -> b -> () +infixr 1 ><> +infixl 2 <>< +infixl 3 ><< +infixr 4 >>< + +-- | Type synonym with fixity +type (a >-< b) = a <-> b +infixl 6 >-< diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs index 1f098d6d..dbce787f 100644 --- a/src/Haddock/Backends/Hoogle.hs +++ b/src/Haddock/Backends/Hoogle.hs @@ -110,7 +110,7 @@ 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 decl dc subdocs _ _) = ppDocumentation dflags (fst dc) ++ f (unL decl) where f (TyClD d@DataDecl{}) = ppData dflags d subdocs f (TyClD d@SynDecl{}) = ppSynonym dflags d diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs index 24e8b7c8..e6108ab6 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) +exportListItem (ExportDecl decl _doc subdocs _insts _fixities) = sep (punctuate comma . map ppDocBinder $ declNames decl) <> case subdocs of [] -> empty @@ -212,7 +212,7 @@ processExports (e : es) = isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName) isSimpleSig (ExportDecl (L _ (SigD (TypeSig lnames (L _ t)))) - (Documentation Nothing Nothing, argDocs) _ _) + (Documentation Nothing Nothing, argDocs) _ _ _) | Map.null argDocs = Just (map unLoc lnames, t) isSimpleSig _ = Nothing @@ -225,8 +225,8 @@ isExportModule _ = Nothing processExport :: ExportItem DocName -> LaTeX processExport (ExportGroup lev _id0 doc) = ppDocGroup lev (docToLaTeX doc) -processExport (ExportDecl decl doc subdocs insts) - = ppDecl decl doc insts subdocs +processExport (ExportDecl decl doc subdocs insts fixities) + = ppDecl decl doc insts subdocs fixities processExport (ExportNoDecl y []) = ppDocName y processExport (ExportNoDecl y subs) @@ -279,9 +279,10 @@ ppDecl :: LHsDecl DocName -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] + -> [(DocName, Fixity)] -> LaTeX -ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs = case decl of +ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of TyClD d@(FamDecl {}) -> ppTyFam False loc doc d unicode TyClD d@(DataDecl {}) -> ppDataDecl instances subdocs loc (Just doc) d unicode diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index bdd1afdc..4eda68f6 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 _ (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) = +processForMiniSynopsis mdl unicode qual (ExportDecl (L _loc decl0) _doc _ _insts _fixities) = ((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,11 +648,11 @@ numberSectionHeadings = go 1 processExport :: Bool -> LinksInfo -> Bool -> Qualification -> ExportItem DocName -> Maybe Html -processExport _ _ _ _ (ExportDecl (L _ (InstD _)) _ _ _) = Nothing -- Hide empty instances +processExport _ _ _ _ (ExportDecl (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) - = processDecl summary $ ppDecl summary links decl doc insts subdocs unicode qual +processExport summary links unicode qual (ExportDecl decl doc subdocs insts fixities) + = processDecl summary $ ppDecl summary links decl doc insts fixities subdocs unicode qual processExport summary _ _ qual (ExportNoDecl y []) = processDeclOneLiner summary $ ppDocName qual Prefix True y processExport summary _ _ qual (ExportNoDecl y subs) diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 9e72d4ad..20db5df1 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -37,50 +37,53 @@ import GHC import Name -ppDecl :: Bool -> LinksInfo -> LHsDecl DocName -> - DocForDecl DocName -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] -> - Bool -> Qualification -> Html -ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode qual = case decl of - TyClD (FamDecl d) -> ppTyFam summ False links instances loc mbDoc d unicode qual - TyClD d@(DataDecl {}) -> ppDataDecl summ links instances subdocs loc mbDoc d unicode qual - TyClD d@(SynDecl {}) -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode qual - TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances loc mbDoc subdocs d unicode qual - SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames lty unicode qual +ppDecl :: Bool -> LinksInfo -> LHsDecl DocName + -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)] + -> [(DocName, DocForDecl DocName)] -> Bool -> Qualification -> Html +ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs unicode qual = case decl of + TyClD (FamDecl d) -> ppTyFam summ False links instances fixities loc mbDoc d unicode qual + TyClD d@(DataDecl {}) -> ppDataDecl summ links instances fixities subdocs loc mbDoc d unicode qual + TyClD d@(SynDecl {}) -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d unicode qual + TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances fixities loc mbDoc subdocs d unicode qual + SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames lty fixities unicode qual SigD (PatSynSig lname args ty prov req) -> - ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname args ty prov req unicode qual - ForD d -> ppFor summ links loc (mbDoc, fnArgsDoc) d unicode qual + ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname args ty prov req fixities unicode qual + ForD d -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities unicode qual InstD _ -> noHtml _ -> error "declaration not supported by ppDecl" ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> - [Located DocName] -> LHsType DocName -> Bool -> Qualification -> Html -ppLFunSig summary links loc doc lnames lty unicode qual = - ppFunSig summary links loc doc (map unLoc lnames) (unLoc lty) unicode qual + [Located DocName] -> LHsType DocName -> [(DocName, Fixity)] -> + Bool -> Qualification -> Html +ppLFunSig summary links loc doc lnames lty fixities unicode qual = + ppFunSig summary links loc doc (map unLoc lnames) (unLoc lty) fixities unicode qual ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> - [DocName] -> HsType DocName -> Bool -> Qualification -> Html -ppFunSig summary links loc doc docnames typ unicode qual = - ppSigLike summary links loc mempty doc docnames (typ, pp_typ) unicode qual + [DocName] -> HsType DocName -> [(DocName, Fixity)] -> + Bool -> Qualification -> Html +ppFunSig summary links loc doc docnames typ fixities unicode qual = + ppSigLike summary links loc mempty doc docnames fixities (typ, pp_typ) unicode qual where pp_typ = ppType unicode qual typ ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> Located DocName -> HsPatSynDetails (LHsType DocName) -> LHsType DocName -> - LHsContext DocName -> LHsContext DocName -> + LHsContext DocName -> LHsContext DocName -> [(DocName, Fixity)] -> Bool -> Qualification -> Html -ppLPatSig summary links loc doc lname args typ prov req unicode qual = - ppPatSig summary links loc doc (unLoc lname) (fmap unLoc args) (unLoc typ) (unLoc prov) (unLoc req) unicode qual +ppLPatSig summary links loc doc lname args typ prov req fixities unicode qual = + ppPatSig summary links loc doc (unLoc lname) (fmap unLoc args) (unLoc typ) (unLoc prov) (unLoc req) fixities unicode qual ppPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> DocName -> HsPatSynDetails (HsType DocName) -> HsType DocName -> - HsContext DocName -> HsContext DocName -> + HsContext DocName -> HsContext DocName -> [(DocName, Fixity)] -> Bool -> Qualification -> Html -ppPatSig summary links loc (doc, _argDocs) docname args typ prov req unicode qual +ppPatSig summary links loc (doc, _argDocs) docname args typ prov req fixities unicode qual | summary = pref1 - | otherwise = topDeclElem links loc [docname] pref1 +++ docSection qual doc + | otherwise = topDeclElem links loc [docname] (ppFixities fixities qual <=> pref1) + +++ docSection qual doc where pref1 = hsep [ toHtml "pattern" , pp_cxt prov @@ -99,16 +102,20 @@ ppPatSig summary links loc (doc, _argDocs) docname args typ prov req unicode qua occname = nameOccName . getName $ docname ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName -> - [DocName] -> (HsType DocName, Html) -> Bool -> Qualification -> Html -ppSigLike summary links loc leader doc docnames (typ, pp_typ) unicode qual = + [DocName] -> [(DocName, Fixity)] -> (HsType DocName, Html) -> + Bool -> Qualification -> Html +ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ) unicode qual = ppTypeOrFunSig summary links loc docnames typ doc - ( leader <+> ppTypeSig summary occnames pp_typ unicode - , concatHtml . punctuate comma $ map (ppBinder False) occnames + ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode + , addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames , dcolon unicode ) unicode qual where occnames = map (nameOccName . getName) docnames + addFixities html + | summary = html + | otherwise = ppFixities fixities qual <=> html ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocName @@ -144,6 +151,16 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) do_args n leader t = [(leader <+> ppType unicode qual t, argDoc n, [])] +ppFixities :: [(DocName, Fixity)] -> Qualification -> Html +ppFixities fs qual = vcat $ map ppFix fs + where + ppFix (n, Fixity p d) = toHtml (ppDir d) <+> toHtml (show p) + <+> ppDocName qual Infix False n + + ppDir InfixR = "infixr" + ppDir InfixL = "infixl" + ppDir InfixN = "infix" + ppTyVars :: LHsTyVarBndrs DocName -> [Html] ppTyVars tvs = map ppTyName (tyvarNames tvs) @@ -154,25 +171,28 @@ tyvarNames = map getName . hsLTyVarNames ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName - -> ForeignDecl DocName -> Bool -> Qualification -> Html -ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _ _) unicode qual - = ppFunSig summary links loc doc [name] typ unicode qual -ppFor _ _ _ _ _ _ _ = error "ppFor" + -> ForeignDecl DocName -> [(DocName, Fixity)] -> Bool -> Qualification -> Html +ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _ _) fixities unicode qual + = ppFunSig summary links loc doc [name] typ fixities unicode qual +ppFor _ _ _ _ _ _ _ _ = error "ppFor" -- we skip type patterns for now -ppTySyn :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool +ppTySyn :: Bool -> LinksInfo -> [(DocName, Fixity)] -> SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> Qualification -> Html -ppTySyn summary links loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars - , tcdRhs = ltype }) +ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars + , tcdRhs = ltype }) unicode qual = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc - (full, hdr, spaceHtml +++ equals) unicode qual + (fixs <=> full, fixs <=> hdr, spaceHtml +++ equals) unicode qual where hdr = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars ltyvars) full = hdr <+> equals <+> ppLType unicode qual ltype occ = nameOccName . getName $ name -ppTySyn _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn" + fixs + | summary = noHtml + | otherwise = ppFixities fixities qual +ppTySyn _ _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn" ppTypeSig :: Bool -> [OccName] -> Html -> Bool -> Html @@ -212,9 +232,10 @@ ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info Nothing -> noHtml ) -ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan -> Documentation DocName -> - FamilyDecl DocName -> Bool -> Qualification -> Html -ppTyFam summary associated links instances loc doc decl unicode qual +ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocName] -> + [(DocName, Fixity)] -> SrcSpan -> Documentation DocName -> + FamilyDecl DocName -> Bool -> Qualification -> Html +ppTyFam summary associated links instances fixities loc doc decl unicode qual | summary = ppTyFamHeader True associated decl unicode qual | otherwise = header_ +++ docSection qual doc +++ instancesBit @@ -222,7 +243,8 @@ ppTyFam summary associated links instances loc doc decl unicode qual where docname = unLoc $ fdLName decl - header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode qual) + header_ = topDeclElem links loc [docname] $ + ppFixities fixities qual <=> ppTyFamHeader summary associated decl unicode qual instancesBit | FamilyDecl { fdInfo = ClosedTypeFamily eqns } <- decl @@ -244,10 +266,10 @@ ppTyFam summary associated links instances loc doc decl unicode qual -------------------------------------------------------------------------------- -ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocName -> Bool - -> Qualification -> Html -ppAssocType summ links doc (L loc decl) unicode qual = - ppTyFam summ True links [] loc (fst doc) decl unicode qual +ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocName + -> [(DocName, Fixity)] -> Bool -> Qualification -> Html +ppAssocType summ links doc (L loc decl) fixities unicode qual = + ppTyFam summ True links [] fixities loc (fst doc) decl unicode qual -------------------------------------------------------------------------------- @@ -363,12 +385,12 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t else (if summary then id else topDeclElem links loc [nm]) (hdr <+> keyword "where") +++ shortSubDecls ( - [ ppAssocType summary links doc at unicode qual | at <- ats + [ ppAssocType summary links doc at [] unicode qual | at <- ats , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ] ++ -- ToDo: add associated type defaults - [ ppFunSig summary links loc doc names typ unicode qual + [ ppFunSig summary links loc doc names typ [] unicode qual | L _ (TypeSig lnames (L _ typ)) <- sigs , let doc = lookupAnySubdoc (head names) subdocs names = map unLoc lnames ] @@ -383,10 +405,11 @@ ppShortClassDecl _ _ _ _ _ _ _ = error "declaration type not supported by ppShor -ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan - -> Documentation DocName -> [(DocName, DocForDecl DocName)] - -> TyClDecl DocName -> Bool -> Qualification -> Html -ppClassDecl summary links instances loc d subdocs +ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)] + -> SrcSpan -> Documentation DocName + -> [(DocName, DocForDecl DocName)] -> TyClDecl DocName + -> Bool -> Qualification -> Html +ppClassDecl summary links instances fixities loc d subdocs decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats }) unicode qual | summary = ppShortClassDecl summary links decl loc subdocs unicode qual @@ -394,21 +417,29 @@ ppClassDecl summary links instances loc d subdocs +++ atBit +++ methodBit +++ instancesBit where classheader - | null lsigs = topDeclElem links loc [nm] (hdr unicode qual) - | otherwise = topDeclElem links loc [nm] (hdr unicode qual <+> keyword "where") + | null lsigs = topDeclElem links loc [nm] (fixs <=> hdr unicode qual) + | otherwise = topDeclElem links loc [nm] (fixs <=> hdr unicode qual <+> keyword "where") + + -- Only the fixity relevant to the class header + fixs = ppFixities [ f | f@(n,_) <- fixities, n == unLoc lname ] qual nm = tcdName decl hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds -- ToDo: add assocatied typ defaults - atBit = subAssociatedTypes [ ppAssocType summary links doc at unicode qual + atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs unicode qual | at <- ats - , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ] + , let n = unL . fdLName $ unL at + doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs + subfixs = [ f | f@(n',_) <- fixities, n == n' ] ] - methodBit = subMethods [ ppFunSig summary links loc doc names typ unicode qual + methodBit = subMethods [ ppFunSig summary links loc doc names typ subfixs unicode qual | L _ (TypeSig lnames (L _ typ)) <- lsigs , let doc = lookupAnySubdoc (head names) subdocs + subfixs = [ f | n <- names + , f@(n',_) <- fixities + , n == n' ] names = map unLoc lnames ] -- FIXME: is taking just the first name ok? Is it possible that -- there are different subdocs for different names in a single @@ -416,7 +447,7 @@ ppClassDecl summary links instances loc d subdocs instancesBit = ppInstances instances nm unicode qual -ppClassDecl _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl" +ppClassDecl _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl" ppInstances :: [DocInstance DocName] -> DocName -> Bool -> Qualification -> Html @@ -471,11 +502,11 @@ ppShortDataDecl summary dataInst dataDecl unicode qual resTy = (con_res . unLoc . head) cons -ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> +ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)] -> [(DocName, DocForDecl DocName)] -> SrcSpan -> Documentation DocName -> TyClDecl DocName -> Bool -> Qualification -> Html -ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual +ppDataDecl summary links instances fixities subdocs loc doc dataDecl unicode qual | summary = ppShortDataDecl summary False dataDecl unicode qual | otherwise = header_ +++ docSection qual doc +++ constrBit +++ instancesBit @@ -485,8 +516,10 @@ ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual cons = dd_cons (tcdDataDefn dataDecl) resTy = (con_res . unLoc . head) cons - header_ = topDeclElem links loc [docname] (ppDataHeader summary dataDecl unicode qual - <+> whereBit) + header_ = topDeclElem links loc [docname] (fix + <=> ppDataHeader summary dataDecl unicode qual <+> whereBit) + + fix = ppFixities (filter (\(n,_) -> n == docname) fixities) qual whereBit | null cons = noHtml @@ -495,7 +528,10 @@ ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual _ -> noHtml constrBit = subConstructors qual - (map (ppSideBySideConstr subdocs unicode qual) cons) + [ ppSideBySideConstr subdocs subfixs unicode qual c + | c <- cons + , let subfixs = filter (\(n,_) -> n == unLoc (con_name (unLoc c))) fixities + ] instancesBit = ppInstances instances docname unicode qual @@ -568,20 +604,20 @@ ppConstrHdr forall_ tvs ctxt unicode qual Implicit -> noHtml -ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> Qualification - -> LConDecl DocName -> SubDecl -ppSideBySideConstr subdocs unicode qual (L _ con) = (decl, mbDoc, fieldPart) +ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)] + -> Bool -> Qualification -> LConDecl DocName -> SubDecl +ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, fieldPart) where decl = case con_res con of ResTyH98 -> case con_details con of PrefixCon args -> - hsep ((header_ unicode qual +++ ppBinder False occ) + hsep ((header_ +++ ppBinder False occ) : map (ppLParendType unicode qual) args) - RecCon _ -> header_ unicode qual +++ ppBinder False occ + RecCon _ -> header_ +++ ppBinder False occ InfixCon arg1 arg2 -> - hsep [header_ unicode qual +++ ppLParendType unicode qual arg1, + hsep [header_ +++ ppLParendType unicode qual arg1, ppBinderInfix False occ, ppLParendType unicode qual arg2] @@ -599,12 +635,13 @@ ppSideBySideConstr subdocs unicode qual (L _ con) = (decl, mbDoc, fieldPart) doRecordFields fields = subFields qual (map (ppSideBySideField subdocs unicode qual) fields) doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html - doGADTCon args resTy = + doGADTCon args resTy = fixity <=> ppBinder False occ <+> dcolon unicode <+> hsep [ppForAll forall_ ltvs (con_cxt con) unicode qual, ppLType unicode qual (foldr mkFunTy resTy args) ] - header_ = ppConstrHdr forall_ tyVars context + fixity = ppFixities fixities qual + header_ = fixity <=> ppConstrHdr forall_ tyVars context unicode qual occ = nameOccName . getName . unLoc . con_name $ con ltvs = con_qvars con tyVars = tyvarNames (con_qvars con) diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs index 232e18cc..cbcbbd6d 100644 --- a/src/Haddock/Backends/Xhtml/Utils.hs +++ b/src/Haddock/Backends/Xhtml/Utils.hs @@ -17,13 +17,13 @@ module Haddock.Backends.Xhtml.Utils ( spliceURL, groupId, - (<+>), char, + (<+>), (<=>), char, keyword, punctuate, braces, brackets, pabrackets, parens, parenList, ubxParenList, arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote, - hsep, + hsep, vcat, collapseSection, collapseToggle, collapseControl, ) where @@ -100,6 +100,11 @@ hsep :: [Html] -> Html hsep [] = noHtml hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls +-- | Concatenate a series of 'Html' values vertically, with linebreaks in between. +vcat :: [Html] -> Html +vcat [] = noHtml +vcat htmls = foldr1 (\a b -> a+++br+++b) htmls + infixr 8 <+> (<+>) :: Html -> Html -> Html @@ -107,6 +112,14 @@ a <+> b = a +++ sep +++ b where sep = if isNoHtml a || isNoHtml b then noHtml else toHtml " " +-- | Join two 'Html' values together with a linebreak in between. +-- Has 'noHtml' as left identity. +infixr 8 <=> +(<=>) :: Html -> Html -> Html +a <=> b = a +++ sep +++ b + where + sep = if isNoHtml a then noHtml else br + keyword :: String -> Html keyword s = thespan ! [theclass "keyword"] << toHtml s diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index f3658a12..37d0fe7d 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -81,6 +81,7 @@ createInterface tm flags modMap instIfaceMap = do (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags gre safety mayDocHeader let declsWithDocs = topDecls group_ + fixMap = mkFixMap group_ (decls, _) = unzip declsWithDocs localInsts = filter (nameIsLocalOrFrom mdl) $ map getName instances ++ map getName fam_instances @@ -97,7 +98,7 @@ createInterface tm flags modMap instIfaceMap = do let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap)) - exportItems <- mkExportItems modMap mdl allWarnings gre exportedNames decls maps exports + exportItems <- mkExportItems modMap mdl allWarnings gre exportedNames decls maps fixMap exports instIfaceMap dflags let !visibleNames = mkVisibleNames maps exportItems opts @@ -369,6 +370,11 @@ classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls topDecls :: HsGroup Name -> [(LHsDecl Name, [HsDocString])] topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup +-- | Extract a map of fixity declarations only +mkFixMap :: HsGroup Name -> FixMap +mkFixMap group_ = M.fromList [ (n,f) + | L _ (FixitySig (L _ n) f) <- hs_fixds group_ ] + -- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'. ungroup :: HsGroup Name -> [LHsDecl Name] @@ -470,15 +476,16 @@ mkExportItems -> [Name] -- exported names (orig) -> [LHsDecl Name] -> Maps + -> FixMap -> Maybe [IE Name] -> InstIfaceMap -> DynFlags -> ErrMsgGhc [ExportItem Name] mkExportItems modMap thisMod warnings gre exportedNames decls - (maps@(docMap, argMap, subMap, declMap, instMap)) optExports instIfaceMap dflags = + maps@(docMap, argMap, subMap, declMap, instMap) fixMap optExports instIfaceMap dflags = case optExports of - Nothing -> fullModuleContents dflags warnings gre maps decls + Nothing -> fullModuleContents dflags warnings gre maps fixMap decls Just exports -> liftM concat $ mapM lookupExport exports where lookupExport (IEVar x) = declWith x @@ -486,7 +493,7 @@ mkExportItems lookupExport (IEThingAll t) = declWith t lookupExport (IEThingWith t _) = declWith t lookupExport (IEModuleContents m) = - moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps + moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap lookupExport (IEGroup lev docStr) = liftErrMsg $ ifDoc (processDocString dflags gre docStr) (\doc -> return [ ExportGroup lev "" doc ]) @@ -511,7 +518,7 @@ mkExportItems case findDecl t of ([L _ (ValD _)], (doc, _)) -> do -- Top-level binding without type signature - export <- hiValExportItem dflags t doc + export <- hiValExportItem dflags t doc $ M.lookup t fixMap return [export] (ds, docs_) | decl : _ <- filter (not . isValD . unLoc) ds -> let declNames = getMainDeclBinder (unL decl) @@ -568,12 +575,13 @@ mkExportItems mkExportDecl :: Name -> LHsDecl Name -> (DocForDecl Name, [(Name, DocForDecl Name)]) -> ExportItem Name - mkExportDecl n decl (doc, subs) = decl' + mkExportDecl name decl (doc, subs) = decl' where - decl' = ExportDecl (restrictTo sub_names (extractDecl n mdl decl)) doc subs' [] - mdl = nameModule n + decl' = ExportDecl (restrictTo sub_names (extractDecl name mdl decl)) doc subs' [] fixities + mdl = nameModule name subs' = filter (isExported . fst) subs sub_names = map fst subs' + fixities = [ (n, f) | n <- name:sub_names, Just f <- [M.lookup n fixMap] ] isExported = (`elem` exportedNames) @@ -600,12 +608,16 @@ hiDecl dflags t = do Just x -> return (Just (tyThingToLHsDecl x)) -hiValExportItem :: DynFlags -> Name -> DocForDecl Name -> ErrMsgGhc (ExportItem Name) -hiValExportItem dflags name doc = do +hiValExportItem :: DynFlags -> Name -> DocForDecl Name -> Maybe Fixity -> ErrMsgGhc (ExportItem Name) +hiValExportItem dflags name doc fixity = do mayDecl <- hiDecl dflags name case mayDecl of Nothing -> return (ExportNoDecl name []) - Just decl -> return (ExportDecl decl doc [] []) + Just decl -> return (ExportDecl decl doc [] [] fixities) + where + fixities = case fixity of + Just f -> [(name, f)] + Nothing -> [] -- | Lookup docs for a declaration from maps. @@ -643,9 +655,10 @@ moduleExports :: Module -- ^ Module A -> IfaceMap -- ^ Already created interfaces -> InstIfaceMap -- ^ Interfaces in other packages -> Maps + -> FixMap -> ErrMsgGhc [ExportItem Name] -- ^ Resulting export items -moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfaceMap maps - | m == thisMod = fullModuleContents dflags warnings gre maps decls +moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfaceMap maps fixMap + | m == thisMod = fullModuleContents dflags warnings gre maps fixMap decls | otherwise = case M.lookup m ifaceMap of Just iface @@ -683,8 +696,9 @@ moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfa -- (For more information, see Trac #69) -fullModuleContents :: DynFlags -> WarningMap -> GlobalRdrEnv -> Maps -> [LHsDecl Name] -> ErrMsgGhc [ExportItem Name] -fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap) decls = +fullModuleContents :: DynFlags -> WarningMap -> GlobalRdrEnv -> Maps -> FixMap + -> [LHsDecl Name] -> ErrMsgGhc [ExportItem Name] +fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap) fixMap decls = liftM catMaybes $ mapM mkExportItem (expandSig decls) where -- A type signature can have multiple names, like: @@ -711,18 +725,21 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap | name:_ <- collectHsBindBinders d, Just [L _ (ValD _)] <- M.lookup name declMap = -- Top-level binding without type signature. let (doc, _) = lookupDocs name warnings docMap argMap subMap in - fmap Just (hiValExportItem dflags name doc) + fmap Just (hiValExportItem dflags name doc $ M.lookup name fixMap) | otherwise = return Nothing mkExportItem decl@(L _ (InstD d)) | Just name <- M.lookup (getInstLoc d) instMap = let (doc, subs) = lookupDocs name warnings docMap argMap subMap in - return $ Just (ExportDecl decl doc subs []) + return $ Just (ExportDecl decl doc subs [] (fixities name subs)) mkExportItem decl | name:_ <- getMainDeclBinder (unLoc decl) = let (doc, subs) = lookupDocs name warnings docMap argMap subMap in - return $ Just (ExportDecl decl doc subs []) + return $ Just (ExportDecl decl doc subs [] (fixities name subs)) | otherwise = return Nothing + fixities name subs = [ (n,f) | n <- name : map fst subs + , Just f <- [M.lookup n fixMap] ] + -- | 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 59b11854..4bf39dfb 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -411,6 +411,9 @@ renameSig sig = case sig of lreq' <- renameLContext lreq lprov' <- renameLContext lprov return $ PatSynSig lname' args' ltype' lreq' lprov' + FixSig (FixitySig lname fixity) -> do + lname' <- renameL lname + return $ FixSig (FixitySig lname' fixity) -- we have filtered out all other kinds of signatures in Interface.Create _ -> error "expected TypeSig" @@ -474,7 +477,7 @@ renameExportItem item = case item of ExportGroup lev id_ doc -> do doc' <- renameDoc doc return (ExportGroup lev id_ doc') - ExportDecl decl doc subs instances -> do + ExportDecl decl doc subs instances fixities -> do decl' <- renameLDecl decl doc' <- renameDocForDecl doc subs' <- mapM renameSub subs @@ -482,7 +485,10 @@ renameExportItem item = case item of inst' <- renameInstHead inst idoc' <- mapM renameDoc idoc return (inst', idoc') - return (ExportDecl decl' doc' subs' instances') + fixities' <- forM fixities $ \(name, fixity) -> do + name' <- lookupRn name + return (name', fixity) + return (ExportDecl decl' doc' subs' instances' fixities') ExportNoDecl x subs -> do x' <- lookupRn x subs' <- mapM lookupRn subs diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index a3d731af..24f9e040 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -18,6 +18,7 @@ module Haddock.Types ( module Haddock.Types , HsDocString, LHsDocString + , Fixity(..) ) where import Data.Foldable @@ -28,6 +29,7 @@ import Control.DeepSeq import Data.Typeable import Data.Map (Map) import qualified Data.Map as Map +import BasicTypes (Fixity(..)) import GHC hiding (NoLink) import DynFlags (ExtensionFlag, Language) import OccName @@ -47,6 +49,7 @@ type ArgMap a = Map Name (Map Int (Doc a)) type SubMap = Map Name [Name] type DeclMap = Map Name [LHsDecl Name] type InstMap = Map SrcSpan Name +type FixMap = Map Name Fixity type SrcMap = Map PackageId FilePath type DocPaths = (FilePath, Maybe FilePath) -- paths to HTML and sources @@ -195,6 +198,9 @@ data ExportItem name -- | Instances relevant to this declaration, possibly with -- documentation. , expItemInstances :: ![DocInstance name] + + -- | Fixity decls relevant to this declaration (including subordinates). + , expItemFixities :: ![(name, Fixity)] } -- | An exported entity for which we have no documentation (perhaps because it |