From c3b5a9c1941d53f6586170b72e3b09da9024b4cc Mon Sep 17 00:00:00 2001 From: Swrup Date: Thu, 9 Dec 2021 07:27:44 +0100 Subject: [PATCH] add click event on map --- src/add_plant.eml.html | 3 +++ src/map.ml | 31 +++++++++++++++++------- src/permap.ml | 23 +++++++++++------- src/user.ml | 53 +++++++++++++++++++++++++----------------- 4 files changed, 72 insertions(+), 38 deletions(-) diff --git a/src/add_plant.eml.html b/src/add_plant.eml.html index 92a218d..1bf68d9 100644 --- a/src/add_plant.eml.html +++ b/src/add_plant.eml.html @@ -1,7 +1,10 @@ let f nick request = <%s Format.sprintf "Add a plant to your Collection %s !" nick %>
+
<%s! Dream.form_tag ~action:"/add_plant" ~enctype:`Multipart_form_data request %> + +
Describe your plant with tags
diff --git a/src/map.ml b/src/map.ml index 09eeb07..4c2e000 100644 --- a/src/map.ml +++ b/src/map.ml @@ -1,3 +1,4 @@ +(* TODO only run this on /add_plant and /map *) let log = Format.printf (* get the leaflet object *) @@ -6,6 +7,9 @@ let leaflet = | 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@."; @@ -43,12 +47,23 @@ let () = let _map : Jv.t = Jv.call tile_layer "addTo" [| map |] in () -(* TODO :-) - (* binding callbacks@ *) - let () = - Format.eprintf "binding callbacks@."; +let on_click e = + log "on_click@."; - Ev.listen Leaflet.Map.click (fun e -> - Console.log [ e |> Ev.as_type |> Leaflet.Ev.MouseEvent.latlng ] ) - @@ Leaflet.Map.as_target map -*) + let lat_lng = Jv.get e "latlng" in + ignore @@ Jv.call popup "setLatLng" [| lat_lng |]; + ignore @@ Jv.call popup "setContent" [| Jv.of_string "YOU CLICKED HERE" |]; + ignore @@ Jv.call popup "openOn" [| map |]; + + (*TODO use Brr to insert lat_lng in the form *) + let open Brr in + let lat_lng_input = El.input ~at:At.[ id (Jstr.v "lat_lng") ] () in + ignore + @@ El.set_at (Jstr.of_string "value") + (Some (Jstr.of_string "FUCK")) + lat_lng_input; + () + +let () = + (*add on_click callback to map*) + ignore @@ Jv.call map "on" [| Jv.of_string "click"; Jv.repr on_click |] diff --git a/src/permap.ml b/src/permap.ml index 1028bdb..643454a 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -154,17 +154,22 @@ let add_plant_post request = | None -> render_unsafe "Not logged in" request | Some nick -> ( match%lwt Dream.multipart request with - | `Ok [ ("files", files); ("tags", tags) ] - | `Ok (("files", files) :: ("tags", tags) :: _ :: _) -> ( + | `Ok [ ("files", files); ("lat_lng", lat_lng); ("tags", tags) ] + | `Ok (("files", files) :: ("lat_lng", lat_lng) :: ("tags", tags) :: _ :: _) + -> ( match tags with | [] -> render_unsafe "Field tag is empty" request - | [ (_, tags) ] -> - let res = - match User.add_plant tags files nick with - | Ok () -> "Your plant was uploaded!" - | Error e -> e - in - render_unsafe res request + | [ (_, tags) ] -> ( + match lat_lng with + | [] -> render_unsafe "Field tag is empty" request + | [ (_, lat_lng) ] -> + let res = + match User.add_plant lat_lng tags files nick with + | Ok () -> "Your plant was uploaded!" + | Error e -> e + in + render_unsafe res request + | _lat_lng -> Dream.empty `Bad_Request ) | _tags -> Dream.empty `Bad_Request ) | `Ok _ -> Dream.empty `Bad_Request | `Expired _ diff --git a/src/user.ml b/src/user.ml index 48b21d3..7a97183 100644 --- a/src/user.ml +++ b/src/user.ml @@ -111,6 +111,10 @@ module Q = struct let get_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.string + "SELECT gps FROM plant_gps WHERE plant_id=?;" end module Db = @@ -201,6 +205,12 @@ let view_plant plant_id = | Ok count -> ( match count with | Some count -> ( + let gps = + match Db.find_opt Q.get_plant_gps plant_id with + | Ok (Some gps) -> gps + | Ok None -> "" + | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e) + in let images = String.concat "\n" (List.map @@ -215,7 +225,7 @@ let view_plant plant_id = | Ok tags -> let tags = String.concat " " tags in (* TODO add link to gps/map too *) - images ^ tags ) + images ^ tags ^ gps ) | None -> "db error" ) | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e) @@ -323,27 +333,28 @@ let upload_avatar files nick = (* TODO do the same for text input: check length, forbidden chars and have a forbidden words filter*) let is_valid_image _content = true -let add_plant tags files nick = - match files with - | files -> ( - let tags_len = String.length tags in - if tags_len > 1000 then - Error "tags too long" +let add_plant gps tags files nick = + let tags_len = String.length tags in + if tags_len > 1000 then + Error "tags too long" + else + let tag_list = Str.split (Str.regexp " +") tags in + (* id for plant*) + let ok_list = List.map (fun (_, content) -> is_valid_image content) files in + let valid_files = List.for_all (fun valid -> valid) ok_list in + if not valid_files then + Error "Invalid image" else - let tag_list = Str.split (Str.regexp " +") tags in - (* id for plant*) - let ok_list = - List.map (fun (_, content) -> is_valid_image content) files - in - let valid_files = List.for_all (fun valid -> valid) ok_list in - if not valid_files then - Error "Invalid image" - else - (* add plant to db *) - 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 + (* add plant to db *) + 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*) + let res_gps = Db.exec Q.upload_plant_gps (plant_id, gps) in + match res_gps with | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) | Ok _ -> ( (* add to plant_id <-> tag table*)