unikernel/duniverse/ocaml-caqti/caqti/lib/caqti_pool_config.ml

@@ -0,0 +1,109 @@
+(* Copyright (C) 2023  Petter A. Urkedal <paurkedal@gmail.com>
+ *
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or (at your
+ * option) any later version, with the LGPL-3.0 Linking Exception.
+ *
+ * This library is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
+ * License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * and the LGPL-3.0 Linking Exception along with this library.  If not, see
+ * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
+ *)
+
+module Log = (val Logs.src_log (Logs.Src.create "caqti.config"))
+
+type t = {
+  max_size: int option;
+  max_idle_size: int option;
+  max_idle_age: Mtime.Span.t option option;
+  max_use_count: int option option;
+}
+
+type _ key =
+  | Max_size : int key
+  | Max_idle_size : int key
+  | Max_idle_age : Mtime.Span.t option key
+  | Max_use_count : int option key
+
+type any_key = Any : _ key -> any_key
+
+let keys = [
+  Any Max_size;
+  Any Max_idle_size;
+  Any Max_idle_age;
+  Any Max_use_count;
+]
+
+let create
+      ?max_size
+      ?max_idle_size
+      ?max_idle_age
+      ?max_use_count
+      () =
+  {max_size; max_idle_size; max_idle_age; max_use_count}
+
+let option_of_string f = function
+ | "" | "none" -> None
+ | s -> Some (f s)
+
+let mtime_span_of_string s =
+  let x = float_of_string s in
+  (match Mtime.Span.of_float_ns (x *. 1e9) with
+   | None -> failwith "Mtime.Span.of_float_ns"
+   | Some x -> x)
+
+let default = create ()
+
+let create_from_env pfx =
+  let get conv sfx =
+    let var = pfx ^ sfx in
+    (match Sys.getenv_opt var with
+     | None -> None
+     | Some str ->
+        (match conv str with
+         | value -> Some value
+         | exception Failure _ ->
+            Log.err (fun m -> m "Failed to parse $%s = %s." var str);
+            None))
+  in
+  {
+    max_size = get int_of_string "_MAX_SIZE";
+    max_idle_size = get int_of_string "_MAX_IDLE_SIZE";
+    max_idle_age = get (option_of_string mtime_span_of_string) "_MAX_IDLE_AGE";
+    max_use_count = get (option_of_string int_of_string) "_MAX_USE_COUNT";
+  }
+
+let default_from_env () = create_from_env "CAQTI_POOL"
+
+let max_size = Max_size
+let max_idle_size = Max_idle_size
+let max_idle_age = Max_idle_age
+let max_use_count = Max_use_count
+
+let get (type a) (k : a key) config : a option =
+  (match k with
+   | Max_size -> config.max_size
+   | Max_idle_size -> config.max_idle_size
+   | Max_idle_age -> config.max_idle_age
+   | Max_use_count -> config.max_use_count)
+
+let modify (type a) (k : a key) (v : a option) config =
+  (match k with
+   | Max_size -> {config with max_size = v}
+   | Max_idle_size -> {config with max_idle_size = v}
+   | Max_idle_age -> {config with max_idle_age = v}
+   | Max_use_count -> {config with max_use_count = v})
+
+let set k v config = modify k (Some v) config
+let unset k config = modify k None config
+
+let merge_left cL cR =
+  let add acc (Any k) =
+    match get k cL with None -> acc | Some v -> (set k v acc)
+  in
+  List.fold_left add cR keys