preserve results interface after switching to synchronous file I/O

Author: yasunariw

lib/api_local.ml

@@ -9,14 +9,15 @@ let cache_dir = Caml.Filename.concat cwd "github-api-cache"
 module Github : Api.Github = struct
   let get_config ~(ctx : Context.t) ~repo:_ =
     let url = Caml.Filename.concat cwd ctx.config_filename in
-    try Lwt.return @@ Ok (url |> get_local_file |> Config_j.config_of_string)
-    with Sys_error e -> Lwt.return @@ fmt_error "error while getting local file: %s\nfailed to get config %s" e url
+    match get_local_file url with
+    | Error e -> Lwt.return @@ fmt_error "error while getting local file: %s\nfailed to get config %s" e url
+    | Ok file -> Lwt.return @@ Ok (Config_j.config_of_string file)
 
   let get_api_commit ~ctx:_ ~repo:_ ~sha =
     let url = Caml.Filename.concat cache_dir sha in
-    try Lwt.return @@ Ok (url |> get_local_file |> Github_j.api_commit_of_string)
-    with Sys_error e ->
-      Lwt.return @@ fmt_error "error while getting local file: %s\nfailed to get api commit %s" e url
+    match get_local_file url with
+    | Error e -> Lwt.return @@ fmt_error "error while getting local file: %s\nfailed to get api commit %s" e url
+    | Ok file -> Lwt.return @@ Ok (Github_j.api_commit_of_string file)
 end
 
 module Slack : Api.Slack = struct

lib/common.ml

@@ -42,6 +42,8 @@ let http_request ?headers ?body meth path =
   | `Ok s -> Lwt.return @@ Ok s
   | `Error e -> Lwt.return @@ Error e
 
-let get_local_file path = Std.input_file path
+let get_local_file path = try Ok (Std.input_file path) with exn -> fmt_error "%s" (Exn.to_string exn)
 
-let write_to_local_file ~data path = Devkit.Files.save_as path (fun oc -> Stdio.Out_channel.fprintf oc "%s" data)
+let write_to_local_file ~data path =
+  try Ok (Devkit.Files.save_as path (fun oc -> Stdio.Out_channel.fprintf oc "%s" data))
+  with exn -> fmt_error "%s" (Exn.to_string exn)

lib/context.ml

@@ -53,17 +53,20 @@ let log = Log.from "context"
 
 let refresh_secrets ctx =
   let path = ctx.secrets_filepath in
-  try
-    ctx.secrets <- Some (path |> get_local_file |> Config_j.secrets_of_string);
+  match get_local_file path with
+  | Error e -> fmt_error "error while getting local file: %s\nfailed to get secrets from file %s" e path
+  | Ok file ->
+    ctx.secrets <- Some (Config_j.secrets_of_string file);
     Ok ctx
-  with Sys_error e -> fmt_error "error while getting local file: %s\nfailed to get secrets from file %s" e path
 
 let refresh_state ctx =
   match ctx.state_filepath with
   | None -> Ok ctx
   | Some path ->
-  try
     log#info "loading saved state from file %s" path;
-    let state = path |> get_local_file |> State_j.state_of_string in
-    Ok { ctx with state }
-  with Sys_error e -> fmt_error "error while getting local file: %s\nfailed to get state from file %s" e path
+    ( match get_local_file path with
+    | Error e -> fmt_error "error while getting local file: %s\nfailed to get state from file %s" e path
+    | Ok file ->
+      let state = State_j.state_of_string file in
+      Ok { ctx with state }
+    )

src/notabot.ml

@@ -25,8 +25,10 @@ let check_gh_action file json config secrets state =
   | None ->
     log#error "aborting because payload %s is not named properly, named should be KIND.NAME_OF_PAYLOAD.json" file
   | Some kind ->
+  match Common.get_local_file file with
+  | Error e -> log#error "%s" e
+  | Ok body ->
     let headers = [ "x-github-event", kind ] in
-    let body = Common.get_local_file file in
     let ctx = Context.make ~config_filename:config ~secrets_filepath:secrets ?state_filepath:state () in
     Lwt_main.run
       ( if json then

test/test.ml

@@ -24,20 +24,21 @@ let process ~(ctx : Context.t) (kind, path, state_path) =
     match state_path with
     | None -> Lwt.return { ctx with state = State.empty }
     | Some state_path ->
-    try
-      let state = state_path |> Common.get_local_file |> State_j.state_of_string in
-      Lwt.return { ctx with state }
-    with Sys_error e ->
+    match Common.get_local_file state_path with
+    | Error e ->
       log#error "failed to read %s: %s" state_path e;
       Lwt.return ctx
+    | Ok file ->
+      let state = State_j.state_of_string file in
+      Lwt.return { ctx with state }
   in
   Stdio.printf "===== file %s =====\n" path;
   let headers = [ "x-github-event", kind ] in
-  try
-    let event = Common.get_local_file path in
+  match Common.get_local_file path with
+  | Error e -> Lwt.return @@ log#error "failed to read %s: %s" path e
+  | Ok event ->
     let%lwt _ctx = Action_local.process_github_notification ctx headers event in
     Lwt.return_unit
-  with Sys_error e -> Lwt.return @@ log#error "failed to read %s: %s" path e
 
 let () =
   let payloads = get_mock_payloads () in