GPS Exchange Format library/CLI in OCaml
anil.recoil.org
1(** GPX Unix I/O operations *)
2
3
4(** Result binding operators *)
5let (let*) = Result.bind
6
7(** Read GPX from file *)
8let read_file ?(validate=false) filename =
9 try
10 let ic = open_in filename in
11 let input = Xmlm.make_input (`Channel ic) in
12 let result = Gpx.parse ~validate input in
13 close_in ic;
14 result
15 with
16 | Sys_error msg -> Error (Gpx.Error.io_error msg)
17 | exn -> Error (Gpx.Error.io_error (Printexc.to_string exn))
18
19(** Write GPX to file *)
20let write_file ?(validate=false) filename gpx =
21 try
22 let oc = open_out filename in
23 let dest = `Channel oc in
24 let result = Gpx.write ~validate dest gpx in
25 close_out oc;
26 result
27 with
28 | Sys_error msg -> Error (Gpx.Error.io_error msg)
29 | exn -> Error (Gpx.Error.io_error (Printexc.to_string exn))
30
31(** Read GPX from stdin *)
32let read_stdin ?(validate=false) () =
33 let input = Xmlm.make_input (`Channel stdin) in
34 Gpx.parse ~validate input
35
36(** Write GPX to stdout *)
37let write_stdout ?(validate=false) gpx =
38 Gpx.write ~validate (`Channel stdout) gpx
39
40(** Check if file exists and is readable *)
41let file_exists filename =
42 try
43 let _ = Unix.stat filename in
44 true
45 with
46 | Unix.Unix_error _ -> false
47
48(** Get file size *)
49let file_size filename =
50 try
51 let stats = Unix.stat filename in
52 Ok stats.st_size
53 with
54 | Unix.Unix_error (errno, _, _) ->
55 Error (Gpx.Error.io_error (Unix.error_message errno))
56
57(** Create backup of file before overwriting *)
58let create_backup filename =
59 if file_exists filename then
60 let backup_name = filename ^ ".bak" in
61 try
62 let ic = open_in filename in
63 let oc = open_out backup_name in
64 let rec copy () =
65 match input_char ic with
66 | c -> output_char oc c; copy ()
67 | exception End_of_file -> ()
68 in
69 copy ();
70 close_in ic;
71 close_out oc;
72 Ok backup_name
73 with
74 | Sys_error msg -> Error (Gpx.Error.io_error msg)
75 | exn -> Error (Gpx.Error.io_error (Printexc.to_string exn))
76 else
77 Ok ""
78
79(** Write GPX to file with backup *)
80let write_file_with_backup ?(validate=false) filename gpx =
81 let* backup_name = create_backup filename in
82 match write_file ~validate filename gpx with
83 | Ok () -> Ok backup_name
84 | Error _ as err ->
85 (* Try to restore backup if write failed *)
86 if backup_name <> "" && file_exists backup_name then (
87 try
88 Sys.rename backup_name filename
89 with _ -> ()
90 );
91 err