<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>src/Haddock/Backends/HH.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-2"></a><span class='hs-comment'>-- |</span>
<a name="line-3"></a><span class='hs-comment'>-- Module : Haddock.Backends.HH</span>
<a name="line-4"></a><span class='hs-comment'>-- Copyright : (c) Simon Marlow 2003</span>
<a name="line-5"></a><span class='hs-comment'>-- License : BSD-like</span>
<a name="line-6"></a><span class='hs-comment'>--</span>
<a name="line-7"></a><span class='hs-comment'>-- Maintainer : haddock@projects.haskell.org</span>
<a name="line-8"></a><span class='hs-comment'>-- Stability : experimental</span>
<a name="line-9"></a><span class='hs-comment'>-- Portability : portable</span>
<a name="line-10"></a><span class='hs-comment'>-----------------------------------------------------------------------------</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Haddock</span><span class='hs-varop'>.</span><span class='hs-conid'>Backends</span><span class='hs-varop'>.</span><span class='hs-conid'>HH</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppHHContents</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppHHIndex</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppHHProject</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-13"></a>
<a name="line-14"></a><a name="ppHHContents"></a><span class='hs-definition'>ppHHContents</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppHHIndex</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppHHProject</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>a</span>
<a name="line-15"></a><span class='hs-definition'>ppHHContents</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-str'>"not yet"</span>
<a name="line-16"></a><a name="ppHHIndex"></a><span class='hs-definition'>ppHHIndex</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-str'>"not yet"</span>
<a name="line-17"></a><a name="ppHHProject"></a><span class='hs-definition'>ppHHProject</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-str'>"not yet"</span>
<a name="line-18"></a>
<a name="line-19"></a><span class='hs-comment'>{-
<a name="line-20"></a>import HaddockModuleTree
<a name="line-21"></a>import HaddockTypes
<a name="line-22"></a>import HaddockUtil
<a name="line-23"></a>import HsSyn2 hiding(Doc)
<a name="line-24"></a>import qualified Map
<a name="line-25"></a>
<a name="line-26"></a>import Data.Char ( toUpper )
<a name="line-27"></a>import Data.Maybe ( fromMaybe )
<a name="line-28"></a>import Text.PrettyPrint
<a name="line-29"></a>
<a name="line-30"></a>ppHHContents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO ()
<a name="line-31"></a>ppHHContents odir doctitle maybe_package tree = do
<a name="line-32"></a> let contentsHHFile = package++".hhc"
<a name="line-33"></a>
<a name="line-34"></a> html =
<a name="line-35"></a> text "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$
<a name="line-36"></a> text "<HTML>" $$
<a name="line-37"></a> text "<HEAD>" $$
<a name="line-38"></a> text "<META name=\"GENERATOR\" content=\"Haddock\">" $$
<a name="line-39"></a> text "<!-- Sitemap 1.0 -->" $$
<a name="line-40"></a> text "</HEAD><BODY>" $$
<a name="line-41"></a> ppModuleTree tree $$
<a name="line-42"></a> text "</BODY><HTML>"
<a name="line-43"></a> writeFile (pathJoin [odir, contentsHHFile]) (render html)
<a name="line-44"></a> where
<a name="line-45"></a> package = fromMaybe "pkg" maybe_package
<a name="line-46"></a>
<a name="line-47"></a> ppModuleTree :: [ModuleTree] -> Doc
<a name="line-48"></a> ppModuleTree ts =
<a name="line-49"></a> text "<OBJECT type=\"text/site properties\">" $$
<a name="line-50"></a> text "<PARAM name=\"FrameName\" value=\"main\">" $$
<a name="line-51"></a> text "</OBJECT>" $$
<a name="line-52"></a> text "<UL>" $+$
<a name="line-53"></a> nest 4 (text "<LI>" <> nest 4
<a name="line-54"></a> (text "<OBJECT type=\"text/sitemap\">" $$
<a name="line-55"></a> nest 4 (text "<PARAM name=\"Name\" value=\""<>text doctitle<>text "\">" $$
<a name="line-56"></a> text "<PARAM name=\"Local\" value=\"index.html\">") $$
<a name="line-57"></a> text "</OBJECT>") $+$
<a name="line-58"></a> text "</LI>" $$
<a name="line-59"></a> text "<UL>" $+$
<a name="line-60"></a> nest 4 (fn [] ts) $+$
<a name="line-61"></a> text "</UL>") $+$
<a name="line-62"></a> text "</UL>"
<a name="line-63"></a>
<a name="line-64"></a> fn :: [String] -> [ModuleTree] -> Doc
<a name="line-65"></a> fn ss [x] = ppNode ss x
<a name="line-66"></a> fn ss (x:xs) = ppNode ss x $$ fn ss xs
<a name="line-67"></a> fn _ [] = error "HaddockHH.ppHHContents.fn: no module trees given"
<a name="line-68"></a>
<a name="line-69"></a> ppNode :: [String] -> ModuleTree -> Doc
<a name="line-70"></a> ppNode ss (Node s leaf _pkg _ []) =
<a name="line-71"></a> ppLeaf s ss leaf
<a name="line-72"></a> ppNode ss (Node s leaf _pkg _ ts) =
<a name="line-73"></a> ppLeaf s ss leaf $$
<a name="line-74"></a> text "<UL>" $+$
<a name="line-75"></a> nest 4 (fn (s:ss) ts) $+$
<a name="line-76"></a> text "</UL>"
<a name="line-77"></a>
<a name="line-78"></a> ppLeaf s ss isleaf =
<a name="line-79"></a> text "<LI>" <> nest 4
<a name="line-80"></a> (text "<OBJECT type=\"text/sitemap\">" $$
<a name="line-81"></a> text "<PARAM name=\"Name\" value=\"" <> text s <> text "\">" $$
<a name="line-82"></a> (if isleaf then text "<PARAM name=\"Local\" value=\"" <> text (moduleHtmlFile mdl) <> text "\">" else empty) $$
<a name="line-83"></a> text "</OBJECT>") $+$
<a name="line-84"></a> text "</LI>"
<a name="line-85"></a> where
<a name="line-86"></a> mdl = foldr (++) "" (s' : map ('.':) ss')
<a name="line-87"></a> (s':ss') = reverse (s:ss)
<a name="line-88"></a> -- reconstruct the module name
<a name="line-89"></a>
<a name="line-90"></a>-------------------------------
<a name="line-91"></a>ppHHIndex :: FilePath -> Maybe String -> [Interface] -> IO ()
<a name="line-92"></a>ppHHIndex odir maybe_package ifaces = do
<a name="line-93"></a> let indexHHFile = package++".hhk"
<a name="line-94"></a>
<a name="line-95"></a> html =
<a name="line-96"></a> text "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$
<a name="line-97"></a> text "<HTML>" $$
<a name="line-98"></a> text "<HEAD>" $$
<a name="line-99"></a> text "<META name=\"GENERATOR\" content=\"Haddock\">" $$
<a name="line-100"></a> text "<!-- Sitemap 1.0 -->" $$
<a name="line-101"></a> text "</HEAD><BODY>" $$
<a name="line-102"></a> text "<UL>" $+$
<a name="line-103"></a> nest 4 (ppList index) $+$
<a name="line-104"></a> text "</UL>" $$
<a name="line-105"></a> text "</BODY><HTML>"
<a name="line-106"></a> writeFile (pathJoin [odir, indexHHFile]) (render html)
<a name="line-107"></a> where
<a name="line-108"></a> package = fromMaybe "pkg" maybe_package
<a name="line-109"></a>
<a name="line-110"></a> index :: [(HsName, [Module])]
<a name="line-111"></a> index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces)
<a name="line-112"></a>
<a name="line-113"></a> getIfaceIndex iface fm =
<a name="line-114"></a> foldl (\m (k,e) -> Map.insertWith (++) k e m) fm [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']
<a name="line-115"></a> where mdl = iface_module iface
<a name="line-116"></a>
<a name="line-117"></a> ppList [] = empty
<a name="line-118"></a> ppList ((name,refs):mdls) =
<a name="line-119"></a> text "<LI>" <> nest 4
<a name="line-120"></a> (text "<OBJECT type=\"text/sitemap\">" $$
<a name="line-121"></a> text "<PARAM name=\"Name\" value=\"" <> text (show name) <> text "\">" $$
<a name="line-122"></a> ppReference name refs $$
<a name="line-123"></a> text "</OBJECT>") $+$
<a name="line-124"></a> text "</LI>" $$
<a name="line-125"></a> ppList mdls
<a name="line-126"></a>
<a name="line-127"></a> ppReference name [] = empty
<a name="line-128"></a> ppReference name (Module mdl:refs) =
<a name="line-129"></a> text "<PARAM name=\"Local\" value=\"" <> text (nameHtmlRef mdl name) <> text "\">" $$
<a name="line-130"></a> ppReference name refs
<a name="line-131"></a>
<a name="line-132"></a>
<a name="line-133"></a>ppHHProject :: FilePath -> String -> Maybe String -> [Interface] -> [FilePath] -> IO ()
<a name="line-134"></a>ppHHProject odir doctitle maybe_package ifaces pkg_paths = do
<a name="line-135"></a> let projectHHFile = package++".hhp"
<a name="line-136"></a> doc =
<a name="line-137"></a> text "[OPTIONS]" $$
<a name="line-138"></a> text "Compatibility=1.1 or later" $$
<a name="line-139"></a> text "Compiled file=" <> text package <> text ".chm" $$
<a name="line-140"></a> text "Contents file=" <> text package <> text ".hhc" $$
<a name="line-141"></a> text "Default topic=" <> text contentsHtmlFile $$
<a name="line-142"></a> text "Display compile progress=No" $$
<a name="line-143"></a> text "Index file=" <> text package <> text ".hhk" $$
<a name="line-144"></a> text "Title=" <> text doctitle $$
<a name="line-145"></a> space $$
<a name="line-146"></a> text "[FILES]" $$
<a name="line-147"></a> ppMods ifaces $$
<a name="line-148"></a> text contentsHtmlFile $$
<a name="line-149"></a> text indexHtmlFile $$
<a name="line-150"></a> ppIndexFiles chars $$
<a name="line-151"></a> ppLibFiles ("":pkg_paths)
<a name="line-152"></a> writeFile (pathJoin [odir, projectHHFile]) (render doc)
<a name="line-153"></a> where
<a name="line-154"></a> package = fromMaybe "pkg" maybe_package
<a name="line-155"></a>
<a name="line-156"></a> ppMods [] = empty
<a name="line-157"></a> ppMods (iface:ifaces) =
<a name="line-158"></a> let Module mdl = iface_module iface in
<a name="line-159"></a> text (moduleHtmlFile mdl) $$
<a name="line-160"></a> ppMods ifaces
<a name="line-161"></a>
<a name="line-162"></a> ppIndexFiles [] = empty
<a name="line-163"></a> ppIndexFiles (c:cs) =
<a name="line-164"></a> text (subIndexHtmlFile c) $$
<a name="line-165"></a> ppIndexFiles cs
<a name="line-166"></a>
<a name="line-167"></a> ppLibFiles [] = empty
<a name="line-168"></a> ppLibFiles (path:paths) =
<a name="line-169"></a> ppLibFile cssFile $$
<a name="line-170"></a> ppLibFile iconFile $$
<a name="line-171"></a> ppLibFile jsFile $$
<a name="line-172"></a> ppLibFile plusFile $$
<a name="line-173"></a> ppLibFile minusFile $$
<a name="line-174"></a> ppLibFiles paths
<a name="line-175"></a> where
<a name="line-176"></a> toPath fname | null path = fname
<a name="line-177"></a> | otherwise = pathJoin [path, fname]
<a name="line-178"></a> ppLibFile fname = text (toPath fname)
<a name="line-179"></a>
<a name="line-180"></a> chars :: [Char]
<a name="line-181"></a> chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces))
<a name="line-182"></a>
<a name="line-183"></a> getIfaceIndex iface fm =
<a name="line-184"></a> Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
<a name="line-185"></a> where mdl = iface_module iface
<a name="line-186"></a>-}</span>
</pre></body>
</html>
distrib
>
Fedora
>
14
>
x86_64
>
media
>
updates
>
by-pkgid
>
33ad064c4b642ed30353356a1d094330
>
files
>
84
