[ out ] -> print_utf8 "After matching in entry\n";
let [] =
match (out :? Any) with
(* [Any*] -> print_utf8 ("!!!1 " @ (string_of out)) *)
| output -> print_utf8 ("!!!2 " @ (string_of out))
| _ -> []
in
(*let _ = u in*) (* check this bug in CDuce ! *)
[ '\n'[ '\n' !dec (output_to_html out dec (level)) '\n' ] '\n' ]
;;
let mk_page ((o & [ws* t _*]) : output) (style : String) : xhtml:html =
xhtml:create [t
[]
[]
]
[ (output_to_html o "" 1) ]
;;
let first_program_id (doc : AnyXml) : String =
match [doc] // _ with
[ <_ ..>[ _* _ _* ] _*] -> id
| _ -> raise "Invalid ROF document"
;;
let todo_ids = ref ([(Latin1, output)*]) []
let push (x : (Latin1,output)) : [] =
todo_ids := (x, !todo_ids)
;;
let name_from_descr (l : String) (suff : String): Latin1 =
let l =
match l with
[ ws* (x::Char)*? ws* ] -> x
in
let l =
transform l @ "_" @ suff with
' ' -> [ '_' ]
| x & ('A'--'Z' | 'a'--'z' | '0'--'9') -> [x]
in
l
;;
let find_by_id (l : [ ('a & <_ id=String ..>_)* ]) (id : String) : ('a & <_ id=String ..>_) =
match l with
[] -> raise "Not found"
| ((<_ id=x ..>_ & y), rest) -> if x = id then y else find_by_id rest id
;;
let getContentById (doc : AnyXml) (id : String) : (Latin1,output) =
let program =
match doc with
[ (l::<(`ns3:program|`ns3:course) id=String ..>_ | _)* ] -> find_by_id l id
| _ -> raise "Invalid ROF document"
in
match program with
([ _* [ _* (String&t) _*]
_* (l | (l:=[]))
_* ] & (course:=`false))
| ([ _* (String&t) _* ] & (l:= []) & (course:=`true))
->
(name_from_descr t id, [ '\n'
t '\n'
!(transform l with
<(`ns3:refCourse
|`ns3:refProgram) ref=(String&r) >_ ->
print_utf8 ("Looking for id: " @ r @"\n");
let (sonref,son) = getContentById doc r in
let descr = match son with [ _* tt _*] -> tt in
push (sonref,son);
[[ son ] '\n'])
])
| _ -> raise ("Invalid ROF document (id: " @ id @ ")")
;;
let main (_ :[]) : [] =
match argv [] with
[ (file & Latin1) ((outdir & Latin1) ) _* ] ->
(let doc = load_xml file in
let id = first_program_id doc in
let (file,out) = getContentById doc id in
let out = match out with
[ (x::ws)* t ; l ] ->
[ !x t !(quicksort cmp_entry (transform l with _ -> [[]])) ]
in
let [] =
let h = mk_page out "style_parcours_main.css" in
xhtml:serialize h `xhtml (outdir @ "/" @ file @".xhtml")
in
transform !todo_ids with
(file,out) ->
let h = mk_page out "style_parcours.css" in
xhtml:serialize h `xhtml (outdir @ "/" @ file @".xhtml")
)
| _ -> raise "Invalid command line arguments"
;;
let [] = main []