<?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/HH2.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.HH2</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'>HH2</span> <span class='hs-layout'>(</span><span class='hs-varid'>ppHH2Contents</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppHH2Index</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppHH2Files</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppHH2Collection</span><span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Haddock</span><span class='hs-varop'>.</span><span class='hs-conid'>Types</span>
<a name="line-15"></a>
<a name="line-16"></a><a name="ppHH2Files"></a><span class='hs-definition'>ppHH2Files</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FilePath</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Interface</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>FilePath</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-conid'>()</span>
<a name="line-17"></a><span class='hs-definition'>ppHH2Files</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><a name="ppHH2Contents"></a><span class='hs-definition'>ppHH2Contents</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppHH2Index</span><span class='hs-layout'>,</span> <span class='hs-varid'>ppHH2Collection</span> <span class='hs-keyglyph'>::</span> <span class='hs-varid'>a</span>
<a name="line-20"></a><span class='hs-definition'>ppHH2Contents</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-str'>"not yet"</span>
<a name="line-21"></a><a name="ppHH2Index"></a><span class='hs-definition'>ppHH2Index</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-str'>"not yet"</span>
<a name="line-22"></a><a name="ppHH2Collection"></a><span class='hs-definition'>ppHH2Collection</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>error</span> <span class='hs-str'>"not yet"</span>
<a name="line-23"></a>
<a name="line-24"></a><span class='hs-comment'>{-
<a name="line-25"></a>import HaddockModuleTree
<a name="line-26"></a>import HaddockUtil
<a name="line-27"></a>import HsSyn2 hiding(Doc)
<a name="line-28"></a>import qualified Map
<a name="line-29"></a>
<a name="line-30"></a>import Data.Char ( toUpper )
<a name="line-31"></a>import Data.Maybe ( fromMaybe )
<a name="line-32"></a>import Text.PrettyPrint
<a name="line-33"></a>
<a name="line-34"></a>ppHH2Contents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO ()
<a name="line-35"></a>ppHH2Contents odir doctitle maybe_package tree = do
<a name="line-36"></a> let
<a name="line-37"></a> contentsHH2File = package++".HxT"
<a name="line-38"></a>
<a name="line-39"></a> doc =
<a name="line-40"></a> text "<?xml version=\"1.0\"?>" $$
<a name="line-41"></a> text "<!DOCTYPE HelpTOC SYSTEM \"ms-help://hx/resources/HelpTOC.DTD\">" $$
<a name="line-42"></a> text "<HelpTOC DTDVersion=\"1.0\">" $$
<a name="line-43"></a> nest 4 (text "<HelpTOCNode Title=\""<>text doctitle<>text"\" Url=\"index.html\">" $$
<a name="line-44"></a> nest 4 (ppModuleTree [] tree) $+$
<a name="line-45"></a> text "</HelpTOCNode>") $$
<a name="line-46"></a> text "</HelpTOC>"
<a name="line-47"></a> writeFile (pathJoin [odir, contentsHH2File]) (render doc)
<a name="line-48"></a> where
<a name="line-49"></a> package = fromMaybe "pkg" maybe_package
<a name="line-50"></a>
<a name="line-51"></a> ppModuleTree :: [String] -> [ModuleTree] -> Doc
<a name="line-52"></a> ppModuleTree ss [x] = ppNode ss x
<a name="line-53"></a> ppModuleTree ss (x:xs) = ppNode ss x $$ ppModuleTree ss xs
<a name="line-54"></a> ppModuleTree _ [] = error "HaddockHH2.ppHH2Contents.ppModuleTree: no module trees given"
<a name="line-55"></a>
<a name="line-56"></a> ppNode :: [String] -> ModuleTree -> Doc
<a name="line-57"></a> ppNode ss (Node s leaf _pkg _short []) =
<a name="line-58"></a> text "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text "/>"
<a name="line-59"></a> ppNode ss (Node s leaf _pkg _short ts) =
<a name="line-60"></a> text "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text ">" $$
<a name="line-61"></a> nest 4 (ppModuleTree (s:ss) ts) $+$
<a name="line-62"></a> text "</HelpTOCNode>"
<a name="line-63"></a>
<a name="line-64"></a> ppAttributes :: Bool -> [String] -> Doc
<a name="line-65"></a> ppAttributes isleaf ss = hsep [ppId,ppTitle,ppUrl]
<a name="line-66"></a> where
<a name="line-67"></a> mdl = foldr (++) "" (s' : map ('.':) ss')
<a name="line-68"></a> (s':ss') = reverse ss
<a name="line-69"></a> -- reconstruct the module name
<a name="line-70"></a>
<a name="line-71"></a> ppId = text "Id=" <> doubleQuotes (text mdl)
<a name="line-72"></a>
<a name="line-73"></a> ppTitle = text "Title=" <> doubleQuotes (text (head ss))
<a name="line-74"></a>
<a name="line-75"></a> ppUrl | isleaf = text " Url=" <> doubleQuotes (text (moduleHtmlFile mdl))
<a name="line-76"></a> | otherwise = empty
<a name="line-77"></a>
<a name="line-78"></a>-----------------------------------------------------------------------------------
<a name="line-79"></a>
<a name="line-80"></a>ppHH2Index :: FilePath -> Maybe String -> [Interface] -> IO ()
<a name="line-81"></a>ppHH2Index odir maybe_package ifaces = do
<a name="line-82"></a> let
<a name="line-83"></a> indexKHH2File = package++"K.HxK"
<a name="line-84"></a> indexNHH2File = package++"N.HxK"
<a name="line-85"></a> docK =
<a name="line-86"></a> text "<?xml version=\"1.0\"?>" $$
<a name="line-87"></a> text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$
<a name="line-88"></a> text "<HelpIndex DTDVersion=\"1.0\" Name=\"K\">" $$
<a name="line-89"></a> nest 4 (ppList index) $+$
<a name="line-90"></a> text "</HelpIndex>"
<a name="line-91"></a> docN =
<a name="line-92"></a> text "<?xml version=\"1.0\"?>" $$
<a name="line-93"></a> text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$
<a name="line-94"></a> text "<HelpIndex DTDVersion=\"1.0\" Name=\"NamedURLIndex\">" $$
<a name="line-95"></a> text "<Keyword Term=\"HomePage\">" $$
<a name="line-96"></a> nest 4 (text "<Jump Url=\""<>text contentsHtmlFile<>text "\"/>") $$
<a name="line-97"></a> text "</Keyword>" $$
<a name="line-98"></a> text "</HelpIndex>"
<a name="line-99"></a> writeFile (pathJoin [odir, indexKHH2File]) (render docK)
<a name="line-100"></a> writeFile (pathJoin [odir, indexNHH2File]) (render docN)
<a name="line-101"></a> where
<a name="line-102"></a> package = fromMaybe "pkg" maybe_package
<a name="line-103"></a>
<a name="line-104"></a> index :: [(HsName, [Module])]
<a name="line-105"></a> index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces)
<a name="line-106"></a>
<a name="line-107"></a> getIfaceIndex iface fm =
<a name="line-108"></a> Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
<a name="line-109"></a> where mdl = iface_module iface
<a name="line-110"></a>
<a name="line-111"></a> ppList [] = empty
<a name="line-112"></a> ppList ((name,mdls):vs) =
<a name="line-113"></a> text "<Keyword Term=\"" <> text (escapeStr (show name)) <> text "\">" $$
<a name="line-114"></a> nest 4 (vcat (map (ppJump name) mdls)) $$
<a name="line-115"></a> text "</Keyword>" $$
<a name="line-116"></a> ppList vs
<a name="line-117"></a>
<a name="line-118"></a> ppJump name (Module mdl) = text "<Jump Url=\"" <> text (nameHtmlRef mdl name) <> text "\"/>"
<a name="line-119"></a>
<a name="line-120"></a>
<a name="line-121"></a>-----------------------------------------------------------------------------------
<a name="line-122"></a>
<a name="line-123"></a>ppHH2Files :: FilePath -> Maybe String -> [Interface] -> [FilePath] -> IO ()
<a name="line-124"></a>ppHH2Files odir maybe_package ifaces pkg_paths = do
<a name="line-125"></a> let filesHH2File = package++".HxF"
<a name="line-126"></a> doc =
<a name="line-127"></a> text "<?xml version=\"1.0\"?>" $$
<a name="line-128"></a> text "<!DOCTYPE HelpFileList SYSTEM \"ms-help://hx/resources/HelpFileList.DTD\">" $$
<a name="line-129"></a> text "<HelpFileList DTDVersion=\"1.0\">" $$
<a name="line-130"></a> nest 4 (ppMods ifaces $$
<a name="line-131"></a> text "<File Url=\""<>text contentsHtmlFile<>text "\"/>" $$
<a name="line-132"></a> text "<File Url=\""<>text indexHtmlFile<>text "\"/>" $$
<a name="line-133"></a> ppIndexFiles chars $$
<a name="line-134"></a> ppLibFiles ("":pkg_paths)) $$
<a name="line-135"></a> text "</HelpFileList>"
<a name="line-136"></a> writeFile (pathJoin [odir, filesHH2File]) (render doc)
<a name="line-137"></a> where
<a name="line-138"></a> package = fromMaybe "pkg" maybe_package
<a name="line-139"></a>
<a name="line-140"></a> ppMods [] = empty
<a name="line-141"></a> ppMods (iface:ifaces) =
<a name="line-142"></a> text "<File Url=\"" <> text (moduleHtmlFile mdl) <> text "\"/>" $$
<a name="line-143"></a> ppMods ifaces
<a name="line-144"></a> where Module mdl = iface_module iface
<a name="line-145"></a>
<a name="line-146"></a> ppIndexFiles [] = empty
<a name="line-147"></a> ppIndexFiles (c:cs) =
<a name="line-148"></a> text "<File Url=\""<>text (subIndexHtmlFile c)<>text "\"/>" $$
<a name="line-149"></a> ppIndexFiles cs
<a name="line-150"></a>
<a name="line-151"></a> ppLibFiles [] = empty
<a name="line-152"></a> ppLibFiles (path:paths) =
<a name="line-153"></a> ppLibFile cssFile $$
<a name="line-154"></a> ppLibFile iconFile $$
<a name="line-155"></a> ppLibFile jsFile $$
<a name="line-156"></a> ppLibFile plusFile $$
<a name="line-157"></a> ppLibFile minusFile $$
<a name="line-158"></a> ppLibFiles paths
<a name="line-159"></a> where
<a name="line-160"></a> toPath fname | null path = fname
<a name="line-161"></a> | otherwise = pathJoin [path, fname]
<a name="line-162"></a> ppLibFile fname = text "<File Url=\""<>text (toPath fname)<>text "\"/>"
<a name="line-163"></a>
<a name="line-164"></a> chars :: [Char]
<a name="line-165"></a> chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces))
<a name="line-166"></a>
<a name="line-167"></a> getIfaceIndex iface fm =
<a name="line-168"></a> Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm
<a name="line-169"></a> where mdl = iface_module iface
<a name="line-170"></a>
<a name="line-171"></a>-----------------------------------------------------------------------------------
<a name="line-172"></a>
<a name="line-173"></a>ppHH2Collection :: FilePath -> String -> Maybe String -> IO ()
<a name="line-174"></a>ppHH2Collection odir doctitle maybe_package = do
<a name="line-175"></a> let
<a name="line-176"></a> package = fromMaybe "pkg" maybe_package
<a name="line-177"></a> collectionHH2File = package++".HxC"
<a name="line-178"></a>
<a name="line-179"></a> doc =
<a name="line-180"></a> text "<?xml version=\"1.0\"?>" $$
<a name="line-181"></a> text "<!DOCTYPE HelpCollection SYSTEM \"ms-help://hx/resources/HelpCollection.DTD\">" $$
<a name="line-182"></a> text "<HelpCollection DTDVersion=\"1.0\" LangId=\"1033\" Title=\"" <> text doctitle <> text "\">" $$
<a name="line-183"></a> nest 4 (text "<CompilerOptions CreateFullTextIndex=\"Yes\">" $$
<a name="line-184"></a> nest 4 (text "<IncludeFile File=\"" <> text package <> text ".HxF\"/>") $$
<a name="line-185"></a> text "</CompilerOptions>" $$
<a name="line-186"></a> text "<TOCDef File=\"" <> text package <> text ".HxT\"/>" $$
<a name="line-187"></a> text "<KeywordIndexDef File=\"" <> text package <> text "K.HxK\"/>" $$
<a name="line-188"></a> text "<KeywordIndexDef File=\"" <> text package <> text "N.HxK\"/>" $$
<a name="line-189"></a> text "<ItemMoniker Name=\"!DefaultToc\" ProgId=\"HxDs.HxHierarchy\" InitData=\"\"/>" $$
<a name="line-190"></a> text "<ItemMoniker Name=\"!DefaultFullTextSearch\" ProgId=\"HxDs.HxFullTextSearch\" InitData=\"\"/>" $$
<a name="line-191"></a> text "<ItemMoniker Name=\"!DefaultAssociativeIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"A\"/>" $$
<a name="line-192"></a> text "<ItemMoniker Name=\"!DefaultKeywordIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"K\"/>" $$
<a name="line-193"></a> text "<ItemMoniker Name=\"!DefaultNamedUrlIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"NamedURLIndex\"/>" $$
<a name="line-194"></a> text "<ItemMoniker Name=\"!SampleInfo\" ProgId=\"HxDs.HxSampleCollection\" InitData=\"\"/>") $$
<a name="line-195"></a> text "</HelpCollection>"
<a name="line-196"></a> writeFile (pathJoin [odir, collectionHH2File]) (render doc)
<a name="line-197"></a>-}</span>
</pre></body>
</html>
distrib
>
Fedora
>
14
>
x86_64
>
media
>
updates
>
by-pkgid
>
33ad064c4b642ed30353356a1d094330
>
files
>
85
