aboutsummaryrefslogtreecommitdiffstats
path: root/lib/branch.ml
diff options
context:
space:
mode:
authorEstevan Castilho <tevo@riajuu.net>2026-05-27 23:24:12 +0000
committerGitHub <noreply@github.com>2026-05-27 23:24:12 +0000
commit9dc0391443ca16bf1ab3114d002aad83872f8a73 (patch)
treee4f78a2533e5e633b733c1ea21d0159aeca79b75 /lib/branch.ml
parentf9097a0562ea8b40d40a19059578a9280b945de4 (diff)
downloadSakura-9dc0391443ca16bf1ab3114d002aad83872f8a73.tar.gz
Sakura-9dc0391443ca16bf1ab3114d002aad83872f8a73.zip
Improve the error handling situation (#71)
* Sketches of a condition system * `Condition.condition` -> `Condition.t` * Migrate `NT` over * Migrate `Branch` over * Migrate `Sublanguage` et al. over * Migrate the PRL over * Migrate the DRL over * Migrate the DML over * Have `Qualified_name.try_parse` return a `Condition.t` * Migrate the DDL over * Migrate the VCL over * Migrate the SCL over * Migrate the ICL over * Migrate the parsers over * Just inherit the errors from NT and the sublanguages * Migrate `Management.Physical` over * Migrate `Configuration` over * Migrate `Management.Branch` over * Migrate `Transport` over * Migrate `System` over * Migrate `Server` over * Include messages on on all conditions * A prettier stringifier
Diffstat (limited to '')
-rw-r--r--lib/branch.ml14
1 files changed, 10 insertions, 4 deletions
diff --git a/lib/branch.ml b/lib/branch.ml
index 8437d55..0b28663 100644
--- a/lib/branch.ml
+++ b/lib/branch.ml
@@ -3,6 +3,12 @@
bound to that branch. Each mutation names its target mg explicitly. *)
module Make (NT : Nt.S) = struct
+ module Error = struct
+ open Condition
+ (* TODO: more structure *)
+ let not_supported msg = condition "not-supported" msg empty
+ let handle_error msg = condition "handle-error" msg empty
+ end
let ( let* ) = Result.bind
@@ -68,7 +74,7 @@ module Make (NT : Nt.S) = struct
match mode with
| Live -> Ok ()
| Detached _ ->
- Error (Nt.NotSupported (op ^ ": detached snapshot is read-only"))
+ Error (Error.not_supported (op ^ ": detached snapshot is read-only"))
method private sync_tip () =
match mode with
@@ -79,10 +85,10 @@ module Make (NT : Nt.S) = struct
| Ok h -> tip <- h
method private get_mg op (mg_name : string) :
- (Management.Multigroup.multigroup, Nt.error) result =
+ (Management.Multigroup.multigroup, Condition.t) result =
match Hashtbl.find_opt mgs mg_name with
| Some mg -> Ok mg
- | None -> Error (Nt.HandleError
+ | None -> Error (Error.handle_error
(op ^ ": multigroup not found: " ^ mg_name))
method create_relation ~(mg : string) ~(rel_name : string) ~schema =
@@ -104,7 +110,7 @@ module Make (NT : Nt.S) = struct
let* () = self#assert_live "clear_relation" in
let* mg_val = self#get_mg "clear_relation" mg in
match mg_val#get_relation rel_name with
- | None -> Error (Nt.HandleError ("relation not found: " ^ rel_name))
+ | None -> Error (Error.handle_error ("relation not found: " ^ rel_name))
| Some rel ->
let* (bh', mg') =
NT.clear_relation bh mg_val