more fixes

This commit is contained in:
Swrup 2022-02-18 03:22:24 +01:00
parent 8ec7533db1
commit 01e62889e2
4 changed files with 20 additions and 29 deletions

View file

@ -217,21 +217,20 @@ let () =
let parse_image image =
match image with
| None -> Ok None
| Some image -> (
let image =
match image with
| Some image_name, image_content, alt ->
(Dream.html_escape image_name, image_content, Dream.html_escape alt)
| None, image_content, alt ->
| Some (name, content, alt) ->
let name =
match name with
| Some name -> Dream.html_escape name
| None ->
(* make up random name if no name was given *)
let image_name = Uuidm.to_string (Uuidm.v4_gen random_state ()) in
(image_name, image_content, Dream.html_escape alt)
Uuidm.to_string (Uuidm.v4_gen random_state ())
in
match image with
| _, image_content, alt ->
if not (is_valid_image image_content) then Error "invalid image"
else if String.length alt > 1000 then Error "Image description too long"
else Ok (Some image) )
if not (is_valid_image content) then
Error "invalid image"
else if String.length alt > 1000 then
Error "Image description too long"
else
Ok (Some (name, content, alt))
(*TODO switch to markdown !*)
(* insert html into the comment, and keep tracks of citations :

View file

@ -11,4 +11,4 @@ let ( let^ ) o f =
| Error e -> Error (Format.sprintf "db error: %s" (Caqti_error.show e))
| Ok x -> f x
let ( let* ) o f = match o with Error e -> Error e | Ok x -> f x
let ( let* ) o f = Result.fold ~ok:f ~error:Result.error o

View file

@ -8,7 +8,7 @@
(library
(name js_pretty_post)
(modules js_pretty_post)
(libraries js_of_ocaml brr)
(libraries js_of_ocaml brr unix)
(preprocess
(pps js_of_ocaml-ppx)))

View file

@ -31,25 +31,17 @@ let image_click post_image event =
let render_time date_span =
log "render time@.";
let unix_time =
let t =
float_of_int
(Jv.to_int
(Jv.call date_span "getAttribute" [| Jv.of_string "data-time" |]) )
in
(*use float because int overflow*)
let time_millisecs = 1000.0 *. unix_time in
let date_constructor = Jv.get Jv.global "Date" in
let date = Jv.new' date_constructor [| Jv.of_float time_millisecs |] in
let year = Jv.to_int @@ Jv.call date "getFullYear" [||] in
(*the month is 0-indexed*)
let month = (Jv.to_int @@ Jv.call date "getMonth" [||]) + 1 in
let day = Jv.to_int @@ Jv.call date "getDate" [||] in
let hour = Jv.to_int @@ Jv.call date "getHours" [||] in
let min = Jv.to_int @@ Jv.call date "getMinutes" [||] in
let date_string =
Format.sprintf "%02d-%02d-%02d %02d:%02d" year month day hour min
let t = Unix.localtime t in
let date =
Format.sprintf "%02d-%02d-%02d %02d:%02d" (1900 + t.tm_year) (1 + t.tm_mon)
t.tm_mday t.tm_hour t.tm_min
in
ignore @@ Jv.set date_span "innerHTML" (Jv.of_string date_string)
ignore @@ Jv.set date_span "innerHTML" (Jv.of_string date)
let make_pretty _ =
log "make pretty@.";