remove /add_plant, add /plants, a board to replace it

src/add_plant.eml.html

@@ -1,21 +0,0 @@
-let f nick request =
-<script type="text/javascript" src="/assets/js/js_plant_map.js" defer="defer"></script>
-<%s  Format.sprintf "Add a plant to your Collection %s !" nick %>
-<div class="row mb-3">
-      <div class="col-md-6">
-<div id="map"></div>
-      </div>
-      <div class="col-md-6">
-        <%s! Dream.form_tag ~action:"/add_plant" ~enctype:`Multipart_form_data request %>
-        <input type="hidden" id="lat_input" name="lat_input">
-        <input type="hidden" id="lng_input" name="lng_input">
-
-        <label for="tags" class="form-label">Tags</label>
-        <textarea name="tags" type="text" class="form-control" id="tags" aria-describedby="tagsHelp"></textarea>
-        <div id="tagsHelp" class="form-text">Describe your plant with tags</div>
-
-        <input id="files" name="files" aria-describedby="filesHelp" type="file" multiple>
-        <div id="filesHelp" class="form-text">Add a optional picture for your plant</div>
-      <button type="submit" class="btn btn-primary">Add Plant</button>
-    </form>
-   </div>

src/babillard.ml

@@ -2,8 +2,26 @@ open Db
 
 exception Invalid_post of string
 
+type board =
+  | Plants
+  | Babillard
+
+let int_of_board = function
+  | Plants -> 0
+  | Babillard -> 1
+
+let string_of_board = function
+  | Plants -> "plants"
+  | Babillard -> "babillard"
+
+let board_of_int = function
+  | 0 -> Plants
+  | 1 -> Babillard
+  | _ -> assert false
+
 type op =
   { id : string
+  ; board : board
   ; date : int
   ; nick : string
   ; subject : string
@@ -58,6 +76,12 @@ module Q = struct
        FOREIGN KEY(post_id) REFERENCES post_user(post_id),\n\
       \       FOREIGN KEY(parent_id) REFERENCES post_user(post_id));"
 
+  let create_thread_board_table =
+    Caqti_request.exec Caqti_type.unit
+      "CREATE TABLE IF NOT EXISTS thread_board (thread_id TEXT, board INT, \
+       FOREIGN KEY(thread_id) REFERENCES post_user(post_id));"
+
+  (* TODO useless? *)
   let create_thread_table =
     Caqti_request.exec Caqti_type.unit
       "CREATE TABLE IF NOT EXISTS threads (thread_id TEXT, post_id TEXT,\n\
@@ -151,6 +175,11 @@ module Q = struct
       Caqti_type.(tup2 string string)
       "INSERT INTO threads VALUES (?,?);"
 
+  let upload_thread_board =
+    Caqti_request.exec
+      Caqti_type.(tup2 string int)
+      "INSERT INTO thread_board VALUES (?,?);"
+
   let upload_post_parent =
     Caqti_request.exec
       Caqti_type.(tup2 string string)
@@ -197,6 +226,10 @@ module Q = struct
     Caqti_request.find_opt Caqti_type.string Caqti_type.string
       "SELECT thread_id FROM threads WHERE thread_id=? LIMIT 1;"
 
+  let get_thread_board =
+    Caqti_request.find Caqti_type.string Caqti_type.int
+      "SELECT board FROM thread_board WHERE thread_id=? LIMIT 1;"
+
   let get_post_subject =
     Caqti_request.find_opt Caqti_type.string Caqti_type.string
       "SELECT subject FROM post_subject WHERE post_id=?;"
@@ -206,9 +239,9 @@ module Q = struct
       Caqti_type.(tup2 float float)
       "SELECT lat, lng FROM post_gps WHERE post_id=?;"
 
-  let list_thread_ids =
+  let list_threads =
-    Caqti_request.collect Caqti_type.unit Caqti_type.string
+    Caqti_request.collect Caqti_type.int Caqti_type.string
-      "SELECT thread_id FROM threads;"
+      "SELECT thread_id FROM thread_board WHERE board=?;"
 end
 
 let () =
@@ -216,6 +249,7 @@ let () =
     [ Q.create_post_user_table
     ; Q.create_post_parent_table
     ; Q.create_thread_table
+    ; Q.create_thread_board_table
     ; Q.create_post_replies_table
     ; Q.create_post_citations_table
     ; Q.create_post_date_table
@@ -233,6 +267,7 @@ let () =
     Dream.warning (fun log -> log "can't create table")
 
 (* TODO should I escape html or smthing ?*)
+(*TODO fix bad link if post in other thread*)
 let parse_comment comment =
   let words = String.split_on_char ' ' comment in
   let cited_posts, words =
@@ -366,6 +401,7 @@ let upload_post post =
     match post with
     | Op
         { id
+        ; board
         ; date
         ; nick
         ; subject
@@ -377,7 +413,7 @@ let upload_post post =
         ; replies = _replies
         ; citations
         } ->
-      let op_data = Some (subject, longitude, latitude) in
+      let op_data = Some (board, subject, longitude, latitude) in
       (id, id, date, nick, comment, Some image, tags, citations, op_data)
     | Reply
         { id
@@ -425,7 +461,10 @@ let upload_post post =
   in
   match op_data with
   | None -> Ok post_id
-  | Some (subject, lng, lat) ->
+  | Some (board, subject, lng, lat) ->
+    let* _res_board =
+      Db.exec Q.upload_thread_board (post_id, int_of_board board)
+    in
     let* _res_gps = Db.exec Q.upload_post_gps (post_id, lat, lng) in
     let* _res_subject = Db.exec Q.upload_post_subject (post_id, subject) in
     Ok post_id
@@ -473,7 +512,7 @@ let make_reply ~comment ?image ~tags ~parent_id nick =
       in
       upload_post reply
 
-let make_op ~comment ~image ~tags ~subject ~lat ~lng nick =
+let make_op ~comment ~image ~tags ~subject ~lat ~lng ~board nick =
   if String.length comment > 10000 then
     Error "invalid comment"
   else
@@ -508,6 +547,7 @@ let make_op ~comment ~image ~tags ~subject ~lat ~lng nick =
         let op =
           Op
             { id
+            ; board
             ; date
             ; nick
             ; subject
@@ -523,9 +563,11 @@ let make_op ~comment ~image ~tags ~subject ~lat ~lng nick =
         upload_post op
 
 (* TODO make this return geojson directly *)
-let marker_list () =
+let marker_list board =
   let* thread_id_list =
-    Db.fold Q.list_thread_ids (fun thread_id acc -> thread_id :: acc) () []
+    Db.fold Q.list_threads
+      (fun thread_id acc -> thread_id :: acc)
+      (int_of_board board) []
   in
   let markers_res =
     List.map

src/babillard_page.eml.html

@@ -1,6 +1,8 @@
 let f request =
 <script type="text/javascript" src="/assets/js/js_babillard.js" defer="defer"></script>
+<div id="board" boardvalue="babillard">
 <%s  Format.sprintf "Babillard is love" %>
+</div>
 <div class="row mb-3">
       <div class="col-md-6">
 % begin match Dream.session "nick" request with

src/dune

@@ -5,7 +5,7 @@
   thread_page
   babillard
   babillard_page
-  plant
+  plants_page
   db
   app
   content
@@ -15,8 +15,7 @@
   register
   template
   user
-  user_profile
+  user_profile)
-  add_plant)
  (libraries
   uuidm
   caqti.blocking
@@ -99,8 +98,8 @@
   (run dream_eml %{deps} --workspace %{workspace_root})))
 
 (rule
- (targets add_plant.ml)
+ (targets plants_page.ml)
- (deps add_plant.eml.html)
+ (deps plants_page.eml.html)
  (action
   (run dream_eml %{deps} --workspace %{workspace_root})))
 

src/js_babillard.ml

@@ -74,7 +74,12 @@ module Marker = struct
     let thread_preview_div = Jv.get Jv.global "thread_preview_div" in
     ignore @@ Jv.set thread_preview_div "innerHTML" thread_preview;
     let thread_link = Jv.get Jv.global "thread_link" in
-    let link = "/babillard/" ^ thread_id in
+    let board_div = Jv.get Jv.global "board" in
+    let board =
+      Jv.to_string
+        (Jv.call board_div "getAttribute" [| Jv.of_string "boardvalue" |])
+    in
+    let link = "/" ^ board ^ "/" ^ thread_id in
     ignore @@ Jv.set thread_link "href" (Jv.of_string link);
     ignore @@ Jv.set thread_link "innerText" (Jv.of_string "[View Thread]");
     ()
@@ -107,9 +112,14 @@ module Marker = struct
 
   let () =
     log "fetch thread geojson@.";
+    let board_div = Jv.get Jv.global "board" in
+    let board =
+      Jv.to_string
+        (Jv.call board_div "getAttribute" [| Jv.of_string "boardvalue" |])
+    in
     let window = Jv.get Jv.global "window" in
     let fetchfutur =
-      Jv.call window "fetch" [| Jv.of_string "/thread_markers" |]
+      Jv.call window "fetch" [| Jv.of_string ("/" ^ board ^ "/markers") |]
     in
     ignore @@ Jv.call fetchfutur "then" [| Jv.repr markers_handle_response |];
     ()

src/newthread_page.eml.html

@@ -1,6 +1,6 @@
-let f request =
+let f ~board request =
 <script type="text/javascript" src="/assets/js/js_babillard.js" defer="defer"></script>
-        <%s! Dream.form_tag ~action:"/babillard/new_thread" ~enctype:`Multipart_form_data request %>
+        <%s! Dream.form_tag ~action:(Format.sprintf "/%s/new_thread" (Babillard.string_of_board board)) ~enctype:`Multipart_form_data request %>
         <input type="hidden" id="lat_input" name="lat_input">
         <input type="hidden" id="lng_input" name="lng_input">
 

src/permap.ml

@@ -131,14 +131,6 @@ let avatar_image request =
     | Some avatar -> Dream.respond ~headers:[ ("Content-Type", "image") ] avatar
     )
 
-let plant_image request =
-  let plant_id = Dream.param "plant_id" request in
-  let nb = int_of_string (Dream.param "nb" request) in
-  let image = Plant.get_plant_image plant_id nb in
-  match image with
-  | Ok image -> Dream.respond ~headers:[ ("Content-Type", "image") ] image
-  | Error _ -> Dream.empty `Not_Found
-
 let post_image request =
   let post_id = Dream.param "post_id" request in
   let image = Babillard.get_post_image post_id in
@@ -146,62 +138,11 @@ let post_image request =
   | Ok image -> Dream.respond ~headers:[ ("Content-Type", "image") ] image
   | Error _ -> Dream.empty `Not_Found
 
-let add_plant_get request =
+let plants_get request = render_unsafe (Plants_page.f request) request
-  match Dream.session "nick" request with
-  | None -> render_unsafe "Not logged in" request
-  | Some nick -> render_unsafe (Add_plant.f nick request) request
 
-let add_plant_post request =
+let markers ~board request =
-  match Dream.session "nick" request with
-  | None -> render_unsafe "Not logged in" request
-  | Some nick -> (
-    match%lwt Dream.multipart request with
-    | `Ok
-        [ ("files", files)
-        ; ("lat_input", [ (_, lat) ])
-        ; ("lng_input", [ (_, lng) ])
-        ; ("tags", [ (_, tags) ])
-        ]
-    | `Ok
-        (("files", files)
-        :: ("lat_input", [ (_, lat) ])
-           :: ("lng_input", [ (_, lng) ]) :: ("tags", [ (_, tags) ]) :: _ :: _
-        ) -> (
-      match (Float.of_string_opt lat, Float.of_string_opt lng) with
-      | None, _ -> render_unsafe "Invalide coordinate" request
-      | _, None -> render_unsafe "Invalide coordinate" request
-      | Some lat, Some lng ->
-        let res =
-          match Plant.add_plant (lat, lng) tags files nick with
-          | Ok () -> "Your plant was uploaded!"
-          | Error e -> e
-        in
-        render_unsafe res request )
-    | `Ok _ -> Dream.empty `Bad_Request
-    | `Expired _
-    | `Many_tokens _
-    | `Missing_token _
-    | `Invalid_token _
-    | `Wrong_session _
-    | `Wrong_content_type ->
-      Dream.empty `Bad_Request )
-
-let plant_markers request =
-  (*TODO should be in plant *)
-  let marker_list = Plant.marker_list () in
-  match marker_list with
-  | Ok marker_list ->
-    let json =
-      {| [ |}
-      ^ String.concat "," (List.map Plant.marker_to_geojson marker_list)
-      ^ "]"
-    in
-    Dream.respond ~headers:[ ("Content-Type", "application/json") ] json
-  | Error e -> render_unsafe e request
-
-let thread_markers request =
   (*TODO should be in babillard*)
-  let marker_list = Babillard.marker_list () in
+  let marker_list = Babillard.marker_list board in
   match marker_list with
   | Ok marker_list ->
     let json =
@@ -214,9 +155,10 @@ let thread_markers request =
 
 let babillard_get request = render_unsafe (Babillard_page.f request) request
 
-let newthread_get request = render_unsafe (Newthread_page.f request) request
+let newthread_get ~board request =
+  render_unsafe (Newthread_page.f ~board request) request
 
-let newthread_post request =
+let newthread_post ~board request =
   match Dream.session "nick" request with
   | None -> render_unsafe "Not logged in" request
   | Some nick -> (
@@ -246,10 +188,15 @@ let newthread_post request =
         | _ :: _ :: _ -> render_unsafe "More than one image" request
         | [ file ] -> (
           match
-            Babillard.make_op ~comment ~image:file ~lat ~lng ~subject ~tags nick
+            Babillard.make_op ~comment ~image:file ~lat ~lng ~subject ~tags
+              ~board nick
           with
           | Ok thread_id ->
-            let adress = Format.sprintf "/babillard/%s" thread_id in
+            let adress =
+              Format.sprintf "/%s/%s"
+                (Babillard.string_of_board board)
+                thread_id
+            in
             Dream.respond ~status:`See_Other ~headers:[ ("Location", adress) ]
               "Your thread was posted on the babillard!"
           | Error e -> render_unsafe e request ) ) )
@@ -279,7 +226,7 @@ let thread_view request =
   | Ok thread_view -> Dream.html (Thread_page.f thread_view thread_id request)
 
 (*form to reply to a thread *)
-let thread_post request =
+let reply_post request =
   match Dream.session "nick" request with
   | None -> render_unsafe "Not logged in" request
   | Some nick -> (
@@ -331,17 +278,20 @@ let () =
        ; Dream.get "/logout" logout
        ; Dream.get "/profile" profile_get
        ; Dream.post "/profile" profile_post
-       ; Dream.get "/add_plant" add_plant_get
-       ; Dream.post "/add_plant" add_plant_post
-       ; Dream.get "/plant_pic/:plant_id/:nb" plant_image
-       ; Dream.get "/plant_markers" plant_markers
-       ; Dream.get "/thread_markers" thread_markers
        ; Dream.get "/thread_view/:thread_id" thread_view
+       ; Dream.get "/plants/markers" (markers ~board:Plants)
+       ; Dream.get "/babillard/markers" (markers ~board:Babillard)
+       ; Dream.get "/plants" plants_get
+       ; Dream.get "/plants/new_thread" (newthread_get ~board:Plants)
+       ; Dream.post "/plants/new_thread" (newthread_post ~board:Plants)
+       ; Dream.get "/plants/:thread_id" thread_get (*todo, bad names ^^*)
+       ; Dream.post "/plants/:thread_id" reply_post
+       ; Dream.get "/post_pic/:post_id" post_image
        ; Dream.get "/babillard" babillard_get
-       ; Dream.get "/babillard/new_thread" newthread_get
+       ; Dream.get "/babillard/new_thread" (newthread_get ~board:Babillard)
-       ; Dream.post "/babillard/new_thread" newthread_post
+       ; Dream.post "/babillard/new_thread" (newthread_post ~board:Babillard)
-       ; Dream.get "/babillard/:thread_id" thread_get (*todo, bad names ^^*)
+       ; Dream.get "/babillard/:thread_id" thread_get
-       ; Dream.post "/babillard/:thread_id" thread_post
+       ; Dream.post "/reply/:thread_id" reply_post
        ; Dream.get "/post_pic/:post_id" post_image
        ]
   @@ Dream.not_found

src/plant.ml

@@ -1,5 +1,18 @@
+(*TODO implement plants as special posts? *)
 open Db
 
+type t =
+  { id : string
+  ; date : int
+  ; nick : string (*TODO ? ; comment : string *)
+  ; images : (string * string) list
+  ; tags : string list
+  ; longitude : float
+  ; latitude : float
+  ; replies : string list
+  ; citations : string list
+  }
+
 (* ('a option, string) result *)
 let ( let** ) o f =
   match o with
@@ -96,39 +109,29 @@ let () =
   then
     Dream.warning (fun log -> log "can't create table")
 
-(* TODO make it return a Result? *)
 let view_plant plant_id =
-  let count = Db.find_opt Q.count_plant_image plant_id in
+  let** count = Db.find_opt Q.count_plant_image plant_id in
-  match count with
+  let gps =
-  | Ok count -> (
+    match Db.find_opt Q.get_plant_gps plant_id with
-    match count with
+    | Ok (Some (lat, lng)) -> Float.to_string lat ^ " " ^ Float.to_string lng
-    | Some count -> (
+    | Ok None -> ""
-      let gps =
+    | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
-        match Db.find_opt Q.get_plant_gps plant_id with
+  in
-        | Ok (Some (lat, lng)) ->
+  let images =
-          Float.to_string lat ^ " " ^ Float.to_string lng
+    String.concat "\n"
-        | Ok None -> ""
+      (List.map
-        | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
+         (Format.sprintf
-      in
+            {|<li><img src="/plant_pic/%s/%i" class="img-thumbnail"></li>|}
-      let images =
+            plant_id )
-        String.concat "\n"
+         (List.init count (fun i -> i)) )
-          (List.map
+  in
-             (Format.sprintf
+  let tags = Db.fold Q.get_plant_tags (fun tag acc -> tag :: acc) plant_id [] in
-                {|<li><img src="/plant_pic/%s/%i" class="img-thumbnail"></li>|}
+  match tags with
-                plant_id )
+  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-             (List.init count (fun i -> i)) )
+  | Ok tags ->
-      in
+    let tags = String.concat " " tags in
-      let tags =
+    (* TODO add link to gps/map too *)
-        Db.fold Q.get_plant_tags (fun tag acc -> tag :: acc) plant_id []
+    Ok (images ^ tags ^ gps)
-      in
-      match tags with
-      | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
-      | Ok tags ->
-        let tags = String.concat " " tags in
-        (* TODO add link to gps/map too *)
-        images ^ tags ^ gps )
-    | None -> "db error" )
-  | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
 
 let marker_list () =
   let* plant_id_list =
@@ -138,9 +141,11 @@ let marker_list () =
     List.map
       (fun plant_id ->
         match Db.find_opt Q.get_plant_gps plant_id with
-        | Ok (Some (lat, lng)) ->
+        | Ok (Some (lat, lng)) -> (
           let content = view_plant plant_id in
-          Ok (lat, lng, content)
+          match content with
+          | Error e -> Error e
+          | Ok content -> Ok (lat, lng, content) )
         | Ok None -> Error "latlng not found"
         | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
         )
@@ -172,12 +177,10 @@ let marker_to_geojson marker =
   }
 } 
 |}
-      (*TODO escape in content ?? *)
       (* geojson use lng lat, and not lat lng*)
       (Float.to_string lng)
       (Float.to_string lat) (String.escaped content)
 
-(* TODO return result *)
 let view_user_plant_list nick =
   let plant_id_list =
     Db.fold Q.get_user_plants (fun plant_id acc -> plant_id :: acc) nick []
@@ -185,7 +188,14 @@ let view_user_plant_list nick =
   match plant_id_list with
   | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
   | Ok plant_id_list ->
-    let plants = List.map view_plant plant_id_list in
+    let plants =
+      List.map
+        (fun p ->
+          match view_plant p with
+          | Ok p -> p
+          | Error _ -> "" )
+        plant_id_list
+    in
     String.concat "\n" plants
 
 let get_plant_image plant_id nb =

src/plants_page.eml.html

@@ -0,0 +1,20 @@
+let f request =
+<script type="text/javascript" src="/assets/js/js_babillard.js" defer="defer"></script>
+<div id="board" boardvalue="plants">
+<%s  Format.sprintf "Plants is love" %>
+</div>
+<div class="row mb-3">
+      <div class="col-md-6">
+% begin match Dream.session "nick" request with
+% | None ->
+
+% | Some _nick ->
+<a href="/plants/new_thread">[New Thread]</a>
+% end;
+<div id="map"></div>
+      </div>
+      <div class="col-md-6">
+<div id="thread_preview_div"></div>
+<a id="thread_link"></a>
+      </div>
+</div>

src/template.eml.html

@@ -33,13 +33,13 @@ let render_unsafe ~title ~content request =
                           <li class="nav-item">
                             <a class="nav-link" href="/profile"><%s! nick %></a>
                           </li>
-                          <li class="nav-item">
-                            <a class="nav-link" href="/add_plant">Add Plant</a>
-                          </li>
                           <li class="nav-item">
                               <a class="nav-link" href="/logout">Logout</a>
                           </li>
 % end;
+                          <li class="nav-item">
+                            <a class="nav-link" href="/plants">Plants</a>
+                          </li>
                           <li class="nav-item">
                               <a class="nav-link" href="/babillard">Babillard</a>
                           </li>

src/thread_page.eml.html

@@ -6,7 +6,7 @@ let f thread_view thread_id request =
 
 % | Some _ ->
       <div class="mb-3">
-        <%s! Dream.form_tag ~action:( Format.sprintf "/babillard/%s" thread_id)
+        <%s! Dream.form_tag ~action:( Format.sprintf "/reply/%s" thread_id)
         ~enctype:`Multipart_form_data request %>
 
         <label for="replyComment" id="replyCommentLabel" class="form-label">Comment</label>

src/user.ml

@@ -149,14 +149,13 @@ let public_profile request =
   | Ok user -> (
     match user with
     | Some (nick, password, email, (bio, _)) ->
-      let plants = Plant.view_user_plant_list nick in
       let user_info =
         Format.sprintf
           {|nick = `%s`; password = `%s`; email = `%s`; bio = '%s';
     <img src="/user/%s/avatar" class="img-thumbnail" alt="Your avatar picture">|}
           nick password email (Dream.html_escape bio) nick
       in
-      user_info ^ plants
+      user_info
     | None -> "incoherent db answer" )
   | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
 

src/user_profile.eml.html

@@ -14,4 +14,3 @@ let f nick bio request =
       <input name="file" type="file">
       <button>Submit!</button>
     </form>
-    <%s! Plant.view_user_plant_list nick %>