viewcvs.cgi/web/macros.cd

type XML_elem = <(_)>XML;;
type XML = [ (XML_elem | Char)* ];;

let fun banner (title : Any, subtitle : Any) : XML =
[<div class="title">[
  !(match title with t & XML \ [] -> [<h1>t] | _ -> [])
  !(match subtitle with t & XML \ [] -> [<h3>t] | _ -> [])
]];;


let fun box (title : Any, subtitle : Any, name : Any, content : XML) : XML =
[<div class="box">[
  !(match name with String \ [] -> [<a name=name>[]] | _ -> [])
  !(match title with t & XML \ [] -> [<h2>t] | _ -> [])
  !(match subtitle with t & XML \ [] -> [<h3>t] | _ -> [])
  !content
]];;

let fun convert (XML_elem | Char | XML -> XML)
 | <box ({ title=t } 
         & ({ subtitle=st } | (st := `nil))
         & ({ link=name } | (name := `nil)) )>x -> 
      box (t,st,name,convert x) 
 | <banner ({ title=t } & ({ subtitle=st } | (st := `nil)))>x -> 
      banner (t,st) 
 | <(tag) (attr)>x -> [<(tag) (attr)>(convert x)]
 | c & Char -> [c]
 | seq -> transform seq with x -> convert x;;


let src =
  match [ (load_xml "index.xml") ] with
  | XML & x -> x
  | _ -> raise ("Invalid input ...");;

let conv : XML = convert src;;

let out : 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">' ]
  @
  (transform convert src with x -> print_xml x);;

dump_to_file "index.html" out;;

1	type XML_elem = <(_)>XML;;
2	type XML = [ (XML_elem \| Char)* ];;
3
4	let fun banner (title : Any, subtitle : Any) : XML =
5	[<div class="title">[
6	!(match title with t & XML \ [] -> [<h1>t] \| _ -> [])
7	!(match subtitle with t & XML \ [] -> [<h3>t] \| _ -> [])
8	]];;
9
10
11	let fun box (title : Any, subtitle : Any, name : Any, content : XML) : XML =
12	[<div class="box">[
13	!(match name with String \ [] -> [<a name=name>[]] \| _ -> [])
14	!(match title with t & XML \ [] -> [<h2>t] \| _ -> [])
15	!(match subtitle with t & XML \ [] -> [<h3>t] \| _ -> [])
16	!content
17	]];;
18
19	let fun convert (XML_elem \| Char \| XML -> XML)
20	\| <box ({ title=t }
21	& ({ subtitle=st } \| (st := `nil))
22	& ({ link=name } \| (name := `nil)) )>x ->
23	box (t,st,name,convert x)
24	\| <banner ({ title=t } & ({ subtitle=st } \| (st := `nil)))>x ->
25	banner (t,st)
26	\| <(tag) (attr)>x -> [<(tag) (attr)>(convert x)]
27	\| c & Char -> [c]
28	\| seq -> transform seq with x -> convert x;;
29
30
31	let src =
32	match [ (load_xml "index.xml") ] with
33	\| XML & x -> x
34	\| _ -> raise ("Invalid input ...");;
35
36	let conv : XML = convert src;;
37
38	let out : String =
39	[ '<?xml version="1.0" encoding="iso-8859-1"?>
40	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
41	"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">' ]
42	@
43	(transform convert src with x -> print_xml x);;
44
45	dump_to_file "index.html" out;;
46