Source file error.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
110
(** Error types and exception handling for GPX operations *)

(** Main error type *)
type t =
  | Invalid_xml of string
  | Invalid_coordinate of string
  | Missing_required_attribute of string * string
  | Missing_required_element of string
  | Validation_error of string
  | Xml_error of string
  | IO_error of string

(** GPX exception *)
exception Gpx_error of t

(** Result type for operations that can fail *)
type 'a result = ('a, t) Result.t

(** {2 Error Operations} *)

(** Convert error to string *)
let to_string = function
  | Invalid_xml msg -> "Invalid XML: " ^ msg
  | Invalid_coordinate msg -> "Invalid coordinate: " ^ msg
  | Missing_required_attribute (element, attr) ->
    Printf.sprintf "Missing required attribute '%s' in element '%s'" attr element
  | Missing_required_element element ->
    Printf.sprintf "Missing required element '%s'" element
  | Validation_error msg -> "Validation error: " ^ msg
  | Xml_error msg -> "XML error: " ^ msg
  | IO_error msg -> "IO error: " ^ msg

(** Pretty print error *)
let pp ppf error = Format.fprintf ppf "%s" (to_string error)

(** Create invalid XML error *)
let invalid_xml msg = Invalid_xml msg

(** Create invalid coordinate error *)
let invalid_coordinate msg = Invalid_coordinate msg

(** Create missing attribute error *)
let missing_attribute element attr = Missing_required_attribute (element, attr)

(** Create missing element error *)
let missing_element element = Missing_required_element element

(** Create validation error *)
let validation_error msg = Validation_error msg

(** Create XML error *)
let xml_error msg = Xml_error msg

(** Create IO error *)
let io_error msg = IO_error msg

(** Compare errors *)
let compare e1 e2 = String.compare (to_string e1) (to_string e2)

(** Test error equality *)
let equal e1 e2 = compare e1 e2 = 0

(** {2 Result Helpers} *)

(** Convert exception to result *)
let catch f x =
  try Ok (f x)
  with Gpx_error e -> Error e

(** Convert result to exception *)
let get_exn = function
  | Ok x -> x
  | Error e -> raise (Gpx_error e)

(** Map over result *)
let map f = function
  | Ok x -> Ok (f x)
  | Error e -> Error e

(** Bind over result *)
let bind result f = 
  match result with
  | Ok x -> f x
  | Error e -> Error e

(** Convert string result to error result *)
let from_string_result = function
  | Ok x -> Ok x
  | Error msg -> Error (Invalid_xml msg)

(** {2 Error Classification} *)

(** Check if error is XML-related *)
let is_xml_error = function
  | Invalid_xml _ | Xml_error _ -> true
  | _ -> false

(** Check if error is coordinate-related *)
let is_coordinate_error = function
  | Invalid_coordinate _ -> true
  | _ -> false

(** Check if error is validation-related *)
let is_validation_error = function
  | Validation_error _ | Missing_required_attribute _ | Missing_required_element _ -> true
  | _ -> false

(** Check if error is IO-related *)
let is_io_error = function
  | IO_error _ -> true
  | _ -> false