convert index to new markup

3 files changed, 36 insertions, 74 deletions

diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 8a66a987..31690b07 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -47,6 +47,7 @@ import System.IO             ( IOMode(..), hClose, hGetBuf, hPutBuf, openFile )
 import System.Directory hiding ( copyFile )
 import Data.Map              ( Map )
 import qualified Data.Map as Map hiding ( Map )
+import Data.List             ( intercalate )
 import Data.Function
 import Data.Ord              ( comparing )
 
@@ -270,12 +271,11 @@ ppHtmlContents odir doctitle
                  styleSheet +++
                  (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
         body << (
-            simpleHeader doctitle Nothing maybe_index_url
-                             maybe_source_url maybe_wiki_url +++
-            vanillaTable << (
-               ppPrologue doctitle prologue </>
-               ppModuleTree doctitle tree) +++
-            footer
+          simpleHeader doctitle Nothing maybe_index_url
+                           maybe_source_url maybe_wiki_url +++
+          ppPrologue doctitle prologue +++
+          ppModuleTree tree +++
+          footer
           )
   createDirectoryIfMissing True odir
   writeFile (joinPath [odir, contentsHtmlFile]) (renderToString html)
@@ -291,75 +291,41 @@ ppHtmlContents odir doctitle
     Just "devhelp" -> return ()
     Just format    -> fail ("The "++format++" format is not implemented")
 
-ppPrologue :: String -> Maybe (Doc GHC.RdrName) -> HtmlTable
-ppPrologue _ Nothing = emptyTable
-ppPrologue title (Just doc) = 
-  (tda [theclass "section1"] << toHtml title) </>
-  (tda [theclass "doc"] << (rdrDocToHtml doc))
+ppPrologue :: String -> Maybe (Doc GHC.RdrName) -> Html
+ppPrologue _ Nothing = noHtml
+ppPrologue title (Just doc) =
+  divDescription << (h1 << title +++ rdrDocToHtml doc)
 
-ppModuleTree :: String -> [ModuleTree] -> HtmlTable
-ppModuleTree _ ts = 
-  tda [theclass "section1"] << toHtml "Modules" </>
-  td << vanillaTable2 << htmlTable
-  where
-    genTable tbl id_ []     = (tbl, id_)
-    genTable tbl id_ (x:xs) = genTable (tbl </> u) id' xs      
-      where
-        (u,id') = mkNode [] x 0 id_
+ppModuleTree :: [ModuleTree] -> Html
+ppModuleTree ts =
+  divModuleList << (sectionName << "Modules" +++ mkNodeList [] "n" ts)
 
-    (htmlTable,_) = genTable emptyTable 0 ts
-
-mkNode :: [String] -> ModuleTree -> Int -> Int -> (HtmlTable,Int)
-mkNode ss (Node s leaf pkg short ts) depth id_ = htmlNode
+mkNodeList :: [String] -> String -> [ModuleTree] -> Html
+mkNodeList ss p ts = case ts of
+  [] -> noHtml
+  _ -> unordList (zipWith (mkNode ss) ps ts)
   where
-    htmlNode = case ts of
-      [] -> (td_pad_w 1.25 depth << htmlModule  <-> shortDescr <-> htmlPkg,id_)
-      _  -> (td_w depth << (collapsebutton id_s +++ htmlModule) <-> shortDescr <-> htmlPkg </> 
-                (td_subtree << sub_tree), id')
-
-    mod_width = 50::Int {-em-}
-
-    td_pad_w :: Double -> Int -> Html -> HtmlTable
-    td_pad_w pad depth_ = 
-        tda [thestyle ("padding-left: " ++ show pad ++ "em;" ++
-                       "width: " ++ show (mod_width - depth_*2) ++ "em")]
-
-    td_w depth_ = 
-        tda [thestyle ("width: " ++ show (mod_width - depth_*2) ++ "em")]
-
-    td_subtree =
-        tda [thestyle ("padding: 0; padding-left: 2em")]
-
-    shortDescr :: HtmlTable
-    shortDescr = case short of
-        Nothing -> cell $ td empty
-        Just doc -> tda [theclass "rdoc"] (origDocToHtml doc)
-
+    ps = [ p ++ '.' : show i | i <- [(1::Int)..]]
+    
+mkNode :: [String] -> String -> ModuleTree -> Html
+mkNode ss p (Node s leaf pkg short ts) = 
+  collBtn +++ htmlModule +++ shortDescr +++ htmlPkg +++ subtree
+  where
+    collBtn = case ts of
+      [] -> noHtml
+      _ -> collapsebutton p
+  
     htmlModule 
-      | leaf      = ppModule (mkModule (stringToPackageId pkgName) 
+      | leaf      = ppModule (mkModule (stringToPackageId (fromMaybe "" pkg)) 
                                        (mkModuleName mdl)) ""
       | otherwise = toHtml s
 
-    -- ehm.. TODO: change the ModuleTree type
-    (htmlPkg, pkgName) = case pkg of
-      Nothing -> (td << empty, "")
-      Just p  -> (td << toHtml p, p)
-
-    mdl = foldr (++) "" (s' : map ('.':) ss')
-    (s':ss') = reverse (s:ss)
-         -- reconstruct the module name
-    
-    id_s = "n." ++ show id_
+    mdl = intercalate "." (reverse (s:ss))
     
-    (sub_tree,id') = genSubTree emptyTable (id_+1) ts
-    
-    genSubTree :: HtmlTable -> Int -> [ModuleTree] -> (Html,Int)
-    genSubTree htmlTable id__ [] = (sub_tree_, id__)
-      where
-        sub_tree_ = collapsed vanillaTable2 id_s htmlTable
-    genSubTree htmlTable id__ (x:xs) = genSubTree (htmlTable </> u) id__' xs      
-      where
-        (u,id__') = mkNode (s:ss) x (depth+1) id__
+    shortDescr = maybe noHtml origDocToHtml short
+    htmlPkg = maybe noHtml toHtml pkg
+
+    subtree = mkNodeList (s:ss) p ts ! [identifier p]
 
 
 -- | Turn a module tree into a flat list of full module names.  E.g.,
@@ -392,7 +358,7 @@ ppHtmlContentsFrame odir doctitle ifaces = do
              styleSheet +++
              (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
         miniBody << divModuleList << 
-          (sectionName << "Modules" +++ shortDeclList mods)
+          (sectionName << "Modules" +++ unordList mods)
   createDirectoryIfMissing True odir
   writeFile (joinPath [odir, frameIndexHtmlFile]) (renderToString html)
 
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index b6818b61..616b3b95 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -135,7 +135,7 @@ subInstances :: String -> [SubDecl] -> Html
 subInstances id_ = divSubDecls "instances" instCaption . instTable
   where
     instCaption = collapsebutton id_ +++ " Instances"
-    instTable = (collapsed thediv id_ `fmap`) . subTable
+    instTable = fmap (thediv ! [identifier id_] <<) . subTable
 
 subMethods :: [Html] -> Html
 subMethods = divSubDecls "methods" "Methods" . subBlock
diff --git a/src/Haddock/Backends/Xhtml/Util.hs b/src/Haddock/Backends/Xhtml/Util.hs
index 13215bb7..d4ead8d8 100644
--- a/src/Haddock/Backends/Xhtml/Util.hs
+++ b/src/Haddock/Backends/Xhtml/Util.hs
@@ -25,7 +25,7 @@ module Haddock.Backends.Xhtml.Util (
   tda, emptyTable, s8,
   abovesSep, hsep,
   
-  collapsebutton, collapseId, collapsed,
+  collapsebutton, collapseId,
   documentCharacterEncoding,
   
   cssFiles, styleSheet, stylePickers, styleMenu
@@ -206,10 +206,6 @@ collapsebutton :: String -> Html
 collapsebutton id_ = 
   image ! [ src minusFile, theclass "coll", onclick ("toggle(this,'" ++ id_ ++ "')"), alt "show/hide" ]
 
-collapsed :: (HTML a) => (Html -> Html) -> String -> a -> Html
-collapsed fn id_ html =
-  fn ! [identifier id_, thestyle "display:block;"] << html
-
 -- A quote is a valid part of a Haskell identifier, but it would interfere with
 -- the ECMA script string delimiter used in collapsebutton above.
 collapseId :: Name -> String