basic code to add lists

Makefile

@@ -20,9 +20,9 @@ SERVER_FILES := src/ulist_t.mli		\
 		src/ulist_j.ml		\
 		src/services.eliom	\
 		src/tools.eliom		\
+		src/ulist_fs.eliom	\
 		src/category.eliom	\
 		src/menu.eliom		\
-		src/ulist_fs.eliom	\
 		src/ulist_btn.eliom	\
 		src/ulist.eliom		\
 		src/utodo.eliom

lists/projets/bidule

@@ -0,0 +1 @@
+{"emails":[],"tasks":[{"uuid":"bdc0a51f-cbde-43cd-b138-87a2d765294f","subList":false,"label":"test","status":false}]}

src/category.eliom

@@ -21,3 +21,41 @@ let genLists cat =
              div ~a:[a_class ["col-md-2"]] [pcdata "0%"]])
         lists)
   )
+
+let createEmptyList (category, listName) =
+  let%lwt l = Ulist_fs.getUList category listName in
+  match l with
+  | Some _ -> Lwt.return false (* List exists, do nothing *)
+  | None   ->
+    let path = "lists/" ^ category ^ "/" ^ listName in
+    let%lwt f = Lwt_io.open_file Lwt_io.Output path in
+    Lwt.return true
+
+let%client createEmptyList_rpc =
+  ~%(Eliom_client.server_function
+       [%derive.json: string * string] createEmptyList)
+
+let newListBtn (category : string) =
+  let inpt = Eliom_content.Html.D.input () in
+  let f = [%client
+    (fun _ ->
+       let elt = Eliom_content.Html.To_dom.of_input ~%inpt in
+       let name = Js.to_string elt##.value in
+       ignore (createEmptyList_rpc (~%category, name))
+    )
+  ] in
+  let btn = Eliom_content.Html.D.(
+    Raw.a
+      ~a:[a_onclick f; a_href (Raw.uri_of_string "#")]
+      [img ~alt:("Delete")
+           ~src:(make_uri ~service:(Eliom_service.static_dir ())
+                   ["images"; "delete.ico"]) ()])
+  in
+  Eliom_content.Html.D.
+    (
+      div ~a:[a_class ["row"; "row-hover"]]
+        [
+          div ~a:[a_class ["col-md-7"]] [inpt];
+          div ~a:[a_class ["col-md-2"]] [btn]
+        ]
+    )

src/ulist_fs.eliom

@@ -1,6 +1,5 @@
 open Tools
 open Services
-open Category
 open%shared Ulist_t
 open%shared Ulist_j
 
@@ -14,8 +13,10 @@ let%server readUList path =
     let%lwt f = Lwt_io.open_file Lwt_io.Input path in
     let s = Lwt_io.read_lines f in
     let%lwt res = Lwt_stream.fold (^) s "" in
-    let ulist = Ulist_j.ulist_of_string res in
-    Lwt.return (Some ulist)
+    try let ulist = Ulist_j.ulist_of_string res in
+      Lwt.return (Some ulist)
+    with
+      _ -> Lwt.return (Some {emails = []; tasks = []})
   else
     Lwt.return None
 
@@ -48,7 +49,10 @@ let%server saveTask (category, listName, nUuid, nSubList, nLabel, nStatus) =
       let tasks' = List.mapi (fun i x ->
         if i = n
         then
-          {uuid = nUuid; subList = nSubList; label = nLabel; status = nStatus} else x) l.tasks
+          {uuid = nUuid; subList = nSubList; label = nLabel; status = nStatus}
+        else
+          x
+        ) l.tasks
       in
       let l' = {emails = l.emails; tasks = tasks'} in
       let%lwt _ = writeUList category listName l' in
@@ -72,5 +76,3 @@ let%server deleteTask (category, listName, id) =
     let l' = ({emails = l.emails; tasks = tasks'}) in
     let%lwt _ = writeUList category listName l' in
     Lwt.return (Some (l', l))
-
-

src/utodo.eliom

@@ -15,9 +15,10 @@ let () =
     ~service:category_service
     (fun category () ->
       let%lwt lists = genLists category in
+      let newList = newListBtn category in
       template category Eliom_content.Html.F.
       (
-        [h1 ~a:[a_class ["text-center"]] [pcdata category]; lists])
+        [h1 ~a:[a_class ["text-center"]] [pcdata category]; lists; newList])
       )
 
 let () =