daemons/whelp/mooglePp.ml

   1
   2 open Printf
   3
   4 let pp_error title msg =
   5   sprintf "<div><b class='error'>%s:</b> %s</div><br />" title msg
   6
   7 let paginate ~size ~page l =
   8   let min = 1 + (page-1) * size in
   9   let max = page * size in
  10   let rec aux i l =
  11     match (i, l) with
  12     | _, [] -> []
  13     | i, hd :: tl when i < min -> aux (i+1) tl
  14     | i, hd :: tl when i >= min && i <= max -> hd :: aux (i+1) tl
  15     | i, hd :: tl -> []
  16   in
  17   assert (size > 0 && page > 0);
  18   aux 1 l
  19
  20   (** pretty print a list of URIs to an HELM theory file *)
  21 let theory_of_result page result =
  22   let results_per_page =
  23     Helm_registry.get_int "search_engine.results_per_page"
  24   in
  25   let results_no = List.length result in
  26   let buffer = Buffer.create (200 * results_no) in
  27   let result = paginate ~size:results_per_page ~page result in
  28   if results_no > 0 then
  29    let mode = "typeonly" in
  30    let output_results () =
  31     let idx = ref ((page - 1) * results_per_page) in
  32      List.iter
  33       (fun uri ->
  34         incr idx;
  35         Printf.bprintf buffer
  36            "<tr>
  37             <td valign=\"top\">%d.</td>
  38             <td><span class=\"uri\">%s</span></td>
  39             </tr>
  40             <tr>
  41             <td />
  42             <td><ht:OBJECT uri=\"%s\" mode=\"%s\"/></td>
  43             </tr>"
  44           !idx uri uri mode) result ;
  45    in
  46    let summary =
  47      sprintf "<b>%d</b> result%s found"
  48        results_no (if results_no > 1 then "s" else "")
  49    in
  50     begin
  51      Buffer.add_string buffer
  52       "<table xmlns:ht=\"http://www.cs.unibo.it/helm/namespaces/helm-theory\">";
  53      output_results ();
  54      Buffer.add_string buffer "</table>";
  55      (summary, Buffer.contents buffer)
  56     end
  57   else
  58     ("no results found", "")
  59
  60 let html_of_interpretations interps =
  61   let choice_of_interp interp =
  62     sprintf "<table>\n%s\n</table>"
  63       (String.concat "\n"
  64         (List.map
  65            (fun (_, k, v) ->
  66               sprintf "<tr><td><em>%s</em></td><td>%s</td></tr>" k v)
  67            interp))
  68   in
  69   let interp_no = ref ~-1 in
  70     sprintf "<table class=\"interp\">\n%s\n</table>"
  71       (String.concat "\n"
  72         (List.map
  73            (fun interp ->
  74               sprintf "
  75                   <tr class=\"interp\">
  76                   <td><input type=\"radio\" name=\"param.interp\" value=\"%d\" /></td>
  77                   <td>
  78                   %s
  79                   </td></tr>"
  80                 (incr interp_no; !interp_no)
  81                 (choice_of_interp interp))
  82            interps))
  83