Generic TTL cache with Eio
Squashed 'ocaml-cache/' content from commit 940726f git-subtree-split: 940726f1275c0706cc4dc85945f884357463d470
+319
+8
.gitignore
+8
.gitignore
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version=0.28.1
+34
cache.opam
+34
cache.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Generic TTL-based cache with Eio support"
4
+
description: """
5
+
A generic in-memory cache with configurable TTL (time-to-live), jitter
6
+
to prevent thundering herd, and thread-safe access using Eio mutexes."""
7
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
9
+
license: "MIT"
10
+
homepage: "https://github.com/samoht/ocaml-cache"
11
+
bug-reports: "https://github.com/samoht/ocaml-cache/issues"
12
+
depends: [
13
+
"dune" {>= "3.0"}
14
+
"ocaml" {>= "5.1"}
15
+
"eio" {>= "1.0"}
16
+
"logs" {>= "0.7"}
17
+
"alcotest" {with-test}
18
+
"eio_main" {with-test}
19
+
"odoc" {with-doc}
20
+
]
21
+
build: [
22
+
["dune" "subst"] {dev}
23
+
[
24
+
"dune"
25
+
"build"
26
+
"-p"
27
+
name
28
+
"-j"
29
+
jobs
30
+
"@install"
31
+
"@runtest" {with-test}
32
+
"@doc" {with-doc}
33
+
]
34
+
]
+25
dune-project
+25
dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name cache)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license MIT)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
(homepage "https://github.com/samoht/ocaml-cache")
11
+
(bug_reports "https://github.com/samoht/ocaml-cache/issues")
12
+
13
+
(package
14
+
(name cache)
15
+
(synopsis "Generic TTL-based cache with Eio support")
16
+
(description
17
+
"A generic in-memory cache with configurable TTL (time-to-live), jitter
18
+
to prevent thundering herd, and thread-safe access using Eio mutexes.")
19
+
(depends
20
+
(ocaml (>= 5.1))
21
+
(eio (>= 1.0))
22
+
(logs (>= 0.7))
23
+
(alcotest :with-test)
24
+
(eio_main :with-test)
25
+
(odoc :with-doc)))
+124
lib/cache.ml
+124
lib/cache.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let log_src = Logs.Src.create "cache"
7
+
8
+
module Log = (val Logs.src_log log_src : Logs.LOG)
9
+
10
+
module type KEY = sig
11
+
type t
12
+
13
+
val equal : t -> t -> bool
14
+
val hash : t -> int
15
+
end
16
+
17
+
module type S = sig
18
+
type key
19
+
type 'a t
20
+
21
+
val create :
22
+
clock:_ Eio.Time.clock -> ?base_ttl:float -> ?jitter:float -> unit -> 'a t
23
+
24
+
val get : 'a t -> key -> 'a option
25
+
val set : 'a t -> key -> 'a -> unit
26
+
val remove : 'a t -> key -> unit
27
+
val get_or_compute : 'a t -> key -> (unit -> 'a) -> 'a
28
+
val gc : 'a t -> unit
29
+
val clear : 'a t -> unit
30
+
val stats : 'a t -> int * int
31
+
end
32
+
33
+
module Make (K : KEY) : S with type key = K.t = struct
34
+
type key = K.t
35
+
36
+
module H = Hashtbl.Make (K)
37
+
38
+
type 'a entry = { value : 'a; expires_at : float }
39
+
40
+
type 'a t = {
41
+
entries : 'a entry H.t;
42
+
mutex : Eio.Mutex.t;
43
+
base_ttl : float;
44
+
jitter : float;
45
+
now : unit -> float;
46
+
}
47
+
48
+
let create ~clock ?(base_ttl = 60.0) ?(jitter = 0.2) () =
49
+
{
50
+
entries = H.create 256;
51
+
mutex = Eio.Mutex.create ();
52
+
base_ttl;
53
+
jitter;
54
+
now = (fun () -> Eio.Time.now clock);
55
+
}
56
+
57
+
let now t = t.now ()
58
+
59
+
let ttl_with_jitter t =
60
+
let jitter_range = t.base_ttl *. t.jitter in
61
+
let random_jitter = Random.float jitter_range -. (jitter_range /. 2.0) in
62
+
t.base_ttl +. random_jitter
63
+
64
+
let get t key =
65
+
Eio.Mutex.use_ro t.mutex @@ fun () ->
66
+
match H.find_opt t.entries key with
67
+
| None -> None
68
+
| Some entry ->
69
+
if now t < entry.expires_at then Some entry.value
70
+
else begin
71
+
H.remove t.entries key;
72
+
None
73
+
end
74
+
75
+
let set t key value =
76
+
Eio.Mutex.use_rw ~protect:true t.mutex @@ fun () ->
77
+
let entry = { value; expires_at = now t +. ttl_with_jitter t } in
78
+
H.replace t.entries key entry
79
+
80
+
let remove t key =
81
+
Eio.Mutex.use_rw ~protect:true t.mutex @@ fun () -> H.remove t.entries key
82
+
83
+
let get_or_compute t key compute =
84
+
match get t key with
85
+
| Some v -> v
86
+
| None ->
87
+
let v = compute () in
88
+
set t key v;
89
+
v
90
+
91
+
let gc t =
92
+
Eio.Mutex.use_rw ~protect:true t.mutex @@ fun () ->
93
+
let current = now t in
94
+
let to_remove =
95
+
H.fold
96
+
(fun k entry acc ->
97
+
if current >= entry.expires_at then k :: acc else acc)
98
+
t.entries []
99
+
in
100
+
List.iter (H.remove t.entries) to_remove;
101
+
Log.debug (fun m ->
102
+
m "Cache GC: removed %d expired entries" (List.length to_remove))
103
+
104
+
let clear t =
105
+
Eio.Mutex.use_rw ~protect:true t.mutex @@ fun () -> H.clear t.entries
106
+
107
+
let stats t =
108
+
Eio.Mutex.use_ro t.mutex @@ fun () ->
109
+
let total = H.length t.entries in
110
+
let current = now t in
111
+
let valid =
112
+
H.fold
113
+
(fun _ entry acc -> if current < entry.expires_at then acc + 1 else acc)
114
+
t.entries 0
115
+
in
116
+
(total, valid)
117
+
end
118
+
119
+
module String = Make (struct
120
+
type t = string
121
+
122
+
let equal = String.equal
123
+
let hash = Hashtbl.hash
124
+
end)
+70
lib/cache.mli
+70
lib/cache.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Generic TTL-based in-memory cache.
7
+
8
+
Provides thread-safe caching with configurable TTL (time-to-live) and jitter
9
+
to prevent thundering herd problems.
10
+
11
+
{1 Example}
12
+
{[
13
+
module MyCache = Cache.Make (struct
14
+
type t = int
15
+
16
+
let equal = Int.equal
17
+
let hash = Hashtbl.hash
18
+
end)
19
+
20
+
let cache = MyCache.create ~clock:(Eio.Stdenv.clock env) ()
21
+
let () = MyCache.set cache 42 "answer"
22
+
let value = MyCache.get cache 42 (* Some "answer" *)
23
+
]} *)
24
+
25
+
module type KEY = sig
26
+
type t
27
+
28
+
val equal : t -> t -> bool
29
+
val hash : t -> int
30
+
end
31
+
32
+
module type S = sig
33
+
type key
34
+
type 'a t
35
+
36
+
val create :
37
+
clock:_ Eio.Time.clock -> ?base_ttl:float -> ?jitter:float -> unit -> 'a t
38
+
(** [create ~clock ?base_ttl ?jitter ()] creates a new cache.
39
+
@param clock Eio time source
40
+
@param base_ttl Base time-to-live in seconds (default: 60.0)
41
+
@param jitter Random jitter factor 0.0-1.0 (default: 0.2) *)
42
+
43
+
val get : 'a t -> key -> 'a option
44
+
(** [get t key] returns the cached value if present and not expired. *)
45
+
46
+
val set : 'a t -> key -> 'a -> unit
47
+
(** [set t key value] stores a value with TTL + jitter. *)
48
+
49
+
val remove : 'a t -> key -> unit
50
+
(** [remove t key] removes a key from the cache. *)
51
+
52
+
val get_or_compute : 'a t -> key -> (unit -> 'a) -> 'a
53
+
(** [get_or_compute t key f] returns cached value or computes and caches it.
54
+
*)
55
+
56
+
val gc : 'a t -> unit
57
+
(** [gc t] removes all expired entries. *)
58
+
59
+
val clear : 'a t -> unit
60
+
(** [clear t] removes all entries. *)
61
+
62
+
val stats : 'a t -> int * int
63
+
(** [stats t] returns [(total_entries, valid_entries)]. *)
64
+
end
65
+
66
+
(** Functor to create a cache with custom key type. *)
67
+
module Make (K : KEY) : S with type key = K.t
68
+
69
+
module String : S with type key = string
70
+
(** Pre-instantiated cache with string keys. *)
+50
test/test.ml
+50
test/test.ml
···
1
+
let test_basic () =
2
+
Eio_main.run @@ fun env ->
3
+
let clock = Eio.Stdenv.clock env in
4
+
let cache = Cache.String.create ~clock ~base_ttl:10.0 ~jitter:0.0 () in
5
+
Cache.String.set cache "key1" "value1";
6
+
Alcotest.(check (option string))
7
+
"get after set" (Some "value1")
8
+
(Cache.String.get cache "key1");
9
+
Alcotest.(check (option string))
10
+
"get missing" None
11
+
(Cache.String.get cache "key2")
12
+
13
+
let test_get_or_compute () =
14
+
Eio_main.run @@ fun env ->
15
+
let clock = Eio.Stdenv.clock env in
16
+
let cache = Cache.String.create ~clock ~base_ttl:10.0 ~jitter:0.0 () in
17
+
let computed = ref 0 in
18
+
let compute () =
19
+
incr computed;
20
+
"computed"
21
+
in
22
+
let v1 = Cache.String.get_or_compute cache "key" compute in
23
+
let v2 = Cache.String.get_or_compute cache "key" compute in
24
+
Alcotest.(check string) "first call" "computed" v1;
25
+
Alcotest.(check string) "second call cached" "computed" v2;
26
+
Alcotest.(check int) "compute called once" 1 !computed
27
+
28
+
let test_stats () =
29
+
Eio_main.run @@ fun env ->
30
+
let clock = Eio.Stdenv.clock env in
31
+
let cache = Cache.String.create ~clock ~base_ttl:10.0 ~jitter:0.0 () in
32
+
let total, valid = Cache.String.stats cache in
33
+
Alcotest.(check int) "empty total" 0 total;
34
+
Alcotest.(check int) "empty valid" 0 valid;
35
+
Cache.String.set cache "k1" "v1";
36
+
Cache.String.set cache "k2" "v2";
37
+
let total, valid = Cache.String.stats cache in
38
+
Alcotest.(check int) "total after set" 2 total;
39
+
Alcotest.(check int) "valid after set" 2 valid
40
+
41
+
let () =
42
+
Alcotest.run "cache"
43
+
[
44
+
( "basic",
45
+
[
46
+
Alcotest.test_case "get/set" `Quick test_basic;
47
+
Alcotest.test_case "get_or_compute" `Quick test_get_or_compute;
48
+
Alcotest.test_case "stats" `Quick test_stats;
49
+
] );
50
+
]