helm/ocaml/hbugs/scripts/build_tutors.ml

   1 #!/usr/bin/ocamlrun /usr/bin/ocaml
   2 (*
   3  * Copyright (C) 2003-2004:
   4  *    Stefano Zacchiroli <zack@cs.unibo.it>
   5  *    for the HELM Team http://helm.cs.unibo.it/
   6  *
   7  *  This file is part of HELM, an Hypertextual, Electronic
   8  *  Library of Mathematics, developed at the Computer Science
   9  *  Department, University of Bologna, Italy.
  10  *
  11  *  HELM is free software; you can redistribute it and/or
  12  *  modify it under the terms of the GNU General Public License
  13  *  as published by the Free Software Foundation; either version 2
  14  *  of the License, or (at your option) any later version.
  15  *
  16  *  HELM is distributed in the hope that it will be useful,
  17  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  18  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19  *  GNU General Public License for more details.
  20  *
  21  *  You should have received a copy of the GNU General Public License
  22  *  along with HELM; if not, write to the Free Software
  23  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  24  *  MA  02111-1307, USA.
  25  *
  26  *  For details, see the HELM World-Wide-Web page,
  27  *  http://helm.cs.unibo.it/
  28  *)
  29 #use "topfind"
  30 #require "pcre"
  31 #require "pxp"
  32 open Printf
  33 open Pxp_document
  34 open Pxp_dtd
  35 open Pxp_types
  36 open Pxp_yacc
  37
  38 let index = "data/tutors_index.xml"
  39 let template = "data/hbugs_tutor.TPL.ml"
  40
  41   (* apply a set of regexp substitutions specified as a list of pairs
  42   <pattern,template> to a string *)
  43 let rec apply_subst ~fill s =
  44   match fill with
  45   | [] -> s
  46   | (pat, templ)::rest ->
  47       apply_subst ~fill:rest (Pcre.replace ~pat ~templ s)
  48   (* fill a ~template file with substitutions specified in ~fill (see
  49   apply_subst) and save output to ~output *)
  50 let fill_template ~template ~fill ~output =
  51   printf "Creating %s ... " output; flush stdout;
  52   let (ic, oc) = (open_in template, open_out output) in
  53   let rec fill_template' () =
  54     output_string oc ((apply_subst ~fill (input_line ic)) ^ "\n");
  55     fill_template' ()
  56   in
  57   try
  58     output_string oc (sprintf
  59 "(*
  60   THIS CODE IS GENERATED - DO NOT MODIFY!
  61
  62   the source of this code is template \"%s\"
  63   the template was filled with data read from \"%s\"
  64 *)\n"
  65       template index);
  66     fill_template' ()
  67   with End_of_file ->
  68     close_in ic;
  69     close_out oc;
  70     printf "done!\n"; flush stdout
  71 let parse_xml fname =
  72   parse_wfdocument_entity default_config (from_file fname) default_spec
  73 let is_tutor node =
  74   match node#node_type with T_element "tutor" -> true | _ -> false
  75 let is_element node =
  76   match node#node_type with T_element _ -> true | _ -> false
  77 let main () =
  78   (parse_xml index)#root#iter_nodes
  79     (fun node ->
  80       try
  81         (match node with
  82         | node when is_tutor node ->
  83             (try  (* skip hand-written tutors *)
  84               ignore (find_element "no_auto" node);
  85               raise Exit
  86             with Not_found -> ());
  87             let output =
  88               try
  89                 (match node#attribute "source" with
  90                 | Value s -> s
  91                 | _ -> assert false)
  92               with Not_found -> assert false
  93             in
  94             let fill =
  95               List.map  (* create substitution list from index data *)
  96                 (fun node ->
  97                   let name =  (* node name *)
  98                     (match node#node_type with
  99                     | T_element s -> s
 100                     | _ -> assert false)
 101                   in
 102                   let value = node#data in  (* node value *)
 103                   (sprintf "@%s@" (String.uppercase name),  (* pattern *)
 104                    value))                                  (* substitution *)
 105                 (List.filter is_element node#sub_nodes)
 106             in
 107             fill_template ~fill ~template ~output
 108         | _ -> ())
 109       with Exit -> ())
 110
 111 let _ = main ()
 112