package octez-internal-libs

  1. Overview
  2. Docs
package octez-internal-libs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file io_errors.ml

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
(*
 * Copyright (c) 2022-2022 Tarides <contact@tarides.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

open Import
open Errors

(** Error manager for errors and exceptions defined in {!Errors} and
    {!Io.S.misc_error} *)
module type S = sig
  module Io : Io.S

  type t = [ Base.t | `Io_misc of Io.misc_error ] [@@deriving irmin]

  val raise_error : [< t ] -> 'a
  val log_error : string -> [< t ] -> unit
  val catch : (unit -> 'a) -> ('a, t) result
  val raise_if_error : ('a, [< t ]) result -> 'a
  val log_if_error : string -> ('a, [< t ]) result -> unit
end

module Make (Io : Io.S) : S with module Io = Io = struct
  module Io = Io

  (* Inline the definition of the polymorphic variant for the ppx. *)
  type t =
    [ `Double_close
    | `File_exists of string
    | `Invalid_parent_directory
    | `No_such_file_or_directory of string
    | `Not_a_file
    | `Read_out_of_bounds
    | `Invalid_argument
    | `Decoding_error
    | `Not_a_directory of string
    | `Index_failure of string
    | `Invalid_layout
    | `Corrupted_legacy_file
    | `Corrupted_mapping_file of string
    | `Pending_flush
    | `Rw_not_allowed
    | `Migration_needed
    | `Migration_to_lower_not_allowed
    | `Corrupted_control_file of string
    | `Sys_error of string
    | `V3_store_from_the_future
    | `Gc_forbidden_during_batch
    | `Unknown_major_pack_version of string
    | `Only_minimal_indexing_strategy_allowed
    | `Commit_key_is_dangling of string
    | `Dangling_key of string
    | `Gc_disallowed of string
    | `Node_or_contents_key_is_indexed of string
    | `Gc_process_error of string
    | `Corrupted_gc_result_file of string
    | `Gc_process_died_without_result_file of string
    | `Gc_forbidden_on_32bit_platforms
    | `Invalid_prefix_read of string
    | `Invalid_sparse_read of [ `After | `Before | `Hole ] * int63
    | `Invalid_volume_read of [ `Empty | `Closed ] * int63
    | `Inconsistent_store
    | `Closed
    | `Ro_not_allowed
    | `Io_misc of Io.misc_error
    | `Split_forbidden_during_batch
    | `Split_disallowed
    | `Multiple_empty_chunks
    | `Forbidden_during_gc
    | `Multiple_empty_volumes
    | `Volume_missing of string
    | `Volume_history_newer_than_archived_data of int63 * int63
    | `Lower_has_no_volume
    | `Add_volume_forbidden_during_gc
    | `Add_volume_requires_lower
    | `Volume_not_found of string
    | `No_tmp_path_provided ]
  [@@deriving irmin]

  let raise_error = function
    | `Io_misc e -> Io.raise_misc_error e
    | #error as e -> Base.raise_error e

  let log_error context e =
    [%log.err "%s failed: %a" context (Irmin.Type.pp t) (e :> t)]

  let catch f =
    match Base.catch (fun () -> Io.catch_misc_error f) with
    | Ok (Ok v) -> Ok v
    | Ok (Error e) -> Error (e :> t)
    | Error e -> Error (e :> t)

  let raise_if_error = function Ok x -> x | Error e -> raise_error e

  let log_if_error context = function
    | Ok _ -> ()
    | Error e -> log_error context e
end
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct