diff --git a/src/add_plant.eml.html b/src/add_plant.eml.html index d7ff24c..9cb07e8 100644 --- a/src/add_plant.eml.html +++ b/src/add_plant.eml.html @@ -1,4 +1,5 @@ let f nick request = + <%s Format.sprintf "Add a plant to your Collection %s !" nick %>
@@ -15,4 +16,3 @@ let f nick request =
- diff --git a/src/babillard.ml b/src/babillard.ml index ed32dbd..5504120 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -284,7 +284,7 @@ let view_post post_id = {|
- +
|} @@ -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 diff --git a/src/babillard_page.eml.html b/src/babillard_page.eml.html index e8f1f32..2805575 100644 --- a/src/babillard_page.eml.html +++ b/src/babillard_page.eml.html @@ -1,29 +1,14 @@ let f request = - + <%s Format.sprintf "Babillard is love" %>
-% 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 %> - - - - - - - - - - - - - -
Add a picture for your thread
- - -%end; +% | Some _nick -> +[New Thread] +% end;
-
+
+
diff --git a/src/content/assets/js/dune b/src/content/assets/js/dune index 2a624ae..b901998 100644 --- a/src/content/assets/js/dune +++ b/src/content/assets/js/dune @@ -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)))) diff --git a/src/dune b/src/dune index 19aba30..fb7c253 100644 --- a/src/dune +++ b/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} diff --git a/src/js_babillard.ml b/src/js_babillard.ml new file mode 100644 index 0000000..7c7350e --- /dev/null +++ b/src/js_babillard.ml @@ -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 + {|© OpenStreetMap 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 diff --git a/src/js_plant_map.ml b/src/js_plant_map.ml index b2b4b6d..9799c29 100644 --- a/src/js_plant_map.ml +++ b/src/js_plant_map.ml @@ -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 - {|© OpenStreetMap 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 + {|© OpenStreetMap 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 = diff --git a/src/js_thread.ml b/src/js_thread.ml new file mode 100644 index 0000000..5e7885c --- /dev/null +++ b/src/js_thread.ml @@ -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) diff --git a/src/js_thread_map.ml b/src/js_thread_map.ml deleted file mode 100644 index 199fa4e..0000000 --- a/src/js_thread_map.ml +++ /dev/null @@ -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 - {|© OpenStreetMap 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) diff --git a/src/newthread_page.eml.html b/src/newthread_page.eml.html new file mode 100644 index 0000000..e173c50 --- /dev/null +++ b/src/newthread_page.eml.html @@ -0,0 +1,20 @@ +let f request = + + <%s! Dream.form_tag ~action:"/babillard/new_thread" ~enctype:`Multipart_form_data request %> + + + + + + + + + + + + + +
Add a picture for your thread
+
+ + diff --git a/src/permap.ml b/src/permap.ml index 9a7c9e8..b8ce910 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -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 diff --git a/src/thread_page.eml.html b/src/thread_page.eml.html index c065a20..95d7383 100644 --- a/src/thread_page.eml.html +++ b/src/thread_page.eml.html @@ -1,5 +1,6 @@ let f thread_view thread_id request = - + + <%s Format.sprintf "[Reply]" %> <%s! thread_view %>