add click event on map

This commit is contained in:
Swrup 2021-12-09 07:27:44 +01:00
parent 407413654c
commit c3b5a9c194
4 changed files with 72 additions and 38 deletions

View file

@ -1,7 +1,10 @@
let f nick request =
<%s Format.sprintf "Add a plant to your Collection %s !" nick %>
<div class="mb-3">
<div id="map"></div>
<%s! Dream.form_tag ~action:"/add_plant" ~enctype:`Multipart_form_data request %>
<input type="hidden" id="lat_lng" name="lat_lng" value="THIS IS NOT WORKING">
<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>

View file

@ -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 |]

View file

@ -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) ] ->
| [ (_, tags) ] -> (
match lat_lng with
| [] -> render_unsafe "Field tag is empty" request
| [ (_, lat_lng) ] ->
let res =
match User.add_plant tags files nick with
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 _

View file

@ -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,18 +333,14 @@ 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 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 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"
@ -345,6 +351,11 @@ let add_plant tags files nick =
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*)
let res_tags =