From: Pino Toscano <ptoscano@redhat.com>
Date: Wed, 13 Sep 2017 16:25:01 +0000 (+0200)
Subject: Enhance the Augeas.Error exception
X-Git-Tag: v0.6~26
X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=f7638380d5d7b67773ae149c4d3206a716dc9a13;p=ocaml-augeas.git

Enhance the Augeas.Error exception

Augeas.Error is very limited, and only provides an error string provided
by ocaml-augeas itself: this makes it hard to actually understand what
is an Augeas.Error that was raised, and eventually perform different
actions based on that.

To overcome that, Augeas.Error is changed to be a tuple containing the
error code (as reported by Augeas), still the ocaml-augeas error string,
and error message and details of the Augeas error -- all the
informations that Augeas provides.
This breaks API compatibility with current users, but unfortunately
there is no way around that.
---

diff --git a/augeas-c.c b/augeas-c.c
index 5c330a8..4db3f6c 100644
--- a/augeas-c.c
+++ b/augeas-c.c
@@ -31,22 +31,74 @@
 
 typedef augeas *augeas_t;
 
+/* Map C aug_errcode_t to OCaml error_code. */
+static const int error_map[] = {
+  /* AugErrInternal */ AUG_EINTERNAL,
+  /* AugErrPathX */    AUG_EPATHX,
+  /* AugErrNoMatch */  AUG_ENOMATCH,
+  /* AugErrMMatch */   AUG_EMMATCH,
+  /* AugErrSyntax */   AUG_ESYNTAX,
+  /* AugErrNoLens */   AUG_ENOLENS,
+  /* AugErrMXfm */     AUG_EMXFM,
+  /* AugErrNoSpan */   AUG_ENOSPAN,
+  /* AugErrMvDesc */   AUG_EMVDESC,
+  /* AugErrCmdRun */   AUG_ECMDRUN,
+  /* AugErrBadArg */   AUG_EBADARG,
+  /* AugErrLabel */    AUG_ELABEL,
+  /* AugErrCpDesc */   AUG_ECPDESC,
+};
+static const int error_map_len = sizeof error_map / sizeof error_map[0];
+
 /* Raise an Augeas.Error exception. */
 static void
 raise_error (augeas_t t, const char *msg)
 {
+  value *exn = caml_named_value ("Augeas.Error");
+  value args[4];
   const int code = aug_error (t);
+  const char *aug_err_minor;
+  const char *aug_err_details;
+  int ocaml_code = -1;
+  int i;
 
   if (code == AUG_ENOMEM)
     caml_raise_out_of_memory ();
 
-  caml_raise_with_string (*caml_named_value ("Augeas.Error"), msg);
+  aug_err_minor = aug_error_minor_message (t);
+  aug_err_details = aug_error_details (t);
+
+  for (i = 0; i < error_map_len; ++i)
+    if (error_map[i] == code) {
+      ocaml_code = i;
+      break;
+    }
+
+  if (ocaml_code != -1)
+    args[0] = Val_int (ocaml_code);
+  else {
+    args[0] = caml_alloc (1, 0);
+    Store_field (args[0], 0, Val_int (code));
+  }
+  args[1] = caml_copy_string (msg);
+  args[2] = caml_copy_string (aug_err_minor ? : "");
+  args[3] = caml_copy_string (aug_err_details ? : "");
+
+  caml_raise_with_args (*exn, 4, args);
 }
 
 static void
 raise_init_error (const char *msg)
 {
-  caml_raise_with_string (*caml_named_value ("Augeas.Error"), msg);
+  value *exn = caml_named_value ("Augeas.Error");
+  value args[4];
+
+  args[0] = caml_alloc (1, 0);
+  Store_field (args[0], 0, Val_int (-1));
+  args[1] = caml_copy_string (msg);
+  args[2] = caml_copy_string ("augeas initialization failed");
+  args[3] = caml_copy_string ("");
+
+  caml_raise_with_args (*exn, 4, args);
 }
 
 /* Map OCaml flags to C flags. */
diff --git a/augeas.ml b/augeas.ml
index f556df0..ba3626e 100644
--- a/augeas.ml
+++ b/augeas.ml
@@ -20,8 +20,6 @@
 
 type t
 
-exception Error of string
-
 type flag =
   | AugSaveBackup
   | AugSaveNewFile
@@ -30,6 +28,24 @@ type flag =
   | AugSaveNoop
   | AugNoLoad
 
+type error_code =
+  | AugErrInternal
+  | AugErrPathX
+  | AugErrNoMatch
+  | AugErrMMatch
+  | AugErrSyntax
+  | AugErrNoLens
+  | AugErrMXfm
+  | AugErrNoSpan
+  | AugErrMvDesc
+  | AugErrCmdRun
+  | AugErrBadArg
+  | AugErrLabel
+  | AugErrCpDesc
+  | AugErrUnknown of int
+
+exception Error of error_code * string * string * string
+
 type path = string
 
 type value = string
@@ -56,4 +72,4 @@ external load : t -> unit
   = "ocaml_augeas_load"
 
 let () =
-  Callback.register_exception "Augeas.Error" (Error "")
+  Callback.register_exception "Augeas.Error" (Error (AugErrInternal, "", "", ""))
diff --git a/augeas.mli b/augeas.mli
index 64e8240..a896270 100644
--- a/augeas.mli
+++ b/augeas.mli
@@ -21,10 +21,6 @@
 type t
   (** Augeas library handle. *)
 
-exception Error of string
-  (** This exception is thrown when the underlying Augeas library
-      returns an error. *)
-
 type flag =
   | AugSaveBackup			(** Rename original with .augsave *)
   | AugSaveNewFile			(** Save changes to .augnew *)
@@ -34,6 +30,32 @@ type flag =
   | AugNoLoad
   (** Flags passed to the {!create} function. *)
 
+type error_code =
+  | AugErrInternal		(** Internal error (bug) *)
+  | AugErrPathX			(** Invalid path expression *)
+  | AugErrNoMatch		(** No match for path expression *)
+  | AugErrMMatch		(** Too many matches for path expression *)
+  | AugErrSyntax		(** Syntax error in lens file *)
+  | AugErrNoLens		(** Lens lookup failed *)
+  | AugErrMXfm			(** Multiple transforms *)
+  | AugErrNoSpan		(** No span for this node *)
+  | AugErrMvDesc		(** Cannot move node into its descendant *)
+  | AugErrCmdRun		(** Failed to execute command *)
+  | AugErrBadArg		(** Invalid argument in funcion call *)
+  | AugErrLabel			(** Invalid label *)
+  | AugErrCpDesc		(** Cannot copy node into its descendant *)
+  | AugErrUnknown of int
+  (** Possible error codes. *)
+
+exception Error of error_code * string * string * string
+  (** This exception is thrown when the underlying Augeas library
+      returns an error.  The tuple represents:
+      - the Augeas error code
+      - the ocaml-augeas error string
+      - the human-readable explanation of the Augeas error, if available
+      - a string with details of the Augeas error
+   *)
+
 type path = string
   (** A path expression.