From 71cd0a0b39816bcae656857688a5b1e63b429532 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Wed, 14 Jul 2010 16:28:53 +0000
Subject: convert instances to SubDecl

---
 src/Haddock/Backends/Xhtml/Decl.hs   | 23 +++++------------------
 src/Haddock/Backends/Xhtml/Layout.hs | 17 ++++++++++-------
 2 files changed, 15 insertions(+), 25 deletions(-)

(limited to 'src')

diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index f5aa4fcf..6e0c5601 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -392,26 +392,13 @@ ppClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortCl
 
 ppInstances :: [DocInstance DocName] -> DocName -> Bool -> Html
 ppInstances instances baseName unicode
-  | null instances = noHtml
-  | otherwise =
-       instHdr instId +++
-       collapsed thediv instId (
-         spacedTable1 << aboves (map (ppDocInstance unicode) instances)
-       )
+  = subInstances instId (map instDecl instances)
   where
     instId = collapseId (getName baseName)
-
--- | Print a possibly commented instance. The instance header is printed inside
--- an 'argBox'. The comment is printed to the right of the box in normal comment
--- style.
-ppDocInstance :: Bool -> DocInstance DocName -> HtmlTable
-ppDocInstance unicode (instHead, maybeDoc) =
-  argBox (ppInstHead unicode instHead) <-> maybeRDocBox maybeDoc
-
-
-ppInstHead :: Bool -> InstHead DocName -> Html
-ppInstHead unicode ([],   n, ts) = ppAppNameTypes n ts unicode
-ppInstHead unicode (ctxt, n, ts) = ppContextNoLocs ctxt unicode <+> ppAppNameTypes n ts unicode
+    instDecl :: DocInstance DocName -> SubDecl
+    instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, [])
+    instHead ([],   n, ts) = ppAppNameTypes n ts unicode
+    instHead (ctxt, n, ts) = ppContextNoLocs ctxt unicode <+> ppAppNameTypes n ts unicode
 
 
 lookupAnySubdoc :: (Eq name1) =>
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 440d8e1e..70f5d88c 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -21,11 +21,13 @@ module Haddock.Backends.Xhtml.Layout (
   
   SubDecl,
   subArguments,
-  subConstructors, subFields,
+  subConstructors,
+  subFields,
+  subInstances,
   
   topDeclElem, declElem,
   
-  instHdr, atHdr, methHdr,
+  atHdr, methHdr,
   argBox, ndocBox, rdocBox, maybeRDocBox,
   
   vanillaTable, vanillaTable2, spacedTable1, spacedTable5  
@@ -70,7 +72,7 @@ divTopDecl = thediv ! [theclass "top"]
 
 type SubDecl = (Html, Maybe (Doc DocName), [Html])
 
-divSubDecls :: String -> String -> Maybe Html -> Html
+divSubDecls :: (HTML a) => String -> a -> Maybe Html -> Html
 divSubDecls cssClass captionName = maybe noHtml wrap
   where
     wrap = (subSection <<) . (subCaption +++)
@@ -109,6 +111,11 @@ subConstructors = divSubDecls "constructors" "Constructors" . subTable
 subFields :: [(Html, Maybe (Doc DocName), [Html])] -> Html
 subFields = divSubDecls "fields" "Fields" . subTable
 
+subInstances :: String -> [(Html, Maybe (Doc DocName), [Html])] -> Html
+subInstances id_ = divSubDecls "instances" instCaption . instTable
+  where
+    instCaption = collapsebutton id_ +++ " Instances"
+    instTable = (collapsed thediv id_ `fmap`) . subTable
 
 -- a box for displaying code
 declElem :: Html -> Html
@@ -178,7 +185,3 @@ spacedTable5 = table ! [theclass "vanilla",  cellspacing 5, cellpadding 0]
 methHdr, atHdr :: Html
 methHdr    = h5 << "Methods"
 atHdr      = h5 << "Associated Types"
-
-instHdr :: String -> Html
-instHdr id_ = 
-  h5 << (collapsebutton id_ +++ toHtml " Instances")
-- 
cgit v1.2.3