change thread_view to a thread_preview with link
This commit is contained in:
parent
0ad247c4be
commit
7330594dbf
12 changed files with 263 additions and 242 deletions
|
|
@ -1,4 +1,5 @@
|
||||||
let f nick request =
|
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 %>
|
<%s Format.sprintf "Add a plant to your Collection %s !" nick %>
|
||||||
<div class="mb-3">
|
<div class="mb-3">
|
||||||
<div id="map"></div>
|
<div id="map"></div>
|
||||||
|
|
@ -15,4 +16,3 @@ let f nick request =
|
||||||
<button type="submit" class="btn btn-primary">Add Plant</button>
|
<button type="submit" class="btn btn-primary">Add Plant</button>
|
||||||
</div>
|
</div>
|
||||||
</form>
|
</form>
|
||||||
<script type="text/javascript" src="/assets/js/js_plant_map.js" defer="defer"></script>
|
|
||||||
|
|
|
||||||
|
|
@ -284,7 +284,7 @@ let view_post post_id =
|
||||||
{|
|
{|
|
||||||
<div class="file">
|
<div class="file">
|
||||||
<a title="%s" href="/post_pic/%s">
|
<a title="%s" href="/post_pic/%s">
|
||||||
<img src="/post_pic/%s" style="width:100" loading="lazy">
|
<img src="/post_pic/%s" style="width:200px;height:200px;" loading="lazy">
|
||||||
</a>
|
</a>
|
||||||
</div>
|
</div>
|
||||||
|}
|
|}
|
||||||
|
|
@ -377,6 +377,7 @@ let view_thread thread_id =
|
||||||
in
|
in
|
||||||
Ok (String.concat "\n\r" view_posts) ) )
|
Ok (String.concat "\n\r" view_posts) ) )
|
||||||
|
|
||||||
|
(*TODO split verifying and doing stuff with uploading to the db*)
|
||||||
let make_post ~comment ?file ~tags ?parent_id nick =
|
let make_post ~comment ?file ~tags ?parent_id nick =
|
||||||
let is_valid_comment =
|
let is_valid_comment =
|
||||||
String.length comment < 10000
|
String.length comment < 10000
|
||||||
|
|
@ -395,7 +396,6 @@ let make_post ~comment ?file ~tags ?parent_id nick =
|
||||||
| _, false, _ -> Error "invalid file"
|
| _, false, _ -> Error "invalid file"
|
||||||
| _, _, false -> Error "invalid tags"
|
| _, _, false -> Error "invalid tags"
|
||||||
| true, true, true -> (
|
| true, true, true -> (
|
||||||
(*TODO make post_id a int *)
|
|
||||||
let post_id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
|
let post_id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
|
||||||
(* add to plant_id <-> user*)
|
(* add to plant_id <-> user*)
|
||||||
let res_post_id = Db.exec Q.upload_post_id (post_id, nick) in
|
let res_post_id = Db.exec Q.upload_post_id (post_id, nick) in
|
||||||
|
|
@ -404,6 +404,7 @@ let make_post ~comment ?file ~tags ?parent_id nick =
|
||||||
let res_comment = Db.exec Q.upload_post_comment (post_id, comment) in
|
let res_comment = Db.exec Q.upload_post_comment (post_id, comment) in
|
||||||
let res_image =
|
let res_image =
|
||||||
match file with
|
match file with
|
||||||
|
| None -> Ok ()
|
||||||
| Some (image_name, image_content) ->
|
| Some (image_name, image_content) ->
|
||||||
let image_name =
|
let image_name =
|
||||||
match image_name with
|
match image_name with
|
||||||
|
|
@ -413,7 +414,6 @@ let make_post ~comment ?file ~tags ?parent_id nick =
|
||||||
Uuidm.to_string (Uuidm.v4_gen random_state ())
|
Uuidm.to_string (Uuidm.v4_gen random_state ())
|
||||||
in
|
in
|
||||||
Db.exec Q.upload_post_image (post_id, image_name, image_content)
|
Db.exec Q.upload_post_image (post_id, image_name, image_content)
|
||||||
| None -> Ok ()
|
|
||||||
in
|
in
|
||||||
let res_tags =
|
let res_tags =
|
||||||
match
|
match
|
||||||
|
|
|
||||||
|
|
@ -1,29 +1,14 @@
|
||||||
let f request =
|
let f request =
|
||||||
<script type="text/javascript" src="/assets/js/js_thread_map.js" defer="defer"></script>
|
<script type="text/javascript" src="/assets/js/js_babillard.js" defer="defer"></script>
|
||||||
<%s Format.sprintf "Babillard is love" %>
|
<%s Format.sprintf "Babillard is love" %>
|
||||||
<div class="mb-3">
|
<div class="mb-3">
|
||||||
% begin match Dream.session "nick" request with
|
% begin match Dream.session "nick" request with
|
||||||
% | None ->
|
% | None ->
|
||||||
|
|
||||||
% | Some _nick ->
|
% | Some _nick ->
|
||||||
<%s! Dream.form_tag ~action:"/babillard" ~enctype:`Multipart_form_data request %>
|
<a href="/babillard/new_thread">[New Thread]</a>
|
||||||
<input type="hidden" id="lat_input" name="lat_input">
|
% end;
|
||||||
<input type="hidden" id="lng_input" name="lng_input">
|
|
||||||
|
|
||||||
<label for="subject" id="subjectLabel" class="form-label">Subject</label>
|
|
||||||
<input name="subject" type="text" class="form-control" id="subject" aria-labelledby="subjectLabel"></input>
|
|
||||||
|
|
||||||
<label for="threadComment" id="threadCommentLabel" class="form-label">Comment</label>
|
|
||||||
<textarea name="threadComment" type="text" class="form-control" id="threadComment" aria-labelledby="threadCommentLabel"></textarea>
|
|
||||||
|
|
||||||
<label for="tags" id="tagsLabel" class="form-label">Tags</label>
|
|
||||||
<input name="tags" type="text" class="form-control" id="tags" aria-labelledby="tagsLabel"></input>
|
|
||||||
|
|
||||||
<input id="file" name="file" aria-describedby="fileHelp" type="file">
|
|
||||||
<div id="fileHelp" class="form-text">Add a picture for your thread</div>
|
|
||||||
<button type="submit" class="btn btn-primary">Make Thread</button>
|
|
||||||
</form>
|
|
||||||
%end;
|
|
||||||
<div id="map"></div>
|
<div id="map"></div>
|
||||||
<div id="thread_div"></div>
|
<div id="thread_preview_div"></div>
|
||||||
|
<a id="thread_link"></a>
|
||||||
</div>
|
</div>
|
||||||
|
|
|
||||||
|
|
@ -8,10 +8,19 @@
|
||||||
(cat ../../../js_plant_map.bc.js))))
|
(cat ../../../js_plant_map.bc.js))))
|
||||||
|
|
||||||
(rule
|
(rule
|
||||||
(target js_thread_map.js)
|
(target js_babillard.js)
|
||||||
(deps
|
(deps
|
||||||
(file ../../../js_thread_map.bc.js))
|
(file ../../../js_babillard.bc.js))
|
||||||
(action
|
(action
|
||||||
(with-stdout-to
|
(with-stdout-to
|
||||||
%{target}
|
%{target}
|
||||||
(cat ../../../js_thread_map.bc.js))))
|
(cat ../../../js_babillard.bc.js))))
|
||||||
|
|
||||||
|
(rule
|
||||||
|
(target js_thread.js)
|
||||||
|
(deps
|
||||||
|
(file ../../../js_thread.bc.js))
|
||||||
|
(action
|
||||||
|
(with-stdout-to
|
||||||
|
%{target}
|
||||||
|
(cat ../../../js_thread.bc.js))))
|
||||||
|
|
|
||||||
24
src/dune
24
src/dune
|
|
@ -1,6 +1,7 @@
|
||||||
(executable
|
(executable
|
||||||
(public_name permap)
|
(public_name permap)
|
||||||
(modules
|
(modules
|
||||||
|
newthread_page
|
||||||
thread_page
|
thread_page
|
||||||
babillard
|
babillard
|
||||||
babillard_page
|
babillard_page
|
||||||
|
|
@ -42,8 +43,18 @@
|
||||||
(pps js_of_ocaml-ppx)))
|
(pps js_of_ocaml-ppx)))
|
||||||
|
|
||||||
(executable
|
(executable
|
||||||
(name js_thread_map)
|
(name js_babillard)
|
||||||
(modules js_thread_map)
|
(modules js_babillard)
|
||||||
|
(libraries js_of_ocaml brr)
|
||||||
|
(modes js)
|
||||||
|
(js_of_ocaml
|
||||||
|
(javascript_files leaflet/leaflet.js))
|
||||||
|
(preprocess
|
||||||
|
(pps js_of_ocaml-ppx)))
|
||||||
|
|
||||||
|
(executable
|
||||||
|
(name js_thread)
|
||||||
|
(modules js_thread)
|
||||||
(libraries js_of_ocaml brr)
|
(libraries js_of_ocaml brr)
|
||||||
(modes js)
|
(modes js)
|
||||||
(js_of_ocaml
|
(js_of_ocaml
|
||||||
|
|
@ -81,6 +92,12 @@
|
||||||
(action
|
(action
|
||||||
(run dream_eml %{deps} --workspace %{workspace_root})))
|
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||||
|
|
||||||
|
(rule
|
||||||
|
(targets newthread_page.ml)
|
||||||
|
(deps newthread_page.eml.html)
|
||||||
|
(action
|
||||||
|
(run dream_eml %{deps} --workspace %{workspace_root})))
|
||||||
|
|
||||||
(rule
|
(rule
|
||||||
(targets add_plant.ml)
|
(targets add_plant.ml)
|
||||||
(deps add_plant.eml.html)
|
(deps add_plant.eml.html)
|
||||||
|
|
@ -98,7 +115,8 @@
|
||||||
(deps
|
(deps
|
||||||
(source_tree content)
|
(source_tree content)
|
||||||
(file content/assets/js/js_plant_map.js)
|
(file content/assets/js/js_plant_map.js)
|
||||||
(file content/assets/js/js_thread_map.js))
|
(file content/assets/js/js_babillard.js)
|
||||||
|
(file content/assets/js/js_thread.js))
|
||||||
(action
|
(action
|
||||||
(with-stdout-to
|
(with-stdout-to
|
||||||
%{null}
|
%{null}
|
||||||
|
|
|
||||||
116
src/js_babillard.ml
Normal file
116
src/js_babillard.ml
Normal file
|
|
@ -0,0 +1,116 @@
|
||||||
|
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
|
||||||
|
{|© <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 marker_on_click thread_preview thread_id _e =
|
||||||
|
log "marker_on_click@.";
|
||||||
|
let thread_id = Jv.to_string thread_id in
|
||||||
|
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
|
||||||
|
ignore @@ Jv.set thread_link "href" (Jv.of_string link);
|
||||||
|
ignore @@ Jv.set thread_link "innerText" (Jv.of_string "[View Thread]");
|
||||||
|
()
|
||||||
|
|
||||||
|
let on_each_feature feature layer =
|
||||||
|
log "on_each_feature@.";
|
||||||
|
let feature_properties = Jv.get feature "properties" in
|
||||||
|
let thread_preview = Jv.get feature_properties "content" in
|
||||||
|
let thread_id = Jv.get feature_properties "thread_id" in
|
||||||
|
ignore
|
||||||
|
@@ Jv.call layer "on"
|
||||||
|
[| Jv.of_string "click"
|
||||||
|
; Jv.repr (marker_on_click thread_preview thread_id)
|
||||||
|
|];
|
||||||
|
()
|
||||||
|
|
||||||
|
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 markers_handle_response response =
|
||||||
|
log "markers_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 thread geojson@.";
|
||||||
|
let window = Jv.get Jv.global "window" in
|
||||||
|
let fetchfutur =
|
||||||
|
Jv.call window "fetch" [| Jv.of_string "/thread_markers" |]
|
||||||
|
in
|
||||||
|
ignore @@ Jv.call fetchfutur "then" [| Jv.repr markers_handle_response |];
|
||||||
|
()
|
||||||
|
end
|
||||||
|
|
@ -1,37 +1,35 @@
|
||||||
(* TODO only run this on /add_plant and /map *)
|
|
||||||
(*TODO clean up this shit *)
|
|
||||||
(*TODO use Jv.find everywhere (do we care?)*)
|
|
||||||
let log = Format.printf
|
let log = Format.printf
|
||||||
|
|
||||||
(* get the leaflet object *)
|
module Leaflet = struct
|
||||||
let leaflet =
|
(* get the leaflet object *)
|
||||||
|
let leaflet =
|
||||||
match Jv.(find global "L") with
|
match Jv.(find global "L") with
|
||||||
| Some l -> l
|
| Some l -> l
|
||||||
| None -> failwith "can't load leaflet"
|
| None -> failwith "can't load leaflet"
|
||||||
|
|
||||||
(* get popup object *)
|
(* get popup object *)
|
||||||
let popup = Jv.call leaflet "popup" [||]
|
let popup = Jv.call leaflet "popup" [||]
|
||||||
|
|
||||||
(* create a map *)
|
(* create a map *)
|
||||||
let map =
|
let map =
|
||||||
log "creating map@.";
|
log "creating map@.";
|
||||||
let open Brr in
|
let open Brr in
|
||||||
let _container = El.div ~at:At.[ id (Jstr.v "map") ] [] in
|
let _container = El.div ~at:At.[ id (Jstr.v "map") ] [] in
|
||||||
Jv.call leaflet "map" [| Jv.of_string "map" |]
|
Jv.call leaflet "map" [| Jv.of_string "map" |]
|
||||||
|
|
||||||
(* create map's pos *)
|
(* create map's pos *)
|
||||||
let lat_lng =
|
let lat_lng =
|
||||||
log "making latlng@.";
|
log "making latlng@.";
|
||||||
Jv.call leaflet "latLng" [| Jv.of_float 51.505; Jv.of_float (-0.09) |]
|
Jv.call leaflet "latLng" [| Jv.of_float 51.505; Jv.of_float (-0.09) |]
|
||||||
|
|
||||||
(* set map's pos *)
|
(* set map's pos *)
|
||||||
let () =
|
let () =
|
||||||
log "setting view@.";
|
log "setting view@.";
|
||||||
let _m : Jv.t = Jv.call map "setView" [| lat_lng; Jv.of_int 13 |] in
|
let _m : Jv.t = Jv.call map "setView" [| lat_lng; Jv.of_int 13 |] in
|
||||||
()
|
()
|
||||||
|
|
||||||
(* create map tile layer *)
|
(* create map tile layer *)
|
||||||
let tile_layer =
|
let tile_layer =
|
||||||
log "creating tile layer@.";
|
log "creating tile layer@.";
|
||||||
Jv.call leaflet "tileLayer"
|
Jv.call leaflet "tileLayer"
|
||||||
[| Jv.of_string "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
|
[| Jv.of_string "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
|
||||||
|
|
@ -43,13 +41,13 @@ let tile_layer =
|
||||||
|]
|
|]
|
||||||
|]
|
|]
|
||||||
|
|
||||||
(* add tile layer *)
|
(* add tile layer *)
|
||||||
let () =
|
let () =
|
||||||
log "adding tile layer@.";
|
log "adding tile layer@.";
|
||||||
let _map : Jv.t = Jv.call tile_layer "addTo" [| map |] in
|
let _map : Jv.t = Jv.call tile_layer "addTo" [| map |] in
|
||||||
()
|
()
|
||||||
|
|
||||||
let on_click e =
|
let on_click e =
|
||||||
log "on_click@.";
|
log "on_click@.";
|
||||||
|
|
||||||
let lat_lng = Jv.get e "latlng" in
|
let lat_lng = Jv.get e "latlng" in
|
||||||
|
|
@ -64,9 +62,10 @@ let on_click e =
|
||||||
ignore @@ Jv.call lat_input "setAttribute" [| Jv.of_string "value"; lat |];
|
ignore @@ Jv.call lat_input "setAttribute" [| Jv.of_string "value"; lat |];
|
||||||
ignore @@ Jv.call lng_input "setAttribute" [| Jv.of_string "value"; lng |]
|
ignore @@ Jv.call lng_input "setAttribute" [| Jv.of_string "value"; lng |]
|
||||||
|
|
||||||
let () =
|
|
||||||
(*add on_click callback to map*)
|
(*add on_click callback to map*)
|
||||||
|
let () =
|
||||||
ignore @@ Jv.call map "on" [| Jv.of_string "click"; Jv.repr on_click |]
|
ignore @@ Jv.call map "on" [| Jv.of_string "click"; Jv.repr on_click |]
|
||||||
|
end
|
||||||
|
|
||||||
module Marker = struct
|
module Marker = struct
|
||||||
let on_each_feature feature layer =
|
let on_each_feature feature layer =
|
||||||
|
|
@ -79,10 +78,9 @@ module Marker = struct
|
||||||
let handle_geojson geojson =
|
let handle_geojson geojson =
|
||||||
log "handle_geojson@.";
|
log "handle_geojson@.";
|
||||||
log "feed geojson to leaflet@.";
|
log "feed geojson to leaflet@.";
|
||||||
(* TODO add onEachFeature *)
|
|
||||||
let dict = Jv.obj [| ("onEachFeature", Jv.repr on_each_feature) |] in
|
let dict = Jv.obj [| ("onEachFeature", Jv.repr on_each_feature) |] in
|
||||||
let layer = Jv.call leaflet "geoJSON" [| geojson; dict |] in
|
let layer = Jv.call Leaflet.leaflet "geoJSON" [| geojson; dict |] in
|
||||||
let _marker_layer = Jv.call layer "addTo" [| map |] in
|
let _marker_layer = Jv.call layer "addTo" [| Leaflet.map |] in
|
||||||
()
|
()
|
||||||
|
|
||||||
let handle_response response =
|
let handle_response response =
|
||||||
|
|
|
||||||
18
src/js_thread.ml
Normal file
18
src/js_thread.ml
Normal file
|
|
@ -0,0 +1,18 @@
|
||||||
|
let log = Format.printf
|
||||||
|
|
||||||
|
(* called by clicking post_id to reply *)
|
||||||
|
(* insert id into reply form *)
|
||||||
|
let insert_quote post_id =
|
||||||
|
log "quote@.";
|
||||||
|
match Jv.(find global "replyComment") with
|
||||||
|
| None -> Jv.undefined
|
||||||
|
| Some comment_textarea ->
|
||||||
|
let content = Jv.get comment_textarea "value" in
|
||||||
|
let new_content =
|
||||||
|
Jv.call content "concat"
|
||||||
|
[| Jv.of_string ">>"; post_id; Jv.of_string " " |]
|
||||||
|
in
|
||||||
|
ignore @@ Jv.set comment_textarea "value" new_content;
|
||||||
|
Jv.undefined
|
||||||
|
|
||||||
|
let () = Jv.set Jv.global "insert_quote" (Jv.repr insert_quote)
|
||||||
|
|
@ -1,147 +0,0 @@
|
||||||
(*TODO clean up this shit *)
|
|
||||||
let log = Format.printf
|
|
||||||
|
|
||||||
(* 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
|
|
||||||
{|© <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 |]
|
|
||||||
|
|
||||||
let () =
|
|
||||||
(*add on_click callback to map*)
|
|
||||||
ignore @@ Jv.call map "on" [| Jv.of_string "click"; Jv.repr on_click |]
|
|
||||||
|
|
||||||
module Marker = struct
|
|
||||||
(* manipulate DOM to show thread in a div *)
|
|
||||||
let handle_thread_view thread_view =
|
|
||||||
log "handle_thread_view@.";
|
|
||||||
let thread_div = Jv.get Jv.global "thread_div" in
|
|
||||||
ignore @@ Jv.set thread_div "innerHTML" thread_view;
|
|
||||||
()
|
|
||||||
|
|
||||||
let handle_response response =
|
|
||||||
log "handle_response@.";
|
|
||||||
let thread_view_futur = Jv.call response "text" [||] in
|
|
||||||
ignore @@ Jv.call thread_view_futur "then" [| Jv.repr handle_thread_view |];
|
|
||||||
()
|
|
||||||
|
|
||||||
(*fuck you js*)
|
|
||||||
let marker_on_click thread_id _e =
|
|
||||||
log "marker_on_click@.";
|
|
||||||
let thread_id = Jv.to_string thread_id in
|
|
||||||
let window = Jv.get Jv.global "window" in
|
|
||||||
log "3@.";
|
|
||||||
let fetchfutur =
|
|
||||||
Jv.call window "fetch" [| Jv.of_string ("/thread_view/" ^ thread_id) |]
|
|
||||||
in
|
|
||||||
log "4@.";
|
|
||||||
ignore @@ Jv.call fetchfutur "then" [| Jv.repr handle_response |];
|
|
||||||
()
|
|
||||||
|
|
||||||
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
|
|
||||||
let thread_id = Jv.get feature_properties "thread_id" in
|
|
||||||
let layer = Jv.call layer "bindPopup" [| feature_properties_content |] in
|
|
||||||
ignore
|
|
||||||
@@ Jv.call layer "on"
|
|
||||||
[| Jv.of_string "click"; Jv.repr (marker_on_click thread_id) |];
|
|
||||||
()
|
|
||||||
|
|
||||||
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 "geoJSON" [| geojson; dict |] in
|
|
||||||
let _marker_layer = Jv.call layer "addTo" [| map |] in
|
|
||||||
|
|
||||||
()
|
|
||||||
|
|
||||||
let markers_handle_response response =
|
|
||||||
log "markers_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 thread geojson@.";
|
|
||||||
let window = Jv.get Jv.global "window" in
|
|
||||||
let fetchfutur =
|
|
||||||
Jv.call window "fetch" [| Jv.of_string "/thread_markers" |]
|
|
||||||
in
|
|
||||||
ignore @@ Jv.call fetchfutur "then" [| Jv.repr markers_handle_response |];
|
|
||||||
()
|
|
||||||
end
|
|
||||||
|
|
||||||
(* called by clicking post_id to reply *)
|
|
||||||
(* insert id into reply form *)
|
|
||||||
let insert_quote post_id =
|
|
||||||
log "quote@.";
|
|
||||||
match Jv.(find global "replyComment") with
|
|
||||||
| None -> Jv.undefined
|
|
||||||
| Some comment_textarea ->
|
|
||||||
let content = Jv.get comment_textarea "value" in
|
|
||||||
let new_content =
|
|
||||||
Jv.call content "concat"
|
|
||||||
[| Jv.of_string ">>"; post_id; Jv.of_string " " |]
|
|
||||||
in
|
|
||||||
ignore @@ Jv.set comment_textarea "value" new_content;
|
|
||||||
Jv.undefined
|
|
||||||
|
|
||||||
let () = Jv.set Jv.global "insert_quote" (Jv.repr insert_quote)
|
|
||||||
20
src/newthread_page.eml.html
Normal file
20
src/newthread_page.eml.html
Normal file
|
|
@ -0,0 +1,20 @@
|
||||||
|
let f 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 %>
|
||||||
|
<input type="hidden" id="lat_input" name="lat_input">
|
||||||
|
<input type="hidden" id="lng_input" name="lng_input">
|
||||||
|
|
||||||
|
<label for="subject" id="subjectLabel" class="form-label">Subject</label>
|
||||||
|
<input name="subject" type="text" class="form-control" id="subject" aria-labelledby="subjectLabel"></input>
|
||||||
|
|
||||||
|
<label for="threadComment" id="threadCommentLabel" class="form-label">Comment</label>
|
||||||
|
<textarea name="threadComment" type="text" class="form-control" id="threadComment" aria-labelledby="threadCommentLabel"></textarea>
|
||||||
|
|
||||||
|
<label for="tags" id="tagsLabel" class="form-label">Tags</label>
|
||||||
|
<input name="tags" type="text" class="form-control" id="tags" aria-labelledby="tagsLabel"></input>
|
||||||
|
|
||||||
|
<input id="file" name="file" aria-describedby="fileHelp" type="file">
|
||||||
|
<div id="fileHelp" class="form-text">Add a picture for your thread</div>
|
||||||
|
<div id="map"></div>
|
||||||
|
<button type="submit" class="btn btn-primary">Make Thread</button>
|
||||||
|
</form>
|
||||||
|
|
@ -223,7 +223,9 @@ let thread_markers request =
|
||||||
|
|
||||||
let babillard_get request = render_unsafe (Babillard_page.f request) request
|
let babillard_get request = render_unsafe (Babillard_page.f request) request
|
||||||
|
|
||||||
let babillard_post request =
|
let newthread_get request = render_unsafe (Newthread_page.f request) request
|
||||||
|
|
||||||
|
let newthread_post request =
|
||||||
match Dream.session "nick" request with
|
match Dream.session "nick" request with
|
||||||
| None -> render_unsafe "Not logged in" request
|
| None -> render_unsafe "Not logged in" request
|
||||||
| Some nick -> (
|
| Some nick -> (
|
||||||
|
|
@ -348,7 +350,8 @@ let () =
|
||||||
; Dream.get "/thread_markers" thread_markers
|
; Dream.get "/thread_markers" thread_markers
|
||||||
; Dream.get "/thread_view/:thread_id" thread_view
|
; Dream.get "/thread_view/:thread_id" thread_view
|
||||||
; Dream.get "/babillard" babillard_get
|
; Dream.get "/babillard" babillard_get
|
||||||
; Dream.post "/babillard" babillard_post
|
; Dream.get "/babillard/new_thread" newthread_get
|
||||||
|
; Dream.post "/babillard/new_thread" newthread_post
|
||||||
; Dream.get "/babillard/:thread_id" thread_get (*todo, bad names ^^*)
|
; Dream.get "/babillard/:thread_id" thread_get (*todo, bad names ^^*)
|
||||||
; Dream.post "/babillard/:thread_id" thread_post
|
; Dream.post "/babillard/:thread_id" thread_post
|
||||||
; Dream.get "/post_pic/:post_id" post_image
|
; Dream.get "/post_pic/:post_id" post_image
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,6 @@
|
||||||
let f thread_view thread_id request =
|
let f thread_view thread_id request =
|
||||||
<script type="text/javascript" src="/assets/js/js_thread_map.js" defer="defer"></script>
|
<script type="text/javascript" src="/assets/js/js_babillard.js" defer="defer"></script>
|
||||||
|
<script type="text/javascript" src="/assets/js/js_thread.js" defer="defer"></script>
|
||||||
<%s Format.sprintf "[Reply]" %>
|
<%s Format.sprintf "[Reply]" %>
|
||||||
<%s! thread_view %>
|
<%s! thread_view %>
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue