improve readability and remove redundant code

- make exceptions adhere to naming conventions
- fix typo in function name
- remove trivial pattern matching
- remove module prefix for locally opened modules
- prefer ppx syntax over Lwt.catch

Author: yasunariw

lib/action.ml

@@ -224,7 +224,7 @@ let partition_status (ctx : Context.t) (n : status_notification) =
     match List.exists n.branches ~f:(fun { name } -> String.equal name main_branch_name) with
     | false -> default ()
     | true ->
-      ( match%lwt Github.generate_query_commmit cfg ~url:n.commit.url ~sha:n.commit.sha with
+      ( match%lwt Github.generate_query_commit cfg ~url:n.commit.url ~sha:n.commit.sha with
       | None -> default ()
       | Some commit ->
         (*

lib/context.ml

@@ -2,7 +2,7 @@ open Devkit
 
 let log = Log.from "context"
 
-exception Context_Error of string
+exception Context_error of string
 
 type cfg_make_args =
   | LocalMake of string
@@ -37,16 +37,11 @@ type context_thunk = {
 
 let get_secrets secrets_path = Config.load_secrets_file ~secrets_path
 
-let get_remote_cfg_json_url url = Github.load_config_json url
-
-let get_remote_cfg_json_req filename ?token req =
-  get_remote_cfg_json_url @@ Github.get_remote_config_json_url filename ?token req
-
-let get_local_cfg_json config_path = Lwt.return @@ Config.load_config_file ~config_path
+let load_config_json_local config_path = Lwt.return @@ Config.load_config_file ~config_path
 
 let resolve_cfg_getter = function
-  | Local -> get_local_cfg_json
-  | Remote -> get_remote_cfg_json_url
+  | Local -> load_config_json_local
+  | Remote -> Github.load_config_json
 
 let refresh_config ctx =
   ( match ctx.data.cfg_source with
@@ -68,7 +63,7 @@ let refresh_and_get_config ctx =
 
 let change_remote_url filename ctx req =
   match ctx.data.cfg_source with
-  | Local -> raise @@ Context_Error "cant load remote config from a local context"
+  | Local -> raise @@ Context_error "can't load remote config from a local context"
   | Remote ->
     ctx.data.cfg_filename <- filename;
     let url = Github.get_remote_config_json_url filename ?token:ctx.secrets.gh_token req in
@@ -96,11 +91,12 @@ let make_with_secrets ~state_path ~cfg_args ~secrets_path ~(secrets : Notabot_t.
   =
   let data_cfg_path, cfg_source, cfg_json, cfg_filename =
     match cfg_args with
-    | LocalMake p -> p, Local, get_local_cfg_json p, p
+    | LocalMake p -> p, Local, load_config_json_local p, p
     | RemoteMake (filename, r) ->
-    match secrets.gh_token with
-    | token ->
-      Github.get_remote_config_json_url filename ?token r, Remote, get_remote_cfg_json_req filename ?token r, filename
+      let token = secrets.gh_token in
+      let url = Github.get_remote_config_json_url filename ?token r in
+      let cfg_json = Github.load_config_json @@ Github.get_remote_config_json_url filename ?token r in
+      url, Remote, cfg_json, filename
   in
   let%lwt cfg_json = cfg_json in
   let data =

lib/context.mli

@@ -1,4 +1,4 @@
-exception Context_Error of string
+exception Context_error of string
 
 type cfg_make_args =
   | LocalMake of string

lib/github.ml

@@ -18,7 +18,9 @@ type t =
 
 (* all other events *)
 
-exception Remote_Config_Error of string
+exception Remote_config_error of string
+
+let remote_config_error fmt = ksprintf (fun s -> raise (Remote_config_error s)) fmt
 
 let to_repo = function
   | Push n -> Some n.repository
@@ -34,8 +36,8 @@ let to_repo = function
 let api_url_of_repo (repo : repository) =
   Option.map ~f:(fun host ->
     match host with
-    | "api.github.com" -> Printf.sprintf "https://%s" host
-    | _ -> Printf.sprintf "https://%s/api/v3" host)
+    | "api.github.com" -> sprintf "https://%s" host
+    | _ -> sprintf "https://%s/api/v3" host)
   @@ Uri.host
   @@ Uri.of_string repo.url
 
@@ -51,24 +53,25 @@ let name_of_full_name_parts full_name_parts =
 
 let get_remote_config_json_url filename ?token req =
   match to_repo req with
-  | None -> raise @@ Remote_Config_Error "unable to resolve repository from request"
+  | None -> remote_config_error "unable to resolve repository from request"
   | Some repo ->
   match String.split ~on:'/' repo.full_name with
   | full_name_parts ->
   match user_of_full_name_parts full_name_parts with
-  | None -> raise @@ Remote_Config_Error "unable to resolve repository owner"
+  | None -> remote_config_error "unable to resolve repository owner"
   | Some owner ->
   match name_of_full_name_parts full_name_parts with
-  | None -> raise @@ Remote_Config_Error "unable to resolve repository name"
+  | None -> remote_config_error "unable to resolve repository name"
   | Some repo_name ->
   match api_url_of_repo repo with
-  | None -> raise @@ Remote_Config_Error "unable to resolve github api url from repository url"
+  | None -> remote_config_error "unable to resolve github api url from repository url"
   | Some base_url ->
-  match Printf.sprintf "%s/repos/%s/%s/contents/%s" base_url owner repo_name filename with
-  | url ->
-  match token with
-  | None -> url
-  | Some token -> Printf.sprintf "%s?access_token=%s" url token
+    let url = sprintf "%s/repos/%s/%s/contents/%s" base_url owner repo_name filename in
+    begin
+      match token with
+      | None -> url
+      | Some token -> sprintf "%s?access_token=%s" url token
+    end
 
 let config_of_content_api_response response =
   match response.encoding with
@@ -79,12 +82,12 @@ let config_of_content_api_response response =
     @@ String.concat
     @@ String.split ~on:'\n'
     @@ response.content
-  | e -> raise @@ Remote_Config_Error (Printf.sprintf "unknown encoding format '%s'." e)
+  | e -> remote_config_error "unknown encoding format '%s'" e
 
 let load_config_json url =
-  let headers = Some [ "Accept: application/vnd.github.v3+json" ] in
-  match%lwt Web.http_request_lwt ?headers `GET url with
-  | `Error e -> raise @@ Remote_Config_Error (Printf.sprintf "error while querying github api %s: %s" url e)
+  let headers = [ "Accept: application/vnd.github.v3+json" ] in
+  match%lwt Web.http_request_lwt ~headers `GET url with
+  | `Error e -> remote_config_error "error while querying github api %s: %s" url e
   | `Ok s -> config_of_content_api_response @@ Github_j.content_api_response_of_string s
 
 let is_valid_signature ~secret headers_sig body =
@@ -93,7 +96,7 @@ let is_valid_signature ~secret headers_sig body =
     Cstruct.to_string @@ Nocrypto.Hash.SHA1.hmac ~key (Cstruct.of_string body)
   in
   let (`Hex request_hash) = Hex.of_string request_hash in
-  String.equal headers_sig (Printf.sprintf "sha1=%s" request_hash)
+  String.equal headers_sig (sprintf "sha1=%s" request_hash)
 
 (* Parse a payload. The type of the payload is detected from the headers. *)
 let parse_exn ~secret headers body =
@@ -135,7 +138,7 @@ let query_api ?token ~url parse =
     log#error ~exn "impossible to parse github api answer to %s" url;
     Lwt.return_none
 
-let generate_query_commmit cfg ~url ~sha =
+let generate_query_commit cfg ~url ~sha =
   (* the expected output is a payload containing content about commits *)
   match cfg.Config.offline with
   | None -> query_api ?token:cfg.Config.gh_token ~url api_commit_of_string
@@ -168,4 +171,4 @@ let generate_commit_from_commit_comment cfg n =
   in
   let commit_url = String.sub ~pos:0 ~len:url_length url ^ "/" ^ sha in
   (* add sha hash to get the full api link *)
-  generate_query_commmit cfg ~url:commit_url ~sha
+  generate_query_commit cfg ~url:commit_url ~sha

src/request_handler.ml

@@ -7,10 +7,7 @@ let update_config (ctx : Lib.Context.t) = function
   | Lib.Github.Push n ->
     let is_config_file f = String.equal f ctx.data.cfg_filename in
     let commit_contains_config_file (c : Lib.Github_t.commit) = List.exists is_config_file (c.added @ c.modified) in
-    ( match List.exists commit_contains_config_file n.commits with
-    | true -> Lib.Context.refresh_config ctx
-    | false -> Lwt.return_unit
-    )
+    if List.exists commit_contains_config_file n.commits then Lib.Context.refresh_config ctx else Lwt.return_unit
   | _ -> Lwt.return_unit
 
 let process_github_notification (ctx_thunk : Lib.Context.context_thunk) headers body =
@@ -31,10 +28,10 @@ let process_github_notification (ctx_thunk : Lib.Context.context_thunk) headers
         Slack.send_notification url data)
       notifications
   with
-  | Lib.Context.Context_Error s ->
+  | Context.Context_error s ->
     log#error "error creating context from payload: %s" s;
     Lwt.return_unit
-  | Lib.Github.Remote_Config_Error s ->
+  | Github.Remote_config_error s ->
     log#error "error retrieving config from payload: %s" s;
     Lwt.return_unit
 

test/test.ml

@@ -1,6 +1,8 @@
 open Base
 open Lib
 
+let log = Devkit.Log.from "test"
+
 let print_notif (chan, msg) =
   let json =
     msg |> Slack_j.string_of_webhook_notification |> Yojson.Basic.from_string |> Yojson.Basic.pretty_to_string
@@ -23,10 +25,10 @@ let process ~state_dir ~cfg_path ~secrets_path file =
       let state_path = Caml.Filename.concat state_dir @@ Caml.Filename.basename file in
       let ctx_partial = Context.make ~state_path ~secrets_path ~disable_write:true in
       let%lwt ctx =
-        Lwt.catch
-          (fun () -> ctx_partial ~cfg_args:(RemoteMake (cfg_path, event)) ())
-          (function
-            | _ -> ctx_partial ~cfg_args:(LocalMake cfg_path) ())
+        try%lwt ctx_partial ~cfg_args:(RemoteMake (cfg_path, event)) ()
+        with exn ->
+          log#info ~exn "unable to find a remote configuration %s" cfg_path;
+          ctx_partial ~cfg_args:(LocalMake cfg_path) ()
       in
       let%lwt notifs = Action.generate_notifications ctx event in
       List.iter notifs ~f:print_notif;