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

(* HCoop Domtool (http://hcoop.sourceforge.net/)
 * Copyright (c) 2006-2007, 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 prog
    end

fun autodoc {outdir, infiles} =
    let
	val (prov, infiles) = Order.order NONE infiles
	val _ = HtmlPrintArg.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 = case desc of
			       NONE => BlockList []
			     | SOME desc => P {align = NONE,
					       content = PCDATA desc}

		val  body = BlockList [body,
				       TextBlock (BR {clear = SOME TextFlowCtl.all})]


		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,
					 Head_LINK {id = NONE,
						    href = SOME Config.Autodoc.stylesheet,
						    rel = SOME "stylesheet",
						    rev = NONE,
						    title = NONE}],
				 body = BODY {background = NONE,
					      bgcolor = NONE,
					      text = NONE,
					      link = NONE,
					      vlink = NONE,
					      alink = NONE,
					      content = BlockList[TextBlock (PCDATA (Config.Autodoc.htmlHeader title)),
								  body,
								  TextBlock (PCDATA Config.Autodoc.htmlFooter)]}}
	    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
				val (desc, _, _) = Parse.parse file
			    in
				LI {ty = NONE,
				    value = NONE,
				    content = BlockList
						  [TextBlock (A {name = NONE,
								 href = SOME (file' ^ ".html"),
								 rel = NONE,
								 rev = NONE,
								 title = NONE,
								 content = PCDATA (uppercase file')}),
						   TextBlock (PCDATA (Option.getOpt (desc, "")))]}
			    end) infiles

	val index = HTML {version = NONE,
			  head = [Head_TITLE title,
				  Head_LINK {id = NONE,
					     href = SOME Config.Autodoc.stylesheet,
					     rel = SOME "stylesheet",
					     rev = NONE,
					     title = NONE}],
			  body = BODY {background = NONE,
				       bgcolor = NONE,
				       text = NONE,
				       link = NONE,
				       vlink = NONE,
				       alink = NONE,
				       content = BlockList[TextBlock (PCDATA (Config.Autodoc.htmlHeader title)),
							   TextBlock (BR {clear = SOME TextFlowCtl.all}),
							   UL {ty = NONE,
							       compact = false,
							       content = items},
							   TextBlock (PCDATA Config.Autodoc.htmlFooter)]}}

	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

fun makeEmacsKeywords infiles =
    let
	val (_, infiles) = Order.order NONE infiles
	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 doFile (file, acc) =
	    let
		val (_, decls, _) = Parse.parse file

		fun isAction evs (t, _) =
		    case t of
			TAction (_, r1, r2) =>
			let
			    fun enrich (r, evs) =
				StringMap.foldli (fn (ev, _, evs) =>
						     StringSet.add (evs, ev))
				      evs r
			in
			    SOME (enrich (r2, enrich (r1, evs)))
			end
		      | TArrow (_, t) => isAction evs t
		      | TNested (_, t) => isAction evs t
		      | TUnif (_, ref (SOME t)) => isAction evs t
		      | _ => NONE
	    in
		foldl (fn ((d, _, _), (types, contexts, actions, vals, evs)) =>
			  case annotate_decl d of
			      DExternType s => (s :: types, contexts, actions, vals, evs)
			    | DExternVal (s, t) =>
			      (case isAction evs t of
				   SOME evs => (types, contexts, s :: actions, vals, evs)
				 | NONE => (types, contexts, actions, s :: vals, evs))
			    | DVal (s, NONE, _) => (types, contexts, actions, s :: vals, evs)
			    | DVal (s, SOME t, _) =>
			      (case isAction evs t of
				   SOME evs => (types, contexts, s :: actions, vals, evs)
				 | NONE => (types, contexts, actions, s :: vals, evs))
			    | DEnv (s, _, _) =>
			      (types, contexts, actions, vals, StringSet.add (evs, s))
			    | DContext s => (types, s :: contexts, actions, vals, evs))
		      acc decls
	    end

	val (types, contexts, actions, vals, evs) =
	    foldl doFile ([], [], [], [], StringSet.empty) infiles

	fun printKind (ident, syms) =
	    (print "(defconst domtool-";
	     print ident;
	     print "-regexp\n  (domtool-syms-re";
	     app (fn s => (print " \""; print s; print "\"")) syms;
	     print ")\n  \"A regexp that matches Domtool ";
	     print ident;
	     print " from the standard library.\")\n\n")
    in
	printKind ("types", types);
	printKind ("contexts", contexts);
	printKind ("actions", actions);
	printKind ("vals", vals);
	printKind ("env-vars", StringSet.listItems evs);
	print "(provide 'domtool-tables)\n"
    end

end
Commit	Line	Data
3196000d	1	(* HCoop Domtool (http://hcoop.sourceforge.net/)
ef18a741	2	* Copyright (c) 2006-2007, Adam Chlipala
3196000d AC	3	*
	4	* This program is free software; you can redistribute it and/or
	5	* modify it under the terms of the GNU General Public License
	6	* as published by the Free Software Foundation; either version 2
	7	* of the License, or (at your option) any later version.
	8	*
	9	* This program is distributed in the hope that it will be useful,
	10	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	11	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	12	* GNU General Public License for more details.
	13	*
	14	* You should have received a copy of the GNU General Public License
	15	* along with this program; if not, write to the Free Software
	16	* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
	17	*)
	18
	19	(* Generating HTML documentation automatically *)
	20
	21	structure Autodoc :> AUTODOC = struct
	22
	23	open Ast HTML HtmlPrint
	24	open PD
	25
	26	fun uppercase s =
	27	case s of
	28	"" => s
	29	\| _ => str (Char.toUpper (String.sub (s, 0)))
	30	^ String.extract (s, 1, NONE)
	31
	32	fun check' G fname =
	33	let
	34	val prog = Parse.parse fname
	35	in
	36	if !ErrorMsg.anyErrors then
	37	G
	38	else
e140629f	39	Tycheck.checkFile G prog
3196000d AC	40	end
	41
	42	fun autodoc {outdir, infiles} =
	43	let
c53e82e4	44	val (prov, infiles) = Order.order NONE infiles
9b7ee2b2	45	val _ = HtmlPrintArg.setProviders prov
3196000d AC	46
	47	val G = foldl (fn (fname, G) => check' G fname) Env.empty infiles
	48
	49	fun annotate_decl d =
	50	case d of
	51	DVal (name, NONE, e) =>
	52	(case Env.lookupVal G name of
	53	NONE => d
	54	\| SOME t => DVal (name, SOME t, e))
	55	\| _ => d
	56
	57	fun modify file =
	58	let
	59	val file' = #file (OS.Path.splitDirFile file)
	60	val file' = #base (OS.Path.splitBaseExt file')
	61	in
	62	file'
	63	end
	64
	65	fun doFile file =
	66	let
	67	val (desc, decls, _) = Parse.parse file
	68
	69	val file' = modify file
	70
	71	val title = "Domtool Module " ^ uppercase file'
	72
	73	val outf = TextIO.openOut (outdir ^ "/" ^ file' ^ ".html")
	74
	75	(*fun doDecl (d, desc, _) =
	76	Option.app (fn desc => (TextIO.output (outf, "<p>");
	77	TextIO.output (outf, desc);
	78	TextIO.output (outf, "</p>\n"))) desc*)
	79
3196000d	80	val body = case desc of
7d5aaf7b AC	81	NONE => BlockList []
	82	\| SOME desc => P {align = NONE,
	83	content = PCDATA desc}
	84
	85	val body = BlockList [body,
	86	TextBlock (BR {clear = SOME TextFlowCtl.all})]
	87
3196000d	88
c2ce01bd AC	89	val summaries = foldr (fn ((d, desc, _), summaries) =>
	90	HtmlPrint.output (p_decl_fref (annotate_decl d))
	91	:: BR {clear = NONE}
	92	:: summaries)
	93	[] decls
	94
3196000d AC	95	val entries = map (fn (d, desc, _) =>
	96	let
	97	val cblock = HtmlPrint.output (p_decl (annotate_decl d))
	98
	99	val dblock = case desc of
	100	NONE => TextBlock (PCDATA "")
	101	\| SOME desc => BLOCKQUOTE (TextBlock (PCDATA desc))
	102	in
	103	BlockList [P {align = NONE,
	104	content = TT cblock},
	105	dblock]
	106	end) decls
	107
c2ce01bd AC	108	val body = BlockList (body
	109	:: HR {align = NONE,
	110	noshade = false,
	111	size = NONE,
	112	width = NONE}
	113	:: TextBlock (TT (TextList summaries))
	114	:: HR {align = NONE,
	115	noshade = false,
	116	size = NONE,
	117	width = NONE}
	118	:: entries)
3196000d AC	119
3196000d AC	120	val html = HTML {version = NONE,
7d5aaf7b AC	121	head = [Head_TITLE title,
	122	Head_LINK {id = NONE,
	123	href = SOME Config.Autodoc.stylesheet,
	124	rel = SOME "stylesheet",
	125	rev = NONE,
	126	title = NONE}],
3196000d AC	127	body = BODY {background = NONE,
	128	bgcolor = NONE,
	129	text = NONE,
	130	link = NONE,
	131	vlink = NONE,
	132	alink = NONE,
7d5aaf7b AC	133	content = BlockList[TextBlock (PCDATA (Config.Autodoc.htmlHeader title)),
	134	body,
	135	TextBlock (PCDATA Config.Autodoc.htmlFooter)]}}
3196000d	136	in
3196000d AC	137	PrHTML.prHTML {putc = (fn ch => TextIO.output1 (outf, ch)),
	138	puts = (fn s => TextIO.output (outf, s))} html;
	139	TextIO.closeOut outf
	140	end
	141
c2ce01bd AC	142	val title = "Domtool Module Index"
	143
	144	val items = map (fn file =>
	145	let
	146	val file' = modify file
6bb366c5	147	val (desc, _, _) = Parse.parse file
c2ce01bd AC	148	in
	149	LI {ty = NONE,
	150	value = NONE,
6bb366c5 AC	151	content = BlockList
	152	[TextBlock (A {name = NONE,
	153	href = SOME (file' ^ ".html"),
	154	rel = NONE,
	155	rev = NONE,
	156	title = NONE,
	157	content = PCDATA (uppercase file')}),
	158	TextBlock (PCDATA (Option.getOpt (desc, "")))]}
c2ce01bd AC	159	end) infiles
	160
	161	val index = HTML {version = NONE,
7d5aaf7b AC	162	head = [Head_TITLE title,
	163	Head_LINK {id = NONE,
	164	href = SOME Config.Autodoc.stylesheet,
	165	rel = SOME "stylesheet",
	166	rev = NONE,
	167	title = NONE}],
c2ce01bd AC	168	body = BODY {background = NONE,
	169	bgcolor = NONE,
	170	text = NONE,
	171	link = NONE,
	172	vlink = NONE,
	173	alink = NONE,
7d5aaf7b AC	174	content = BlockList[TextBlock (PCDATA (Config.Autodoc.htmlHeader title)),
	175	TextBlock (BR {clear = SOME TextFlowCtl.all}),
	176	UL {ty = NONE,
	177	compact = false,
	178	content = items},
	179	TextBlock (PCDATA Config.Autodoc.htmlFooter)]}}
c2ce01bd	180
3196000d AC	181	val outf = TextIO.openOut (outdir ^ "/index.html")
3196000d AC	182	in
c2ce01bd AC	183	PrHTML.prHTML {putc = (fn ch => TextIO.output1 (outf, ch)),
c2ce01bd AC	184	puts = (fn s => TextIO.output (outf, s))} index;
3196000d AC	185	TextIO.closeOut outf;
	186
	187	app doFile infiles
	188	end
	189
ef18a741 AC	190	fun makeEmacsKeywords infiles =
	191	let
	192	val (_, infiles) = Order.order NONE infiles
	193	val G = foldl (fn (fname, G) => check' G fname) Env.empty infiles
	194
	195	fun annotate_decl d =
	196	case d of
	197	DVal (name, NONE, e) =>
	198	(case Env.lookupVal G name of
	199	NONE => d
	200	\| SOME t => DVal (name, SOME t, e))
	201	\| _ => d
	202
	203	fun doFile (file, acc) =
	204	let
	205	val (_, decls, _) = Parse.parse file
	206
	207	fun isAction evs (t, _) =
	208	case t of
	209	TAction (_, r1, r2) =>
	210	let
	211	fun enrich (r, evs) =
	212	StringMap.foldli (fn (ev, _, evs) =>
	213	StringSet.add (evs, ev))
	214	evs r
	215	in
	216	SOME (enrich (r2, enrich (r1, evs)))
	217	end
	218	\| TArrow (_, t) => isAction evs t
	219	\| TNested (_, t) => isAction evs t
	220	\| TUnif (_, ref (SOME t)) => isAction evs t
	221	\| _ => NONE
	222	in
	223	foldl (fn ((d, _, _), (types, contexts, actions, vals, evs)) =>
	224	case annotate_decl d of
	225	DExternType s => (s :: types, contexts, actions, vals, evs)
	226	\| DExternVal (s, t) =>
	227	(case isAction evs t of
	228	SOME evs => (types, contexts, s :: actions, vals, evs)
	229	\| NONE => (types, contexts, actions, s :: vals, evs))
	230	\| DVal (s, NONE, _) => (types, contexts, actions, s :: vals, evs)
	231	\| DVal (s, SOME t, _) =>
	232	(case isAction evs t of
	233	SOME evs => (types, contexts, s :: actions, vals, evs)
	234	\| NONE => (types, contexts, actions, s :: vals, evs))
c4d0eab9 CE	235	\| DEnv (s, _, _) =>
c4d0eab9 CE	236	(types, contexts, actions, vals, StringSet.add (evs, s))
ef18a741 AC	237	\| DContext s => (types, s :: contexts, actions, vals, evs))
	238	acc decls
	239	end
	240
	241	val (types, contexts, actions, vals, evs) =
	242	foldl doFile ([], [], [], [], StringSet.empty) infiles
	243
	244	fun printKind (ident, syms) =
	245	(print "(defconst domtool-";
	246	print ident;
	247	print "-regexp\n (domtool-syms-re";
	248	app (fn s => (print " \""; print s; print "\"")) syms;
	249	print ")\n \"A regexp that matches Domtool ";
	250	print ident;
	251	print " from the standard library.\")\n\n")
	252	in
	253	printKind ("types", types);
	254	printKind ("contexts", contexts);
	255	printKind ("actions", actions);
	256	printKind ("vals", vals);
03b14a21 AC	257	printKind ("env-vars", StringSet.listItems evs);
03b14a21 AC	258	print "(provide 'domtool-tables)\n"
ef18a741 AC	259	end
ef18a741 AC	260
3196000d	261	end