From: Adam Chlipala Date: Mon, 4 Sep 2006 00:31:55 +0000 (+0000) Subject: Basic HTML documentation generation X-Git-Tag: release_2010-11-19~348 X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/commitdiff_plain/3196000d8e29e14665f43ffd74460b2e6d592250?hp=36e42cb86393a7b9e333ecd7edfbdd16c7d9a1ac;ds=sidebyside Basic HTML documentation generation --- diff --git a/configDefault/autodoc.cfg b/configDefault/autodoc.cfg new file mode 100644 index 0000000..b80bf5d --- /dev/null +++ b/configDefault/autodoc.cfg @@ -0,0 +1,12 @@ +structure Autodoc :> AUTODOC_CONFIG = struct + +val htmlHeader = fn title => + String.concat ["", + title, + "

", + title, + "

\n"] + +val htmlFooter = "" + +end diff --git a/configDefault/autodoc.cfs b/configDefault/autodoc.cfs new file mode 100644 index 0000000..8b2c37d --- /dev/null +++ b/configDefault/autodoc.cfs @@ -0,0 +1,2 @@ +structure Autodoc : AUTODOC_CONFIG + diff --git a/configDefault/autodoc.csg b/configDefault/autodoc.csg new file mode 100644 index 0000000..023a749 --- /dev/null +++ b/configDefault/autodoc.csg @@ -0,0 +1,6 @@ +signature AUTODOC_CONFIG = sig + +val htmlHeader : string -> string +val htmlFooter : string + +end diff --git a/doc/lib/.cvsignore b/doc/lib/.cvsignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/doc/lib/.cvsignore @@ -0,0 +1 @@ +*.html diff --git a/lib/apache.dtl b/lib/apache.dtl index 9e70f74..9b88bd3 100644 --- a/lib/apache.dtl +++ b/lib/apache.dtl @@ -21,7 +21,7 @@ context Location; extern type location; {{A valid URI prefix}} -extern val location : location -> ^Vhost & Location => [Vhost & !Location]; +extern val location : location -> Vhost & Location => [Vhost & !Location]; extern val directory : your_path -> ^Vhost & Location => [Vhost & !Location]; {{Set some configuration specific to a URI prefix or filesystem directory, respectively.}} diff --git a/src/autodoc.sig b/src/autodoc.sig new file mode 100644 index 0000000..8f52802 --- /dev/null +++ b/src/autodoc.sig @@ -0,0 +1,25 @@ +(* 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 *) + +signature AUTODOC = sig + + val autodoc : {outdir : string, infiles : string list} -> unit + +end diff --git a/src/autodoc.sml b/src/autodoc.sml new file mode 100644 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, "

"); + TextIO.output (outf, desc); + TextIO.output (outf, "

\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, "

"); + TextIO.output (outf, uppercase file'); + TextIO.output (outf, "

\n") + end) infiles; + + TextIO.output (outf, Config.Autodoc.htmlFooter); + TextIO.closeOut outf; + + app doFile infiles + end + +end diff --git a/src/domtool.cm b/src/domtool.cm index d10f96d..f23f86d 100644 --- a/src/domtool.cm +++ b/src/domtool.cm @@ -3,6 +3,7 @@ Group is $/basis.cm $/smlnj-lib.cm $/ml-yacc-lib.cm +$/html-lib.cm $/pp-lib.cm $c/internals/c-int.cm @@ -84,5 +85,11 @@ order.sml openssl.sig openssl.sml +htmlPrint.sig +htmlPrint.sml + +autodoc.sig +autodoc.sml + main.sig main.sml diff --git a/src/htmlPrint.sig b/src/htmlPrint.sig new file mode 100644 index 0000000..7b0297b --- /dev/null +++ b/src/htmlPrint.sig @@ -0,0 +1,34 @@ +(* 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. + *) + +(* Pretty-printing Domtool configuration file ASTs for HTML *) + +signature HTML_PRINT = sig + +val setProviders : Order.providers -> unit + +structure PD : PP_DESC + +val p_pred : Ast.pred -> PD.pp_desc +val p_typ : Ast.typ -> PD.pp_desc +val p_exp : Ast.exp -> PD.pp_desc +val p_decl : Ast.decl' -> PD.pp_desc + +val output : PD.pp_desc -> HTML.text + +end diff --git a/src/htmlPrint.sml b/src/htmlPrint.sml new file mode 100644 index 0000000..d607d46 --- /dev/null +++ b/src/htmlPrint.sml @@ -0,0 +1,195 @@ +(* 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. + *) + +(* Pretty-printing Domtool configuration file ASTs for HTML *) + +structure HtmlPrint :> HTML_PRINT = struct + +open Ast Order + +val prov : providers option ref = ref NONE +fun setProviders p = prov := SOME p + +structure TextToken = struct +type token = string +type style = HTMLDev.style +fun string t = t +fun style t = HTMLDev.styleTT +fun size t = String.size t +end + +structure SM = PPStreamFn(structure Token = TextToken + structure Device = HTMLDev) + +structure PD = PPDescFn(SM) +open PD + +fun dBox ds = hovBox (PPS.Rel 1, ds) +fun dvBox ds = vBox (PPS.Rel 0, ds) +fun ivBox ds = vBox (PPS.Rel 1, ds) + +fun keyword s = style (HTMLDev.styleB, [string s]) +val punct = string + +fun modify file = + let + val file' = #file (OS.Path.splitDirFile file) + val file' = #base (OS.Path.splitBaseExt file') + in + file' + end + +fun context s = + case providesContext (valOf (!prov), s) of + NONE => string s + | SOME m => style (HTMLDev.link (modify m ^ ".html#C_" ^ s), [string s]) +fun typ s = + case providesType (valOf (!prov), s) of + NONE => string s + | SOME m => style (HTMLDev.link (modify m ^ ".html#T_" ^ s), [string s]) +fun exp s = + case providesValue (valOf (!prov), s) of + NONE => string s + | SOME m => style (HTMLDev.link (modify m ^ ".html#V_" ^ s), [string s]) + +val field = string +val lit = string +val ident = string + +fun parenIf pn ds = + if pn then + dBox (punct "(" :: ds @ [punct ")"]) + else + dBox ds + +fun p_pred' pn (p, _) = + case p of + CRoot => keyword "Root" + | CConst s => context s + | CPrefix p => dBox [punct "^", p_pred' true p] + | CNot p => dBox [punct "!", p_pred' true p] + | CAnd (p1, p2) => + parenIf pn [p_pred' true p1, space 1, punct "&", space 1, p_pred' true p2] + +val p_pred = p_pred' false + +fun p_predBoxed p = dBox [punct "[", p_pred p, punct "]"] + +fun p_typ' pn (t, _) = + case t of + TBase s => typ s + | TList t => dBox [punct "[", p_typ' false t, punct "]"] + | TArrow (t1, t2) => + parenIf pn [p_typ' true t1, space 1, punct "->", space 1, p_typ' true t2] + | TAction (p, r1, r2) => + parenIf pn [p_predBoxed p, space 1, p_record r1, space 1, + punct "=>", space 1, p_record r2] + | TNested (p, t) => + parenIf pn [p_pred' false p, space 1, punct "=>", space 1, p_typ' false t] + + | TError => keyword "" + | TUnif (_, ref (SOME t)) => p_typ' pn t + | TUnif (name, ref NONE) => string ("<" ^ name ^ ">") + +and p_record r = + case StringMap.foldri (fn (name, t, d) => + SOME (case d of + NONE => dBox [field name, space 1, + punct ":", space 1, p_typ t] + | SOME d => dBox [dBox [field name, space 1, + punct ":", space 1, p_typ t], + punct ",", space 1, d])) + NONE r of + NONE => punct "{}" + | SOME d => dBox [punct "{", d, punct "}"] + +and p_typ t = p_typ' false t + +fun p_exp (e, _) = + case e of + EInt n => lit (Int.toString n) + | EString s => lit (String.concat ["\"", String.toString s, "\""]) + | EList es => + (case foldr (fn (e, d) => + SOME (case d of + NONE => p_exp e + | SOME d => dBox [p_exp e, punct ",", space 1, d])) + NONE es of + NONE => punct "[]" + | SOME d => dBox [punct "[", d, punct "]"]) + + | ELam (x, NONE, e) => dBox [punct "(\\", space 1, exp x, space 1, + punct "->", space 1, p_exp e, punct ")"] + | ELam (x, SOME t, e) => dBox [punct "(\\", space 1, exp x, space 1, + punct ":", space 1, + dBox [punct "(", p_typ t, punct ")"], + space 1, punct "->", space 1, p_exp e, punct ")"] + + | EVar x => exp x + | EApp (e1, e2) => dBox [punct "(", p_exp e1, break {nsp = 1, offset = 0}, p_exp e2, punct ")"] + + | ESkip => keyword "_" + | ESet (x, e) => dBox [exp x, space 1, punct "=", space 1, p_exp e] + | EGet (x1, x2, e) => dBox [dBox [exp x1, space 1, punct "<-", + space 1, exp x2, punct ";", space 1], + p_exp e] + | ESeq es => dBox (valOf (foldr (fn (e, NONE) => SOME [p_exp e] + | (e, SOME ds) => SOME (dBox [p_exp e, punct ";", newline] :: ds)) + NONE es)) + | ELocal (e1, e2) => dBox [keyword "let", space 1, + p_exp e1, space 1, + keyword "in", space 1, + p_exp e2, space 1, + keyword "end"] + | EWith (e1, (ESkip, _)) => dBox [p_exp e1, space 1, keyword "with", space 1, keyword "end"] + | EWith (e1, e2) => dBox [p_exp e1, space 1, keyword "with", p_exp e2, space 1, keyword "end"] + +fun p_decl d = + case d of + DExternType name => style (HTMLDev.anchor ("T_" ^ name), + [dBox [keyword "extern", space 1, + keyword "type", space 1, + ident name]]) + | DExternVal (name, t) => style (HTMLDev.anchor ("V_" ^ name), + [dBox [keyword "extern", space 1, + keyword "val", space 1, + ident name, space 1, + string ":", space 1, + p_typ t]]) + | DVal (name, NONE, _) => string "Unannotated val declaration!" + | DVal (name, SOME t, _) => style (HTMLDev.anchor ("V_" ^ name), + [dBox [keyword "val", space 1, + ident name, space 1, + punct ":", space 1, + p_typ t]]) + | DContext name => style (HTMLDev.anchor ("C_" ^ name), + [dBox [keyword "context", space 1, + ident name]]) + +fun output d = + let + val dev = HTMLDev.openDev {wid = 80, + textWid = NONE} + val myStream = SM.openStream dev + in + description (myStream, d); + SM.flushStream myStream; + HTMLDev.done dev + end + +end diff --git a/src/main.sig b/src/main.sig index 69abb82..d4467eb 100644 --- a/src/main.sig +++ b/src/main.sig @@ -34,4 +34,6 @@ signature MAIN = sig val service : unit -> unit val slave : unit -> unit + val autodocBasis : string -> unit + end diff --git a/src/main.sml b/src/main.sml index 734b10a..87a1b73 100644 --- a/src/main.sml +++ b/src/main.sml @@ -53,7 +53,7 @@ fun basis () = loop files val files = loop [] - val files = Order.order files + val (_, files) = Order.order files in if !ErrorMsg.anyErrors then Env.empty @@ -277,10 +277,35 @@ fun slave () = OpenSSL.close bio; loop () end - end + end handle OpenSSL.OpenSSL s => + (print ("OpenSSL error: "^ s ^ "\n"); + OpenSSL.close bio + handle OpenSSL.OpenSSL _ => (); + loop ()) in loop (); OpenSSL.shutdown sock end +fun autodocBasis outdir = + let + val dir = Posix.FileSys.opendir Config.libRoot + + fun loop files = + case Posix.FileSys.readdir dir of + NONE => (Posix.FileSys.closedir dir; + files) + | SOME fname => + if String.isSuffix ".dtl" fname then + loop (OS.Path.joinDirFile {dir = Config.libRoot, + file = fname} + :: files) + else + loop files + + val files = loop [] + in + Autodoc.autodoc {outdir = outdir, infiles = files} + end + end diff --git a/src/order.sig b/src/order.sig index 10621dd..f33941a 100644 --- a/src/order.sig +++ b/src/order.sig @@ -20,6 +20,13 @@ signature ORDER = sig - val order : string list -> string list + type providers + (* Information on which files define which symbols *) + val providesContext : providers * string -> string option + val providesType : providers * string -> string option + val providesValue : providers * string -> string option + (* Look up which file defines a symbol *) + + val order : string list -> providers * string list end diff --git a/src/order.sml b/src/order.sml index 47ee1bc..cf1dee1 100644 --- a/src/order.sml +++ b/src/order.sml @@ -169,19 +169,6 @@ fun mergeProvide kind fname (m1, m2) = fun order fnames = let - fun doFile fname = - let - val file = Parse.parse fname - val (provide, require) = fileSig file - in - print "\nFile "; - print fname; - print "\nPROVIDE:\n"; - printSig provide; - print "\nREQUIRE:\n"; - printSig require - end - fun doFile (fname, (provideC, provideT, provideV, require)) = let val file = Parse.parse fname @@ -271,7 +258,18 @@ fun order fnames = SS.app (fn fname' => (print " "; print fname')) requires; print "\n")) require;*) - loop (ready, waiting, []) + ({provideC = provideC, + provideT = provideT, + provideV = provideV}, + loop (ready, waiting, [])) end +type providers = {provideC : string SM.map, + provideT : string SM.map, + provideV : string SM.map} + +fun providesContext (p : providers, s) = SM.find (#provideC p, s) +fun providesType (p : providers, s) = SM.find (#provideT p, s) +fun providesValue (p : providers, s) = SM.find (#provideV p, s) + end