use prelude

.ocamlformat

@@ -1,4 +1,4 @@
-version=0.26.2
+version=0.27.0
 assignment-operator=end-line
 break-cases=fit
 break-fun-decl=wrap

example/dune

@@ -1,4 +1,4 @@
 (executable
  (name main)
  (modules main)
- (libraries drame scfg))
+ (libraries drame prelude scfg))

example/main.ml

@@ -16,8 +16,7 @@ let template_html (_request : Request.t) ~title ~body =
   let styles =
     List.map
       (fun s ->
-        link ~rel:[ `Stylesheet ] ~href:(Format.sprintf "/assets/css/%s" s) ()
-        )
+        link ~rel:[ `Stylesheet ] ~href:(Format.sprintf "/assets/css/%s" s) () )
       [ "style.css" ]
   in
   let head = head (Html.title title) styles in

src/cookie.ml

@@ -19,7 +19,7 @@ let get ~decrypt:_ request id =
     | _, true -> "__Secure-"
     | _, _ -> ""
   in
-  let name = Format.sprintf "%s%s" cookie_prefix id in
+  let name = Fmt.str "%s%s" cookie_prefix id in
   let cookies = all_cookies request in
   let v = List.find_opt (fun (name', _) -> String.equal name name') cookies in
   Option.map snd v
@@ -28,19 +28,18 @@ let to_set_cookie ~max_age ~path name value =
   let max_age =
     match max_age with
     | None -> ""
-    | Some seconds -> Printf.sprintf "; Max-Age=%.0f" (floor seconds)
+    | Some seconds -> Fmt.str "; Max-Age=%.0f" (floor seconds)
   in
 
   let path =
-    match path with None -> "" | Some path -> Printf.sprintf "; Path=%s" path
+    match path with None -> "" | Some path -> Fmt.str "; Path=%s" path
   in
 
   let secure = "; Secure" in
   let http_only = "; HttpOnly" in
   let same_site = "; SameSite=Lax" in
 
-  Printf.sprintf "%s=%s%s%s%s%s%s" name value max_age path secure http_only
-    same_site
+  Fmt.str "%s=%s%s%s%s%s%s" name value max_age path secure http_only same_site
 
 let make_set_headers ~encrypt:(_ : bool) ~max_age ~key ~value =
   let path = Some "/" in
@@ -51,7 +50,7 @@ let make_set_headers ~encrypt:(_ : bool) ~max_age ~key ~value =
     | _, true -> "__Secure-"
     | _, _ -> ""
   in
-  let name = Format.sprintf "%s%s" cookie_prefix key in
+  let name = Fmt.str "%s%s" cookie_prefix key in
 
   let set_cookie = to_set_cookie ~max_age ~path name value in
   [ ("Set-Cookie", set_cookie) ]

src/dune

@@ -25,6 +25,7 @@
   (re_export js_of_ocaml-compiler)
   miou
   miou.unix
+  prelude
   ptime
   ptime.clock.os
   (re_export scfg)
@@ -33,4 +34,6 @@
   htmlit
   unix
   uri
-  uuidm))
+  uuidm)
+ (flags
+  (:standard -open Prelude)))

src/form.ml

@@ -9,5 +9,10 @@ let form request =
       let form =
         List.map (fun (name, values) -> (name, String.concat "," values)) query
       in
-      Ok (List.sort compare form)
+      Ok
+        (List.sort
+           (fun (name1, values1) (name2, values2) ->
+             let cmp_names = String.compare name1 name2 in
+             if cmp_names = 0 then String.compare values1 values2 else cmp_names )
+           form )
     | _content_type -> Error "wrong content type" )

src/html_doc.ml

@@ -4,7 +4,6 @@ let to_string = Fun.id
 
 let of_tyxml doc =
   let indent = false in
-  let content = Format.asprintf "%a@\n" (Tyxml.Html.pp ~indent ()) doc in
-  content
+  Fmt.str "%a@\n" (Tyxml.Html.pp ~indent ()) doc
 
 let of_htmlit doc = Htmlit.El.to_string ~doctype:true doc

src/mimetype.ml

@@ -32,7 +32,7 @@ type t =
   | Video_webm
 
 let pp fmt mimetype =
-  Format.pp_print_string fmt
+  Fmt.string fmt
     ( match mimetype with
     | Audio_aac -> "audio/aac"
     | Audio_midi -> "audio/midi"
@@ -68,4 +68,4 @@ let pp fmt mimetype =
     | Video_mp4 -> "video/mp4"
     | Video_webm -> "video/webm" )
 
-let to_string mimetype = Format.asprintf "%a" pp mimetype
+let to_string mimetype = Fmt.str "%a" pp mimetype

src/mimetype.mli

@@ -32,6 +32,6 @@ type t =
   | Video_mp4
   | Video_webm
 
-val pp : Format.formatter -> t -> unit
+val pp : Fmt.formatter -> t -> unit
 
 val to_string : t -> string

src/request.ml

@@ -10,13 +10,11 @@ type t =
   ; get_body : unit -> string
   }
 
-let pp_comma fmt () = Format.pp_print_char fmt ','
+let pp_comma fmt () = Fmt.char fmt ','
 
-let pp_comma_sep_string_list =
-  Format.pp_print_list ~pp_sep:pp_comma Format.pp_print_string
+let pp_comma_sep_string_list = Fmt.list ~sep:pp_comma Fmt.string
 
-let query_values_to_string query =
-  Format.asprintf "%a" pp_comma_sep_string_list query
+let query_values_to_string query = Fmt.str "%a" pp_comma_sep_string_list query
 
 let query { query; _ } name : string option =
   let query = List.assoc_opt name query in
@@ -85,11 +83,11 @@ let get_body reqd =
   | `V1 reqd ->
     let body_reader = H1.Reqd.request_body reqd in
     aux (H1.Body.Reader.schedule_read body_reader) (fun () ->
-        H1.Body.Reader.close body_reader )
+      H1.Body.Reader.close body_reader )
   | `V2 reqd ->
     let body_reader = H2.Reqd.request_body reqd in
     aux (H2.Body.Reader.schedule_read body_reader) (fun () ->
-        H2.Body.Reader.close body_reader )
+      H2.Body.Reader.close body_reader )
 
 let of_reqd reqd =
   let { Httpcats.Server.target; meth; headers; _ } =

src/route.ml

@@ -1,13 +1,11 @@
 type t = string array
 
 let pp fmt route =
-  Format.fprintf fmt "/%a"
-    (Format.pp_print_array
-       ~pp_sep:(fun fmt () -> Format.pp_print_char fmt '/')
-       Format.pp_print_string )
+  Fmt.pf fmt "/%a"
+    (Fmt.array ~sep:(fun fmt () -> Fmt.char fmt '/') Fmt.string)
     route
 
 let of_string s =
   let ss = String.split_on_char '/' s in
-  let ss = List.filter (fun s -> s <> "") ss in
+  let ss = List.filter (fun s -> not (String.equal "" s)) ss in
   Array.of_list ss

src/route.mli

@@ -1,5 +1,5 @@
 type t = string array
 
-val pp : Format.formatter -> t -> unit
+val pp : Fmt.formatter -> t -> unit
 
 val of_string : string -> t

src/server.ml

@@ -11,8 +11,7 @@ struct
 
     let force_dir d name =
       match d with
-      | None ->
-        Format.ksprintf failwith "can not compute %s directory path" name
+      | None -> Fmt.failwith "can not compute %s directory path" name
       | Some dir -> dir
 
     let cache_dir = force_dir cache_dir "cache"
@@ -31,9 +30,9 @@ struct
   end
 
   let config =
-    let filename = Filename.concat Project.config_dir "config.scfg" in
-    match Scfg.Parse.from_file filename with
-    | (exception Sys_error msg) | Error msg -> failwith msg
+    let filename = Fpath.(v Project.config_dir / "config.scfg") in
+    match Scfg.Parse.from_file (Fpath.to_string filename) with
+    | (exception Sys_error msg) | Error msg -> Fmt.failwith "%s" msg
     | Ok config -> config
 
   open Scfg.Query
@@ -41,10 +40,10 @@ struct
   let port =
     let directive = get_dir "port" config in
     match directive with
-    | None -> failwith "configuration file is missing a port directive"
+    | None -> Fmt.failwith "configuration file is missing a port directive"
     | Some directive -> (
       let param = get_param_int 0 directive in
-      match param with Error msg -> failwith msg | Ok port -> port )
+      match param with Error msg -> Fmt.failwith "%s" msg | Ok port -> port )
 
   let listen () =
     let inet_addr = Unix.inet_addr_loopback in
@@ -57,14 +56,14 @@ struct
     let content_type = Content.to_mimetype content |> Mimetype.to_string in
     let content =
       match content with
-      | Content.Css sheet -> Format.asprintf "%a@\n" Css.pp_string_css sheet
+      | Content.Css sheet -> Fmt.str "%a@\n" Css.pp_string_css sheet
       | Html doc -> Html_doc.to_string doc
       | JavaScript program ->
         let open Js_of_ocaml_compiler in
         let accept_unnamed_var = true in
         let buffer = Buffer.create 4096 in
         let pp = Pretty_print.to_buffer buffer in
-        let _source_map : Source_map.t option =
+        let _source_map : Source_map.info =
           Js_output.program ~accept_unnamed_var pp program
         in
         (* setting a charset is invalid for JavaScript ! *)

src/session.ml

@@ -142,10 +142,10 @@ let make_send_headers session =
 
 let pp fmt request =
   let { id; expires_at; payload } = load request in
-  Format.fprintf fmt "id = %a ; expires_at = %a ; payload:@\n  @[<v>" Id.pp id
-    Ptime.pp expires_at;
-  Format.pp_print_list
-    ~pp_sep:(fun fmt () -> Format.pp_print_string fmt "@\n")
-    (fun fmt (k, v) -> Format.fprintf fmt "%s = %s" k v)
+  Fmt.pf fmt "id = %a ; expires_at = %a ; payload:@\n  @[<v>" Id.pp id Ptime.pp
+    expires_at;
+  Fmt.list
+    ~sep:(fun fmt () -> Fmt.string fmt "@\n")
+    (fun fmt (k, v) -> Fmt.pf fmt "%s = %s" k v)
     fmt payload;
-  Format.fprintf fmt "@]"
+  Fmt.pf fmt "@]"

src/session.mli

@@ -10,7 +10,7 @@ val set : Request.t -> string -> string -> unit
 
 val drop : Request.t -> string -> unit
 
-val pp : Format.formatter -> Request.t -> unit
+val pp : Fmt.formatter -> Request.t -> unit
 
 (* Internal *)
 val make_send_headers : t -> (string * string) list