helm/hbugs/tutors/build_tutors.ml

   1 #!/usr/bin/ocamlrun /usr/bin/ocaml
   2 (*
   3  * Copyright (C) 2003:
   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 = "INDEX.xml" ;;
  39 let template = "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 ;;
  49   (* fill a ~template file with substitutions specified in ~fill (see
  50   apply_subst) and save output to ~output *)
  51 let fill_template ~template ~fill ~output =
  52   printf "Creating %s ... " output; flush stdout;
  53   let (ic, oc) = (open_in template, open_out output) in
  54   let rec fill_template' () =
  55     output_string oc ((apply_subst ~fill (input_line ic)) ^ "\n");
  56     fill_template' ()
  57   in
  58   try
  59     output_string oc (sprintf
  60 "(*
  61   THIS CODE IS GENERATED - DO NOT MODIFY!
  62
  63   the source of this code is template \"%s\"
  64   the template was filled with data read from \"%s\"
  65 *)\n"
  66       template index);
  67     fill_template' ()
  68   with End_of_file ->
  69     close_in ic;
  70     close_out oc;
  71     printf "done!\n"; flush stdout
  72 ;;
  73 let parse_xml fname =
  74   parse_wfdocument_entity default_config (from_file fname) default_spec
  75 ;;
  76 let is_tutor node =
  77   match node#node_type with T_element "tutor" -> true | _ -> false
  78 ;;
  79 let is_element node =
  80   match node#node_type with T_element _ -> true | _ -> false
  81 ;;
  82 exception Skip;;
  83 let main () =
  84   (parse_xml index)#root#iter_nodes
  85     (fun node ->
  86       try
  87         (match node with
  88         | node when is_tutor node ->
  89             (try  (* skip hand-written tutors *)
  90               ignore (find_element "no_auto" node);
  91               raise Skip
  92             with Not_found -> ());
  93             let output =
  94               try
  95                 (match node#attribute "source" with
  96                 | Value s -> s
  97                 | _ -> assert false)
  98               with Not_found -> assert false
  99             in
 100             let fill =
 101               List.map  (* create substitution list from index data *)
 102                 (fun node ->
 103                   let name =  (* node name *)
 104                     (match node#node_type with
 105                     | T_element s -> s
 106                     | _ -> assert false)
 107                   in
 108                   let value = node#data in  (* node value *)
 109                   (sprintf "@%s@" (String.uppercase name),  (* pattern *)
 110                    value))                                  (* substitution *)
 111                 (List.filter is_element node#sub_nodes)
 112             in
 113             fill_template ~fill ~template ~output
 114         | _ -> ())
 115       with Skip -> ())
 116 ;;
 117 main ();;
 118