Merge pull request #16 from ocsigen/2022-update

2022 update

.github/workflows/master.yml

@@ -31,16 +31,10 @@ jobs:
       # ideally it should be done by `opam install . --deps-only` but right now
       # we have opam 1.x in the repo, and I'm not very optimistic to even try it
       - run: opam depext conf-dbm -y
-      - run: opam install eliom ocsigen-toolkit cairo2 ocsipersist-dbm -y
+      - run: opam install eliom ocsigen-toolkit cairo2 ocsipersist-dbm calendar syndic -y
 
       - name: Compiling simple
         run: opam exec -- make -C simple all
 
-      # first call of make fails, it should be fixed somehow
       - name: Compiling extended
-        run: |
-          opam exec -- make -C extended all || echo "Attempt 1 fails somehow"
-          opam exec -- make -C extended all
-
-      - name: Compiling web_app
-        run: opam exec -- make -C webapp all
+        run: opam exec -- make -C extended all

README.md

@@ -14,7 +14,7 @@ http://ocsigen.org/tuto/latest/manual/application
 Requirements
 ------------
 
-    opam install eliom ocsigen-toolkit cairo2 ocsipersist-dbm
+    opam install eliom ocsigen-toolkit cairo2 ocsipersist-dbm syndic
 
 Usage
 -----

extended/Makefile.options

@@ -1,4 +1,3 @@
-
 #----------------------------------------------------------------------
 #           SETTINGS FOR THE ELIOM PROJECT graffiti
 #----------------------------------------------------------------------
@@ -12,12 +11,11 @@ SERVER_FILES := $(wildcard *.eliomi *.eliom) server.ml common.ml feed.ml
 CLIENT_FILES := $(wildcard *.eliomi *.eliom) client.ml common.ml
 
 # OCamlfind packages for the server
-SERVER_PACKAGES := cairo2 unix eliom.server.ext \
-                       js_of_ocaml.deriving.ppx lwt.ppx
+SERVER_PACKAGES := cairo2 unix js_of_ocaml-ppx_deriving_json lwt_ppx syndic
 
 # OCamlfind packages for the client
 CLIENT_PACKAGES := ocsigen-toolkit.client \
-                       js_of_ocaml-ppx js_of_ocaml.deriving lwt_ppx
+		       js_of_ocaml-ppx js_of_ocaml.deriving lwt_ppx
 
 # Directory with files to be statically served
 LOCAL_STATIC = static

extended/client.ml

@@ -19,6 +19,7 @@
  *)
 
 open Common
+open Js_of_ocaml
 open Eliom_content
 
 let draw ctx ((r, g, b), size, (x1, y1), (x2, y2)) =
@@ -58,9 +59,8 @@ let launch_client_canvas bus image_elt canvas_elt slider =
 
 
   (* The color palette: *)
-  let colorpicker = Ow_color_picker.create ~width:150 () in
-  Ow_color_picker.append_at (Dom_html.document##.body) colorpicker;
-  Ow_color_picker.init_handler colorpicker;
+  let colorpicker, cp_sig = Ot_color_picker.make () in
+  Html.(Manip.appendChild (Manip.Elt.body ()) colorpicker);
 
   let x = ref 0 and y = ref 0 in
   let set_coord ev =
@@ -69,7 +69,9 @@ let launch_client_canvas bus image_elt canvas_elt slider =
   let compute_line ev =
     let oldx = !x and oldy = !y in
     set_coord ev;
-    let rgb = Ow_color_picker.get_rgb colorpicker in
+    let h, s, v = Eliom_shared.React.S.value cp_sig in
+    let r, g, b = Ot_color_picker.hsv_to_rgb h s v in
+    let rgb = int_of_float r, int_of_float g, int_of_float b in
     let size_slider = Html.To_dom.of_input slider in
     let size = int_of_string (Js.to_string size_slider##.value) in
     (rgb, size, (oldx, oldy), (!x, !y))
@@ -82,13 +84,13 @@ let launch_client_canvas bus image_elt canvas_elt slider =
   in
   let t = Lwt_stream.iter (draw ctx) (Eliom_bus.stream bus) in
   let drawing_thread =
-    Lwt_js_events.(
+    Js_of_ocaml_lwt.Lwt_js_events.(
       mousedowns canvas (fun ev elt ->
         Dom.preventDefault ev;
         set_coord ev;
         let%lwt () = line ev in
         Lwt.pick [mousemoves Dom_html.document (fun a _ -> line a);
-	          let%lwt ev = mouseup Dom_html.document in line ev]))
+                  let%lwt ev = mouseup Dom_html.document in line ev]))
   in
   { message_thread = t;
     drawing_thread = drawing_thread }

extended/feed.ml

@@ -19,13 +19,13 @@
  *)
 
 open Eliom_content
-open Eliom_lib
+open Lwt.Infix
 open Html.F
 open Server
 
 let static_dir =
   match Eliom_config.get_config () with
-  | [Simplexmlparser.Element ("staticdir", [], [Simplexmlparser.PCData dir])] ->
+  | [Element ("staticdir", [], [PCData dir])] ->
     dir
   | [] ->
     raise (Ocsigen_extensions.Error_in_config_file
@@ -34,11 +34,19 @@ let static_dir =
     raise (Ocsigen_extensions.Error_in_config_file
              ("Unexpected content inside graffiti config"))
 
+let create_dir dir =
+  try%lwt Lwt_unix.mkdir dir 0o777 with
+  | Unix.Unix_error (Unix.EEXIST, "mkdir", _) -> Lwt.return_unit
+  | _ ->
+      Eliom_lib.debug "could not create the directory %s" dir;
+      Lwt.return_unit
+
 let image_dir name =
-  let dir = static_dir ^ "/graffiti_saved/" ^ (Url.encode name) in
-  (try%lwt Lwt_unix.mkdir dir 0o777 with
-   | _ -> debug "could not create the directory %s" dir; Lwt.return ()) >|=
-  (fun () -> dir)
+  let dir = static_dir ^ "/graffiti_saved/" in
+  let%lwt () = create_dir dir in
+  let dir = dir ^ Eliom_lib.Url.encode name in
+  let%lwt () = create_dir dir in
+  Lwt.return dir
 
 let make_filename name number =
   image_dir name >|= ( fun dir -> (dir ^ "/" ^ (string_of_int number) ^ ".png") )
@@ -48,45 +56,39 @@ let save image name number =
   let%lwt out_chan = Lwt_io.open_file ~mode:Lwt_io.output file_name in
   Lwt_io.write out_chan image
 
-let image_info_table = Ocsipersist.open_table "image_info_table"
+let image_info_table = Ocsipersist.Polymorphic.open_table "image_info_table"
 
 let save_image username =
-  let now = CalendarLib.Calendar.now () in
+  let now = Option.get (Ptime.of_float_s (Unix.gettimeofday ())) in
   let%lwt image_info_table = image_info_table in
   let%lwt number,_,list =
-    try%lwt Ocsipersist.find image_info_table username with
+    try%lwt Ocsipersist.Polymorphic.find image_info_table username with
     | Not_found -> Lwt.return (0,now,[])
     | e -> Lwt.fail e
   in
-  let%lwt () = Ocsipersist.add image_info_table
+  let%lwt () = Ocsipersist.Polymorphic.add image_info_table
       username (number+1,now,(number,now)::list) in
   let (_,image_string) = Hashtbl.find graffiti_info username in
   save (image_string ()) username number
 
-let save_image_box =
-  let save_service_reference =
-    Eliom_reference.eref ~scope:Eliom_common.default_group_scope None in
-  fun name ->
-    let%lwt save_image_service =
-      match%lwt Eliom_reference.get save_service_reference with
-      | None ->
-        let service = Eliom_registration.Action.create
-            ~scope:Eliom_common.default_group_scope
-            ~meth:(Eliom_service.Post
-                     (Eliom_parameter.unit,
-                      Eliom_parameter.unit))
-            ~path:Eliom_service.No_path
-            (fun () () -> save_image name) in
-        let%lwt () = Eliom_reference.set save_service_reference (Some service) in
-        Lwt.return service
-      | Some service -> Lwt.return service
-    in
-    Lwt.return (
-      Html.D.Form.post_form save_image_service
-        (fun _ ->
-           [p [
-               Html.D.Form.input ~input_type:`Submit ~value:"save"
-                 Html.D.Form.string]]) ())
+let save_image_service =
+  Eliom_service.create
+    ~meth:(Eliom_service.Post
+             (Eliom_parameter.unit, Eliom_parameter.string "name"))
+    ~path:Eliom_service.No_path ()
+
+let () =
+  Eliom_registration.Action.register
+    ~service:save_image_service (fun () name -> save_image name)
+
+let save_image_box name =
+  Lwt.return
+    (Html.D.Form.post_form ~service:save_image_service
+       (fun param_name ->
+         [p [Html.D.Form.input ~input_type:`Hidden ~name:param_name
+              ~value:name Html.D.Form.string;
+             Html.D.Form.button_no_value ~button_type:`Submit [txt "save"]]])
+       ())
 
 let feed_service =
   Eliom_service.create
@@ -95,53 +97,52 @@ let feed_service =
     ()
 
 let local_filename name number =
-  ["graffiti_saved"; Url.encode name ; (string_of_int number) ^ ".png"]
+  ["graffiti_saved"; Eliom_lib.Url.encode name ; (string_of_int number) ^ ".png"]
 
 let rec entries name list = function
   | 0 -> []
   | len ->
     match list with
     | [] -> []
     | (n,saved)::q ->
-      let title = Atom_feed.plain
-	  ("graffiti " ^ name ^ " " ^ (string_of_int n)) in
       let uri =
-	Html.D.make_uri ~absolute:true
-	  ~service:(Eliom_service.static_dir ())
-	  (local_filename name n)
-      in
+        Html.D.make_uri ~absolute:true
+          ~service:(Eliom_service.static_dir ())
+          (local_filename name n)
+        |> Xml.string_of_uri
+        |> Uri.of_string in
+      let content = Syndic.Atom.Src (None, uri) in
+      let authors = (Syndic.Atom.author name), [] in
+      let title : Syndic.Atom.text_construct =
+        Syndic.Atom.Text ("graffiti " ^ name ^ " " ^ (string_of_int n)) in
       let entry =
-	Atom_feed.entry ~title ~id:(Xml.string_of_uri uri) ~updated:saved
-          [Atom_feed.html5C [ Html.F.img ~src:uri ~alt:"image" ()]] in
+        Syndic.Atom.entry ~content ~id:uri ~authors ~title ~updated:saved () in
       entry::(entries name q (len - 1))
 
-let feed name () =
-  let id = Xml.string_of_uri (Html.D.make_uri ~absolute:true
-                                ~service:feed_service name) in
-  let title = Atom_feed.plain ("nice drawings of " ^ name) in
-  try%lwt
-    let%lwt image_info_table = image_info_table in
-    Ocsipersist.find image_info_table name >|=
-    (fun (number,updated,list) ->
-       Atom_feed.feed ~id ~updated ~title (entries name list 10))
-  with
-  | Not_found ->
-    let now = CalendarLib.Calendar.now () in
-    Lwt.return (Atom_feed.feed ~id ~updated:now ~title [])
-  | e -> Lwt.fail e
+let string_page_of_feed feed =
+  feed
+  |> Syndic.Atom.to_xml
+  |> Syndic.XML.to_string ~ns_prefix:(fun x -> Some x)
+  |> fun string -> string, ""
 
 let feed name () =
-  let id = Xml.string_of_uri (Html.D.make_uri ~absolute:true ~service:feed_service name) in
-  let title = Atom_feed.plain ("nice drawings of " ^ name) in
+  let id =
+    Xml.string_of_uri
+      (Html.D.make_uri ~absolute:true ~service:feed_service name)
+    |> Uri.of_string in
+  let title : Syndic.Atom.text_construct =
+    Syndic.Atom.Text ("nice drawings of " ^ name) in
   Lwt.catch
     (fun () ->
        let%lwt image_info_table = image_info_table in
-       Ocsipersist.find image_info_table name >|=
-      (fun (number,updated,list) -> Atom_feed.feed ~id ~updated ~title (entries name list 10)))
+       Ocsipersist.Polymorphic.find image_info_table name >|=
+      (fun (number,updated,list) ->
+         Syndic.Atom.feed ~id ~updated ~title (entries name list 10)
+       |> string_page_of_feed))
     ( function Not_found ->
-      let now = CalendarLib.Calendar.now () in
-      Lwt.return (Atom_feed.feed ~id ~updated:now ~title [])
+      let now = Option.get (Ptime.of_float_s (Unix.gettimeofday ())) in
+      Lwt.return (Syndic.Atom.feed ~id ~updated:now ~title []
+                  |> string_page_of_feed)
              | e -> Lwt.fail e )
 
-let () = Eliom_atom.Reg.register
-    ~service:feed_service feed
+let () = Eliom_registration.String.register ~service:feed_service feed

extended/graffiti.conf.in

@@ -22,7 +22,7 @@
       <static dir="%%STATICDIR%%" />
       <static dir="%%ELIOMSTATICDIR%%" />
       <eliommodule module="%%LIBDIR%%/%%PROJECT_NAME%%.cma">
-        <staticdir>local/var/data</staticdir>
+        <staticdir>static</staticdir>
       </eliommodule>
       <eliom/>
     </host>