diff options
| -rw-r--r-- | TODO | 2 | ||||
| -rw-r--r-- | src/HaddockHtml.hs | 53 | ||||
| -rw-r--r-- | src/HaddockRename.hs | 6 | ||||
| -rw-r--r-- | src/HaddockTypes.hs | 3 | ||||
| -rw-r--r-- | src/HaddockVersion.hs | 4 | ||||
| -rw-r--r-- | src/HsLexer.lhs | 6 | ||||
| -rw-r--r-- | src/HsParser.ly | 6 | ||||
| -rw-r--r-- | src/HsSyn.lhs | 5 | ||||
| -rw-r--r-- | src/Main.hs | 41 | ||||
| -rw-r--r-- | src/Makefile | 10 | ||||
| -rw-r--r-- | src/haddock.sh | 7 |
11 files changed, 103 insertions, 40 deletions
@@ -3,8 +3,6 @@ For 1.0: * IDoc compatibility, as far as possible - bird-tracks for code blocks -* named chunks of documentation? - * Do the unlitting/CPPing from Haddock itself * facilities for saving interfaces so that you can run Haddock against 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+"$@"} |