aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/HaddockHtml.hs81
-rw-r--r--src/HaddockLex.x25
-rw-r--r--src/HaddockParse.y10
-rw-r--r--src/HaddockRename.hs3
-rw-r--r--src/HsSyn.lhs12
-rw-r--r--src/Main.hs30
6 files changed, 116 insertions, 45 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index e1604fad..03a837c3 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -1,10 +1,13 @@
--
-- Haddock - A Haskell Documentation Tool
--
--- (c) Simon Marlow 2002
+-- (c) Simon Marlow 2002-2003
--
-module HaddockHtml ( ppHtml, copyHtmlBits, ppHtmlIndex ) where
+module HaddockHtml (
+ ppHtml, copyHtmlBits,
+ ppHtmlIndex, ppHtmlContents
+ ) where
import Prelude hiding (div)
import HaddockVersion
@@ -47,23 +50,30 @@ ppHtml :: String
-> FilePath -- destination directory
-> Maybe Doc -- prologue text, maybe
-> Bool -- do MS Help stuff
+ -> Maybe String -- the contents URL (--use-contents)
-> Maybe String -- the index URL (--use-index)
-> IO ()
-ppHtml doctitle source_url ifaces odir prologue do_ms_help maybe_index_url = do
+ppHtml doctitle source_url ifaces odir prologue do_ms_help
+ maybe_contents_url maybe_index_url = do
let
visible_ifaces = filter visible ifaces
visible (_, i) = OptHide `notElem` iface_options i
- ppHtmlContents odir doctitle maybe_index_url (map fst visible_ifaces) prologue
- ppHtmlIndex odir doctitle visible_ifaces
+ when (not (isJust maybe_contents_url)) $
+ ppHtmlContents odir doctitle maybe_index_url
+ (map fst visible_ifaces) prologue
+
+ when (not (isJust maybe_index_url)) $
+ ppHtmlIndex odir doctitle maybe_contents_url visible_ifaces
-- Generate index and contents page for MS help if requested
when do_ms_help $ do
ppHHContents odir (map fst visible_ifaces)
ppHHIndex odir visible_ifaces
- mapM_ (ppHtmlModule odir doctitle source_url maybe_index_url) visible_ifaces
+ mapM_ (ppHtmlModule odir doctitle source_url
+ maybe_contents_url maybe_index_url) visible_ifaces
copyHtmlBits :: FilePath -> FilePath -> Maybe FilePath -> IO ()
@@ -119,30 +129,34 @@ parent_button mdl =
_ ->
Html.emptyTable
-contentsButton :: HtmlTable
-contentsButton = topButBox (anchor ! [href contentsHtmlFile] <<
- toHtml "Contents")
+contentsButton :: Maybe String -> HtmlTable
+contentsButton maybe_contents_url
+ = topButBox (anchor ! [href url] << toHtml "Contents")
+ where url = case maybe_contents_url of
+ Nothing -> contentsHtmlFile
+ Just url -> url
indexButton :: Maybe String -> HtmlTable
indexButton maybe_index_url
- = topButBox (anchor ! [href url] << toHtml "Index")
+ = topButBox (anchor ! [href url] << toHtml "Index")
where url = case maybe_index_url of
Nothing -> indexHtmlFile
Just url -> url
-simpleHeader :: String -> Maybe String -> HtmlTable
-simpleHeader doctitle maybe_index_url =
+simpleHeader :: String -> Maybe String -> Maybe String -> HtmlTable
+simpleHeader doctitle maybe_contents_url maybe_index_url =
(tda [theclass "topbar"] <<
vanillaTable << (
(td <<
image ! [src "haskell_icon.gif", width "16", height 16, alt " " ]
) <->
(tda [theclass "title"] << toHtml doctitle) <->
- contentsButton <-> indexButton maybe_index_url
+ contentsButton maybe_contents_url <-> indexButton maybe_index_url
))
-pageHeader :: String -> Interface -> String -> Maybe String -> Maybe String -> HtmlTable
-pageHeader mdl iface doctitle source_url maybe_index_url =
+pageHeader :: String -> Interface -> String
+ -> Maybe String -> Maybe String -> Maybe String -> HtmlTable
+pageHeader mdl iface doctitle source_url maybe_contents_url maybe_index_url =
(tda [theclass "topbar"] <<
vanillaTable << (
(td <<
@@ -151,7 +165,7 @@ pageHeader mdl iface doctitle source_url maybe_index_url =
(tda [theclass "title"] << toHtml doctitle) <->
src_button source_url mdl (iface_filename iface) <->
parent_button mdl <->
- contentsButton <->
+ contentsButton maybe_contents_url <->
indexButton maybe_index_url
)
) </>
@@ -179,16 +193,20 @@ moduleInfo iface =
-- ---------------------------------------------------------------------------
-- Generate the module contents
-ppHtmlContents :: FilePath -> String -> Maybe String -> [Module] -> Maybe Doc
+ppHtmlContents
+ :: FilePath -> String
+ -> Maybe String
+ -> [Module] -> Maybe Doc
-> IO ()
-ppHtmlContents odir doctitle maybe_index_url mdls prologue = do
+ppHtmlContents odir doctitle maybe_index_url
+ mdls prologue = do
let tree = mkModuleTree mdls
html =
header (thetitle (toHtml doctitle) +++
thelink ! [href cssFile,
rel "stylesheet", thetype "text/css"]) +++
body << vanillaTable << (
- simpleHeader doctitle maybe_index_url </>
+ simpleHeader doctitle Nothing maybe_index_url </>
ppPrologue prologue </>
ppModuleTree doctitle tree </>
s15 </>
@@ -218,7 +236,7 @@ mkNode ss (Node s leaf ts) =
mkLeaf :: String -> [String] -> Bool -> Html
mkLeaf s _ False = toHtml s
-mkLeaf s ss True = anchor ! [href (moduleHtmlFile "" mdl)] << toHtml s
+mkLeaf s ss True = ppHsModule mdl
where mdl = foldr (++) "" (s' : map ('.':) ss')
(s':ss') = reverse (s:ss)
-- reconstruct the module name
@@ -226,14 +244,15 @@ mkLeaf s ss True = anchor ! [href (moduleHtmlFile "" mdl)] << toHtml s
-- ---------------------------------------------------------------------------
-- Generate the index
-ppHtmlIndex :: FilePath -> String -> [(Module,Interface)] -> IO ()
-ppHtmlIndex odir doctitle ifaces = do
+ppHtmlIndex :: FilePath -> String -> Maybe String
+ -> [(Module,Interface)] -> IO ()
+ppHtmlIndex odir doctitle maybe_contents_url ifaces = do
let html =
header (thetitle (toHtml (doctitle ++ " (Index)")) +++
thelink ! [href cssFile,
rel "stylesheet", thetype "text/css"]) +++
body << vanillaTable << (
- simpleHeader doctitle Nothing </>
+ simpleHeader doctitle maybe_contents_url Nothing </>
index_html
)
@@ -270,7 +289,7 @@ ppHtmlIndex odir doctitle ifaces = do
thelink ! [href cssFile,
rel "stylesheet", thetype "text/css"]) +++
body << vanillaTable << (
- simpleHeader doctitle Nothing </>
+ simpleHeader doctitle maybe_contents_url Nothing </>
indexInitialLetterLinks </>
tda [theclass "section1"] <<
toHtml ("Index (" ++ c:")") </>
@@ -337,15 +356,18 @@ ppHtmlIndex odir doctitle ifaces = do
-- ---------------------------------------------------------------------------
-- Generate the HTML page for a module
-ppHtmlModule :: FilePath -> String -> Maybe String -> Maybe String ->
- (Module,Interface) -> IO ()
-ppHtmlModule odir doctitle source_url maybe_index_url (Module mdl,iface) = do
+ppHtmlModule
+ :: FilePath -> String -> Maybe String -> Maybe String -> Maybe String
+ -> (Module,Interface) -> IO ()
+ppHtmlModule odir doctitle source_url
+ maybe_contents_url maybe_index_url (Module mdl,iface) = do
let html =
header (thetitle (toHtml mdl) +++
thelink ! [href cssFile,
rel "stylesheet", thetype "text/css"]) +++
body << vanillaTable << (
- pageHeader mdl iface doctitle source_url maybe_index_url </> s15 </>
+ pageHeader mdl iface doctitle source_url
+ maybe_contents_url maybe_index_url </> s15 </>
ifaceToHtml mdl iface </> s15 </>
footer
)
@@ -917,11 +939,14 @@ htmlMarkup = Markup {
markupMonospaced = tt . toHtml,
markupUnorderedList = ulist . concatHtml . map (li <<),
markupOrderedList = olist . concatHtml . map (li <<),
+ markupDefList = dlist . concatHtml . map markupDef,
markupCodeBlock = pre,
markupURL = \url -> anchor ! [href url] << toHtml url,
markupAName = \aname -> namedAnchor aname << toHtml ""
}
+markupDef (a,b) = dterm << a +++ ddef << b
+
-- If the doc is a single paragraph, don't surround it with <P> (this causes
-- ugly extra whitespace with some browsers).
docToHtml :: Doc -> Html
diff --git a/src/HaddockLex.x b/src/HaddockLex.x
index feac18ab..b4030700 100644
--- a/src/HaddockLex.x
+++ b/src/HaddockLex.x
@@ -14,7 +14,7 @@ import Char
import HsSyn
import HsLexer hiding (Token)
import HsParseMonad
-import Debug.Trace
+--import Debug.Trace
}
$ws = $white # \n
@@ -29,8 +29,9 @@ $ident = [$alphanum \_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~]
<0,para> {
$ws* \n ;
$ws* \> { begin birdtrack }
- $ws* [\*\-] { token TokBullet }
- $ws* \( $digit+ \) { token TokNumber }
+ $ws* [\*\-] { token TokBullet `andBegin` string }
+ $ws* \[ { token TokDefStart `andBegin` def }
+ $ws* \( $digit+ \) { token TokNumber `andBegin` string }
$ws* { begin string }
}
@@ -43,7 +44,7 @@ $ident = [$alphanum \_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~]
<birdtrack> .* \n? { strtoken TokBirdTrack `andBegin` line }
-<string> {
+<string,def> {
$special { strtoken $ \s -> TokSpecial (head s) }
\<.*\> { strtoken $ \s -> TokURL (init (tail s)) }
\#.*\# { strtoken $ \s -> TokAName (init (tail s)) }
@@ -52,8 +53,18 @@ $ident = [$alphanum \_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~]
-- allow special characters through if they don't fit one of the previous
-- patterns.
[\'\`\<\#\\] { strtoken TokString }
- [^ $special \< \# \n \'\` \\]* \n { strtoken TokString `andBegin` line }
- [^ $special \< \# \n \'\` \\]+ { strtoken TokString }
+ [^ $special \< \# \n \'\` \\ \]]* \n { strtoken TokString `andBegin` line }
+ [^ $special \< \# \n \'\` \\ \]]+ { strtoken TokString }
+}
+
+<def> {
+ \] { token TokDefEnd `andBegin` string }
+}
+
+-- ']' doesn't have any special meaning outside of the [...] at the beginning
+-- of a definition paragraph.
+<string> {
+ \] { strtoken TokString }
}
{
@@ -61,6 +72,8 @@ data Token
= TokPara
| TokNumber
| TokBullet
+ | TokDefStart
+ | TokDefEnd
| TokSpecial Char
| TokIdent [HsQName]
| TokString String
diff --git a/src/HaddockParse.y b/src/HaddockParse.y
index 29b3b70a..dbc97446 100644
--- a/src/HaddockParse.y
+++ b/src/HaddockParse.y
@@ -9,10 +9,12 @@ import HsSyn
%token '/' { TokSpecial '/' }
'@' { TokSpecial '@' }
+ '[' { TokDefStart }
+ ']' { TokDefEnd }
DQUO { TokSpecial '\"' }
URL { TokURL $$ }
ANAME { TokAName $$ }
- '*' { TokBullet }
+ '-' { TokBullet }
'(n)' { TokNumber }
'>..' { TokBirdTrack $$ }
IDENT { TokIdent $$ }
@@ -35,14 +37,18 @@ doc :: { Doc }
apara :: { Doc }
: ulpara { DocUnorderedList [$1] }
| olpara { DocOrderedList [$1] }
+ | defpara { DocDefList [$1] }
| para { $1 }
ulpara :: { Doc }
- : '*' para { $2 }
+ : '-' para { $2 }
olpara :: { Doc }
: '(n)' para { $2 }
+defpara :: { (Doc,Doc) }
+ : '[' seq ']' seq { ($2, $4) }
+
para :: { Doc }
: seq { docParagraph $1 }
| codepara { DocCodeBlock $1 }
diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs
index ef32ae80..ad90c1a2 100644
--- a/src/HaddockRename.hs
+++ b/src/HaddockRename.hs
@@ -213,11 +213,14 @@ markupRename = Markup {
markupMonospaced = liftM DocMonospaced,
markupUnorderedList = liftM DocUnorderedList . sequence,
markupOrderedList = liftM DocOrderedList . sequence,
+ markupDefList = liftM DocDefList . mapM markupDef,
markupCodeBlock = liftM DocCodeBlock,
markupURL = return . DocURL,
markupAName = return . DocAName
}
+markupDef (ma,mb) = do a <- ma; b <- mb; return (a,b)
+
renameDoc :: Doc -> RnM Doc
renameDoc = markup markupRename
diff --git a/src/HsSyn.lhs b/src/HsSyn.lhs
index 139ef327..e43826a0 100644
--- a/src/HsSyn.lhs
+++ b/src/HsSyn.lhs
@@ -1,5 +1,5 @@
% -----------------------------------------------------------------------------
-% $Id: HsSyn.lhs,v 1.18 2003/10/20 17:19:23 sof Exp $
+% $Id: HsSyn.lhs,v 1.19 2003/11/06 12:39:47 simonmar Exp $
%
% (c) The GHC Team, 1997-2002
%
@@ -400,6 +400,7 @@ data GenDoc id
| DocMonospaced (GenDoc id)
| DocUnorderedList [GenDoc id]
| DocOrderedList [GenDoc id]
+ | DocDefList [(GenDoc id, GenDoc id)]
| DocCodeBlock (GenDoc id)
| DocURL String
| DocAName String
@@ -422,6 +423,7 @@ data DocMarkup id a = Markup {
markupMonospaced :: a -> a,
markupUnorderedList :: [a] -> a,
markupOrderedList :: [a] -> a,
+ markupDefList :: [(a,a)] -> a,
markupCodeBlock :: a -> a,
markupURL :: String -> a,
markupAName :: String -> a
@@ -438,10 +440,13 @@ markup m (DocEmphasis d) = markupEmphasis m (markup m d)
markup m (DocMonospaced d) = markupMonospaced m (markup m d)
markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds)
markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds)
+markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds)
markup m (DocCodeBlock d) = markupCodeBlock m (markup m d)
markup m (DocURL url) = markupURL m url
markup m (DocAName ref) = markupAName m ref
+markupPair m (a,b) = (markup m a, markup m b)
+
-- | The identity markup
idMarkup :: DocMarkup a (GenDoc a)
idMarkup = Markup {
@@ -455,6 +460,7 @@ idMarkup = Markup {
markupMonospaced = DocMonospaced,
markupUnorderedList = DocUnorderedList,
markupOrderedList = DocOrderedList,
+ markupDefList = DocDefList,
markupCodeBlock = DocCodeBlock,
markupURL = DocURL,
markupAName = DocAName
@@ -479,6 +485,10 @@ docAppend (DocOrderedList ds1) (DocOrderedList ds2)
= DocOrderedList (ds1++ds2)
docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d)
= DocAppend (DocOrderedList (ds1++ds2)) d
+docAppend (DocDefList ds1) (DocDefList ds2)
+ = DocDefList (ds1++ds2)
+docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d)
+ = DocAppend (DocDefList (ds1++ds2)) d
docAppend DocEmpty d = d
docAppend d DocEmpty = d
docAppend d1 d2
diff --git a/src/Main.hs b/src/Main.hs
index 25d6cc16..3d5f97b4 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -80,6 +80,8 @@ data Flag
| Flag_Help
| Flag_Verbose
| Flag_Version
+ | Flag_UseContents String
+ | Flag_GenContents
| Flag_UseIndex String
| Flag_GenIndex
deriving (Eq)
@@ -119,6 +121,10 @@ options =
"output version information and exit",
Option ['v'] ["verbose"] (NoArg Flag_Verbose)
"increase verbosity",
+ Option [] ["use-contents"] (ReqArg Flag_UseContents "URL")
+ "use a separately-generated HTML contents page",
+ Option [] ["gen-contents"] (NoArg Flag_GenContents)
+ "generate an HTML contents from specified interfaces",
Option [] ["use-index"] (ReqArg Flag_UseIndex "URL")
"use a separately-generated HTML index",
Option [] ["gen-index"] (NoArg Flag_GenIndex)
@@ -167,6 +173,11 @@ run flags files = do
no_implicit_prelude = Flag_NoImplicitPrelude `elem` flags
verbose = Flag_Verbose `elem` flags
+ maybe_contents_url =
+ case [url | Flag_UseContents url <- flags] of
+ [] -> Nothing
+ us -> Just (last us)
+
maybe_index_url =
case [url | Flag_UseIndex url <- flags] of
[] -> Nothing
@@ -178,15 +189,17 @@ run flags files = do
updateHTMLXRefs (map fst ifaces_to_read) read_ifaces_s
- if Flag_GenIndex `elem` flags
- then do
- when (not (null files)) $
- die ("--gen-index: expected no additional file arguments")
- ppHtmlIndex odir title (concat read_ifaces_s)
+ writeIORef saved_flags flags
+
+ when (Flag_GenContents `elem` flags) $ do
+ ppHtmlContents odir title maybe_index_url
+ (map fst (concat read_ifaces_s)) prologue
+ copyHtmlBits odir libdir css_file
+
+ when (Flag_GenIndex `elem` flags) $ do
+ ppHtmlIndex odir title maybe_contents_url (concat read_ifaces_s)
copyHtmlBits odir libdir css_file
- else do
- writeIORef saved_flags flags
parsed_mods <- mapM parse_file files
let read_ifaces = concat read_ifaces_s
@@ -225,7 +238,8 @@ run flags files = do
when (Flag_Html `elem` flags) $ do
ppHtml title source_url these_mod_ifaces odir
- prologue (Flag_MSHtmlHelp `elem` flags) maybe_index_url
+ prologue (Flag_MSHtmlHelp `elem` flags)
+ maybe_contents_url maybe_index_url
copyHtmlBits odir libdir css_file
-- dump an interface if requested
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 12:34:41 +0000