include "xhtml-strict.cd";; (* XHTML 1 Strict DTD *) include "xhtml-categ.cd";; (* Categories (Inline, ...) from this DTD *) type SitePage = [] | [];; type Site = [ SitePage* ];; 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 | Xtable | Paper | Slides | Link | <include-verbatim file=String>[] | InlineText )* ];; type InlineText = Char | <(`b|`i) {||}>[InlineText*] | <duce>[InlineText*] | Xa | Ximg | Xbr ;; 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 text (t : [InlineText*]) : Inlines = map t with <duce>x -> <b>[ <tt>(text x) ] | <b>x -> <b>(text x) | <i>x -> <i>(text x) | z -> z;; 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) '. ' !(text com) <div class="abstract">[ 'Abstract:' !(content ab) ] ] | <slides file=f>[ <title>tit aut::Author* <comment>com ] -> [ <a href=f>tit '. ' !(authors aut) '. ' !(text com) ] | <include-verbatim file=f>[] -> let code = load_file f in (* let code = transform code with | '\n' -> [ '\n' <br>[] ] | ' ' -> "\160" | c -> [c] in *) [ <div class="code">[ <pre>code ] ] | <link url=url; title=title>com -> [ <a href=url>title '. ' !(text com) ] | <ul>lis -> [ <ul>(map lis with <li>x -> <li>(content x)) ] | Xtable & x -> [ x ] | <p>x -> [ <p>(text x) ] | <ul>x -> [ <ul>(text x) ] | x -> text [ 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>(text banner) ] <div id="Sidelog">navig <div id="Content">(transform main with b -> main2html b) ] ];; type P = (String,<title>String);; let fun make_plan (l : [ P+ ]) : Page = <page>[ <title>"CDuce site" <banner>"CDuce site" <navig>[ <box>[ <a href="/">"Home" ] ] <main>[ <box title="Pages"; link="pages">[ <ul>(map l with (file,<title>t) -> <li>[<a href=file>t]) ] <meta>[ 'This page was automatically generated by a CDuce program.' ] ] ];; let fun do_page((Page,String) -> []) (page,outf) -> 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 fun do_file((String,String) -> P) (inf,outf) -> let _ = print [ 'Loading ' !inf '... ' ] in let page = match load_xml inf with | Page & p -> p | _ -> raise ("Invalid input document: " @ inf) in let _ = do_page (page,outf) in let tit = match [page]/<title>_ with [t] -> t in (outf, tit);; let site = let _ = print [ 'Loading site.xml ...\n' ] in match load_xml "site.xml" with | Site & <site>s -> let ts = map s with | <page input=inf; output=outf>_ -> do_file(inf,outf) | <external href=url; title=t>_ -> (url,<title>t) in let _ = print [ 'Create plan... ' ] in let plan = make_plan (ts @ [("plan.html", <title>"CDuce site")]) in do_page(plan,"plan.html") | _ -> raise "Invalid site.xml";;