remove plants :(

src/babillard.ml

@@ -2,20 +2,15 @@ open Db
 
 exception Invalid_post of string
 
-type board =
+type board = Babillard
-  | Plants
-  | Babillard
 
 let int_of_board = function
-  | Plants -> 0
   | Babillard -> 1
 
 let pp_board fmt = function
-  | Plants -> Format.fprintf fmt "plants"
   | Babillard -> Format.fprintf fmt "babillard"
 
 let board_of_int = function
-  | 0 -> Plants
   | 1 -> Babillard
   | _ -> raise (Invalid_argument "board_of_int")
 

src/babillard_page.eml.html

@@ -1,6 +1,7 @@
-let f request =
+let f ~board request =
+%let board = Format.asprintf "%a" Babillard.pp_board board in
 <script type="text/javascript" src="/assets/js/js_babillard.js" defer="defer"></script>
-<div id="board" data-board="babillard">
+<div id="board" data-board=<%s board %> >
 <%s  Format.sprintf "Babillard is love" %>
 </div>
 <div class="row mb-3">
@@ -9,7 +10,8 @@ let f request =
 % | None ->
 
 % | Some _nick ->
-<a href="/babillard/new_thread">[New Thread]</a>
+%let url = Format.sprintf "/%s/new_thread" board in
+<a href=<%s url %>>[New Thread]</a>
 % end;
 <div id="map"></div>
       </div>

src/content/assets/js/dune

@@ -1,12 +1,3 @@
-(rule
- (target js_plant_map.js)
- (deps
-  (file ../../../js_plant_map.bc.js))
- (action
-  (with-stdout-to
-   %{target}
-   (cat ../../../js_plant_map.bc.js))))
-
 (rule
  (target js_babillard.js)
  (deps

src/dune

@@ -5,7 +5,6 @@
   thread_page
   babillard
   babillard_page
-  plants_page
   db
   app
   content
@@ -30,16 +29,6 @@
  (preprocess
   (pps lwt_ppx)))
 
-(executable
- (name js_plant_map)
- (modules js_plant_map)
- (libraries js_of_ocaml brr)
- (modes js)
- (js_of_ocaml
-  (javascript_files leaflet/leaflet.js))
- (preprocess
-  (pps js_of_ocaml-ppx)))
-
 (executable
  (name js_babillard)
  (modules js_babillard)
@@ -106,12 +95,6 @@
  (action
   (run dream_eml %{deps} --workspace %{workspace_root})))
 
-(rule
- (targets plants_page.ml)
- (deps plants_page.eml.html)
- (action
-  (run dream_eml %{deps} --workspace %{workspace_root})))
-
 (rule
  (targets user_profile.ml)
  (deps user_profile.eml.html)
@@ -122,7 +105,6 @@
  (target content.ml)
  (deps
   (source_tree content)
-  (file content/assets/js/js_plant_map.js)
   (file content/assets/js/js_babillard.js)
   (file content/assets/js/js_newthread.js)
   (file content/assets/js/js_thread.js))

src/js_plant_map.ml

@@ -1,100 +0,0 @@
-let log = Format.printf
-
-module Leaflet = struct
-  (* get the leaflet object *)
-  let leaflet =
-    match Jv.(find global "L") with
-    | Some l -> l
-    | None -> failwith "can't load leaflet"
-
-  (* get popup object *)
-  let popup = Jv.call leaflet "popup" [||]
-
-  (* create a map *)
-  let map =
-    log "creating map@.";
-    let open Brr in
-    let _container = El.div ~at:At.[ id (Jstr.v "map") ] [] in
-    Jv.call leaflet "map" [| Jv.of_string "map" |]
-
-  (* create map's pos *)
-  let lat_lng =
-    log "making latlng@.";
-    Jv.call leaflet "latLng" [| Jv.of_float 51.505; Jv.of_float (-0.09) |]
-
-  (* set map's pos *)
-  let () =
-    log "setting view@.";
-    let _m : Jv.t = Jv.call map "setView" [| lat_lng; Jv.of_int 13 |] in
-    ()
-
-  (* create map tile layer *)
-  let tile_layer =
-    log "creating tile layer@.";
-    Jv.call leaflet "tileLayer"
-      [| Jv.of_string "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
-       ; Jv.obj
-           [| ( "attribution"
-              , Jv.of_string
-                  {|&copy; <a href="https://.www.openstreetmap.org/copyright">OpenStreetMap</a> contributors|}
-              )
-           |]
-      |]
-
-  (* add tile layer *)
-  let () =
-    log "adding tile layer@.";
-    let _map : Jv.t = Jv.call tile_layer "addTo" [| map |] in
-    ()
-
-  let on_click e =
-    log "on_click@.";
-
-    let lat_lng = Jv.get e "latlng" in
-    ignore @@ Jv.call popup "setLatLng" [| lat_lng |];
-    ignore @@ Jv.call popup "setContent" [| Jv.of_string "euujjj" |];
-    ignore @@ Jv.call popup "openOn" [| map |];
-
-    let lat = Jv.get lat_lng "lat" in
-    let lng = Jv.get lat_lng "lng" in
-    let lat_input = Jv.get Jv.global "lat_input" in
-    let lng_input = Jv.get Jv.global "lng_input" in
-    ignore @@ Jv.call lat_input "setAttribute" [| Jv.of_string "value"; lat |];
-    ignore @@ Jv.call lng_input "setAttribute" [| Jv.of_string "value"; lng |]
-
-  (*add on_click callback to map*)
-  let () =
-    ignore @@ Jv.call map "on" [| Jv.of_string "click"; Jv.repr on_click |]
-end
-
-module Marker = struct
-  let on_each_feature feature layer =
-    log "on_each_feature@.";
-    let feature_properties = Jv.get feature "properties" in
-    let feature_properties_content = Jv.get feature_properties "content" in
-    ignore @@ Jv.call layer "bindPopup" [| feature_properties_content |];
-    ()
-
-  let handle_geojson geojson =
-    log "handle_geojson@.";
-    log "feed geojson to leaflet@.";
-    let dict = Jv.obj [| ("onEachFeature", Jv.repr on_each_feature) |] in
-    let layer = Jv.call Leaflet.leaflet "geoJSON" [| geojson; dict |] in
-    let _marker_layer = Jv.call layer "addTo" [| Leaflet.map |] in
-    ()
-
-  let handle_response response =
-    log "handle_response@.";
-    let geo_json_list_futur = Jv.call response "json" [||] in
-    ignore @@ Jv.call geo_json_list_futur "then" [| Jv.repr handle_geojson |];
-    ()
-
-  let () =
-    log "fetch plant geojson@.";
-    let window = Jv.get Jv.global "window" in
-    let fetchfutur =
-      Jv.call window "fetch" [| Jv.of_string "/plant_markers" |]
-    in
-    ignore @@ Jv.call fetchfutur "then" [| Jv.repr handle_response |];
-    ()
-end

src/newthread_page.eml.html

@@ -1,11 +1,12 @@
 let f ~board request =
-%let url = Format.asprintf "/%a/new_thread" Babillard.pp_board board in
+%let board = Format.asprintf "%a" Babillard.pp_board board in
+%let url = Format.sprintf "/%s/new_thread" board in
 % begin match Dream.session "nick" request with
 % | None ->
 Login to make a new thread.
 % | Some _nick ->
 <script type="text/javascript" src="/assets/js/js_newthread.js" defer="defer"></script>
-<div id="board" data-board="babillard">Click the map to make a new thread:</div>
+<div id="board" data-board=<%s board %> >Click the map to make a new thread:</div>
 <div class="row mb-3">
     <div class="col-md-6">
         <div id="map"></div>

src/permap.ml

@@ -148,8 +148,6 @@ let post_image request =
   | Ok image -> Dream.respond ~headers:[ ("Content-Type", "image") ] image
   | Error _ -> Dream.empty `Not_Found
 
-let plants_get request = render_unsafe (Plants_page.f request) request
-
 let markers ~board request =
   let markers = Babillard.get_markers board in
   match markers with
@@ -157,7 +155,8 @@ let markers ~board request =
     Dream.respond ~headers:[ ("Content-Type", "application/json") ] markers
   | Error e -> render_unsafe e request
 
-let babillard_get request = render_unsafe (Babillard_page.f request) request
+let babillard_get ~board request =
+  render_unsafe (Babillard_page.f ~board request) request
 
 let newthread_get ~board request =
   render_unsafe (Newthread_page.f ~board request) request
@@ -283,15 +282,9 @@ let () =
        ; Dream.get "/profile" profile_get
        ; Dream.post "/profile" profile_post
        ; 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" (babillard_get ~board:Babillard)
        ; Dream.get "/babillard/new_thread" (newthread_get ~board:Babillard)
        ; Dream.post "/babillard/new_thread" (newthread_post ~board:Babillard)
        ; Dream.get "/babillard/:thread_id" thread_get

src/plant.ml

@@ -1,255 +0,0 @@
-(*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
-  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-  | Ok None -> Error (Format.sprintf "db error: value not found")
-  | Ok (Some x) -> f x
-
-(* ('a, string) result *)
-let ( let* ) o f =
-  match o with
-  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-  | Ok x -> f x
-
-module Q = struct
-  let create_plant_user_table =
-    Caqti_request.exec Caqti_type.unit
-      "CREATE TABLE IF NOT EXISTS plant_user (plant_id TEXT, nick TEXT, \
-       PRIMARY KEY(plant_id), FOREIGN KEY(nick) REFERENCES user(nick));"
-
-  let create_plant_image_table =
-    Caqti_request.exec Caqti_type.unit
-      "CREATE TABLE IF NOT EXISTS plant_image ( plant_id TEXT, image TEXT,id \
-       INTEGER, FOREIGN KEY(plant_id) REFERENCES plant_user(plant_id));"
-
-  let create_plant_tag_table =
-    Caqti_request.exec Caqti_type.unit
-      "CREATE TABLE IF NOT EXISTS plant_tag (plant_id TEXT, tag TEXT, FOREIGN \
-       KEY(plant_id) REFERENCES plant_user(plant_id));"
-
-  let create_plant_gps_table =
-    Caqti_request.exec Caqti_type.unit
-      "CREATE TABLE IF NOT EXISTS plant_gps (plant_id TEXT, lat FLOAT,lng \
-       FLOAT, FOREIGN KEY(plant_id) REFERENCES plant_user(plant_id));"
-
-  let upload_plant_id =
-    Caqti_request.exec
-      Caqti_type.(tup2 string string)
-      "INSERT INTO plant_user VALUES (?,?);"
-
-  let upload_plant_tag =
-    Caqti_request.exec
-      Caqti_type.(tup2 string string)
-      "INSERT INTO plant_tag VALUES (?,?);"
-
-  let upload_plant_gps =
-    Caqti_request.exec
-      Caqti_type.(tup3 string float float)
-      "INSERT INTO plant_gps VALUES (?,?,?);"
-
-  let upload_plant_image =
-    Caqti_request.exec
-      Caqti_type.(tup3 string string int)
-      "INSERT INTO plant_image VALUES (?,?,?);"
-
-  let get_user_plants =
-    Caqti_request.collect Caqti_type.string Caqti_type.string
-      "SELECT plant_id FROM plant_user WHERE nick=?;"
-
-  let list_plant_ids =
-    Caqti_request.collect Caqti_type.unit Caqti_type.string
-      "SELECT plant_id FROM plant_user;"
-
-  let count_plant_image =
-    Caqti_request.find_opt Caqti_type.string Caqti_type.int
-      "SELECT COUNT(*) FROM plant_image WHERE plant_id=?;"
-
-  let get_plant_image =
-    Caqti_request.find_opt
-      Caqti_type.(tup2 string int)
-      Caqti_type.string
-      "SELECT image FROM plant_image WHERE plant_id=? AND id=?;"
-
-  let get_plant_tags =
-    Caqti_request.collect Caqti_type.string Caqti_type.string
-      "SELECT tag FROM plant_tag WHERE plant_id=?;"
-
-  let get_plant_gps =
-    Caqti_request.find_opt Caqti_type.string
-      Caqti_type.(tup2 float float)
-      "SELECT lat, lng FROM plant_gps WHERE plant_id=?;"
-end
-
-let () =
-  let tables =
-    [ Q.create_plant_user_table
-    ; Q.create_plant_image_table
-    ; Q.create_plant_tag_table
-    ; Q.create_plant_gps_table
-    ]
-  in
-  if
-    List.exists Result.is_error
-      (List.map (fun query -> Db.exec query ()) tables)
-  then
-    Dream.warning (fun log -> log "can't create table")
-
-let view_plant plant_id =
-  let** count = Db.find_opt Q.count_plant_image plant_id in
-  let gps =
-    match Db.find_opt Q.get_plant_gps plant_id with
-    | Ok (Some (lat, lng)) -> Float.to_string lat ^ " " ^ Float.to_string lng
-    | Ok None -> ""
-    | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
-  in
-  let images =
-    String.concat "\n"
-      (List.map
-         (Format.sprintf
-            {|<li><img src="/plant_pic/%s/%i" class="img-thumbnail"></li>|}
-            plant_id )
-         (List.init count (fun i -> i)) )
-  in
-  let tags = Db.fold Q.get_plant_tags (fun tag acc -> tag :: acc) plant_id [] in
-  match tags with
-  | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-  | Ok tags ->
-    let tags = String.concat " " tags in
-    (* TODO add link to gps/map too *)
-    Ok (images ^ tags ^ gps)
-
-let marker_list () =
-  let* plant_id_list =
-    Db.fold Q.list_plant_ids (fun plant_id acc -> plant_id :: acc) () []
-  in
-  let markers_res =
-    List.map
-      (fun plant_id ->
-        match Db.find_opt Q.get_plant_gps plant_id with
-        | Ok (Some (lat, lng)) -> (
-          let content = view_plant plant_id in
-          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))
-        )
-      plant_id_list
-  in
-  let markers =
-    List.map
-      (fun res ->
-        match res with
-        | Ok res -> res
-        | Error _ -> assert false )
-      (List.filter Result.is_ok markers_res)
-  in
-  Ok markers
-
-let marker_to_geojson marker =
-  match marker with
-  | lat, lng, content ->
-    Format.sprintf
-      {|
-{
-  "type": "Feature",
-  "geometry": {
-    "type": "Point",
-    "coordinates": [%s,%s]
-  },
-  "properties": {
-    "content": "%s"
-  }
-} 
-|}
-      (* geojson use lng lat, and not lat lng*)
-      (Float.to_string lng)
-      (Float.to_string lat) (String.escaped content)
-
-let view_user_plant_list nick =
-  let plant_id_list =
-    Db.fold Q.get_user_plants (fun plant_id acc -> plant_id :: acc) nick []
-  in
-  match plant_id_list with
-  | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e)
-  | Ok plant_id_list ->
-    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 =
-  let** content = Db.find_opt Q.get_plant_image (plant_id, nb) in
-  Ok content
-
-(*TODO split validation and uploading to db like for babillard *)
-let add_plant (lat, lng) tags files nick =
-  if String.length tags > 1000 then
-    Error "tags too long"
-  else
-    let tag_list = Str.split (Str.regexp " +") tags in
-    let is_valid_list =
-      List.map (fun (_, content) -> is_valid_image content) files
-    in
-    let is_valid_files = List.for_all (fun valid -> valid) is_valid_list in
-    if not is_valid_files then
-      Error "Invalid image"
-    else
-      (* add plant to db *)
-      (* make id for plant*)
-      let plant_id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
-      (* add to plant_id <-> user*)
-      let res_plant = Db.exec Q.upload_plant_id (plant_id, nick) in
-      match res_plant with
-      | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-      | Ok _ -> (
-        (* add to plant_id <-> gps table*)
-        (*TODO check if valid latlng *)
-        let res_gps = Db.exec Q.upload_plant_gps (plant_id, lat, lng) in
-        match res_gps with
-        | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-        | Ok _ -> (
-          (* add to plant_id <-> tag table*)
-          let res_tags =
-            List.map
-              (fun tag -> Db.exec Q.upload_plant_tag (plant_id, tag))
-              tag_list
-          in
-          match List.find_opt Result.is_error res_tags with
-          | Some (Error e) ->
-            Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-          | Some _ -> assert false
-          | None -> (
-            (* add to plant_id <-> image*)
-            let res_images =
-              List.find_opt Result.is_error
-                (List.mapi
-                   (fun nb (_, content) ->
-                     Db.exec Q.upload_plant_image (plant_id, content, nb) )
-                   files )
-            in
-            match res_images with
-            | Some (Error e) ->
-              Error (Format.sprintf "db error: %s" (Caqti_error.show e))
-            | Some (Ok _) -> assert false
-            | None -> Ok () ) ) )

src/plants_page.eml.html

@@ -1,20 +0,0 @@
-let f request =
-<script type="text/javascript" src="/assets/js/js_babillard.js" defer="defer"></script>
-<div id="board" data-board="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

@@ -37,9 +37,6 @@ let render_unsafe ~title ~content request =
                               <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>