aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs14
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs21
2 files changed, 22 insertions, 13 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 2febd5ae..59e5af3e 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -1,4 +1,5 @@
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# LANGUAGE RecordWildCards #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Backends.LaTeX
@@ -560,12 +561,13 @@ ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
ppInstHead :: Bool -> InstHead DocName -> LaTeX
-ppInstHead unicode (n, ks, ts, ClassInst ctx) = ppContextNoLocs ctx unicode <+> ppAppNameTypes n ks ts unicode
-ppInstHead unicode (n, ks, ts, TypeInst rhs) = keyword "type"
- <+> ppAppNameTypes n ks ts unicode
- <+> maybe empty (\t -> equals <+> ppType unicode t) rhs
-ppInstHead _unicode (_n, _ks, _ts, DataInst _dd) =
- error "data instances not supported by --latex yet"
+ppInstHead unicode (InstHead {..}) = case ihdInstType of
+ ClassInst ctx -> ppContextNoLocs ctx unicode <+> typ
+ TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs
+ DataInst _ -> error "data instances not supported by --latex yet"
+ where
+ typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode
+ tibody = maybe empty (\t -> equals <+> ppType unicode t)
lookupAnySubdoc :: (Eq name1) =>
name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index a5f3676e..afbbaad1 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE TransformListComp #-}
+{-# LANGUAGE RecordWildCards #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Backends.Html.Decl
@@ -507,15 +508,21 @@ ppInstances links instances _ baseName unicode qual
where
instName = getOccString $ getName baseName
instDecl :: DocInstance DocName -> (SubDecl,Located DocName)
- instDecl (inst, maybeDoc,l) = ((instHead inst, maybeDoc, []),l)
- instHead (n, ks, ts, ClassInst cs) = ppContextNoLocs cs unicode qual
- <+> ppAppNameTypes n ks ts unicode qual
- instHead (n, ks, ts, TypeInst rhs) = keyword "type"
- <+> ppAppNameTypes n ks ts unicode qual
+ instDecl (inst, maybeDoc,l) =
+ ((ppInstHead links unicode qual inst, maybeDoc, []),l)
+
+ppInstHead :: LinksInfo -> Unicode -> Qualification
+ -> InstHead DocName
+ -> Html
+ppInstHead _ unicode qual (InstHead {..}) = case ihdInstType of
+ ClassInst cs -> ppContextNoLocs cs unicode qual <+> typ
+ TypeInst rhs -> keyword "type" <+> typ
<+> maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
- instHead (n, ks, ts, DataInst dd) = keyword "data"
- <+> ppAppNameTypes n ks ts unicode qual
+ DataInst dd -> keyword "data" <+> typ
<+> ppShortDataDecl False True dd unicode qual
+ where
+ typ = ppAppNameTypes ihdClsName ihdKinds ihdTypes unicode qual
+
lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n