From b726fc22567ec1aab4963939bad2cad54b618774 Mon Sep 17 00:00:00 2001 From: Swrup Date: Thu, 16 Dec 2021 08:56:05 +0100 Subject: [PATCH] wip: marker for plants on the map --- src/content/assets/img/layers-2x.png | Bin 0 -> 1259 bytes src/content/assets/img/layers.png | Bin 0 -> 696 bytes src/content/assets/img/marker-icon-2x.png | Bin 0 -> 2464 bytes src/content/assets/img/marker-icon.png | Bin 0 -> 1466 bytes src/content/assets/img/marker-shadow.png | Bin 0 -> 618 bytes src/dune | 10 ++++ src/map.ml | 36 ++++++++++++ src/permap.ml | 31 ++++++++--- src/template.eml.html | 1 + src/user.ml | 64 ++++++++++++++++++++-- 10 files changed, 130 insertions(+), 12 deletions(-) create mode 100644 src/content/assets/img/layers-2x.png create mode 100644 src/content/assets/img/layers.png create mode 100644 src/content/assets/img/marker-icon-2x.png create mode 100644 src/content/assets/img/marker-icon.png create mode 100644 src/content/assets/img/marker-shadow.png diff --git a/src/content/assets/img/layers-2x.png b/src/content/assets/img/layers-2x.png new file mode 100644 index 0000000000000000000000000000000000000000..200c333dca9652ac4cba004d609e5af4eee168c1 GIT binary patch literal 1259 zcmeAS@N?(olHy`uVBq!ia0y~yU@!q;4i*LmhWx_I2@DJ@n><|{Ln;`Pe)y|cT4BSrpMM7AKE|dn|XR+k!t#k(tv`Q zFW(sEd!8~#>$+9`f9l__#fF!KZ}B_rzo8eC{r}xGzO@x)!A}C+%Y(`<1s-2^LiGH- zNefThzU1_3Qe}!q>B&sRiQ8E#H9j`Wp1zeElOM1<_xPqG{7q&i{}sRA|NWDBa`yhi zf4~1}Z!&l?D{`K~v~Df`g0pk31-#L={QUP&^~BTfPt276eJZ4F#OLLkrWm<1w?G}$K(_Zg>&?>%7rSDWy?-oPVGDw+3f6ddKzommMznMtmE1m^mE;|X)^@3r5^M>q%(7WwwkhRUVZzX zFui*B_UL;{ERE{7ySzCa{A5c-^`03^s-Cnw)fD`#!?J7Jk{=GMTBd1ws=RS{H7RMA z+lH2N3m&&zxMt!%-Q)BVRe@_$r#$1#RlV@>f}~i)v%B7(D}^uiKE0`=J9&~rL}git za^vjh=XaOCc>eeO>kuD~_nyZSSrR*HoRZ?^jT=9HS|#-C z#I0=$9oqx1b}%c7@V%LR;e=gTTa&Q*O*Q|E%7{caZdK)_+ZJf zZ?&H!g%0t3zQ`e9eahh1=NZBi3YOTd+htU}IKfpW%e~b`fYbPb(yyJ0eX|!$;Jmtc zpGlI(Uq{=OPOf@MjvXyZfAUxkxkT|?T2R1T7_4W$NpIDXdncV=-Og(5O3XcC)5tQ> zz+Ah^=e$i`pnF#TudS&IcRlWTsKE8W$-*hoo%u=2$;`|LE*k2wcM@{W?B28Hj1!|( z?&`3_D`smL6xn7gD*L#dPAd}*D+qeymA_@1k^7b7fk)o?9(Qdv5?I?{*Qdo6H_a$Z zWx4ILe&t;!1-}-TBu7TxOI@rh@5%8t*~M7);;#tq)bxD@K>`uh2LySGU20__qc2Mz zz5e8&(8Q{b_nT$qIxJK3ZwNANm$G;z+!`QW&+ygqZIXsCQ=*b?Q`wxE@t%9{h$R(y z`}7A0eZ8=B>r+-n=MV*-1+Ej;cKH>13)vbyyUbGSW~KP1V^g_>mQb1#clPCv9d}vs ze&jIq>z1(p^?bgvyl$yv;Vr)mizp0?3uUtD~sA1FSi+%x^t@XE}h@-tYzk9 zqoeJq#fQ#h%zQM#GO;LXnVpKdkC%5qo68}Ws3tQNA+-xadlV-caB*y5$@NebP0l+XkKIZj$K literal 0 HcmV?d00001 diff --git a/src/content/assets/img/layers.png b/src/content/assets/img/layers.png new file mode 100644 index 0000000000000000000000000000000000000000..1a72e5784b2b456eac5d7670738db80697af3377 GIT binary patch literal 696 zcmeAS@N?(olHy`uVBq!ia0y~yV2}b~4i*Lm24?3LR|W>AdQTU}kP61$5aS9JMv;5A zx9={r3D-Qo$}jd-@Kme(q}h{gk8N9f^YEHSI?4X$wi&*^XXUqVf93n@6)G0|HB0O+ z{oGRd;!&;aKiPjre@~N1y8by_{oP(ApF5A&Z+bmlV3plXXQ4Q^(0Q+y~?G3 z!a`R6-Bzb}>nxoMS3g;|c>CL9(`O!9VDQ7}^1l9i({>+QJ4%7S^9P-Qtwc)jUmWjVlF-6H4cVyjqg@ zMm}=+(G^1+f9k%t3*NyNhGDITISixbZs=XtX?<#@#To^} zllR&yC7Q0b2+Ufee$_3@VyDHEwjITj6hhx>ORdzOd~VN~YpdKO9dmD=@;Ir&?!Ka0 ze9@!>sms1^+w^n(%oWF3dR*t__&0jzGw-8qqez~?-<4~x zU6bljyRxA4^qUU`2YDx)`}y=x*@+KtSBac>;qcY?zuAd~x7`1fA4n|jeLTA^%I{0R z&%u&I8&&`GCa_jieR-P2?K98qLyM^QzxM~_RzHi!*UqnACyylIHN^Rj+B6T>B0g6wD2rb>45pm~>lr(g1)bIG-PU&x&EkqfVSO*&yS z;hbgfS=;Jm?$a(hPCjqmxW%!3m-FO{289cX=kK>@-tIN=m|6E(zuA|q`_Fk#J#X4| z*0y{tG5mYrJM&be(p=rT6IlmmfW5UU2Hz<2n7J+mwrr-TRF?&V zs_)#7Uw`VB9X@~mmHni1?h{YB&A71m;5DZS7tY*$5wYNs%e3=LkK8nDKjS{>tX=Pg zt!M9fH?R8l@Bi^z&p&_vW!`i4?dR`v_g=Q2d_K5+tzXB6px$jMQ@2gtej$F@_2e0Q z9Xb!V_n&Z^e9@s{ZR~{2!982zCT(|`dj84V&nBH`ww%75u>873@7dlh=bfjXH|{(W z7d!Ji0|SF|NswPKgN%7_eosI1qqlQh)VQ0z2_?Q_-+JKUU7huPe~$OxD4((Q%=1rn z?q4@-&3bU7TsbLBvg!I5S2dYWD;2#S7ZU|h_he3U@wtzOHt*icIpHmL zy?Ai&|Ch$MFYn&^pnlOR%aGe&>)tMux+?e~{z}Q!-sv)H?Z4&ghKAqWlXPcq>ejrS z$BVzazm`65urEF{ge%(WbpDLf>%-W3W7Q8Z-diaxRrFdX{@IL*dsFs5{QGXyqWOP4-1PE)zwr(UqLCNG@BDShIb@BbQOH~rvz6x(1rM{&)h zCI2^1ie0}woOhbaNv}DX8hPC_CNKHouloIxr(aOX;V(s%tEQ{y7mEGo6BjSNdm(Vs z!BXu_x9&`h);d4=?!Ti)lNFxZ-a1{#+&m+>>+vSZ{Dx(nJA39omT)(Wd}d*OchY}> zS=Wlr9G}5lbce-J`;++A6P>4z=5$@YRO0(?M@{jf7aF}sW!InoesgvD`S0uR{y+7c zJM*Z^%fdw#&#l*lSVe4|v9FI;Blz0)M}eM4}1S7y|fO|lGIHmwo6)ysN) z@`Y2E&hx0QzQ6Ic0N5mtVH?#oTPjdTv<|H^U?6ohXl5NmKFtfVaU1XGt93HWL;;RCz(~i-B@2 ztMZwa3;7ji`<>cuYUsWYyyfT~aW>~)Ttdp0haa*^A7`rEIn48j^>mNb9mZLUU;Dgq zb(BBsvZ#Nx_Uel(roBAMoph#Zi{zHxs=z<2V(tqsuD&`oda+X07I6J*oa%H2;&Oq~}6b8UMv1o^cHB zw@!+h7H6D zE$XK?O<(fKWT9kaoQA9NCob2O4UaD6IrQb)Yuwtmc1m82EZ4gF#as5z)n(u0^CphP zQoO8O{?ujuQ*uXBbiS=f+M{6qXZNIC-#wKX9$WmgkWlOGG%UQt>8v8C#bLHj^{?#p zq^}Oqw=ccclsgm}$Rb#}qSsU0T>Y|%q3Of?gq$MZT@r_@Zu{PyecS50-wK8AYV-e2 zfB!+nf3KYzTfhAMRX%I(>aI5GIrFb~>*ZDV4V`!wuLxajKX3Ps*sJFZ{dk2L|LmL? zzat=TpVAF?U;l!InHzU3j`scCuEl+urt8mrgm91(dc6j+tP z6A`%Mx>-aj?~J8<#TLO+mYPp{qlT&iN z&a1S3<*O-TZj{@!u_4N6X2lKeSu#n_P@}6L{b6Jl@&cjG~%U8!&Dx}z( zrMAAcayuD$-&lEawocKa4aqJsJ&X3~rhP8ov`9`;z3BX#j-a~m>C=zc{$M|Ob;m?a ziOFe4?k@Rq<_XD> zB4=;4Zhd?AM&|77+xND~`rPKZmAu(>+oP1++ovkt{rkN7+x4_tFaL!ukK6nGo$YfQ z^*v9n8!cmLEqlSVG%sR-0gvk$*DRbW z{m-p)*DZrjd!y_xaa_#o*4U(@uKo4!Pp!ij7T!1}%l>}rjh7!Q-(N81zW?~clRw*E z{?k)GYWmiy#bRlmL;oJl&J$aiudgm)F0-iHas2Qk`y1cI?%sa8bcrAT(b;!%I<0P9 z{GTy@w!r#Jyj6z3I9)}Su6`_XYb*QXS!FV5bHD9z{itSs)R*aqqTRyE=Ymg+ZNB$v zHnpZ&)$hNave^Ci{e>)>+mm|UX)=F2arlas*Y!VZ^`gp;W=x!PmHFb<*?e}lzMCE0 zvRk9d-y7$jUC*^W@geu4@I-OlYNyz3uMQ~hJ@ZAvR^;ZhPs}lPSAO%o7BSQa zbpPGC@q~NNuAHs@aeMx#hPkYYE#J1MVCVaHeA;*K{uFcFvg=QSSx&=`UA`hqVtqd? zdYU5{zPVBEP0{7r*yQI8{Cgfe_xwDKZM9d}j|Vzyjy`R7nLK@io8wY#kL`E7Jf<68x9vugLJO(0z-KZ&Qdg!24aAb07_69#wwGGo2xYnJYN`~G6Y z{f5WJTvyi~d3Pw}=hJ5XJrB~|HdTa{+%+rHYo0wvW<#>j?DETdO_@vH{3w)qU%ji; z_NZx&{M3G{ii77TKhyiAxALr4;M%-PCKi?|B^8>h(u}9Bzu_-jd+e)R*D9HVSAKyF zecrkG`QJvbip||uzVh)2I2K)AknA*Z-`f1(ke>{yQhV!uK44yNk^b+!z|FQq$H>U% z4;rj)&CipZ6`-=U+SoNLchL;9^D}-vc+R=`7mwnv#>0hg<$|tQStOh|DXSMGs-QM%v9#OT6aOo!0u!OS>mk{4v*^-gU{kUv-=DI!X3RTGs59 zrms7aq`qxvdDNrlbwOV>GmT$cCUm!OcDu!Xn-2~CQ?8YY{CTrg$>;Sw`KWyp56!-# zvTn<7$3qHR4xXKK)bzH)nQ1H9&39e2*J8I>_;hw(^Yq=jSu~fmADQ`g-w!kW*($3f zq`R`zS+DL4=#y?Q`_N(ZtLBi%<=QzX-b%(U=MFlvzxDbXmD0JBS)OidXsr40A^42_ zgQZVg7!FDwD~idOcvfy#ai6Y&gUYVfn=F;xwLJ0PR(xmSKH_ux;D=dz-;~^0xZPL! z1ozroz7KYO?cK)hC-BfMm|Z;L!tIi4FB=3m3Vm8)$!*y6sqlWqio>o2PxU5+TD=Tg zTYBn%ncKVvzMt<;x^8t&I-EsdU*;9>P2#^cg&*=|96!BiOWgcbr%qb!*P729?QZ?6 zRrA<$=6|mncDLWmyzk*RUeFH>vO3!Qi?h`T=KR)_2Cros(q` zrr!L0L#TAiV);U2p+@gxZ`B_y65O@-44>dO5ph1@TNmwv1>fy$%wBo$+&WgT#8pop z)W1KvrsG3JiO}O;u{)0M6cpu=b+0}4U()?P(=nGF;+fwCy{@FkvLxKGX3gAtJaCcS qX{9?EN|FMnBE=+YEB(x$$D3}plVUPRyu-l2z~JfX=d#Wzp$P!`FXGq$ literal 0 HcmV?d00001 diff --git a/src/content/assets/img/marker-shadow.png b/src/content/assets/img/marker-shadow.png new file mode 100644 index 0000000000000000000000000000000000000000..9fd2979532a19a15b824ce763c76e04a8dafadfb GIT binary patch literal 618 zcmeAS@N?(olHy`uVBq!ia0y~yV9*3%4i*Lm2ByptwG0eQhMq2tAr*{oFSYhPb`W5> zz-9dRf4!`+aT{;(+DlW`OuKvh(cD`Fe?o50tvmGJPyYYkI}^-Pj=%i->5t$_?z+Eg z<0t)EHE)aXMy2F{nEjj_T;IYwdK?Rnnaqjf{1)D-;#kNmzt4GE;O+QxK@S+5(^AaU z7N=aDb)V1U?7Vn^%sUpxJr3q=Te918=e*elN$zhlHIzdXC1oeM8Mbg5Nj2o3WOPw+ zpMOwu*&gweJLb*OS~P7Ar@rLmS*ayg8lq+dZ0+?Zm6nX!yo^w|MJ60@P{_ADQggak&v`^0oPSK8g z6Zm$gzJVJ145{rKZ=dn?y=(KrV#&L&JR6VjWuMu>*SMBLWeLMd-$OHax6Mdiqt~NQ zs^Y#(?6|a*=efdFwcBoGHo3%{*nZNbWKCU{!`kM%S>CBD4~8GC3UcaXD%fwav8F%f z=oGOgmCmZ50aHZd{ geojson *) + (* TODO make popup *) + log "fetch geojson@."; + let window = Jv.get Jv.global "window" in + let fetchfutur = Jv.call window "fetch" [| Jv.of_string "/markers" |] in + ignore @@ Jv.call fetchfutur "then" [| Jv.repr handle_response |]; + () + 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 3994542..cf59c60 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -170,13 +170,17 @@ let add_plant_post request = match (lat, lng) with | [], _ -> render_unsafe "Field tag is empty" request | _, [] -> 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) ] -> ( + 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 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 @@ -188,6 +192,18 @@ let add_plant_post request = | `Wrong_content_type -> Dream.empty `Bad_Request ) +let markers request = + let marker_list = User.marker_list () in + match marker_list with + | Ok marker_list -> + let json = + {| [ |} + ^ String.concat "," (List.map User.marker_to_geojson marker_list) + ^ "]" + in + Dream.respond ~headers:[ ("Content-Type", "application/json") ] json + | Error e -> render_unsafe e request + let () = Dream.run @@ Dream.logger @@ Dream.memory_sessions @@ Dream.router @@ -207,5 +223,6 @@ let () = ; 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 "/markers" markers ] @@ Dream.not_found diff --git a/src/template.eml.html b/src/template.eml.html index d305546..cfd145c 100644 --- a/src/template.eml.html +++ b/src/template.eml.html @@ -7,6 +7,7 @@ let render_unsafe ~title ~content request = +
diff --git a/src/user.ml b/src/user.ml index 9079c86..775e320 100644 --- a/src/user.ml +++ b/src/user.ml @@ -29,8 +29,8 @@ module Q = struct let create_plant_gps_table = Caqti_request.exec Caqti_type.unit - "CREATE TABLE IF NOT EXISTS plant_gps (plant_id TEXT, lat TEXT,lng TEXT, \ - FOREIGN KEY(plant_id) REFERENCES plant_user(plant_id));" + "CREATE TABLE IF NOT EXISTS plant_gps (plant_id TEXT, lat FLOAT,lng \ + FLOAT, FOREIGN KEY(plant_id) REFERENCES plant_user(plant_id));" let get_password = Caqti_request.find_opt Caqti_type.string Caqti_type.string @@ -86,7 +86,7 @@ module Q = struct let upload_plant_gps = Caqti_request.exec - Caqti_type.(tup3 string string string) + Caqti_type.(tup3 string float float) "INSERT INTO plant_gps VALUES (?,?,?);" let upload_plant_image = @@ -98,6 +98,10 @@ module Q = struct 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=?;" @@ -114,7 +118,7 @@ module Q = struct let get_plant_gps = Caqti_request.find_opt Caqti_type.string - Caqti_type.(tup2 string string) + Caqti_type.(tup2 float float) "SELECT lat, lng FROM plant_gps WHERE plant_id=?;" end @@ -208,7 +212,8 @@ let view_plant plant_id = | Some count -> ( let gps = match Db.find_opt Q.get_plant_gps plant_id with - | Ok (Some (lat, lng)) -> lat ^ " " ^ lng + | 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 @@ -230,6 +235,55 @@ let view_plant plant_id = | None -> "db error" ) | Error e -> Format.sprintf "db error: %s" (Caqti_error.show e) +let marker_list () = + let plant_id_list = + Db.fold Q.list_plant_ids (fun plant_id acc -> plant_id :: acc) () [] + in + match plant_id_list with + | Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e)) + | Ok plant_id_list -> + 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 + 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" + } +} +|} + (*TODO escape in content ?? *) + (Float.to_string lat) + (Float.to_string lng) (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 []