Apply .ocamlformat.0.18.0

mirage · Apr 26, 2021 · 7308891 · 7308891
1 parent 2aad380
commit 7308891
Show file tree

Hide file tree

Showing 54 changed files with 3,577 additions and 2,958 deletions.
diff --git a/.ocamlformat b/.ocamlformat
@@ -1,4 +1,4 @@
-version=0.17.0
+version=0.18.0
 module-item-spacing=compact
 break-struct=natural
 break-infix=fit-or-vertical

diff --git a/examples/attachment.ml b/examples/attachment.ml
@@ -2,10 +2,11 @@ open Mrmime
 
 let romain_calascibetta =
   let open Mailbox in
-  Local.[ w "romain"; w "calascibetta" ] @ Domain.(domain, [ a "gmail"; a "com" ])
+  Local.[ w "romain"; w "calascibetta" ]
+  @ Domain.(domain, [ a "gmail"; a "com" ])
 
 let date =
-  let now = Ptime_clock.now () in
+  let now = Option.get (Ptime.of_float_s 1619454050.0) in
   Date.of_ptime ~zone:Date.Zone.GMT now
 
 let subject =
@@ -14,40 +15,56 @@ let subject =
 
 let content_disposition = Field_name.v "Content-Disposition"
 
-let content_type_1 = Content_type.(make `Text (Subtype.v `Text "plain") Parameters.empty)
-let content_type_2 = Content_type.(make `Image (Subtype.v `Image "png") Parameters.empty)
+let content_type_1 =
+  Content_type.(make `Text (Subtype.v `Text "plain") Parameters.empty)
+
+let content_type_2 =
+  Content_type.(make `Image (Subtype.v `Image "png") Parameters.empty)
 
 let stream_of_file filename : Mt.buffer Mt.stream =
   let tp = Bytes.create 0x1000 in
   let ic = open_in filename in
-  fun () -> match input ic tp 0 0x1000 with
-  | 0 -> close_in ic ; None
-  | len -> Some (Bytes.unsafe_to_string tp, 0, len)
+  fun () ->
+    match input ic tp 0 0x1000 with
+    | 0 ->
+        close_in ic;
+        None
+    | len -> Some (Bytes.unsafe_to_string tp, 0, len)
 
 let stream_of_string str : Mt.buffer Mt.stream =
   let consumed = ref false in
-  fun () -> match !consumed with
-  | true -> None
-  | false -> consumed := true ; Some (str, 0, String.length str)
+  fun () ->
+    match !consumed with
+    | true -> None
+    | false ->
+        consumed := true;
+        Some (str, 0, String.length str)
 
 let part0 =
   let header =
     let open Header in
     empty
     |> add Field_name.content_type Field.(Content, content_type_1)
-    |> add Field_name.content_encoding Field.(Encoding, `Quoted_printable) in
+    |> add Field_name.content_encoding Field.(Encoding, `Quoted_printable)
+  in
   Mt.part ~header (stream_of_string "Hello World!")
 
 let part1 =
-  let header = 
+  let header =
     let open Header in
     empty
     |> add Field_name.content_type Field.(Content, content_type_2)
     |> add Field_name.content_encoding Field.(Encoding, `Base64)
-    |> add content_disposition Field.(Unstructured,
-       Unstructured.Craft.(compile
-         [ v "attachement"; sp 0; v ";"; sp 1;
-           v "filename"; sp 0; v "="; sp 0; v "mrmime.png" ])) in
+    |> add content_disposition
+         Field.
+           ( Unstructured,
+             Unstructured.Craft.(
+               compile
+                 [
+                   v "attachement"; sp 0; v ";"; sp 1; v "filename"; sp 0;
+                   v "="; sp 0; v "mrmime.png";
+                 ]) )
+  in
   Mt.part ~header (stream_of_file "mrmime.png")
 
 let header =
@@ -56,7 +73,8 @@ let header =
   |> add Field_name.date Field.(Date, date)
   |> add Field_name.subject Field.(Unstructured, subject)
   |> add Field_name.from Field.(Mailboxes, [ romain_calascibetta ])
-  |> add (Field_name.v "To") Field.(Addresses, Address.[ mailbox romain_calascibetta ])
+  |> add (Field_name.v "To")
+       Field.(Addresses, Address.[ mailbox romain_calascibetta ])
 
 let rng ?g:_ len =
   let res = Bytes.create len in
@@ -65,15 +83,21 @@ let rng ?g:_ len =
     | n when n < 26 -> Bytes.set res i (Char.chr (Char.code 'a' + n))
     | n when n < 52 -> Bytes.set res i (Char.chr (Char.code 'A' + (n - 26)))
     | n -> Bytes.set res i (Char.chr (Char.code '0' + (n - 26 - 26)))
-  done ; Bytes.unsafe_to_string res
+  done;
+  Bytes.unsafe_to_string res
 
 let email = Mt.make header Mt.multi (Mt.multipart ~rng [ part0; part1 ])
+
 let email =
   let stream = Mt.to_stream email in
   let buffer = Buffer.create 0x1000 in
-  let rec go () = match stream () with
-    | Some (str, off, len) -> Buffer.add_substring buffer str off len ; go ()
-    | None -> Buffer.contents buffer in
+  let rec go () =
+    match stream () with
+    | Some (str, off, len) ->
+        Buffer.add_substring buffer str off len;
+        go ()
+    | None -> Buffer.contents buffer
+  in
   go ()
 
 let () = print_string email
diff --git a/examples/test.t b/examples/test.t
@@ -3,7 +3,7 @@ Simple email with attachment
   To: romain.calascibetta@gmail.com
   From: romain.calascibetta@gmail.com
   Subject: A Simple Email
-  Date: Mon, 26 Apr 2021 13:58:05 GMT
+  Date: Mon, 26 Apr 2021 16:20:50 GMT
   Content-Type: multipart/mixed; boundary=YlGxbWQC
 
   --YlGxbWQC

diff --git a/fuzz/common.ml b/fuzz/common.ml
@@ -1,33 +1,40 @@
 open Crowbar
 
-let (<.>) f g = fun x -> f (g x)
+let ( <.> ) f g x = f (g x)
 
 let char_from_alphabet alphabet =
   map [ range (String.length alphabet) ] (String.make 1 <.> String.get alphabet)
 
 let string_from_alphabet alphabet len =
   let rec go acc = function
     | 0 -> concat_gen_list (const "") acc
-    | n -> go (char_from_alphabet alphabet :: acc) (pred n) in
+    | n -> go (char_from_alphabet alphabet :: acc) (pred n)
+  in
   go [] len
 
 let alphabet_from_predicate predicate =
   let len =
     let rec go acc = function
       | 0 -> if predicate (Char.unsafe_chr 0) then acc + 1 else acc
       | n ->
-        let acc = if predicate (Char.unsafe_chr n) then acc + 1 else acc in
-        go acc (n - 1) in
-    go 0 255 in
+          let acc = if predicate (Char.unsafe_chr n) then acc + 1 else acc in
+          go acc (n - 1)
+    in
+    go 0 255
+  in
   let res = Bytes.create len in
   let rec go idx = function
     | 0 ->
-      if predicate (Char.unsafe_chr 0) then Bytes.unsafe_set res idx (Char.unsafe_chr 0)
+        if predicate (Char.unsafe_chr 0) then
+          Bytes.unsafe_set res idx (Char.unsafe_chr 0)
     | n ->
-      if predicate (Char.unsafe_chr n) then Bytes.unsafe_set res idx (Char.unsafe_chr n) ;
-      let idx = if predicate (Char.unsafe_chr n) then idx + 1 else idx in
-      go idx (n - 1) in
-  go 0 255 ; Bytes.unsafe_to_string res
+        if predicate (Char.unsafe_chr n) then
+          Bytes.unsafe_set res idx (Char.unsafe_chr n);
+        let idx = if predicate (Char.unsafe_chr n) then idx + 1 else idx in
+        go idx (n - 1)
+  in
+  go 0 255;
+  Bytes.unsafe_to_string res
 
 let is_dcontent = function
   | '\033' .. '\090' | '\094' .. '\126' -> true
@@ -37,8 +44,9 @@ let is_atext = function
   | 'a' .. 'z'
   | 'A' .. 'Z'
   | '0' .. '9'
-  | '!' | '#' | '$' | '%' | '&' | '\'' | '*' | '+' | '-' | '/' | '=' | '?'
-  | '^' | '_' | '`' | '{' | '}' | '|' | '~' -> true
+  | '!' | '#' | '$' | '%' | '&' | '\'' | '*' | '+' | '-' | '/' | '=' | '?' | '^'
+  | '_' | '`' | '{' | '}' | '|' | '~' ->
+      true
   | _ -> false
 
 let is_obs_no_ws_ctl = function
@@ -51,6 +59,15 @@ let is_dtext = function
 
 let atext = alphabet_from_predicate is_atext
 let dtext = alphabet_from_predicate is_dtext
-let ldh_str = alphabet_from_predicate (function 'a' .. 'z' | 'A'.. 'Z' | '0' .. '9' | '-' -> true | _ -> false)
-let let_dig = alphabet_from_predicate (function 'a' .. 'z' | 'A'.. 'Z' | '0' .. '9' -> true | _ -> false)
+
+let ldh_str =
+  alphabet_from_predicate (function
+    | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '-' -> true
+    | _ -> false)
+
+let let_dig =
+  alphabet_from_predicate (function
+    | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' -> true
+    | _ -> false)
+
 let dcontent = alphabet_from_predicate is_dcontent
diff --git a/fuzz/dune b/fuzz/dune
@@ -6,7 +6,7 @@
 (executable
  (name fuzz_encoder)
  (modules fuzz_encoder)
- (libraries mrmime.prettym common crowbar jsonm))
+ (libraries prettym common crowbar jsonm))
 
 (executable
  (name fuzz_mailbox)

diff --git a/fuzz/fuzz_content_type.ml b/fuzz/fuzz_content_type.ml
@@ -5,70 +5,73 @@ open Common
 
 let token = alphabet_from_predicate Mrmime.Content_type.is_token
 let qtext = alphabet_from_predicate Mrmime.Content_type.is_qtext
-
 let token = dynamic_bind (range ~min:1 32) (string_from_alphabet token)
 
 let value =
-  map [ token ]
-    (fun v -> match Mrmime.Content_type.Parameters.value v with
-       | Ok v -> v
-       | Error _ -> bad_test ())
+  map [ token ] (fun v ->
+      match Mrmime.Content_type.Parameters.value v with
+      | Ok v -> v
+      | Error _ -> bad_test ())
 
 (* XXX(dinosaure): IETF token does not exists - see [Rfc2045.ty] *)
 
 let x_token =
-  map [ choose [ const "x"; const "X" ]
-      ; token ]
+  map
+    [ choose [ const "x"; const "X" ]; token ]
     (fun head tail -> head ^ "-" ^ tail)
 
 let ty =
   choose
-    [ const `Text
-    ; const `Image
-    ; const `Audio
-    ; const `Video
-    ; const `Application
-    ; const `Message
-    ; const `Multipart
-    ; map [ x_token ] (fun v -> `X_token v) ]
+    [
+      const `Text; const `Image; const `Audio; const `Video; const `Application;
+      const `Message; const `Multipart; map [ x_token ] (fun v -> `X_token v);
+    ]
 
 let iana ty =
-  choose (Mrmime.Iana.Map.find (Mrmime.Content_type.Type.to_string ty) Mrmime.Iana.database
-          |> Mrmime.Iana.Set.elements
-          |> List.map const)
-
-let key = map [ token ] (fun v -> match Mrmime.Content_type.Parameters.key v with
-    | Ok v -> v
-    | Error _ -> bad_test ())
+  choose
+    (Mrmime.Iana.Map.find
+       (Mrmime.Content_type.Type.to_string ty)
+       Mrmime.Iana.database
+    |> Mrmime.Iana.Set.elements
+    |> List.map const)
+
+let key =
+  map [ token ] (fun v ->
+      match Mrmime.Content_type.Parameters.key v with
+      | Ok v -> v
+      | Error _ -> bad_test ())
 
 let subty = function
-  | (#Mrmime.Content_type.Type.discrete
-    | #Mrmime.Content_type.Type.composite) as ty -> map [ iana ty ] (fun v -> ty, `Iana_token v)
-  | ty -> map [ x_token ] (fun v -> ty, `X_token v)
-
-let parameter = map [ key; value] (fun key value -> (key, value))
+  | (#Mrmime.Content_type.Type.discrete | #Mrmime.Content_type.Type.composite)
+    as ty ->
+      map [ iana ty ] (fun v -> (ty, `Iana_token v))
+  | ty -> map [ x_token ] (fun v -> (ty, `X_token v))
 
+let parameter = map [ key; value ] (fun key value -> (key, value))
 let parameters = list parameter
 
 let content_type =
-  map [ dynamic_bind ty subty; parameters; ]
-    (fun (ty_, subty_) parameters_ -> Mrmime.Content_type.{ ty= ty_; subty= subty_; parameters= parameters_; })
+  map [ dynamic_bind ty subty; parameters ] (fun (ty_, subty_) parameters_ ->
+      Mrmime.Content_type.{ ty = ty_; subty = subty_; parameters = parameters_ })
 
 module BBuffer = Buffer
 
 let emitter_of_buffer buf =
   let open Prettym in
-
   let write a = function
-    | { IOVec.buffer= Buffer.String x; off; len; } ->
-      BBuffer.add_substring buf x off len; a + len
-    | { IOVec.buffer= Buffer.Bytes x; off; len; } ->
-      BBuffer.add_subbytes buf x off len; a + len
-    | { IOVec.buffer= Buffer.Bigstring x; off; len; } ->
-      BBuffer.add_string buf (Bigstringaf.substring x ~off ~len); a + len in
+    | { IOVec.buffer = Buffer.String x; off; len } ->
+        BBuffer.add_substring buf x off len;
+        a + len
+    | { IOVec.buffer = Buffer.Bytes x; off; len } ->
+        BBuffer.add_subbytes buf x off len;
+        a + len
+    | { IOVec.buffer = Buffer.Bigstring x; off; len } ->
+        BBuffer.add_string buf (Bigstringaf.substring x ~off ~len);
+        a + len
+  in
   List.fold_left write 0
 
-let ( <.> ) f g = fun x -> f (g x)
+let ( <.> ) f g x = f (g x)
 
 let parser buf =
   let open Angstrom in
@@ -78,27 +81,34 @@ let parser buf =
     Unstrctrd.without_comments v
     >>| Unstrctrd.fold_fws
     >>| Unstrctrd.to_utf_8_string
-    >>= ( R.reword_error R.msg <.> Angstrom.parse_string Mrmime.Content_type.Decoder.content ) in
-  match res with
-  | Ok v -> return v
-  | Error (`Msg err) -> fail err
+    >>= (R.reword_error R.msg
+        <.> Angstrom.parse_string ~consume:Prefix
+              Mrmime.Content_type.Decoder.content)
+  in
+  match res with Ok v -> return v | Error (`Msg err) -> fail err
 
 let () =
   let open Mrmime in
-
   Crowbar.add_test ~name:"content-type" [ content_type ] @@ fun content_type ->
-
   let buffer = Buffer.create 0x100 in
-  let encoder = Prettym.create ~margin:78 ~new_line:"\r\n" 0x100 ~emitter:(emitter_of_buffer buffer) in
-  let encoder = Prettym.keval Prettym.flush encoder Prettym.[ !!Content_type.Encoder.content_type; new_line; ] content_type in
-
-  check_eq ~pp:Fmt.bool ~eq:(=) (Prettym.is_empty encoder) true ;
+  let encoder =
+    Prettym.create ~margin:78 ~new_line:"\r\n" 0x100
+      ~emitter:(emitter_of_buffer buffer)
+  in
+  let encoder =
+    Prettym.keval Prettym.flush encoder
+      Prettym.[ !!Content_type.Encoder.content_type; new_line ]
+      content_type
+  in
+
+  check_eq ~pp:Fmt.bool ~eq:( = ) (Prettym.is_empty encoder) true;
 
   let result = Buffer.contents buffer in
   let buf = Bytes.create 0x7f in
 
-  match Angstrom.parse_string (parser buf) result with
+  match Angstrom.parse_string ~consume:Prefix (parser buf) result with
   | Ok content_type' ->
-    check_eq ~pp:Content_type.pp ~eq:Content_type.equal content_type content_type'
+      check_eq ~pp:Content_type.pp ~eq:Content_type.equal content_type
+        content_type'
   | Error err ->
-    failf "%a can not be parsed: %s" Content_type.pp content_type err
+      failf "%a can not be parsed: %s" Content_type.pp content_type err