Add unit tests for get-activity-lib

bin/main.ml

@@ -8,6 +8,8 @@ let or_die = function
       Fmt.epr "%s@." m;
       exit 1
 
+let ( let* ) x y = y @@ or_die x
+
 let home =
   match Sys.getenv_opt "HOME" with
   | None -> Fmt.failwith "$HOME is not set!"
@@ -73,13 +75,14 @@ let run period : unit =
   | `Normal ->
       Period.with_period period ~last_fetch_file ~f:(fun period ->
           (* Fmt.pr "period: %a@." Fmt.(pair string string) period; *)
-          let token = get_token () |> or_die in
-          show ~from:(fst period) @@ Contributions.fetch ~period ~token)
+          let* token = get_token () in
+          let* contributions = Contributions.fetch ~period ~token in
+          show ~from:(fst period) contributions)
   | `Save ->
       Period.with_period period ~last_fetch_file ~f:(fun period ->
-          let token = get_token () |> or_die in
-          Contributions.fetch ~period ~token
-          |> Yojson.Safe.to_file "activity.json")
+          let* token = get_token () in
+          let* contributions = Contributions.fetch ~period ~token 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: *)
       let from =

dune-project

@@ -16,6 +16,7 @@
  (name get-activity-lib)
  (synopsis "Collect activity as markdown")
  (depends
+  (alcotest :with-test)
   cohttp
   cohttp-lwt
   cohttp-lwt-unix

get-activity-lib.opam

@@ -7,6 +7,7 @@ homepage: "https://github.com/tarides/get-activity"
 bug-reports: "https://github.com/tarides/get-activity/issues"
 depends: [
   "dune" {>= "2.8"}
+  "alcotest" {with-test}
   "cohttp"
   "cohttp-lwt"
   "cohttp-lwt-unix"

lib/contributions.mli

@@ -15,7 +15,10 @@ 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
+val fetch :
+  period:string * string ->
+  token:Token.t ->
+  (Yojson.Safe.t, [ `Msg of string ]) result
 
 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

@@ -21,12 +21,17 @@ let exec ?variables ~token ~query () =
   | `OK -> (
       let json = Yojson.Safe.from_string body in
       match json / "errors" with
-      | `Null -> json
+      | `Null -> Ok json
       | _errors ->
-          Fmt.failwith "@[<v2>GitHub returned errors: %a@]"
-            (Yojson.Safe.pretty_print ~std:true)
-            json)
+          Error
+            (`Msg
+              (Format.asprintf "@[<v2>GitHub returned errors: %a@]"
+                 (Yojson.Safe.pretty_print ~std:true)
+                 json)))
   | err ->
-      Fmt.failwith "@[<v2>Error performing GraphQL query on GitHub: %s@,%s@]"
-        (Cohttp.Code.string_of_status err)
-        body
+      Error
+        (`Msg
+          (Format.asprintf
+             "@[<v2>Error performing GraphQL query on GitHub: %s@,%s@]"
+             (Cohttp.Code.string_of_status err)
+             body))

lib/graphql.mli

@@ -3,4 +3,4 @@ val exec :
   token:string ->
   query:string ->
   unit ->
-  Yojson.Safe.t Lwt.t
+  (Yojson.Safe.t, [ `Msg of string ]) result Lwt.t

test/lib/alcotest_ext.ml

@@ -0,0 +1,47 @@
+open Alcotest
+
+module Msg = struct
+  type 'a t = [ `Msg of 'a ]
+
+  let pp f fs (`Msg s : 'a t) = Format.fprintf fs "%a" f s
+  let eq f (`Msg s1 : 'a t) (`Msg s2 : 'a t) = f s1 s2
+
+  let testable t =
+    let pp = pp (Alcotest.pp t) in
+    let eq = eq (Alcotest.equal t) in
+    testable pp eq
+end
+
+let msg = Msg.testable
+let string_msg = msg string
+let or_msg x = result x string_msg
+
+module Lwt = struct
+  type 'a t = 'a Lwt.t
+
+  let pp f fs (x : 'a t) =
+    let x = Lwt_main.run x in
+    Format.fprintf fs "%a" f x
+
+  let eq f (x : 'a t) (y : 'a t) =
+    let x = Lwt_main.run x in
+    let y = Lwt_main.run y in
+    f x y
+
+  let testable (t : 'a testable) : 'a t testable =
+    let pp = pp (Alcotest.pp t) in
+    let eq = eq (Alcotest.equal t) in
+    testable pp eq
+end
+
+let lwt = Lwt.testable
+
+module Yojson = struct
+  type t = Yojson.Safe.t
+
+  let pp = Yojson.Safe.pp
+  let eq = Yojson.Safe.equal
+  let testable : t testable = testable pp eq
+end
+
+let yojson = Yojson.testable

test/lib/alcotest_ext.mli

@@ -0,0 +1,8 @@
+val msg : 'a Alcotest.testable -> [ `Msg of 'a ] Alcotest.testable
+val string_msg : [ `Msg of string ] Alcotest.testable
+
+val or_msg :
+  'a Alcotest.testable -> ('a, [ `Msg of string ]) result Alcotest.testable
+
+val lwt : 'a Alcotest.testable -> 'a Lwt.t Alcotest.testable
+val yojson : Yojson.Safe.t Alcotest.testable

test/lib/dune

@@ -0,0 +1,4 @@
+(test
+ (name main)
+ (package get-activity-lib)
+ (libraries get-activity-lib alcotest))

test/lib/main.ml

@@ -0,0 +1,8 @@
+let () =
+  Alcotest.run "get-activity-lib"
+    [
+      Test_token.suite;
+      Test_period.suite;
+      Test_graphql.suite;
+      Test_contributions.suite;
+    ]