Don't exit in library code

src/odoc/bin/main.ml

@@ -5,7 +5,6 @@
 
 open Odoc_odoc
 open Cmdliner
-open Result
 
 let convert_syntax : Odoc_html.Tree.syntax Arg.converter =
   let syntax_parser str =
@@ -53,7 +52,7 @@ let convert_uri : Odoc_html.Tree.uri Arg.converter =
   (parser, printer)
 
 let handle_error = function
-  | Ok () -> ()
+  | Result.Ok () -> ()
   | Error (`Cli_error msg) ->
     Printf.eprintf "%s\n%!" msg;
     exit 2
@@ -215,8 +214,7 @@ end = struct
     let file = Fs.File.of_string input_file in
     match index_for with
     | None ->
-      Html_page.from_odoc ~env ~syntax ~theme_uri ~output:output_dir file;
-      Ok ()
+      Html_page.from_odoc ~env ~syntax ~theme_uri ~output:output_dir file
     | Some pkg_name ->
       Html_page.from_mld ~env ~syntax ~output:output_dir ~package:pkg_name ~warn_error file
 
@@ -332,20 +330,23 @@ module Depends = struct
 
   module Odoc_html = struct
     let list_dependencies input_file =
-      List.iter (Depends.for_html_step (Fs.Directory.of_string input_file))
+      let open Or_error in
+      Depends.for_html_step (Fs.Directory.of_string input_file) >>= fun depends ->
+      List.iter depends
         ~f:(fun (root : Odoc_model.Root.t) ->
           Printf.printf "%s %s %s\n"
             root.package
             (Odoc_model.Root.Odoc_file.name root.file)
             (Digest.to_hex root.digest)
-        )
+        );
+      Ok ()
 
     let cmd =
       let input =
         let doc = "Input directory" in
         Arg.(required & pos 0 (some file) None & info ~doc ~docv:"PKG_DIR" [])
       in
-      Term.(const list_dependencies $ input)
+      Term.(const handle_error $ (const list_dependencies $ input))
 
   let info =
     Term.info "html-deps"
@@ -371,20 +372,21 @@ module Targets = struct
 
   module Odoc_html = struct
     let list_targets directories output_dir odoc_file =
+      let open Or_error in
       let env = Env.create ~important_digests:false ~directories in
       let odoc_file = Fs.File.of_string odoc_file in
-      let targets =
-        Targets.of_odoc_file ~env ~output:output_dir odoc_file
-        |> List.map ~f:Fs.File.to_string
-      in
-      Printf.printf "%s\n%!" (String.concat ~sep:"\n" targets)
+      Targets.of_odoc_file ~env ~output:output_dir odoc_file >>= fun targets ->
+      let targets = List.map ~f:Fs.File.to_string targets in
+      Printf.printf "%s\n%!" (String.concat ~sep:"\n" targets);
+      Ok ()
 
     let cmd =
       let input =
         let doc = "Input file" in
         Arg.(required & pos 0 (some file) None & info ~doc ~docv:"file.odoc" [])
       in
-      Term.(const list_targets $ odoc_file_directories $ dst () $ input)
+      Term.(const handle_error $ (const list_targets $ odoc_file_directories $
+            dst () $ input))
 
     let info =
       Term.info "html-targets" ~doc:"TODO: Fill in."

src/odoc/compilation_unit.ml

@@ -14,7 +14,7 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-
+open Or_error
 
 type t = Odoc_model.Lang.Compilation_unit.t
 
@@ -35,18 +35,20 @@ let load =
   fun file ->
     let file = Fs.File.to_string file in
     match Hashtbl.find units file with
-    | unit -> unit
+    | unit -> Ok unit
     | exception Not_found ->
       try
         let ic = open_in_bin file in
         let _root = Root.load file ic in
         let res = Marshal.from_channel ic in
         close_in ic;
         Hashtbl.add units file res;
-        res
+        Ok res
       with exn ->
-        Printf.eprintf "Error while unmarshalling %S: %s\n%!" file
-          (match exn with
-           | Failure s -> s
-           | _ -> Printexc.to_string exn);
-        exit 2
+        let msg =
+          Printf.sprintf "Error while unmarshalling %S: %s\n%!" file
+            (match exn with
+              | Failure s -> s
+              | _ -> Printexc.to_string exn)
+        in
+        Error (`Msg msg)

src/odoc/compilation_unit.mli

@@ -14,6 +14,8 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+open Or_error
+
 type t = Odoc_model.Lang.Compilation_unit.t
 
 val root : t -> Odoc_model.Root.t
@@ -24,4 +26,4 @@ val save : Fs.File.t -> t -> unit
 
 (** {2 Deserialization} *)
 
-val load : Fs.File.t -> t
+val load : Fs.File.t -> (t, [> msg]) result

src/odoc/compile.ml

@@ -1,4 +1,4 @@
-open Result
+open Or_error
 
 (*
  * Copyright (c) 2014 Leo White <leo@lpw25.net>
@@ -33,14 +33,14 @@ let resolve_and_substitute ~env ~output ~warn_error input_file read_file =
             " Using %S while you should use the .cmti file" filename)
     );
     let resolve_env = Env.build env (`Unit unit) in
-    let resolved = Odoc_xref.resolve (Env.resolver resolve_env) unit in
+    Odoc_xref.resolve (Env.resolver resolve_env) unit >>= fun resolved ->
     (* [expand unit] fetches [unit] from [env] to get the expansion of local, previously
        defined, elements. We'd rather it got back the resolved bit so we rebuild an
        environment with the resolved unit.
        Note that this is bad and once rewritten expand should not fetch the unit it is
        working on. *)
     let expand_env = Env.build env (`Unit resolved) in
-    let expanded = Odoc_xref.expand (Env.expander expand_env) resolved in
+    Odoc_xref.expand (Env.expander expand_env) resolved >>= fun expanded ->
     Compilation_unit.save output expanded;
     Ok ()
 
@@ -96,14 +96,12 @@ let mld ~env ~package ~output ~warn_error input =
     let page = Odoc_model.Lang.Page.{ name; content; digest } in
     let page = Odoc_xref.Lookup.lookup_page page in
     let env = Env.build env (`Page page) in
-    let resolved = Odoc_xref.resolve_page (Env.resolver env) page in
+    Odoc_xref.resolve_page (Env.resolver env) page >>= fun resolved ->
     Page.save output resolved;
     Ok ()
   in
-  match Fs.File.read input with
-  | Error _ as e -> e
-  | Ok str ->
-    match Odoc_loader.read_string name location str with
-    | Error e -> Error (`Msg (Odoc_model.Error.to_string e))
-    | Ok `Stop -> resolve [] (* TODO: Error? *)
-    | Ok (`Docs content) -> resolve content
+  Fs.File.read input >>= fun str ->
+  match Odoc_loader.read_string name location str with
+  | Error e -> Error (`Msg (Odoc_model.Error.to_string e))
+  | Ok `Stop -> resolve [] (* TODO: Error? *)
+  | Ok (`Docs content) -> resolve content

src/odoc/compile.mli

@@ -14,24 +14,26 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+open Or_error
+
 (** Produces .odoc files out of .cm{i,t,ti} or .mld files. *)
 
 val cmti :
   env:Env.builder -> package:Odoc_model.Root.Package.t -> hidden:bool ->
   output:Fs.File.t -> warn_error:bool -> Fs.File.t ->
-  (unit, [> `Msg of string ]) Result.result
+  (unit, [> msg]) result
 
 val cmt :
   env:Env.builder -> package:Odoc_model.Root.Package.t -> hidden:bool ->
   output:Fs.File.t -> warn_error:bool -> Fs.File.t ->
-  (unit, [> `Msg of string ]) Result.result
+  (unit, [> msg]) result
 
 val cmi :
   env:Env.builder -> package:Odoc_model.Root.Package.t -> hidden:bool ->
   output:Fs.File.t -> warn_error:bool -> Fs.File.t ->
-  (unit, [> `Msg of string ]) Result.result
+  (unit, [> msg]) result
 
 val mld :
   env:Env.builder -> package:Odoc_model.Root.Package.t ->
   output:Fs.File.t -> warn_error:bool -> Fs.File.t ->
-  (unit, [> `Msg of string ]) Result.result
+  (unit, [> msg]) result

src/odoc/depends.ml

@@ -15,6 +15,7 @@
  *)
 
 open StdLabels
+open Or_error
 
 module Compile = struct
   type t = {
@@ -64,19 +65,21 @@ end = struct
   let elements t = Odoc_model.Root.Hash_table.fold (fun s () acc -> s :: acc) t []
 end
 
-let deps_of_odoc_file ~deps input = match (Root.read input).file with
-| Page _ -> () (* XXX something should certainly be done here *)
-| Compilation_unit _ ->
-    let odoctree = Compilation_unit.load input in
+let deps_of_odoc_file ~deps input =
+  Root.read input >>= function
+  | { file = Page _; _ } -> Ok () (* XXX something should certainly be done here *)
+  | { file = Compilation_unit _; _ } ->
+    Compilation_unit.load input >>= fun odoctree ->
     List.iter odoctree.Odoc_model.Lang.Compilation_unit.imports ~f:(fun import ->
         match import with
         | Odoc_model.Lang.Compilation_unit.Import.Unresolved _  -> ()
         | Odoc_model.Lang.Compilation_unit.Import.Resolved root ->
             Hash_set.add deps root
-      )
+      );
+    Ok ()
 
 let for_html_step pkg_dir =
   let deps = Hash_set.create () in
   let add_deps () file = deps_of_odoc_file ~deps file in
-  Fs.Directory.fold_files_rec ~ext:".odoc" add_deps () pkg_dir;
-  Hash_set.elements deps
+  Fs.Directory.fold_files_rec_result ~ext:".odoc" add_deps () pkg_dir >>= fun () ->
+  Ok (Hash_set.elements deps)

src/odoc/depends.mli

@@ -14,6 +14,8 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
+open Or_error
+
 (** Computes the dependencies required for each step of the pipeline to work
     correctly on a given input. *)
 
@@ -27,7 +29,7 @@ end
 val for_compile_step : Fs.File.t -> Compile.t list
 (** Takes a .cm{i,t,ti} file and returns the list of its dependencies. *)
 
-val for_html_step : Fs.Directory.t -> Odoc_model.Root.t list
+val for_html_step : Fs.Directory.t -> (Odoc_model.Root.t list, [> msg]) result
 (** Takes the directory where the .odoc files of a given package are stored and
     returns the list of roots that need to be in odoc's load path to process
     html from these .odoc files. *)

src/odoc/env.ml

@@ -34,6 +34,8 @@ open Odoc_compat
    Where we notice this ambiguity we warn the user to wrap their libraries,
    which will generally fix this issue. *)
 
+open Or_error
+
 type t = {
   expander : Odoc_xref.expander ;
   resolver : Odoc_xref.resolver ;
@@ -91,9 +93,13 @@ module Accessible_paths = struct
         List.fold_right (fun x acc -> match f x with | Some y -> y::acc | None -> acc) l []
       in
       let safe_read file =
-        try Some (Root.read file, file)
-        with
-        | End_of_file ->
+        match Root.read file with
+        | Ok root -> Some (root, file)
+        | Error (`Msg msg) ->
+          let warning = Odoc_model.Error.filename_only msg (Fs.File.to_string file) in
+          prerr_endline (Odoc_model.Error.to_string warning);
+          None
+        | exception End_of_file ->
           let warning = Odoc_model.Error.filename_only "End_of_file while reading" (Fs.File.to_string file) in
           prerr_endline (Odoc_model.Error.to_string warning);
           None
@@ -174,15 +180,19 @@ let fetch_page ap root =
   match Accessible_paths.file_of_root ap root with
   | path -> Page.load path
   | exception Not_found ->
-    Printf.eprintf "No unit for root: %s\n%!" (Odoc_model.Root.to_string root);
-    exit 2
+    let msg =
+      Printf.sprintf "No unit for root: %s\n%!" (Odoc_model.Root.to_string root)
+    in
+    Error (`Msg msg)
 
 let fetch_unit ap root =
   match Accessible_paths.file_of_root ap root with
   | path -> Compilation_unit.load path
   | exception Not_found ->
-    Printf.eprintf "No unit for root: %s\n%!" (Odoc_model.Root.to_string root);
-    exit 2
+    let msg =
+      Printf.sprintf "No unit for root: %s\n%!" (Odoc_model.Root.to_string root)
+    in
+    Error (`Msg msg)
 
 type builder = [ `Unit of Compilation_unit.t | `Page of Page.t ] -> t
 
@@ -211,24 +221,24 @@ let create ?(important_digests=true) ~directories : builder =
           end
         | x -> x
     in
-    let fetch_unit root : Odoc_model.Lang.Compilation_unit.t =
+    let fetch_unit root : (Odoc_model.Lang.Compilation_unit.t, _) Result.result =
       match unit_or_page with
       | `Page _ -> fetch_unit ap root
       | `Unit unit ->
         let current_root = Compilation_unit.root unit in
         if Odoc_model.Root.equal root current_root then
-          unit
+          Ok unit
         else
           fetch_unit ap root
     in
     let lookup_page target_name = lookup_page ap target_name in
-    let fetch_page root : Odoc_model.Lang.Page.t =
+    let fetch_page root : (Odoc_model.Lang.Page.t, _) Result.result =
       match unit_or_page with
       | `Unit _ -> fetch_page ap root
       | `Page page ->
         let current_root = Page.root page in
         if Odoc_model.Root.equal root current_root then
-          page
+          Ok page
         else
           fetch_page ap root
     in

src/odoc/fs.ml

@@ -15,6 +15,7 @@
  *)
 
 open StdLabels
+open Or_error
 
 type directory = Fpath.t
 type file = Fpath.t
@@ -146,6 +147,17 @@ module Directory = struct
     in
     loop ext f acc ([Fpath.to_string d] :: []);;
 
+  exception Stop_iter of msg
+
+  let fold_files_rec_result ?ext f acc d =
+    let f acc fn =
+      match f acc fn with
+      | Ok acc -> acc
+      | Error e -> raise (Stop_iter e)
+    in
+    try Ok (fold_files_rec ?ext f acc d)
+    with Stop_iter (`Msg _ as e) -> Error e
+
   module Table = Hashtbl.Make(struct
       type nonrec t = t
       let equal = Fpath.equal