blob: 20f83f5087ad61f3ed2162832afc75107dd80a94 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
module Errors = struct
include Concepts.Condition
let key_already_exists key =
condition "key-already-exists" "The specified key already exists in the namespace"
("key" |=| Concepts.Value.String key)
let no_such_key key =
condition "no-such-key" "The specified key does not exist in the namespace"
("key" |=| Concepts.Value.String key)
end
class namespace = object (self)
inherit Lifecycle.null
val entries : (string, Protocols.Handle.t) BatMap.t Atomic.t =
Atomic.make BatMap.empty
method protocols = Protocols.[Directory.make self; Registry.make self]
method register key value =
Utilities.Atomic.mswap entries
(fun e ->
match BatMap.find_opt key e with
| None -> Ok (BatMap.add key value e)
| Some _ -> Error (Errors.key_already_exists key))
|> Result.map ignore
method unregister key =
Utilities.Atomic.mswap entries
(fun e ->
try
Ok (BatMap.remove_exn key e)
with Not_found ->
Error (Errors.no_such_key key))
|> Result.map ignore
method list =
Atomic.get entries
|> BatMap.keys
|> BatFingerTree.of_enum
|> Result.ok
method find key =
Atomic.get entries
|> BatMap.find_opt key
|> Utilities.Option.fmap Protocols.Handle.copy
|> Result.ok
end
let make () = Protocols.Handle.make (new namespace)
|
