@@ -43,8 +43,8 @@ let f request =
-
-
+
+
diff --git a/src/catalog_page.eml.html b/src/catalog_page.eml.html
index 8f0f95a..87b85c8 100644
--- a/src/catalog_page.eml.html
+++ b/src/catalog_page.eml.html
@@ -1,6 +1,6 @@
let f content =
-
+
Catalog:
diff --git a/src/content/assets/css/style.css b/src/content/assets/css/style.css
index 4089e24..fb66069 100644
--- a/src/content/assets/css/style.css
+++ b/src/content/assets/css/style.css
@@ -118,14 +118,6 @@ blockquote.blockquote {
visibility: hidden;
}
-#alt-label {
- display:none;
-}
-
-#alt {
- display:none;
-}
-
a.preview-link {
text-decoration: none;
color: unset;
diff --git a/src/content/assets/js/dune b/src/content/assets/js/dune
index 8f1ecd2..de39723 100644
--- a/src/content/assets/js/dune
+++ b/src/content/assets/js/dune
@@ -1,26 +1,26 @@
(rule
- (target js_catalog.js)
+ (target catalog.js)
(deps
- (file ../../../js/js_catalog.bc.js))
+ (file ../../../js/catalog.bc.js))
(action
(with-stdout-to
%{target}
- (cat ../../../js/js_catalog.bc.js))))
+ (cat ../../../js/catalog.bc.js))))
(rule
- (target js_babillard.js)
+ (target babillard.js)
(deps
- (file ../../../js/js_babillard.bc.js))
+ (file ../../../js/babillard.bc.js))
(action
(with-stdout-to
%{target}
- (cat ../../../js/js_babillard.bc.js))))
+ (cat ../../../js/babillard.bc.js))))
(rule
- (target js_thread.js)
+ (target thread.js)
(deps
- (file ../../../js/js_thread.bc.js))
+ (file ../../../js/thread.bc.js))
(action
(with-stdout-to
%{target}
- (cat ../../../js/js_thread.bc.js))))
+ (cat ../../../js/thread.bc.js))))
diff --git a/src/delete_page.eml.html b/src/delete_page.eml.html
index 874c235..bce2690 100644
--- a/src/delete_page.eml.html
+++ b/src/delete_page.eml.html
@@ -1,6 +1,6 @@
let f post_preview post_id request =
-
+
<%s! post_preview %>
% let url = Format.sprintf "/delete/%s" post_id in
% begin match Dream.session "nick" request with
diff --git a/src/dune b/src/dune
index 9958048..02f188d 100644
--- a/src/dune
+++ b/src/dune
@@ -111,9 +111,9 @@
(target content.ml)
(deps
(source_tree content)
- (file content/assets/js/js_babillard.js)
- (file content/assets/js/js_catalog.js)
- (file content/assets/js/js_thread.js))
+ (file content/assets/js/babillard.js)
+ (file content/assets/js/catalog.js)
+ (file content/assets/js/thread.js))
(action
(with-stdout-to
%{null}
diff --git a/src/js/js_babillard.ml b/src/js/babillard.ml
similarity index 59%
rename from src/js/js_babillard.ml
rename to src/js/babillard.ml
index 960e665..075293d 100644
--- a/src/js/js_babillard.ml
+++ b/src/js/babillard.ml
@@ -1,29 +1,26 @@
-open Js_map
-include Js_post_form
+open Brr
+open Utils
+open Map
module Visibility = struct
- let new_thread_div = Jv.get Jv.global "new-thread"
+ let new_thread_div = find_by_id "new-thread"
- let thread_preview_div = Jv.get Jv.global "thread-preview"
+ let thread_preview_div = find_by_id "thread-preview"
- let return_button = Jv.get Jv.global "return-button"
+ let return_button = find_by_id "return-button"
(* new-thread-button is new-thread-button-redirect if not logged in *)
- let new_thread_button = Jv.find Jv.global "new-thread-button"
+ let new_thread_button = find_by_id_opt "new-thread-button"
let is_in_new_thread_mode = ref false
let set_visible el =
log "set_visible@\n";
- let class_list = Jv.get el "classList" in
- ignore
- @@ Jv.call class_list "replace" [| Jv.of_string "off"; Jv.of_string "on" |]
+ El.set_class (Jstr.of_string "off") false el
let set_invisible el =
log "set_invisible@\n";
- let class_list = Jv.get el "classList" in
- ignore
- @@ Jv.call class_list "replace" [| Jv.of_string "on"; Jv.of_string "off" |]
+ El.set_class (Jstr.of_string "off") true el
let to_new_thread_mode _event =
log "change_page_mode@\n";
@@ -45,32 +42,32 @@ module Visibility = struct
let () =
log "add events on return/new thread button@\n";
- ignore
- @@ Jv.call return_button "addEventListener"
- [| Jv.of_string "click"; Jv.repr to_babillard_mode |];
+ let (_ : Ev.listener) =
+ Ev.listen Ev.click to_babillard_mode (El.as_target return_button)
+ in
Option.iter
(fun button ->
- ignore
- @@ Jv.call button "addEventListener"
- [| Jv.of_string "click"; Jv.repr to_new_thread_mode |] )
+ let (_ : Ev.listener) =
+ Ev.listen Ev.click to_new_thread_mode (El.as_target button)
+ in
+ () )
new_thread_button
end
module Marker = struct
- let window = Jv.get Jv.global "window"
-
- let thread_preview_div = Jv.get Jv.global "thread-preview"
+ let thread_preview_div = find_by_id "thread-preview"
let marker_on_click thread_preview _e =
log "marker_on_click@\n";
- if not !Visibility.is_in_new_thread_mode then
- ignore @@ Jv.set thread_preview_div "innerHTML" thread_preview;
- Js_pretty_post.make_pretty ()
+ if not !Visibility.is_in_new_thread_mode then (
+ let inner_html = El.Prop.jstr (Jstr.of_string "innerHTML") in
+ El.set_prop inner_html thread_preview thread_preview_div;
+ Pretty_post.make_pretty () )
let on_each_feature feature layer =
log "on_each_feature@\n";
let feature_properties = Jv.get feature "properties" in
- let thread_preview = Jv.get feature_properties "content" in
+ let thread_preview = Jv.get feature_properties "content" |> Jv.to_jstr in
Leaflet.Layer.on Leaflet.Event.Click (marker_on_click thread_preview) layer
let handle_geojson geojson =
@@ -89,15 +86,17 @@ module Marker = struct
let () =
log "fetch thread geojson@\n";
let link = Jv.of_string "/markers" in
+ (* todo: fetch with Brr *)
+ let window = Jv.get Jv.global "window" in
let fetchfutur = Jv.call window "fetch" [| link |] in
ignore @@ Jv.call fetchfutur "then" [| Jv.repr markers_handle_response |]
end
-let lat_input = Jv.get Jv.global "lat-input"
+let lat_input = find_by_id "lat-input"
-let lng_input = Jv.get Jv.global "lng-input"
+let lng_input = find_by_id "lng-input"
-let button = Jv.get Jv.global "submit-new-thread-button"
+let button = find_by_id "submit-new-thread-button"
(* set input lat/lng when clicked*)
let on_click_set_latlng e =
@@ -110,12 +109,12 @@ let on_click_set_latlng e =
in
Leaflet.Map.open_popup popup map;
- let lat = Leaflet.Latlng.lat latlng |> Jv.of_float in
- let lng = Leaflet.Latlng.lng latlng |> Jv.of_float in
- 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 button "removeAttribute" [| Jv.of_string "disabled" |] )
+ let lat = Leaflet.Latlng.lat latlng |> Jstr.of_float in
+ let lng = Leaflet.Latlng.lng latlng |> Jstr.of_float in
+ let value_jstr = Jstr.of_string "value" in
+ El.set_at value_jstr (Some lat) lat_input;
+ El.set_at value_jstr (Some lng) lng_input;
+ El.set_at (Jstr.of_string "disabled") None button )
(*add on_click callback to map*)
let () = Leaflet.Map.on Leaflet.Event.Click on_click_set_latlng map
diff --git a/src/js/catalog.ml b/src/js/catalog.ml
new file mode 100644
index 0000000..e69de29
diff --git a/src/js/dune b/src/js/dune
index b589c7b..4da74f5 100644
--- a/src/js/dune
+++ b/src/js/dune
@@ -1,46 +1,53 @@
(library
- (name js_post_form)
- (modules js_post_form)
- (libraries js_of_ocaml brr)
+ (name utils)
+ (modules utils)
+ (libraries brr)
(preprocess
(pps js_of_ocaml-ppx)))
(library
- (name js_pretty_post)
- (modules js_pretty_post)
- (libraries js_of_ocaml brr unix)
+ (name post_form)
+ (modules post_form)
+ (libraries js_of_ocaml brr utils)
(preprocess
(pps js_of_ocaml-ppx)))
(library
- (name js_map)
- (modules js_map)
- (libraries js_of_ocaml brr leaflet)
+ (name pretty_post)
+ (modules pretty_post)
+ (libraries js_of_ocaml brr unix utils)
+ (preprocess
+ (pps js_of_ocaml-ppx)))
+
+(library
+ (name map)
+ (modules map)
+ (libraries js_of_ocaml brr leaflet utils)
(js_of_ocaml
(javascript_files leaflet/leaflet.js))
(preprocess
(pps js_of_ocaml-ppx)))
(executable
- (name js_catalog)
- (modules js_catalog)
- (libraries js_of_ocaml brr js_pretty_post)
+ (name catalog)
+ (modules catalog)
+ (libraries js_of_ocaml brr pretty_post)
(modes js)
(preprocess
(pps js_of_ocaml-ppx)))
(executable
- (name js_babillard)
- (modules js_babillard)
- (libraries js_of_ocaml brr js_map js_post_form js_pretty_post leaflet)
+ (name babillard)
+ (modules babillard)
+ (libraries js_of_ocaml brr map post_form pretty_post leaflet utils)
(modes js)
(preprocess
(pps js_of_ocaml-ppx)))
(executable
- (name js_thread)
- (modules js_thread)
- (libraries js_of_ocaml brr js_post_form js_pretty_post)
+ (name thread)
+ (modules thread)
+ (libraries js_of_ocaml brr post_form pretty_post)
(modes js)
(preprocess
(pps js_of_ocaml-ppx)))
diff --git a/src/js/js_catalog.ml b/src/js/js_catalog.ml
deleted file mode 100644
index 0b673cf..0000000
--- a/src/js/js_catalog.ml
+++ /dev/null
@@ -1 +0,0 @@
-include Js_pretty_post
diff --git a/src/js/js_post_form.ml b/src/js/js_post_form.ml
deleted file mode 100644
index 8bbae01..0000000
--- a/src/js/js_post_form.ml
+++ /dev/null
@@ -1,55 +0,0 @@
-let log = Format.printf
-
-(* called by clicking post_id *)
-(* insert emojid into reply form *)
-let insert_quote emojid _event =
- log "quote@\n";
- Option.iter
- (fun textarea ->
- let content = Jv.to_string @@ Jv.get textarea "value" in
- let new_content =
- if String.ends_with ~suffix:"\n" content || String.length content = 0
- then (* don't skip a line *)
- Format.sprintf "%s[%s] " content emojid
- else Format.sprintf "%s@\n[%s] " content emojid
- in
- ignore @@ Jv.set textarea "value" (Jv.of_string new_content) )
- Jv.(find global "reply-comment")
-
-let () =
- log "add inser_quote event on post links@\n";
- let document = Jv.get Jv.global "document" in
- let quote_links =
- Jv.to_jv_list
- @@ Jv.call document "getElementsByClassName" [| Jv.of_string "quote-link" |]
- in
- log "quote_links leng %d@\n" (List.length quote_links);
- let add_click quote_link =
- let emojid =
- Jv.to_string
- @@ Jv.call quote_link "getAttribute" [| Jv.of_string "data-emojid" |]
- in
- ignore
- @@ Jv.call quote_link "addEventListener"
- [| Jv.of_string "click"; Jv.repr (insert_quote emojid) |]
- in
- List.iter add_click quote_links
-
-(* make image description field visible when a file is selected*)
-let make_visible el _event =
- let el_style = Jv.get el "style" in
- ignore @@ Jv.set el_style "display" (Jv.of_string "block")
-
-let () =
- log "change image description visibility@\n";
- Option.iter
- (fun file_input ->
- let alt_input = Jv.get Jv.global "alt" in
- let alt_label = Jv.get Jv.global "alt-label" in
- ignore
- @@ Jv.call file_input "addEventListener"
- [| Jv.of_string "change"; Jv.repr (make_visible alt_input) |];
- ignore
- @@ Jv.call file_input "addEventListener"
- [| Jv.of_string "change"; Jv.repr (make_visible alt_label) |] )
- Jv.(find global "file")
diff --git a/src/js/js_thread.ml b/src/js/js_thread.ml
deleted file mode 100644
index 5e83a8d..0000000
--- a/src/js/js_thread.ml
+++ /dev/null
@@ -1,2 +0,0 @@
-include Js_post_form
-include Js_pretty_post
diff --git a/src/js/js_map.ml b/src/js/map.ml
similarity index 91%
rename from src/js/js_map.ml
rename to src/js/map.ml
index 4e5060f..5b471ed 100644
--- a/src/js/js_map.ml
+++ b/src/js/map.ml
@@ -1,4 +1,4 @@
-let log = Format.printf
+open Utils
let map = Leaflet.Map.create_on "map"
@@ -53,8 +53,7 @@ let on_zoomend _event =
log "on zoomend event@\n";
let zoom = Leaflet.Map.get_zoom map in
match
- Brr_io.Storage.set_item storage (Jstr.of_string "zoom")
- (Jv.to_jstr @@ Jv.of_int zoom)
+ Brr_io.Storage.set_item storage (Jstr.of_string "zoom") (Jstr.of_int zoom)
with
| (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage"
| Ok () -> ()
@@ -81,8 +80,9 @@ module Geolocalize = struct
ignore @@ Fut.await (Brr_io.Geolocation.get l) update_location
let () =
- let button = Jv.get Jv.global "geolocalize" in
- ignore
- @@ Jv.call button "addEventListener"
- [| Jv.of_string "click"; Jv.repr geolocalize |]
+ let button = find_by_id "geolocalize" in
+ let (_ : Brr.Ev.listener) =
+ Brr.Ev.listen Brr.Ev.click geolocalize (Brr.El.as_target button)
+ in
+ ()
end
diff --git a/src/js/js_newthread.ml b/src/js/newthread.ml
similarity index 100%
rename from src/js/js_newthread.ml
rename to src/js/newthread.ml
diff --git a/src/js/post_form.ml b/src/js/post_form.ml
new file mode 100644
index 0000000..7fd606c
--- /dev/null
+++ b/src/js/post_form.ml
@@ -0,0 +1,45 @@
+open Brr
+open Utils
+
+(* called by clicking post_id *)
+(* insert emojid into reply form *)
+let insert_quote el _event =
+ log "quote@\n";
+ let emojid =
+ match El.at (Jstr.of_string "data-emojid") el with
+ | None -> "no data-emojid on element"
+ | Some emojid -> Jstr.to_string emojid
+ in
+ let textarea = find_by_id "reply-comment" in
+ let inner_html = El.Prop.jstr (Jstr.of_string "innerHTML") in
+ let content = Jstr.to_string @@ El.prop inner_html textarea in
+ let new_content =
+ if String.ends_with ~suffix:"\n" content || String.length content = 0 then
+ (* don't skip a line *)
+ Format.sprintf "%s[>%s] " content emojid
+ else Format.sprintf "%s@\n[>%s] " content emojid
+ in
+ El.set_prop inner_html (Jstr.of_string new_content) textarea
+
+let () =
+ log "add inser_quote event on post links@\n";
+ add_event_to_class Ev.click "quote-link" insert_quote
+
+(* make image description field visible when a file is selected*)
+let make_visible el _event = El.set_class (Jstr.of_string "off") false el
+
+let () =
+ log "add event to change image description visibility@\n";
+ match find_by_id_opt "file" with
+ | None -> log "no file element found, not logged in?@\n"
+ | Some file_input ->
+ let alt_input = find_by_id "alt" in
+ let alt_label = find_by_id "alt-label" in
+ let change = Ev.Type.create (Jstr.of_string "change") in
+ let (_ : Ev.listener) =
+ Ev.listen change (make_visible alt_input) (El.as_target file_input)
+ in
+ let (_ : Ev.listener) =
+ Ev.listen change (make_visible alt_label) (El.as_target file_input)
+ in
+ ()
diff --git a/src/js/js_pretty_post.ml b/src/js/pretty_post.ml
similarity index 82%
rename from src/js/js_pretty_post.ml
rename to src/js/pretty_post.ml
index 18cae88..eb26c29 100644
--- a/src/js/js_pretty_post.ml
+++ b/src/js/pretty_post.ml
@@ -1,6 +1,5 @@
open Brr
-
-let log = Format.printf
+open Utils
type image_size =
| Big
@@ -50,12 +49,6 @@ let render_time date_span =
| None -> failwith "no attribute data-time for date element"
| Some data_time -> Jstr.to_float data_time
in
- (*
- let t =
- Jv.to_float
- (Jv.call date_span "getAttribute" [| Jv.of_string "data-time" |])
- in
- *)
let t = Unix.localtime data_time in
let date =
Format.sprintf "%02d-%02d-%02d %02d:%02d" (1900 + t.tm_year) (1 + t.tm_mon)
@@ -75,7 +68,7 @@ let on_hashchange _event =
let frag = Jstr.to_string @@ Uri.fragment @@ Window.location G.window in
if frag = "" then ()
else
- match Document.find_el_by_id G.document (Jstr.of_string frag) with
+ match find_by_id_opt frag with
| None -> log "fragment not found on the page"
| Some reply ->
let () =
@@ -110,9 +103,7 @@ let clone_element el =
let body = Jv.get document "body" in
ignore @@ Jv.call body "append" [| div |];
(* go back to El *)
- match
- Document.find_el_by_id G.document (Jstr.of_string "floating-reply-preview")
- with
+ match find_by_id_opt "floating-reply-preview" with
| None -> failwith "error cloning element"
| Some el -> el
@@ -122,15 +113,17 @@ let on_mouse_over el _event =
let reply_id =
match El.at (Jstr.of_string "data-id") el with
| None -> failwith "no data-id on element"
- | Some data_id -> data_id
+ | Some data_id -> Jstr.to_string data_id
in
- match Document.find_el_by_id G.document reply_id with
+ match find_by_id_opt reply_id with
| None -> failwith "error getting reply_div, this reply is not on this page"
| Some reply_div ->
(* check if it in view, if it is, just make it of class `highlight` *)
- let window = Jv.get Jv.global "window" in
- let window_height = Jv.get window "innerHeight" |> Jv.to_int in
+ let window_height =
+ let window = Jv.get Jv.global "window" in
+ Jv.get window "innerHeight" |> Jv.to_int
+ in
let reply_top = El.bound_y reply_div |> int_of_float in
if reply_top < window_height - 50 && reply_top + 50 > 0 then (
(* just highlight if reply is in viewport *)
@@ -184,30 +177,21 @@ let on_mouse_out _el _event =
let make_pretty _event =
log "make pretty@\n";
- let add_event_to_class ~name ~event handler =
- let event = Ev.Type.create (Jstr.of_string event) in
- let el_list = El.find_by_class (Jstr.of_string name) in
- List.iter (fun el -> Ev.listen event (handler el) (El.as_target el)) el_list
- in
-
let dates = El.find_by_class (Jstr.of_string "date") in
List.iter render_time dates;
(*add event image_click to all postImage*)
- let () = add_event_to_class ~name:"post-image" ~event:"click" image_click in
+ let () = add_event_to_class Ev.click "post-image" image_click in
(*add event mouse_over/out to all reply-link *)
- let () =
- add_event_to_class ~name:"reply-link" ~event:"mouseover" on_mouse_over
- in
- let () =
- add_event_to_class ~name:"reply-link" ~event:"mouseout" on_mouse_out
- in
+ let () = add_event_to_class Ev.mouseover "reply-link" on_mouse_over in
+ let () = add_event_to_class Ev.mouseout "reply-link" on_mouse_out in
(* add fragment listener to mark as selected the linked post *)
- (* TODO call with brr*)
let hashchange = Ev.Type.create (Jstr.of_string "hashchange") in
- Ev.listen hashchange on_hashchange (Window.as_target G.window);
+ let (_ : Ev.listener) =
+ Ev.listen hashchange on_hashchange (Window.as_target G.window)
+ in
(* call hashchange on page load too *)
on_hashchange ()
@@ -215,6 +199,7 @@ let make_pretty _event =
let () =
log "add load eventlistener to make pretty@\n";
let load = Ev.Type.create (Jstr.of_string "load") in
- Ev.listen load make_pretty (Window.as_target G.window)
-
-(* TODO reply can be in another thread, how to display it? if displaying it on mouseover we need to fetch it. and display it in special color. need to change pp_post in pp_babillard *)
+ let (_ : Ev.listener) =
+ Ev.listen load make_pretty (Window.as_target G.window)
+ in
+ ()
diff --git a/src/js/thread.ml b/src/js/thread.ml
new file mode 100644
index 0000000..e69de29
diff --git a/src/js/utils.ml b/src/js/utils.ml
new file mode 100644
index 0000000..5b85fc3
--- /dev/null
+++ b/src/js/utils.ml
@@ -0,0 +1,18 @@
+open Brr
+
+let log = Format.printf
+
+let find_by_id_opt id = Document.find_el_by_id G.document (Jstr.of_string id)
+
+let find_by_id id =
+ match find_by_id_opt id with
+ | None -> failwith (Format.sprintf "element `%s` not found" id)
+ | Some el -> el
+
+let add_event_to_class event name handler =
+ let el_list = El.find_by_class (Jstr.of_string name) in
+ List.iter
+ (fun el ->
+ let (_ : Ev.listener) = Ev.listen event (handler el) (El.as_target el) in
+ () )
+ el_list
diff --git a/src/report_page.eml.html b/src/report_page.eml.html
index 20cb3c1..dd28f87 100644
--- a/src/report_page.eml.html
+++ b/src/report_page.eml.html
@@ -1,6 +1,6 @@
let f post_preview post_id request =
-
+
<%s! post_preview %>
% let url = Format.sprintf "/report/%s" post_id in
% begin match Dream.session "nick" request with
diff --git a/src/thread_page.eml.html b/src/thread_page.eml.html
index 6f311a2..177ed2e 100644
--- a/src/thread_page.eml.html
+++ b/src/thread_page.eml.html
@@ -1,5 +1,5 @@
let f thread_view thread_id request =
-
+
<%s! thread_view %>
% let thread_url = Format.sprintf "/thread/%s" thread_id in
% begin match Dream.session "nick" request with