fae44955db44d889bd0902bbc67a7ff5222675aa
[hcoop/domtool2.git] / src / autodoc.sml
1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006, Adam Chlipala
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
39 Tycheck.checkFile G (Defaults.tInit ()) prog
40 end
41
42 fun autodoc {outdir, infiles} =
43 let
44 val (prov, infiles) = Order.order infiles
45 val _ = HtmlPrint.setProviders prov
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
80 val body = Hn {n = 1,
81 align = NONE,
82 content = PCDATA title}
83
84 val body = case desc of
85 NONE => body
86 | SOME desc => BlockList [body,
87 P {align = NONE,
88 content = PCDATA desc}]
89
90 val entries = map (fn (d, desc, _) =>
91 let
92 val cblock = HtmlPrint.output (p_decl (annotate_decl d))
93
94 val dblock = case desc of
95 NONE => TextBlock (PCDATA "")
96 | SOME desc => BLOCKQUOTE (TextBlock (PCDATA desc))
97 in
98 BlockList [P {align = NONE,
99 content = TT cblock},
100 dblock]
101 end) decls
102
103 val body = BlockList (body :: entries)
104
105 val html = HTML {version = NONE,
106 head = [Head_TITLE title],
107 body = BODY {background = NONE,
108 bgcolor = NONE,
109 text = NONE,
110 link = NONE,
111 vlink = NONE,
112 alink = NONE,
113 content = body}}
114 in
115 (*TextIO.output (outf, Config.Autodoc.htmlHeader ("Domtool Module " ^ uppercase file'));
116 Option.app (fn desc => (TextIO.output (outf, desc);
117 TextIO.output (outf, "\n"))) desc;
118
119 app doDecl decls;
120
121 TextIO.output (outf, Config.Autodoc.htmlFooter);*)
122 PrHTML.prHTML {putc = (fn ch => TextIO.output1 (outf, ch)),
123 puts = (fn s => TextIO.output (outf, s))} html;
124 TextIO.closeOut outf
125 end
126
127 val outf = TextIO.openOut (outdir ^ "/index.html")
128 in
129 TextIO.output (outf, Config.Autodoc.htmlHeader "Domtool Module Index");
130
131 app (fn file =>
132 let
133 val file' = modify file
134 in
135 TextIO.output (outf, "<li> <a href=\"");
136 TextIO.output (outf, file');
137 TextIO.output (outf, ".html\">");
138 TextIO.output (outf, uppercase file');
139 TextIO.output (outf, "</a></li>\n")
140 end) infiles;
141
142 TextIO.output (outf, Config.Autodoc.htmlFooter);
143 TextIO.closeOut outf;
144
145 app doFile infiles
146 end
147
148 end