Only test the request built and not the execution

bin/main.ml

@@ -76,12 +76,14 @@ let run period : unit =
       Period.with_period period ~last_fetch_file ~f:(fun period ->
           (* Fmt.pr "period: %a@." Fmt.(pair string string) period; *)
           let* token = get_token () in
-          let* contributions = Contributions.fetch ~period ~token in
+          let request = Contributions.request ~period ~token in
+          let* contributions = Graphql.exec request in
           show ~from:(fst period) contributions)
   | `Save ->
       Period.with_period period ~last_fetch_file ~f:(fun period ->
           let* token = get_token () in
-          let* contributions = Contributions.fetch ~period ~token in
+          let request = Contributions.request ~period ~token in
+          let* contributions = Graphql.exec request in
           Yojson.Safe.to_file "activity.json" contributions)
   | `Load ->
       (* When testing formatting changes, it is quicker to fetch the data once and then load it again for each test: *)

lib/contributions.ml

@@ -3,7 +3,7 @@ module Json = Yojson.Safe
 let ( / ) a b = Json.Util.member b a
 
 let query =
-  {| query($from: DateTime!, $to: DateTime!) {
+  {|query($from: DateTime!, $to: DateTime!) {
    viewer {
     login
     contributionsCollection(from: $from, to: $to) {
@@ -55,9 +55,9 @@ let query =
   }
 }|}
 
-let fetch ~period:(start, finish) ~token =
+let request ~period:(start, finish) ~token =
   let variables = [ ("from", `String start); ("to", `String finish) ] in
-  Graphql.exec ~token ~variables ~query ()
+  Graphql.request ~token ~variables ~query ()
 
 module Datetime = struct
   type t = string

lib/contributions.mli

@@ -15,10 +15,7 @@ module Repo_map : Map.S with type key = string
 
 type t = { username : string; activity : item list Repo_map.t }
 
-val fetch :
-  period:string * string ->
-  token:Token.t ->
-  (Yojson.Safe.t, [ `Msg of string ]) result
+val request : period:string * string -> token:Token.t -> Curly.Request.t
 
 val of_json : from:string -> Yojson.Safe.t -> t
 (** We pass [from] again here so we can filter out anything that GitHub included by accident. *)

lib/graphql.ml

@@ -14,8 +14,7 @@ let request ?variables ~token ~query () =
   let headers = [ ("Authorization", "bearer " ^ token) ] in
   Curly.Request.make ~headers ~body ~url ~meth:`POST ()
 
-let exec ?variables ~token ~query () =
-  let request = request ?variables ~token ~query () in
+let exec request =
   match Curly.run request with
   | Ok { Curly.Response.body; _ } -> (
       let json = Yojson.Safe.from_string body in

lib/graphql.mli

@@ -1,6 +1,8 @@
-val exec :
+val request :
   ?variables:(string * Yojson.Safe.t) list ->
   token:string ->
   query:string ->
   unit ->
-  (Yojson.Safe.t, [ `Msg of string ]) result
+  Curly.Request.t
+
+val exec : Curly.Request.t -> (Yojson.Safe.t, [ `Msg of string ]) result

test/lib/alcotest_ext.ml

@@ -25,3 +25,21 @@ module Yojson = struct
 end
 
 let yojson = Yojson.testable
+
+module Curly = struct
+  module Request = struct
+    type t = Curly.Request.t
+
+    let pp = Curly.Request.pp
+
+    let eq (x : t) (y : t) =
+      let x = Format.asprintf "%a" Curly.Request.pp x in
+
+      let y = Format.asprintf "%a" Curly.Request.pp y in
+      String.equal x y
+
+    let testable = Alcotest.testable pp eq
+  end
+end
+
+let request = Curly.Request.testable

test/lib/alcotest_ext.mli

@@ -5,3 +5,4 @@ val or_msg :
   'a Alcotest.testable -> ('a, [ `Msg of string ]) result Alcotest.testable
 
 val yojson : Yojson.Safe.t Alcotest.testable
+val request : Curly.Request.t Alcotest.testable

test/lib/test_contributions.ml

@@ -83,18 +83,25 @@ module Testable = struct
   let contributions = Contributions.testable
 end
 
-let test_fetch =
+let test_request =
   let make_test name ~period ~token ~expected =
-    let name = Printf.sprintf "fetch: %s" name in
+    let name = Printf.sprintf "request: %s" name in
     let test_fun () =
-      let actual = Contributions.fetch ~period ~token in
-      Alcotest.(check Alcotest_ext.(or_msg yojson)) name expected actual
+      let actual = Contributions.request ~period ~token in
+      Alcotest.(check Alcotest_ext.request) name expected actual
     in
     (name, `Quick, test_fun)
   in
   [
     make_test "no token" ~token:"" ~period:("", "")
-      ~expected:(Error (`Msg "GitHub returned errors: Bad credentials"));
+      ~expected:
+        {
+          meth = `POST;
+          url = "https://api.github.com/graphql";
+          headers = [ ("Authorization", "bearer ") ];
+          body =
+            {|{"query":"query($from: DateTime!, $to: DateTime!) {\n   viewer {\n    login\n    contributionsCollection(from: $from, to: $to) {\n      issueContributions(first: 100) {\n        nodes {\n          occurredAt\n          issue {\n            url\n            title\n            body\n            repository { nameWithOwner }\n          }\n        }\n      }\n      pullRequestContributions(first: 100) {\n        nodes {\n          occurredAt\n          pullRequest {\n            url\n            title\n            body\n            repository { nameWithOwner }\n          }\n        }\n      }\n      pullRequestReviewContributions(first: 100) {\n        nodes {\n          occurredAt\n          pullRequestReview {\n            url\n            pullRequest { title }\n            body\n            state\n            comments(first: 100) { nodes { body } }\n            repository { nameWithOwner }\n          }\n        }\n      }\n      repositoryContributions(first: 100) {\n        nodes {\n          occurredAt\n          repository {\n            url\n            nameWithOwner\n          }\n        }\n      }\n    }\n  }\n}","variables":{"from":"","to":""}}|};
+        };
   ]
 
 let activity_example =
@@ -388,4 +395,4 @@ let test_pp =
   ]
 
 let suite =
-  ("Contributions", test_fetch @ test_of_json @ test_is_empty @ test_pp)
+  ("Contributions", test_request @ test_of_json @ test_is_empty @ test_pp)

test/lib/test_graphql.ml

@@ -1,18 +1,24 @@
 open Get_activity
 
-let test_exec =
+let test_request =
   let make_test name ?variables ~token ~query ~expected () =
-    let name = Printf.sprintf "exec: %s" name in
+    let name = Printf.sprintf "request: %s" name in
     let test_fun () =
-      let actual = Graphql.exec ?variables ~token ~query () in
-      Alcotest.(check Alcotest_ext.(or_msg yojson)) name expected actual
+      let actual = Graphql.request ?variables ~token ~query () in
+      Alcotest.(check Alcotest_ext.request) name expected actual
     in
     (name, `Quick, test_fun)
   in
   [
     make_test "no token" ~token:"" ~query:""
-      ~expected:(Error (`Msg "GitHub returned errors: Bad credentials"))
+      ~expected:
+        {
+          meth = `POST;
+          url = "https://api.github.com/graphql";
+          headers = [ ("Authorization", "bearer ") ];
+          body = {|{"query":""}|};
+        }
       ();
   ]
 
-let suite = ("Graphql", test_exec)
+let suite = ("Graphql", test_request)