fmt

.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=fit
-break-cases=all
-break-collection-expressions=fit-or-vertical
 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
+if-then-else=compact
-function-indent-nested=never
-if-then-else=k-r
-indent-after-in=0
 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

src/babillard.ml

@@ -212,8 +212,7 @@ let () =
   if
     List.exists Result.is_error
       (List.map (fun query -> Db.exec query ()) tables)
-  then
+  then Dream.error (fun log -> log "can't create table")
-    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
+      if not (is_valid_image image_content) then Error "invalid image"
-        Error "invalid image"
+      else if String.length alt > 1000 then Error "Image description too long"
-      else if String.length alt > 1000 then
+      else Ok (Some image) )
-        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 {|<a href="#%s">%s</a>|} sub_w w in
         (new_w, Some sub_w)
-    else
+    else (w, None)
-      (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
+  if Option.is_none (Uuidm.of_string parent_id) then Error "invalid thread id"
-    Error "invalid thread id"
+  else if String.length comment > 10000 then Error "invalid comment"
-  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
+      if String.length tags > 1000 then Error "invalid tags"
-        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
+  if not is_valid_latlng then Error "Invalid coordinate"
-    Error "Invalid coordinate"
+  else if String.length subject > 600 then Error "Invalid subject"
-  else if String.length subject > 600 then
-    Error "Invalid subject"
   else
     let thread_data = { subject; lng; lat } in
     let* reply =

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 =
+let ( let* ) o f = match o with Error e -> Error e | Ok x -> f x
-  match o with
-  | Error e -> Error e
-  | Ok x -> f x

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 _)
+    | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage"
-    | 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 _)
+      | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage"
-      | 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 _)
+    | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage"
-    | Error _ ->
-      failwith "can't set latlng storage"
     | Ok () -> ()
 
   let () =

src/js/js_pretty_post.ml

@@ -9,9 +9,7 @@ let of_string = function
   | "postImageBig" -> Some Big
   | _ -> None
 
-let to_string = function
+let to_string = function Small -> "postImage" | Big -> "postImageBig"
-  | 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
+      to_string (match image_size with Big -> Small | Small -> Big)
-        ( match image_size with
-        | Big -> Small
-        | Small -> Big )
     | None -> failwith "invalid image class name"
   in
   ignore

src/permap.ml

@@ -3,14 +3,11 @@ let get_title content =
   try
     let soup = content |> parse in
     soup $ "h1" |> R.leaf_text
-  with
+  with Failure _e -> "Permap"
-  | Failure _e -> "Permap"
 
 let render ?title content request =
   let title =
-    match title with
+    match title with None -> get_title content | Some title -> title
-    | 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
+    match title with None -> get_title content | Some title -> title
-    | 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 _
+  | `Ok _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
-  | `Many_tokens _
+  | `Wrong_session _ | `Expired _ | `Wrong_content_type ->
-  | `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 =
+    let bio = match User.get_bio nick with Ok bio -> bio | Error e -> e in
-      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 _
+    | `Ok _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
-    | `Many_tokens _
+    | `Wrong_session _ | `Expired _ | `Wrong_content_type -> (
-    | `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 _
+      | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
-      | `Many_tokens _
+      | `Wrong_session _ | `Wrong_content_type ->
-      | `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
+  | Ok None | Error _ -> (
-  | 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 _
+    | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
-    | `Many_tokens _
+    | `Wrong_session _ | `Wrong_content_type ->
-    | `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 _
+    | `Expired _ | `Many_tokens _ | `Missing_token _ | `Invalid_token _
-    | `Many_tokens _
+    | `Wrong_session _ | `Wrong_content_type ->
-    | `Missing_token _
-    | `Invalid_token _
-    | `Wrong_session _
-    | `Wrong_content_type ->
       Dream.empty `Bad_Request )
 
 let redirect_to_babillard _request =

src/user.ml

@@ -68,8 +68,7 @@ let () =
   if
     List.exists Result.is_error
       (List.map (fun query -> Db.exec query ()) tables)
-  then
+  then Dream.error (fun log -> log "can't create table")
-    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
+  else Error "wrong password"
-    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
+    match Emile.of_string email with Ok _ -> true | Error _ -> false
-    | 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
+  if not valid then Error "Something is wrong"
-    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
+    else Error "nick or email already exists"
-      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
+  if not valid then Error "Not biologic"
-    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
+  if String.length avatar = 0 then Ok None else Ok (Some avatar)
-    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
+    if not (is_valid_image content) then Error "Invalid image"
-      Error "Invalid image"
     else
       let^ () = Db.exec Q.upload_avatar (content, nick) in
       Ok ()