aboutsummaryrefslogtreecommitdiffstats
path: root/lib/manipulation.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/manipulation.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/manipulation.ml24
1 files changed, 16 insertions, 8 deletions
diff --git a/lib/manipulation.ml b/lib/manipulation.ml
index 55b1c32..e62af28 100644
--- a/lib/manipulation.ml
+++ b/lib/manipulation.ml
@@ -15,7 +15,15 @@
(** Functor to create manipulation operations with a storage backend *)
module Make (Storage : Management.Physical.S) = struct
type storage = Storage.t
- type error = Error.t
+ type error = Condition.t
+
+ module Error = struct
+ open Condition
+
+ (* TODO: more specific errors *)
+ let storage_error message =
+ condition "storage-error" message empty
+ end
let ( let* ) = Result.bind
@@ -27,7 +35,7 @@ module Make (Storage : Management.Physical.S) = struct
match
Storage.store_raw storage relation#hash (Storable.Relation.to_bytes @@ relation#serialize ())
with
- | Error _ -> Error (Error.StorageError "Failed to store relation")
+ | Error _ -> Error (Error.storage_error "Failed to store relation")
| Ok () -> Ok ()
(** Store a database state to storage.
@@ -38,13 +46,13 @@ module Make (Storage : Management.Physical.S) = struct
match
Storage.store_raw storage db#name (Storable.Multigroup.to_bytes @@ db#serialize ())
with
- | Error _ -> Error (Error.StorageError "Failed to store multigroup")
+ | Error _ -> Error (Error.storage_error "Failed to store multigroup")
| Ok () -> Ok ()
(** Load a relation state from storage by hash *)
let load_relation (storage : storage) (rel_hash : Conventions.Hash.t) : (Relation.stored option, error) Result.t =
match Storage.load_raw storage rel_hash with
- | Error _ -> Error (Error.StorageError "Failed to load relation")
+ | Error _ -> Error (Error.storage_error "Failed to load relation")
| Ok None -> Ok None
| Ok (Some bytes) ->
let _stored = Storable.Relation.of_bytes bytes in
@@ -68,7 +76,7 @@ module Make (Storage : Management.Physical.S) = struct
let load_multigroup (storage : storage) (mg_hash : Conventions.Hash.t) :
(Management.Multigroup.multigroup option, error) Result.t =
match Storage.load_raw storage mg_hash with
- | Error _ -> Error (Error.StorageError "Failed to load multigroup")
+ | Error _ -> Error (Error.storage_error "Failed to load multigroup")
| Ok None -> Ok None
| Ok (Some bytes) ->
(* TODO: Properly deserialize multigroup state *)
@@ -87,7 +95,7 @@ module Make (Storage : Management.Physical.S) = struct
let load_tuple (storage : storage) (tuple_hash : Conventions.Hash.t) :
(Tuple.materialized option, error) Result.t =
match Storage.load_raw storage tuple_hash with
- | Error _ -> Error (Error.StorageError "Failed to load tuple")
+ | Error _ -> Error (Error.storage_error "Failed to load tuple")
| Ok None -> Ok None
| Ok (Some tuple_bytes) ->
let _stored = Storable.Tuple.of_bytes tuple_bytes in
@@ -99,9 +107,9 @@ module Make (Storage : Management.Physical.S) = struct
match Storage.load_raw storage attr_hash with
| Error _ ->
Error
- (Error.StorageError ("Failed to load attribute: " ^ name))
+ (Error.storage_error ("Failed to load attribute: " ^ name))
| Ok None ->
- Error (Error.StorageError ("Attribute not found: " ^ name))
+ Error (Error.storage_error ("Attribute not found: " ^ name))
| Ok (Some value_bytes) ->
let value : Conventions.AbstractValue.t =
Marshal.from_bytes value_bytes 0