From 47753368e3dd08ec8906f75951306966bb4a58ee Mon Sep 17 00:00:00 2001 From: zapashcanon Date: Fri, 18 Feb 2022 02:40:04 +0100 Subject: [PATCH] fmt --- .ocamlformat | 23 ++------------- src/babillard.ml | 30 +++++++------------ src/bindings.ml | 5 +--- src/js/js_map.ml | 12 ++------ src/js/js_pretty_post.ml | 9 ++---- src/permap.ml | 62 ++++++++++------------------------------ src/user.ml | 27 ++++++----------- 7 files changed, 41 insertions(+), 127 deletions(-) diff --git a/.ocamlformat b/.ocamlformat index 7aac18a..cc34f68 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,51 +1,34 @@ version=0.20.1 -align-cases=false -align-constructors-decl=false -align-variants-decl=false assignment-operator=end-line -break-before-in=fit-or-vertical -break-cases=all -break-collection-expressions=fit-or-vertical +break-cases=fit break-fun-decl=wrap break-fun-sig=wrap break-infix=wrap break-infix-before-func=false break-separators=before break-sequences=true -break-string-literals=auto -break-struct=force cases-exp-indent=2 cases-matching-exp-indent=normal -disambiguate-non-breaking-match=false doc-comments=before doc-comments-padding=2 doc-comments-tag-only=default dock-collection-brackets=false exp-grouping=preserve -extension-indent=2 field-space=loose -function-indent=2 -function-indent-nested=never -if-then-else=k-r -indent-after-in=0 +if-then-else=compact indicate-multiline-delimiters=space indicate-nested-or-patterns=unsafe-no infix-precedence=indent leading-nested-match-parens=false let-and=sparse -let-binding-indent=2 let-binding-spacing=compact let-module=compact margin=80 -match-indent=0 -match-indent-nested=never max-indent=68 module-item-spacing=sparse -nested-match=wrap ocp-indent-compat=false parens-ite=false parens-tuple=always -parens-tuple-patterns=multi-line-only parse-docstrings=true sequence-blank-line=preserve-one sequence-style=terminator @@ -54,8 +37,6 @@ space-around-arrays=true space-around-lists=true space-around-records=true space-around-variants=true -stritem-extension-indent=0 type-decl=sparse -type-decl-indent=2 wrap-comments=false wrap-fun-args=true diff --git a/src/babillard.ml b/src/babillard.ml index 9d347b5..72e0c9a 100644 --- a/src/babillard.ml +++ b/src/babillard.ml @@ -212,8 +212,7 @@ let () = if List.exists Result.is_error (List.map (fun query -> Db.exec query ()) tables) - then - Dream.error (fun log -> log "can't create table") + then Dream.error (fun log -> log "can't create table") let parse_image image = match image with @@ -230,12 +229,9 @@ let parse_image image = 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 image_content) then Error "invalid image" + else if String.length alt > 1000 then Error "Image description too long" + else Ok (Some image) ) (*TODO switch to markdown !*) (* insert html into the comment, and keep tracks of citations : @@ -255,8 +251,7 @@ let parse_comment comment = | Some _ -> let new_w = Format.sprintf {|%s|} sub_w w in (new_w, Some sub_w) - else - (w, None) + else (w, None) in let handle_line l = let trim_w = String.trim l in @@ -366,16 +361,13 @@ let build_reply ~comment ?image ~tags ?parent_id nick = let id = Uuidm.to_string (Uuidm.v4_gen random_state ()) in (* parent_id is None if this reply is supposed to be a new thread *) let parent_id = Option.value parent_id ~default:id in - if Option.is_none (Uuidm.of_string parent_id) then - Error "invalid thread id" - else if String.length comment > 10000 then - Error "invalid comment" + if Option.is_none (Uuidm.of_string parent_id) then Error "invalid thread id" + else if String.length comment > 10000 then Error "invalid comment" else match parse_image image with | Error e -> Error e | Ok image -> - if String.length tags > 1000 then - Error "invalid tags" + if String.length tags > 1000 then Error "invalid tags" else (* TODO latlng validation? *) let tag_list = Str.split (Str.regexp " +") tags in @@ -399,10 +391,8 @@ let build_op ~comment ?image ~tags ~subject ~lat ~lng nick = let subject = Dream.html_escape subject in (* TODO latlng validation? *) let is_valid_latlng = true in - if not is_valid_latlng then - Error "Invalid coordinate" - else if String.length subject > 600 then - Error "Invalid subject" + if not is_valid_latlng then Error "Invalid coordinate" + else if String.length subject > 600 then Error "Invalid subject" else let thread_data = { subject; lng; lat } in let* reply = diff --git a/src/bindings.ml b/src/bindings.ml index 84ebde6..cae77cf 100644 --- a/src/bindings.ml +++ b/src/bindings.ml @@ -11,7 +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 = match o with Error e -> Error e | Ok x -> f x diff --git a/src/js/js_map.ml b/src/js/js_map.ml index b07d9a5..26532c5 100644 --- a/src/js/js_map.ml +++ b/src/js/js_map.ml @@ -65,16 +65,12 @@ module Leaflet = struct match Brr_io.Storage.set_item storage (Jstr.of_string "lat") (Jv.to_jstr lat) with - | (exception Jv.Error _) - | Error _ -> - failwith "can't set latlng storage" + | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" | Ok () -> ( match Brr_io.Storage.set_item storage (Jstr.of_string "lng") (Jv.to_jstr lng) with - | (exception Jv.Error _) - | Error _ -> - failwith "can't set latlng storage" + | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" | Ok () -> () ) let on_zoomend _event = @@ -83,9 +79,7 @@ module Leaflet = struct match Brr_io.Storage.set_item storage (Jstr.of_string "zoom") (Jv.to_jstr zoom) with - | (exception Jv.Error _) - | Error _ -> - failwith "can't set latlng storage" + | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" | Ok () -> () let () = diff --git a/src/js/js_pretty_post.ml b/src/js/js_pretty_post.ml index 9a5b211..9ad6464 100644 --- a/src/js/js_pretty_post.ml +++ b/src/js/js_pretty_post.ml @@ -9,9 +9,7 @@ let of_string = function | "postImageBig" -> Some Big | _ -> None -let to_string = function - | Small -> "postImage" - | Big -> "postImageBig" +let to_string = function Small -> "postImage" | Big -> "postImageBig" (*change postImage class to make it bigger/smaller on click*) let image_click post_image event = @@ -22,10 +20,7 @@ let image_click post_image event = let new_class = match of_string current_class with | Some image_size -> - to_string - ( match image_size with - | Big -> Small - | Small -> Big ) + to_string (match image_size with Big -> Small | Small -> Big) | None -> failwith "invalid image class name" in ignore diff --git a/src/permap.ml b/src/permap.ml index 6c916f3..393b941 100644 --- a/src/permap.ml +++ b/src/permap.ml @@ -3,14 +3,11 @@ let get_title content = try let soup = content |> parse in soup $ "h1" |> R.leaf_text - with - | Failure _e -> "Permap" + with Failure _e -> "Permap" let render ?title content request = let title = - match title with - | None -> get_title content - | Some title -> title + match title with None -> get_title content | Some title -> title in Dream.html @@ Template.render_unsafe ~title:(Dream.html_escape title) @@ -19,9 +16,7 @@ let render ?title content request = let render_unsafe ?title content request = let title = - match title with - | None -> get_title content - | Some title -> title + match title with None -> get_title content | Some title -> title in Dream.html @@ Template.render_unsafe ~title ~content request @@ -45,13 +40,8 @@ let register_post request = match%lwt Dream.form request with | `Ok [ ("email", email); ("nick", nick); ("password", password) ] -> render_unsafe (Register.f ~nick ~email ~password request) request - | `Ok _ - | `Many_tokens _ - | `Missing_token _ - | `Invalid_token _ - | `Wrong_session _ - | `Expired _ - | `Wrong_content_type -> + | `Ok _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ + | `Wrong_session _ | `Expired _ | `Wrong_content_type -> assert false let login_get request = render_unsafe (Login.f request) request @@ -79,11 +69,7 @@ let profile_get request = match Dream.session "nick" request with | None -> render_unsafe "Not logged in" request | Some nick -> - let bio = - match User.get_bio nick with - | Ok bio -> bio - | Error e -> e - in + let bio = match User.get_bio nick with Ok bio -> bio | Error e -> e in render_unsafe (User_profile.f nick bio request) request let profile_post request = @@ -98,13 +84,8 @@ let profile_post request = ~headers:[ ("Location", "/profile") ] "Your bio was updated!" | Error e -> render_unsafe e request ) - | `Ok _ - | `Many_tokens _ - | `Missing_token _ - | `Invalid_token _ - | `Wrong_session _ - | `Expired _ - | `Wrong_content_type -> ( + | `Ok _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ + | `Wrong_session _ | `Expired _ | `Wrong_content_type -> ( match%lwt Dream.multipart request with | `Ok [ ("file", file) ] -> ( match User.upload_avatar file nick with @@ -114,12 +95,8 @@ let profile_post request = "Your avatar was updated!" | Error e -> render_unsafe e request ) | `Ok _ -> Dream.empty `Bad_Request - | `Expired _ - | `Many_tokens _ - | `Missing_token _ - | `Invalid_token _ - | `Wrong_session _ - | `Wrong_content_type -> + | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ + | `Wrong_session _ | `Wrong_content_type -> Dream.empty `Bad_Request ) ) let avatar_image request = @@ -128,8 +105,7 @@ let avatar_image request = match avatar with | Ok (Some avatar) -> Dream.respond ~headers:[ ("Content-Type", "image") ] avatar - | Ok None - | Error _ -> ( + | Ok None | Error _ -> ( match Content.read "/assets/img/default_avatar.png" with | None -> Dream.empty `Not_Found | Some avatar -> Dream.respond ~headers:[ ("Content-Type", "image") ] avatar @@ -187,12 +163,8 @@ let newthread_post request = "Your thread was posted!" | Error e -> render_unsafe e request ) ) | `Ok _ -> Dream.empty `Bad_Request - | `Expired _ - | `Many_tokens _ - | `Missing_token _ - | `Invalid_token _ - | `Wrong_session _ - | `Wrong_content_type -> + | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ + | `Wrong_session _ | `Wrong_content_type -> Dream.empty `Bad_Request ) let thread_get request = @@ -240,12 +212,8 @@ let reply_post request = "Your reply was posted!" | Error e -> render_unsafe e request ) | `Ok _ -> Dream.empty `Bad_Request - | `Expired _ - | `Many_tokens _ - | `Missing_token _ - | `Invalid_token _ - | `Wrong_session _ - | `Wrong_content_type -> + | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _ + | `Wrong_session _ | `Wrong_content_type -> Dream.empty `Bad_Request ) let redirect_to_babillard _request = diff --git a/src/user.ml b/src/user.ml index 71d5078..93f2f55 100644 --- a/src/user.ml +++ b/src/user.ml @@ -68,8 +68,7 @@ let () = if List.exists Result.is_error (List.map (fun query -> Db.exec query ()) tables) - then - Dream.error (fun log -> log "can't create table") + then Dream.error (fun log -> log "can't create table") let login ~nick ~password request = let^? good_password = Db.find_opt Q.get_password nick in @@ -79,8 +78,7 @@ let login ~nick ~password request = Dream.put_session "nick" nick request in Ok () - else - Error "wrong password" + else Error "wrong password" let register ~email ~nick ~password = (* TODO: remove bad characters (e.g. delthas) *) @@ -91,9 +89,7 @@ let register ~email ~nick ~password = in let valid_email = - match Emile.of_string email with - | Ok _ -> true - | Error _ -> false + match Emile.of_string email with Ok _ -> true | Error _ -> false in let valid_password = @@ -105,15 +101,13 @@ let register ~email ~nick ~password = let password = Bcrypt.hash password in let password = Bcrypt.string_of_hash password in - if not valid then - Error "Something is wrong" + if not valid then Error "Something is wrong" else let^? nb = Db.find_opt Q.is_already_user (nick, email) in if nb = 0 then let^ () = Db.exec Q.inser_new_user (nick, password, email, ("", "")) in Ok () - else - Error "nick or email already exists" + else Error "nick or email already exists" let list () = let^ users = Db.collect_list Q.list_nicks () in @@ -153,8 +147,7 @@ let profile request = let update_bio bio nick = let bio = Dream.html_escape bio in let valid = String.length bio < 10000 in - if not valid then - Error "Not biologic" + if not valid then Error "Not biologic" else let^ () = Db.exec Q.update_bio (bio, nick) in Ok () @@ -165,17 +158,13 @@ let get_bio nick = let get_avatar nick = let^? avatar = Db.find_opt Q.get_avatar nick in - if String.length avatar = 0 then - Ok None - else - Ok (Some avatar) + if String.length avatar = 0 then Ok None else Ok (Some avatar) let upload_avatar files nick = match files with | [] -> Error "No file provided" | [ (_, content) ] -> - if not (is_valid_image content) then - Error "Invalid image" + if not (is_valid_image content) then Error "Invalid image" else let^ () = Db.exec Q.upload_avatar (content, nick) in Ok ()