more prelude

drame.opam

@@ -18,6 +18,7 @@ depends: [
   "httpcats"
   "js_of_ocaml-compiler"
   "miou"
+  "prelude"
   "ptime"
   "scfg"
   "tyxml"

dune-project

@@ -36,6 +36,7 @@
    httpcats
    js_of_ocaml-compiler
    miou
+   prelude
    ptime
    scfg
    tyxml

example/dune

@@ -1,4 +1,6 @@
 (executable
  (name main)
  (modules main)
+ (flags
+  (:standard -open Prelude))
  (libraries drame prelude scfg))

example/main.ml

@@ -15,8 +15,7 @@ module Server = Server.Make (App_id)
 let template_html (_request : Request.t) ~title ~body =
   let styles =
     List.map
-      (fun s ->
-        link ~rel:[ `Stylesheet ] ~href:(Format.sprintf "/assets/css/%s" s) () )
+      (fun s -> link ~rel:[ `Stylesheet ] ~href:(Fmt.str "/assets/css/%s" s) ())
       [ "style.css" ]
   in
   let head = head (Html.title title) styles in
@@ -28,7 +27,7 @@ let template_html (_request : Request.t) ~title ~body =
 let hello =
   let body = txt "How are you doing?" in
   fun ~name ->
-    let title = Format.ksprintf txt "Hello %s!" name in
+    let title = Fmt.kstr txt "Hello %s!" name in
     fun request ->
       let doc = template_html request ~title ~body in
       let content = Content.Html doc in
@@ -37,14 +36,14 @@ let hello =
 let hello_q request =
   let name = Request.query request "name" in
   let name = Option.value name ~default:"World" in
-  let msg = Format.ksprintf txt "Hello %s!" name in
+  let msg = Fmt.kstr txt "Hello %s!" name in
   let doc = template_html request ~title:msg ~body:msg in
   let content = Content.Html doc in
   Ok content
 
 let config =
   let title = txt "Configuration" in
-  let body = Format.kasprintf txt "%a" Scfg.Pp.config Server.config in
+  let body = Fmt.kstr txt "%a" Scfg.Pp.config Server.config in
   fun request ->
     let doc = template_html request ~title ~body in
     let content = Content.Html doc in
@@ -67,8 +66,8 @@ let style =
   fun _request -> Ok content
 
 let handler route =
-  Format.printf "[request] %a@\n" Route.pp route;
-  Format.pp_print_flush Format.std_formatter ();
+  Fmt.pr "[request] %a@\n" Route.pp route;
+  Fmt.flush Fmt.stdout ();
   match route with
   | [||] -> hello ~name:"World"
   | [| "assets"; "css"; "style.css" |] -> style

src/cookie.ml

@@ -21,7 +21,7 @@ let get ~decrypt:_ request 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
+  let v = List.find (fun (name', _) -> String.equal name name') cookies in
   Option.map snd v
 
 let to_set_cookie ~max_age ~path name value =

src/request.ml

@@ -17,7 +17,7 @@ let pp_comma_sep_string_list = Fmt.list ~sep:pp_comma Fmt.string
 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
+  let query = List.assoc name query in
   Option.map query_values_to_string query
 
 let queries { query; _ } name : string list =
@@ -38,7 +38,7 @@ let all_queries { query; _ } : (string * string) list =
 
 let header { headers; _ } name : string option =
   let header =
-    List.find_opt (fun (name', _value) -> String.equal name name') headers
+    List.find (fun (name', _value) -> String.equal name name') headers
   in
   Option.map snd header
 

src/session.ml

@@ -41,7 +41,7 @@ end = struct
 
   let find key =
     Mutex.lock mutex;
-    Fun.protect ~finally (fun () -> find_opt tbl key)
+    Fun.protect ~finally (fun () -> find tbl key)
 
   let add key value =
     Mutex.lock mutex;
@@ -117,7 +117,7 @@ let load request =
 
 let get request key =
   let { payload; _ } = load request in
-  List.assoc_opt key payload
+  List.assoc key payload
 
 let set request key value =
   let ({ payload; _ } as session) = load request in