change thread_view to a thread_preview with link
This commit is contained in:
parent
cc13eb6ed3
commit
a6f1c10113
12 changed files with 263 additions and 242 deletions
|
|
@ -1,4 +1,5 @@
|
|||
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 %>
|
||||
<div class="mb-3">
|
||||
<div id="map"></div>
|
||||
|
|
@ -15,4 +16,3 @@ let f nick request =
|
|||
<button type="submit" class="btn btn-primary">Add Plant</button>
|
||||
</div>
|
||||
</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">
|
||||
<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>
|
||||
</div>
|
||||
|}
|
||||
|
|
@ -377,6 +377,7 @@ let view_thread thread_id =
|
|||
in
|
||||
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 is_valid_comment =
|
||||
String.length comment < 10000
|
||||
|
|
@ -395,7 +396,6 @@ let make_post ~comment ?file ~tags ?parent_id nick =
|
|||
| _, false, _ -> Error "invalid file"
|
||||
| _, _, false -> Error "invalid tags"
|
||||
| true, true, true -> (
|
||||
(*TODO make post_id a int *)
|
||||
let post_id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
|
||||
(* add to plant_id <-> user*)
|
||||
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_image =
|
||||
match file with
|
||||
| None -> Ok ()
|
||||
| Some (image_name, image_content) ->
|
||||
let image_name =
|
||||
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 ())
|
||||
in
|
||||
Db.exec Q.upload_post_image (post_id, image_name, image_content)
|
||||
| None -> Ok ()
|
||||
in
|
||||
let res_tags =
|
||||
match
|
||||
|
|
|
|||
|
|
@ -1,29 +1,14 @@
|
|||
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" %>
|
||||
<div class="mb-3">
|
||||
% begin match Dream.session "nick" request with
|
||||
% | None ->
|
||||
% begin match Dream.session "nick" request with
|
||||
% | None ->
|
||||
|
||||
% | Some _nick ->
|
||||
<%s! Dream.form_tag ~action:"/babillard" ~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>
|
||||
<button type="submit" class="btn btn-primary">Make Thread</button>
|
||||
</form>
|
||||
%end;
|
||||
% | Some _nick ->
|
||||
<a href="/babillard/new_thread">[New Thread]</a>
|
||||
% end;
|
||||
<div id="map"></div>
|
||||
<div id="thread_div"></div>
|
||||
<div id="thread_preview_div"></div>
|
||||
<a id="thread_link"></a>
|
||||
</div>
|
||||
|
|
|
|||
|
|
@ -8,10 +8,19 @@
|
|||
(cat ../../../js_plant_map.bc.js))))
|
||||
|
||||
(rule
|
||||
(target js_thread_map.js)
|
||||
(target js_babillard.js)
|
||||
(deps
|
||||
(file ../../../js_thread_map.bc.js))
|
||||
(file ../../../js_babillard.bc.js))
|
||||
(action
|
||||
(with-stdout-to
|
||||
%{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
|
||||
(public_name permap)
|
||||
(modules
|
||||
newthread_page
|
||||
thread_page
|
||||
babillard
|
||||
babillard_page
|
||||
|
|
@ -42,8 +43,18 @@
|
|||
(pps js_of_ocaml-ppx)))
|
||||
|
||||
(executable
|
||||
(name js_thread_map)
|
||||
(modules js_thread_map)
|
||||
(name js_babillard)
|
||||
(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)
|
||||
(modes js)
|
||||
(js_of_ocaml
|
||||
|
|
@ -81,6 +92,12 @@
|
|||
(action
|
||||
(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
|
||||
(targets add_plant.ml)
|
||||
(deps add_plant.eml.html)
|
||||
|
|
@ -98,7 +115,8 @@
|
|||
(deps
|
||||
(source_tree content)
|
||||
(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
|
||||
(with-stdout-to
|
||||
%{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,72 +1,71 @@
|
|||
(* 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
|
||||
|
||||
(* get the leaflet object *)
|
||||
let leaflet =
|
||||
match Jv.(find global "L") with
|
||||
| Some l -> l
|
||||
| None -> failwith "can't load leaflet"
|
||||
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" [||]
|
||||
(* 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 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) |]
|
||||
(* 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
|
||||
()
|
||||
(* 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|}
|
||||
)
|
||||
|]
|
||||
|]
|
||||
(* 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
|
||||
()
|
||||
(* 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 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_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 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 |]
|
||||
let () =
|
||||
ignore @@ Jv.call map "on" [| Jv.of_string "click"; Jv.repr on_click |]
|
||||
end
|
||||
|
||||
module Marker = struct
|
||||
let on_each_feature feature layer =
|
||||
|
|
@ -79,10 +78,9 @@ module Marker = struct
|
|||
let handle_geojson geojson =
|
||||
log "handle_geojson@.";
|
||||
log "feed geojson to leaflet@.";
|
||||
(* TODO add onEachFeature *)
|
||||
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 layer = Jv.call Leaflet.leaflet "geoJSON" [| geojson; dict |] in
|
||||
let _marker_layer = Jv.call layer "addTo" [| Leaflet.map |] in
|
||||
()
|
||||
|
||||
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_post request =
|
||||
let newthread_get request = render_unsafe (Newthread_page.f request) request
|
||||
|
||||
let newthread_post request =
|
||||
match Dream.session "nick" request with
|
||||
| None -> render_unsafe "Not logged in" request
|
||||
| Some nick -> (
|
||||
|
|
@ -348,7 +350,8 @@ let () =
|
|||
; Dream.get "/thread_markers" thread_markers
|
||||
; Dream.get "/thread_view/:thread_id" thread_view
|
||||
; 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.post "/babillard/:thread_id" thread_post
|
||||
; Dream.get "/post_pic/:post_id" post_image
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
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! thread_view %>
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue