Basic HTML documentation generation

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

diff --git a/src/autodoc.sml b/src/autodoc.sml
new file mode 100644 (file)
index 0000000..fae4495
--- /dev/null
+++ b/src/autodoc.sml
@@ -0,0 +1,148 @@
+(* 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 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 :: 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
+               (*TextIO.output (outf, Config.Autodoc.htmlHeader ("Domtool Module " ^ uppercase file'));
+               Option.app (fn desc => (TextIO.output (outf, desc);
+                                       TextIO.output (outf, "\n"))) desc;
+
+               app doDecl decls;
+
+               TextIO.output (outf, Config.Autodoc.htmlFooter);*)
+               PrHTML.prHTML {putc = (fn ch => TextIO.output1 (outf, ch)),
+                              puts = (fn s => TextIO.output (outf, s))} html;
+               TextIO.closeOut outf
+           end
+
+       val outf = TextIO.openOut (outdir ^ "/index.html")
+    in
+       TextIO.output (outf, Config.Autodoc.htmlHeader "Domtool Module Index");
+
+       app (fn file =>
+               let
+                   val file' = modify file
+               in
+                   TextIO.output (outf, "<li> <a href=\"");
+                   TextIO.output (outf, file');
+                   TextIO.output (outf, ".html\">");
+                   TextIO.output (outf, uppercase file');
+                   TextIO.output (outf, "</a></li>\n")
+               end) infiles;
+                        
+       TextIO.output (outf, Config.Autodoc.htmlFooter);
+       TextIO.closeOut outf;
+
+       app doFile infiles
+    end
+
+end