[r2003-05-14 17:03:17 by cvscast] Some comments on site.cd

Original author: cvscast
Date: 2003-05-14 17:03:17+00:00

web/site.cd

 (* This CDuce script produces CDuce web site. *)
 
+(** Output types **)
 
 include "xhtml-strict.cd";;  (* XHTML 1 Strict DTD *)
 include "xhtml-categ.cd";;   (* Categories (Inline, ...) from this DTD *)
 
 
+(** Input types **)
+
+type Page =  <page name=String>[ <title>String <banner>[InlineText*] Item* ];;
+type External = <external {|href=String; title=String; name=String |}>[];;
+
+type Item = 
+   <box title=String; subtitle=?String; link=String>Content
+ | <meta>Content
+ | <left>Content
+ | Page
+ | External;;
+
+type Author = <author>String;;
+type Paper = 
+  <paper file=?String>[ 
+     <title>String Author+ <comment>[InlineText*] <abstract>Content ];;
+
+type Slides = 
+  <slides file=String>[ <title>String Author+ <comment>[InlineText*] ];;
+
+type Link =
+  <link url=String; title=String>[ InlineText* ];;
+
+type Content =      
+   [ ( <p {||}>[InlineText*]
+     | <ul {||}>[<li {||}>Content +]
+     | <section title=String>Content
+     | <sample>String
+     | Xtable
+     | Paper | Slides | Link
+     | <boxes-toc>[]
+     | <pages-toc>[]
+     | <site-toc>[]
+     | <local-links href=String>[]
+     | InlineText
+     )* ];;
+
+type InlineText =
+     Char
+   | <(`b|`i|`tt|`em) {||}>[InlineText*]
+   | <code>String
+   | <local href=String>[]
+   | Xa | Ximg | Xbr ;;
+
+
+(** Generic purpose functions **)
+
+(* Recursive inclusion of XML files and verbatim text files *)
+
 let fun load_include (String -> [Any*])
  name ->
    let _ = print [ 'Loading ' !name '... \n' ] in
@@ -12,6 +62,7 @@ let fun load_include (String -> [Any*])
    | <include file=(s & String)>[] -> load_include s
    | <include-verbatim file=(s & String)>[] -> load_file s;; 
 
+(* Highlighting text between {{...}} *)
 
 let fun highlight (String -> [ (Char | Xvar)* ] )
  | [ '{{' h ::(Char *?) '}}' ; rest ] -> 
@@ -19,15 +70,17 @@ let fun highlight (String -> [ (Char | Xvar)* ] )
  | [ c; rest ] -> [ c; highlight rest ]
  | [] -> [];;
 
+(* Split a comma-separated string *)
+
 let fun split_comma (String -> [String*])
  | [ x::(Char*?) ',' ; rest ] -> (x, split_comma rest)
  | s -> [ s ];;
 
 
-(* Ugly hack to introduce PHP code ...
-   The idea is to produce first an XML document with a distinguished element.
-   The function patch_css search for the textual representation of this
-   element and replace it with the PHP code. *)
+(** Ugly hack to introduce PHP code ...
+    The idea is to produce first an XML document with a distinguished element.
+    The function patch_css search for the textual representation of this
+    element and replace it with the PHP code. **)
 
 let php_css : String =
 [' <?php
@@ -55,61 +108,7 @@ let fun patch_css (String -> String)
 
 
 
-
-
-type Page = 
-  <page name=String>[
-    <title>String
-    <banner>[InlineText*]
-    Item*
-  ];;
-
-type External = <external {|href=String; title=String; name=String |}>[];;
-
-type Item = 
-   <box title=String; subtitle=?String; link=String>Content
- | <meta>Content
- | <left>Content
- | Page
- | External;;
-
-type Author = <author>String;;
-type Paper = 
-  <paper file=?String>[ 
-    <title>String 
-    Author+ 
-    <comment>[InlineText*] 
-    <abstract>Content ];;
-
-type Slides = 
-  <slides file=String>[ 
-   <title>String 
-   Author+ 
-   <comment>[InlineText*] ];;
-
-type Link =
-  <link url=String; title=String>[ InlineText* ];;
-
-type Content =      
-   [ ( <p {||}>[InlineText*]
-     | <ul {||}>[<li {||}>Content +]
-     | <section title=String>Content
-     | <sample>String
-     | Xtable
-     | Paper | Slides | Link
-     | <boxes-toc>[]
-     | <pages-toc>[]
-     | <site-toc>[]
-     | <local-links href=String>[]
-     | InlineText
-     )* ];;
-
-type InlineText =
-     Char
-   | <(`b|`i|`tt|`em) {||}>[InlineText*]
-   | <code>String
-   | <local href=String>[]
-   | Xa | Ximg | Xbr ;;
+(** Internal types **)
 
 type Path = [ { url = String; title = String }* ];;
 type Tree = { name = String; url = String; title = String; 
@@ -133,7 +132,6 @@ let fun local_link (sitemap : Tree, l : String) : Inline =
  try find_local_link ([sitemap],l) 
  with `Not_found -> raise [ 'Local link not found: ' !l ];;
  
-
 let fun compute_sitemap ((Page|External) -> Tree)
  <page name=name>[ <title>title (c::(Page|External) | _)* ] ->
    let children = map c with p -> compute_sitemap p in
@@ -146,6 +144,8 @@ let fun display_sitemap (h : Tree) :  Xli =
   let ch = match ch with [] -> [] | l -> [ <ul>l ] in
   <li>[ <a href=(h . url)>(h . title); ch ];;
 
+(* Main transformation function *)
+
 let fun gen_page (page : Page, path : Path, sitemap : Tree) : [] = 
 match page with
 <page name=name>[ <title>title <banner>banner ; items ] ->
@@ -234,17 +234,14 @@ match page with
      '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
      '  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
      !(patch_css (print_xml html)) ] in
- let _ = print [ 'Generating page ' !name '...\n' ] in
- let filename = name @ ".php" in
- let _ = dump_to_file filename txt in
+ let [] = dump_to_file (name @ ".php") txt in
  let path = path @ [ { url = name; title = title } ] in
  transform items with p & Page -> gen_page (p,path,sitemap);;
     
 
+(* Entry point *)
 
 match load_include "site.xml" with
- | [ Page & p ] ->
-     let sitemap = compute_sitemap p in
-     gen_page (p,[],sitemap)
+ | [ Page & p ] -> gen_page (p,[], compute_sitemap p)
  | _ -> raise "Invalid site.xml";;