diff options
| author | Estevan Castilho <tevo@riajuu.net> | 2026-05-27 23:24:12 +0000 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2026-05-27 23:24:12 +0000 |
| commit | 9dc0391443ca16bf1ab3114d002aad83872f8a73 (patch) | |
| tree | e4f78a2533e5e633b733c1ea21d0159aeca79b75 /lib/manipulation.ml | |
| parent | f9097a0562ea8b40d40a19059578a9280b945de4 (diff) | |
| download | Sakura-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.ml | 24 |
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 |
