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.

8 files changed, 182 insertions, 102 deletions

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