String <banner>[InlineText*] <navig>[ NavigBox* ] <main>[ Box* ] ];; 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 | Paper | Slides | Link | InlineText )* ];; type InlineText = Char | <(`b|`i) {||}>[InlineText*] | Xa | Ximg ;; type Box = <box title=String; subtitle=?String; link=String>Content | <meta>Content;; type NavigBox = <box>Content | <toc>[];; let fun authors ([Author+] -> String) | [ <author>a ] -> a | [ <author>a1 <author>a2 ] -> a1 @ ", and " @ a2 | [ <author>a; rem ] -> a @ ", " @ authors rem;; let fun content (t : Content) : Flow = transform t with | <section title=title>c -> [ <h4>title !(content c) ] | <paper (r)>[ <title>tit aut::Author* <comment>com <abstract>ab ] -> [ (match r with | { file = f } -> <a href=f>tit | _ -> <b>tit ) '. ' !(authors aut) '. ' !com <div class="abstract">[ 'Abstract:' !(content ab) ] ] | <slides file=f>[ <title>tit aut::Author* <comment>com ] -> [ <a href=f>tit '. ' !(authors aut) '. ' !com ] | <link url=url; title=title>com -> [ <a href=url>title '. ' !com ] | <ul>lis -> [ <ul>(map lis with <li>x -> <li>(content x)) ] | x -> [ x ];; let fun main2html (Box -> Flow) <box (r)>c -> [ <div class="box">[ <h2>(r.title) !(match r with { subtitle = t } -> [<b>t] | _ -> []) <a name=r.link>[] !(content c) ] ] | <meta>c -> [ <div class="meta">(content c) ];; let fun page2html (Page -> Xhtml) <page>[ <title>title <banner>banner <navig>navig <main>main ] -> let toc = transform main with <box title=t; link=l>_ -> [ <li>[ <a href=('#',l)>t ] ] in let toc = match toc with [] -> [] | lis -> [ <ul>lis ] in let navig : Flow = transform navig with | <box>c -> [ <div class="box">(content c) ] | <toc>[] -> [ <div class="box">toc ] in <html>[ <head>[ <title>title <meta content="text/html; charset=iso-8859-1"; http-equiv="Content-Type">[] <link rel="stylesheet"; href="cduce.css"; type="text/css"> [] ] <body>[ <div class="title">[ <h1>banner ] <div id="Sidelog">navig <div id="Content">(transform main with b -> main2html b) ] ];; let fun do_page((String,String) -> []) (inf,outf) -> let _ = print [ 'Loading ' !inf '... ' ] in let page = match load_xml inf with | Page & p -> p | _ -> raise ("Invalid input document" @ inf) in let _ = print [ 'Generating html ... ' ] in let html : String = [ '<?xml version="1.0" encoding="iso-8859-1"?>' '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"' ' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">' !(print_xml (page2html page)) ] in let _ = print [ 'Saving to ' !outf '...\n' ] in dump_to_file outf html;; let site = let _ = print [ 'Loading site.xml ...\n' ] in match load_xml "site.xml" with | Site & <site>s -> (transform s with <page input=inf; output=outf>[] -> do_page(inf,outf))

include "xhtml-strict.cd";; include "xhtml-categ.cd";; type Site = [ []* ];; type Page = [ String <banner>[InlineText*] <navig>[ NavigBox* ] <main>[ Box* ] ];; 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 | Paper | Slides | Link | InlineText )* ];; type InlineText = Char | <(`b|`i) {||}>[InlineText*] | Xa | Ximg ;; type Box = <box title=String; subtitle=?String; link=String>Content | <meta>Content;; type NavigBox = <box>Content | <toc>[];; let fun authors ([Author+] -> String) | [ <author>a ] -> a | [ <author>a1 <author>a2 ] -> a1 @ ", and " @ a2 | [ <author>a; rem ] -> a @ ", " @ authors rem;; let fun content (t : Content) : Flow = transform t with | <section title=title>c -> [ <h4>title !(content c) ] | <paper (r)>[ <title>tit aut::Author* <comment>com <abstract>ab ] -> [ (match r with | { file = f } -> <a href=f>tit | _ -> <b>tit ) '. ' !(authors aut) '. ' !com <div class="abstract">[ 'Abstract:' !(content ab) ] ] | <slides file=f>[ <title>tit aut::Author* <comment>com ] -> [ <a href=f>tit '. ' !(authors aut) '. ' !com ] | <link url=url; title=title>com -> [ <a href=url>title '. ' !com ] | <ul>lis -> [ <ul>(map lis with <li>x -> <li>(content x)) ] | x -> [ x ];; let fun main2html (Box -> Flow) <box (r)>c -> [ <div class="box">[ <h2>(r.title) !(match r with { subtitle = t } -> [<b>t] | _ -> []) <a name=r.link>[] !(content c) ] ] | <meta>c -> [ <div class="meta">(content c) ];; let fun page2html (Page -> Xhtml) <page>[ <title>title <banner>banner <navig>navig <main>main ] -> let toc = transform main with <box title=t; link=l>_ -> [ <li>[ <a href=('#',l)>t ] ] in let toc = match toc with [] -> [] | lis -> [ <ul>lis ] in let navig : Flow = transform navig with | <box>c -> [ <div class="box">(content c) ] | <toc>[] -> [ <div class="box">toc ] in <html>[ <head>[ <title>title <meta content="text/html; charset=iso-8859-1"; http-equiv="Content-Type">[] <link rel="stylesheet"; href="cduce.css"; type="text/css"> [] ] <body>[ <div class="title">[ <h1>banner ] <div id="Sidelog">navig <div id="Content">(transform main with b -> main2html b) ] ];; let fun do_page((String,String) -> []) (inf,outf) -> let _ = print [ 'Loading ' !inf '... ' ] in let page = match load_xml inf with | Page & p -> p | _ -> raise ("Invalid input document" @ inf) in let _ = print [ 'Generating html ... ' ] in let html : String = [ '<?xml version="1.0" encoding="iso-8859-1"?>' '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"' ' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">' !(print_xml (page2html page)) ] in let _ = print [ 'Saving to ' !outf '...\n' ] in dump_to_file outf html;; let site = let _ = print [ 'Loading site.xml ...\n' ] in match load_xml "site.xml" with | Site & <site>s -> (transform s with <page input=inf; output=outf>[] -> do_page(inf,outf)) | _ -> raise "Invalid site.xml";;