Generate autodoc index with SML/NJ HTML lib

[hcoop/domtool2.git] / src / autodoc.sml

(* HCoop Domtool (http://hcoop.sourceforge.net/)
 * Copyright (c) 2006, Adam Chlipala
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *)

(* Generating HTML documentation automatically *)

structure Autodoc :> AUTODOC = struct

open Ast HTML HtmlPrint
open PD

fun uppercase s =
    case s of
	"" => s
      | _ => str (Char.toUpper (String.sub (s, 0)))
	     ^ String.extract (s, 1, NONE)

fun check' G fname =
    let
	val prog = Parse.parse fname
    in
	if !ErrorMsg.anyErrors then
	    G
	else
	    Tycheck.checkFile G (Defaults.tInit ()) prog
    end

fun autodoc {outdir, infiles} =
    let
	val (prov, infiles) = Order.order infiles
	val _ = HtmlPrint.setProviders prov

	val G = foldl (fn (fname, G) => check' G fname) Env.empty infiles

	fun annotate_decl d =
	    case d of
		DVal (name, NONE, e) =>
		(case Env.lookupVal G name of
		     NONE => d
		   | SOME t => DVal (name, SOME t, e))
	      | _ => d

	fun modify file =
	    let
		val file' = #file (OS.Path.splitDirFile file)
		val file' = #base (OS.Path.splitBaseExt file')
	    in
		file'
	    end

	fun doFile file =
	    let
		val (desc, decls, _) = Parse.parse file

		val file' = modify file

		val title = "Domtool Module " ^ uppercase file'

		val outf = TextIO.openOut (outdir ^ "/" ^ file' ^ ".html")

		(*fun doDecl (d, desc, _) =
		    Option.app (fn desc => (TextIO.output (outf, "<p>");
					    TextIO.output (outf, desc);
					    TextIO.output (outf, "</p>\n"))) desc*)

		val body = Hn {n = 1,
			       align = NONE,
			       content = PCDATA title}

		val body = case desc of
			       NONE => body
			     | SOME desc => BlockList [body,
						       P {align = NONE,
							  content = PCDATA desc}]

		val summaries = foldr (fn ((d, desc, _), summaries) =>
					HtmlPrint.output (p_decl_fref (annotate_decl d))
					:: BR {clear = NONE}
					:: summaries)
				    [] decls

		val entries = map (fn (d, desc, _) =>
				      let
					  val cblock = HtmlPrint.output (p_decl (annotate_decl d))

					  val dblock = case desc of
							   NONE => TextBlock (PCDATA "")
							 | SOME desc => BLOCKQUOTE (TextBlock (PCDATA desc))
				      in
					  BlockList [P {align = NONE,
							content = TT cblock},
						     dblock]
				      end) decls

		val body = BlockList (body
				      :: HR {align = NONE,
					     noshade = false,
					     size = NONE,
					     width = NONE}
				      :: TextBlock (TT (TextList summaries))
				      :: HR {align = NONE,
					     noshade = false,
					     size = NONE,
					     width = NONE}
				      :: entries)

		val html = HTML {version = NONE,
				 head = [Head_TITLE title],
				 body = BODY {background = NONE,
					      bgcolor = NONE,
					      text = NONE,
					      link = NONE,
					      vlink = NONE,
					      alink = NONE,
					      content = body}}
	    in
		PrHTML.prHTML {putc = (fn ch => TextIO.output1 (outf, ch)),
			       puts = (fn s => TextIO.output (outf, s))} html;
		TextIO.closeOut outf
	    end

	val title = "Domtool Module Index"

	val items = map (fn file =>
			    let
				val file' = modify file
			    in
				LI {ty = NONE,
				    value = NONE,
				    content = TextBlock (A {name = NONE,
							    href = SOME (file' ^ ".html"),
							    rel = NONE,
							    rev = NONE,
							    title = NONE,
							    content = PCDATA (uppercase file')})}
			    end) infiles

	val index = HTML {version = NONE,
			  head = [Head_TITLE title],
			  body = BODY {background = NONE,
				       bgcolor = NONE,
				       text = NONE,
				       link = NONE,
				       vlink = NONE,
				       alink = NONE,
				       content = UL {ty = NONE,
						     compact = false,
						     content = items}}}

	val outf = TextIO.openOut (outdir ^ "/index.html")
    in
	PrHTML.prHTML {putc = (fn ch => TextIO.output1 (outf, ch)),
		       puts = (fn s => TextIO.output (outf, s))} index;	
	TextIO.closeOut outf;

	app doFile infiles
    end

end