matita/matita/contribs/lambdadelta/bin/roles/webEngine.ml

   1 (*
   2     ||M||  This file is part of HELM, an Hypertextual, Electronic
   3     ||A||  Library of Mathematics, developed at the Computer Science
   4     ||T||  Department, University of Bologna, Italy.
   5     ||I||
   6     ||T||  HELM is free software; you can redistribute it and/or
   7     ||A||  modify it under the terms of the GNU General Public License
   8     \   /  version 2 or (at your option) any later version.
   9      \ /   This software is distributed as is, NO WARRANTY.
  10       V_______________________________________________________________ *)
  11
  12 module KP = Printf
  13
  14 module EE = RolesEngine
  15 module EG = RolesGlobal
  16 module ET = RolesTypes
  17 module EU = RolesUtils
  18 module WS = WebLWS
  19
  20 let error = ref ""
  21
  22 let open_out () =
  23   let author = "λδ development binary: roles manager" in
  24   let description = "λδ development binary: roles manager" in
  25   let title = "Roles Manager" in
  26   let css = Filename.concat !EG.base_url "css/roles.css" in
  27   let icon = Filename.concat !EG.base_url "images/crux_32.ico" in
  28   WS.open_out_html author description title css icon
  29
  30 let close_out () =
  31   WS.close_out_html ()
  32
  33 let string_of_request req arg =
  34   WS.string_of_request "roles" (["system-"^req, arg], "")
  35
  36 let status_out () =
  37   let button_specs = [
  38     "default", "Refresh";
  39     "save", "Save";
  40     "add", "Add";
  41     "match", "Match";
  42     "remove", "Remove";
  43   ] in
  44   let each_button (action, str) =
  45     let req = string_of_request action "" in
  46     KP.printf "<span class=\"button\"><a href=\"%s\">%s</a></span>\n" req str
  47   in
  48   let before_roles p count =
  49     let req = string_of_request "toggle" p in
  50     KP.printf "<div class=\"roles-head role-color\">\n";
  51     KP.printf "<a href=\"%s\">Roles:</a>\n" req;
  52     KP.printf "<span class=\"count\">%s</span>\n" count
  53   in
  54   let each_role p b str =
  55     let req = string_of_request "toggle" p in
  56     let s = if b then " selected" else "" in
  57     KP.printf "<div class=\"role role-color%s\">" s;
  58     KP.printf "<a href=\"#%s\">⮞</a> " p;
  59     KP.printf "<a href=\"%s\">%s</a>" req str;
  60     KP.printf "</div>\n"
  61   in
  62   let before_role p =
  63     KP.printf "<div id=\"%s\" class=\"roles\">\n" p;
  64   in
  65   let after_role () =
  66     KP.printf "</div>\n"
  67   in
  68   let after_roles () =
  69     KP.printf "</div>\n";
  70     KP.printf "<div class=\"buttons\">\n";
  71     List.iter each_button button_specs;
  72     KP.printf "</div>\n"
  73   in
  74   let stage s =
  75     KP.printf "<div class=\"stage role-color\">";
  76     KP.printf "Stage: %s" s;
  77     KP.printf "</div>\n"
  78   in
  79   let before_atoms a p count =
  80     let c, str =
  81       if a then "object-color", "objects"
  82       else "name-color", "names"
  83     in
  84     let req = string_of_request "toggle" p in
  85     KP.printf "<div class=\"atoms-head %s\">\n" c;
  86     KP.printf "<a href=\"%s\">%s:</a>\n" req str;
  87     KP.printf "<span class=\"count\">%s</span>\n" count;
  88     KP.printf "</div>\n";
  89     KP.printf "<div class=\"atoms\"><table class=\"atoms-table\"><tr>\n"
  90   in
  91   let each_atom a p b str =
  92     let c = if a then "object-color" else "name-color" in
  93     let s = if b then " selected" else "" in
  94     let req = string_of_request "toggle" p in
  95     KP.printf "<td class=\"atom %s%s\"><a href=\"%s\">%s</a></td>\n" c s req str
  96   in
  97   let after_atoms () =
  98     KP.printf "</tr></table></div>\n"
  99   in
 100   KP.printf "<div class=\"head\">Role Manager</div>\n";
 101   EE.visit_status
 102     before_roles each_role before_role after_role after_roles stage
 103     (before_atoms true) (each_atom true) after_atoms
 104     (before_atoms false) (each_atom false) after_atoms;
 105   if !error <> "" then
 106     KP.printf "<div class=\"error error-color\">Error: %s</div>\n" !error
 107
 108 let handler opt arg () =
 109   begin try match opt with
 110   | "system-default" -> ()
 111   | "system-add"     -> EE.add_role ()
 112   | "system-remove"  -> ()
 113   | "system-match"   -> EE.add_matching ()
 114   | "system-toggle"  -> EE.toggle_entry (EU.pointer_of_string arg)
 115   | "system-save"    -> EE.write_status ()
 116   | _                -> EU.raise_error (ET.EWrongRequest (opt, arg))
 117   with
 118   | ET.Error e -> error := EU.string_of_error e
 119   | e          -> error := Printexc.to_string e
 120   end;
 121   open_out ();
 122   status_out ();
 123   close_out ();
 124   error := ""
 125
 126 let init () =
 127   WS.loop_in ignore handler ignore ()