aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/HaddockHtml.hs53
-rw-r--r--src/HaddockRename.hs6
-rw-r--r--src/HaddockTypes.hs3
-rw-r--r--src/HaddockVersion.hs4
-rw-r--r--src/HsLexer.lhs6
-rw-r--r--src/HsParser.ly6
-rw-r--r--src/HsSyn.lhs5
-rw-r--r--src/Main.hs41
-rw-r--r--src/Makefile10
-rw-r--r--src/haddock.sh7
10 files changed, 103 insertions, 38 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index 2b2c4f3e..994b17e1 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -22,26 +22,39 @@ import Html
import qualified Html
-- -----------------------------------------------------------------------------
+-- Files we need to copy from our $libdir
+
+cssFile = "haddock.css"
+iconFile = "haskell_icon.gif"
+
+-- -----------------------------------------------------------------------------
-- Generating HTML documentation
ppHtml :: String
-> Maybe String
-> [(Module, Interface)]
-> FilePath -- destination directory
- -> String -- CSS file
+ -> Maybe String -- CSS file
+ -> String -- $libdir
-> IO ()
-ppHtml title source_url ifaces odir css_file = do
+ppHtml title source_url ifaces odir maybe_css libdir = do
let
- (_css_dir, css_basename, css_suff) = splitFilename3 css_file
- css_filename = css_basename ++ '.':css_suff
- css_destination = odir ++ pathSeparator:css_filename
+ css_file = case maybe_css of
+ Nothing -> libdir ++ pathSeparator:cssFile
+ Just f -> f
+ css_destination = odir ++ pathSeparator:cssFile
+
+ icon_file = libdir ++ pathSeparator:iconFile
+ icon_destination = odir ++ pathSeparator:iconFile
css_contents <- readFile css_file
writeFile css_destination css_contents
+ icon_contents <- readFile icon_file
+ writeFile icon_destination icon_contents
- ppHtmlContents odir css_filename title source_url (map fst ifaces)
- ppHtmlIndex odir css_filename title ifaces
- mapM_ (ppHtmlModule odir css_filename title source_url) ifaces
+ ppHtmlContents odir title source_url (map fst ifaces)
+ ppHtmlIndex odir title ifaces
+ mapM_ (ppHtmlModule odir title source_url) ifaces
moduleHtmlFile :: String -> FilePath
moduleHtmlFile mod = mod ++ ".html" -- ToDo: Z-encode filename?
@@ -134,13 +147,13 @@ moduleInfo iface
-- ---------------------------------------------------------------------------
-- Generate the module contents
-ppHtmlContents :: FilePath -> String -> String -> Maybe String -> [Module]
+ppHtmlContents :: FilePath -> String -> Maybe String -> [Module]
-> IO ()
-ppHtmlContents odir css_filename title source_url mods = do
+ppHtmlContents odir title source_url mods = do
let tree = mkModuleTree mods
html =
header (thetitle (toHtml title) +++
- thelink ! [href css_filename,
+ thelink ! [href cssFile,
rel "stylesheet", thetype "text/css"]) +++
body <<
table ! [width "100%", cellpadding 0, cellspacing 1] << (
@@ -195,11 +208,11 @@ splitModule (Module mod) = split mod
-- ---------------------------------------------------------------------------
-- Generate the index
-ppHtmlIndex :: FilePath -> String -> String -> [(Module,Interface)] -> IO ()
-ppHtmlIndex odir css_filename title ifaces = do
+ppHtmlIndex :: FilePath -> String -> [(Module,Interface)] -> IO ()
+ppHtmlIndex odir title ifaces = do
let html =
header (thetitle (toHtml (title ++ " (Index)")) +++
- thelink ! [href css_filename,
+ thelink ! [href cssFile,
rel "stylesheet", thetype "text/css"]) +++
body <<
table ! [width "100%", cellpadding 0, cellspacing 1] << (
@@ -235,7 +248,7 @@ ppHtmlIndex odir css_filename title ifaces = do
(renderHtml html)
where
html = header (thetitle (toHtml (title ++ " (" ++ descr ++ "Index)")) +++
- thelink ! [href css_filename,
+ thelink ! [href cssFile,
rel "stylesheet", thetype "text/css"]) +++
body <<
table ! [width "100%", cellpadding 0, cellspacing 1] << (
@@ -285,12 +298,12 @@ idBeginsWith (HsSpecial s) c = head s `elem` [toLower c, toUpper c]
-- ---------------------------------------------------------------------------
-- Generate the HTML page for a module
-ppHtmlModule :: FilePath -> String -> String -> Maybe String
+ppHtmlModule :: FilePath -> String -> Maybe String
-> (Module,Interface) -> IO ()
-ppHtmlModule odir css_filename title source_url (Module mod,iface) = do
+ppHtmlModule odir title source_url (Module mod,iface) = do
let html =
header (thetitle (toHtml mod) +++
- thelink ! [href css_filename,
+ thelink ! [href cssFile,
rel "stylesheet", thetype "text/css"]) +++
body <<
table ! [width "100%", cellpadding 0, cellspacing 1] << (
@@ -352,6 +365,7 @@ ppModuleContents exports
process :: Int -> [ExportItem] -> ([Html],[ExportItem])
process n [] = ([], [])
process n (ExportDecl _ : rest) = process n rest
+ process n (ExportDoc _ : rest) = process n rest
process n items@(ExportGroup lev id doc : rest)
| lev <= n = ( [], items )
| otherwise = ( html:sections, rest2 )
@@ -380,6 +394,9 @@ processExport doc_map summary (ExportGroup lev id doc)
| otherwise = ppDocGroup lev (anchor ! [name id] << markup htmlMarkup doc)
processExport doc_map summary (ExportDecl decl)
= doDecl doc_map summary decl
+processExport doc_map summary (ExportDoc doc)
+ | summary = Html.emptyTable
+ | otherwise = docBox (markup htmlMarkup doc)
ppDocGroup lev doc
| lev == 1 = tda [ theclass "section1" ] << doc
diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs
index d43fb959..9dfa7147 100644
--- a/src/HaddockRename.hs
+++ b/src/HaddockRename.hs
@@ -69,6 +69,9 @@ renameExportList spec = mapM renameExport spec
lookupRn (\x' -> HsEThingWith x' cs') x
renameExport (HsEModuleContents m) = return (HsEModuleContents m)
renameExport (HsEGroup lev str) = return (HsEGroup lev str)
+ renameExport (HsEDoc str) = return (HsEDoc str)
+ renameExport (HsEDocNamed str) = return (HsEDocNamed str)
+
renameDecl :: HsDecl -> RnM HsDecl
renameDecl decl
@@ -197,3 +200,6 @@ renameExportItems items = mapM rn items
rn (ExportDecl decl)
= do decl <- renameDecl decl
return (ExportDecl decl)
+ rn (ExportDoc doc)
+ = do doc <- renameDoc doc
+ return (ExportDoc doc)
diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs
index 21ee513c..c5010fa4 100644
--- a/src/HaddockTypes.hs
+++ b/src/HaddockTypes.hs
@@ -72,6 +72,9 @@ data ExportItem
String -- section "id" (for hyperlinks)
Doc -- section heading text
+ | ExportDoc -- some documentation
+ Doc
+
type ModuleMap = FiniteMap Module Interface
-- -----------------------------------------------------------------------------
diff --git a/src/HaddockVersion.hs b/src/HaddockVersion.hs
index 6617203c..5048d899 100644
--- a/src/HaddockVersion.hs
+++ b/src/HaddockVersion.hs
@@ -4,7 +4,9 @@
-- (c) Simon Marlow 2002
--
-module HaddockVersion ( projectName, projectVersion, projectUrl ) where
+module HaddockVersion (
+ projectName, projectVersion, projectUrl
+ ) where
projectName = "Haddock"
projectUrl = "http://www.haskell.org/haddock"
diff --git a/src/HsLexer.lhs b/src/HsLexer.lhs
index ac5fa9ae..8f5c0174 100644
--- a/src/HsLexer.lhs
+++ b/src/HsLexer.lhs
@@ -1,5 +1,5 @@
-----------------------------------------------------------------------------
--- $Id: HsLexer.lhs,v 1.3 2002/04/24 15:12:41 simonmar Exp $
+-- $Id: HsLexer.lhs,v 1.4 2002/04/25 14:40:05 simonmar Exp $
--
-- (c) The GHC Team, 1997-2000
--
@@ -66,7 +66,7 @@ data Token
| DocCommentNext String -- something beginning '-- |'
| DocCommentPrev String -- something beginning '-- ^'
- | DocCommentNamed String -- something beginning '-- @'
+ | DocCommentNamed String -- something beginning '-- $'
| DocSection Int String -- a section heading
-- Reserved operators
@@ -222,6 +222,7 @@ lexer cont input (SrcLoc _ x) y col =
doc (' ':'/':_) = True
doc (' ':'^':_) = True
doc (' ':'*':_) = True
+ doc (' ':'$':_) = True
doc _ = False
nextTab x = x + (tAB_LENGTH - (x-1) `mod` tAB_LENGTH)
@@ -280,6 +281,7 @@ lexToken cont s loc y x =
'-':'-':' ':'|':s -> docComment DocCommentNext cont s loc y x
'-':'-':' ':'/':s -> docComment DocCommentNext cont s loc y x
'-':'-':' ':'^':s -> docComment DocCommentPrev cont s loc y x
+ '-':'-':' ':'$':s -> docComment DocCommentNamed cont s loc y x
'-':'-':' ':'*':s -> docSection cont ('*':s) loc y x
'\'':s -> lexChar cont s loc y (x+1)
diff --git a/src/HsParser.ly b/src/HsParser.ly
index 26829cd9..c7833bf2 100644
--- a/src/HsParser.ly
+++ b/src/HsParser.ly
@@ -1,5 +1,5 @@
q-----------------------------------------------------------------------------
-$Id: HsParser.ly,v 1.3 2002/04/24 15:57:47 simonmar Exp $
+$Id: HsParser.ly,v 1.4 2002/04/25 14:40:05 simonmar Exp $
(c) Simon Marlow, Sven Panne 1997-2000
@@ -69,6 +69,7 @@ Docs
> DOCNEXT { DocCommentNext $$ }
> DOCPREV { DocCommentPrev $$ }
+> DOCNAMED { DocCommentNamed $$ }
> DOCGROUP { DocSection _ _ }
Symbols
@@ -185,6 +186,8 @@ The Export List
> exportlist :: { [HsExportSpec] }
> : export ',' exportlist { $1 : $3 }
> | docgroup exportlist { $1 : $2 }
+> | DOCNAMED exportlist { HsEDocNamed $1 : $2 }
+> | DOCNEXT exportlist { HsEDoc $1 : $2 }
> | ',' exportlist { $2 }
> | export { [$1] }
> | {- empty -} { [] }
@@ -324,6 +327,7 @@ shift/reduce-conflict, so we don't handle this case here, but in bodyaux.
> | valdef { $1 }
> | DOCNEXT { HsDocCommentNext $1 }
> | DOCPREV { HsDocCommentPrev $1 }
+> | DOCNAMED { HsDocCommentNamed $1 }
> | DOCGROUP { case $1 of { DocSection i s ->
> HsDocGroup i s } }
diff --git a/src/HsSyn.lhs b/src/HsSyn.lhs
index ae55402e..7abf4454 100644
--- a/src/HsSyn.lhs
+++ b/src/HsSyn.lhs
@@ -1,5 +1,5 @@
% -----------------------------------------------------------------------------
-% $Id: HsSyn.lhs,v 1.3 2002/04/24 15:57:48 simonmar Exp $
+% $Id: HsSyn.lhs,v 1.4 2002/04/25 14:40:05 simonmar Exp $
%
% (c) The GHC Team, 1997-2002
%
@@ -80,6 +80,8 @@ data HsExportSpec
| HsEThingWith HsQName [HsQName] -- T(C_1,...,C_n)
| HsEModuleContents Module -- module M (not for imports)
| HsEGroup Int String -- a doc section heading
+ | HsEDoc String -- some documentation
+ | HsEDocNamed String -- a reference to named doc
deriving (Eq,Show)
data HsImportDecl
@@ -127,6 +129,7 @@ data HsDecl
| HsForeignExport SrcLoc HsCallConv String HsName HsType
| HsDocCommentNext String -- a documentation annotation
| HsDocCommentPrev String -- a documentation annotation
+ | HsDocCommentNamed String -- a documentation annotation
| HsDocGroup Int String -- a documentation group
deriving (Eq,Show)
diff --git a/src/Main.hs b/src/Main.hs
index ee6c0d3b..0b8ac7d0 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -50,6 +50,7 @@ data Flag
| Flag_Heading String
| Flag_SourceURL String
| Flag_CSS String
+ | Flag_Lib String
| Flag_OutputDir FilePath
deriving (Eq)
@@ -68,7 +69,9 @@ options =
Option ['v'] ["verbose"] (NoArg Flag_Verbose)
"be verbose",
Option [] ["css"] (ReqArg Flag_CSS "FILE")
- "The CSS file to use for HTML output"
+ "The CSS file to use for HTML output",
+ Option [] ["lib"] (ReqArg Flag_Lib "DIR")
+ "Directory containing Haddock's auxiliary files"
]
saved_flags :: IORef [Flag]
@@ -83,10 +86,14 @@ run flags files = do
[] -> Nothing
(t:ts) -> Just t
- css_file <- case [str | Flag_CSS str <- flags] of
- [] -> dieMsg "no --css option"
+ libdir <- case [str | Flag_Lib str <- flags] of
+ [] -> dieMsg "no --lib option"
fs -> return (last fs)
+ let css_file = case [str | Flag_CSS str <- flags] of
+ [] -> Nothing
+ fs -> Just (last fs)
+
odir <- case [str | Flag_OutputDir str <- flags] of
[] -> return "."
fs -> return (last fs)
@@ -107,7 +114,7 @@ run flags files = do
putStr (ppDocBook odir mod_ifaces)
when (Flag_Html `elem` flags) $
- ppHtml title source_url mod_ifaces odir css_file
+ ppHtml title source_url mod_ifaces odir css_file libdir
parse_file file = do
@@ -292,6 +299,15 @@ mkExportItems mod_map mod env decl_map decls (Just specs)
= [ ExportGroup lev "" doc ]
where (doc, _names) = formatDocHeading (lookupForDoc env) str
-- ToDo: report the unresolved names
+ lookupExport (HsEDoc str)
+ = [ ExportDoc doc ]
+ where (doc, _names) = formatDocString (lookupForDoc env) str
+ -- ToDo: report the unresolved names
+ lookupExport (HsEDocNamed str)
+ | Just found <- findNamedDoc str decls
+ = let (doc, _names) = formatDocString (lookupForDoc env) found in
+ [ ExportDoc doc ]
+
lookupExport _ = [] -- didn't find it?
fullContentsOf m
@@ -552,3 +568,20 @@ moduleHeaderRE = mkRegexWithOpts
-- rest of the module documentation - we might want to revist
-- this at some point (perhaps have a separator between the
-- portability field and the module documentation?).
+
+-- -----------------------------------------------------------------------------
+-- Named documentation
+
+findNamedDoc :: String -> [HsDecl] -> Maybe String
+findNamedDoc str decls =
+ case matchRegex docNameRE str of
+ Just (name:_) -> search decls
+ where search [] = Nothing
+ search (HsDocCommentNamed str : rest) =
+ case matchRegexAll docNameRE str of
+ Nothing -> search rest
+ Just (_, _, after, _, _) -> Just after
+ search (_other_decl : rest) = search rest
+ _other -> Nothing
+
+docNameRE = mkRegex "[ \t]*([A-Za-z0-9_]*)"
diff --git a/src/Makefile b/src/Makefile
index 238009e0..fe2beb1e 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -9,18 +9,16 @@ HS_PROG = haddock.bin
HsParser_HC_OPTS += -Onot
HaddockVersion_HC_OPTS = -DHADDOCK_VERSION=$(ProjectVersion)
-CSS_FILE = haddock.css
-
ifeq "$(INSTALLING)" "1"
ifeq "$(BIN_DIST)" "1"
-HADDOCKCSS=$$\"\"libdir/haddock/$(CSS_FILE)
+HADDOCKLIB=$$\"\"libdir/haddock
HADDOCKBIN=$$\"\"libexecdir/$(HS_PROG)
else
-HADDOCKCSS=$(libdir)/haddock/$(CSS_FILE)
+HADDOCKLIB=$(libdir)/haddock
HADDOCKBIN=$(libexecdir)/$(HS_PROG)
endif # BIN_DIST
else
-HADDOCKCSS=$(FPTOOLS_TOP_ABS)/haddock/html/$(CSS_FILE)
+HADDOCKLIB=$(FPTOOLS_TOP_ABS)/haddock/html
HADDOCKBIN=$(FPTOOLS_TOP_ABS)/haddock/src/$(HS_PROG)
endif
@@ -40,7 +38,7 @@ SCRIPT_OBJS=haddock.sh
INTERP=$(SHELL)
-SCRIPT_SUBST_VARS = HADDOCKCSS HADDOCKBIN
+SCRIPT_SUBST_VARS = HADDOCKLIB HADDOCKBIN
INSTALL_SCRIPTS += $(SCRIPT_PROG)
INSTALL_LIBEXECS = $(HS_PROG)
diff --git a/src/haddock.sh b/src/haddock.sh
index b0b534f0..f1ad0191 100644
--- a/src/haddock.sh
+++ b/src/haddock.sh
@@ -1,10 +1,7 @@
# Mini-driver for Haddock
# needs the following variables:
-# HADDOCKCSS
+# HADDOCKLIB
# HADDOCKBIN
-case $* in
-*--css*) $HADDOCKBIN ${1+"$@"};;
-*) $HADDOCKBIN --css $HADDOCKCSS ${1+"$@"};;
-esac
+$HADDOCKBIN --lib $HADDOCKLIB ${1+"$@"}
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 11:06:41 +0000