From 0cb41d4d08fa892f79de4262a76eb4e5ff557f6f Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Thu, 7 Mar 2024 10:48:54 +0000 Subject: [PATCH] Add unit tests for get-activity-lib --- bin/main.ml | 13 +- dune-project | 1 + get-activity-lib.opam | 1 + lib/contributions.mli | 5 +- lib/graphql.ml | 19 +- lib/graphql.mli | 2 +- test/lib/alcotest_ext.ml | 47 ++++ test/lib/alcotest_ext.mli | 8 + test/lib/dune | 4 + test/lib/main.ml | 8 + test/lib/test_contributions.ml | 388 +++++++++++++++++++++++++++++++++ test/lib/test_graphql.ml | 23 ++ test/lib/test_period.ml | 35 +++ test/lib/test_token.ml | 25 +++ 14 files changed, 565 insertions(+), 14 deletions(-) create mode 100644 test/lib/alcotest_ext.ml create mode 100644 test/lib/alcotest_ext.mli create mode 100644 test/lib/dune create mode 100644 test/lib/main.ml create mode 100644 test/lib/test_contributions.ml create mode 100644 test/lib/test_graphql.ml create mode 100644 test/lib/test_period.ml create mode 100644 test/lib/test_token.ml diff --git a/bin/main.ml b/bin/main.ml index e42e3fb..860066a 100644 --- a/bin/main.ml +++ b/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 = diff --git a/dune-project b/dune-project index 327ad69..331d1f3 100644 --- a/dune-project +++ b/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 diff --git a/get-activity-lib.opam b/get-activity-lib.opam index 9f576d4..ac06ad1 100644 --- a/get-activity-lib.opam +++ b/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" diff --git a/lib/contributions.mli b/lib/contributions.mli index c3e7bb3..2377546 100644 --- a/lib/contributions.mli +++ b/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. *) diff --git a/lib/graphql.ml b/lib/graphql.ml index 01a5eda..4bfed1c 100644 --- a/lib/graphql.ml +++ b/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 "@[GitHub returned errors: %a@]" - (Yojson.Safe.pretty_print ~std:true) - json) + Error + (`Msg + (Format.asprintf "@[GitHub returned errors: %a@]" + (Yojson.Safe.pretty_print ~std:true) + json))) | err -> - Fmt.failwith "@[Error performing GraphQL query on GitHub: %s@,%s@]" - (Cohttp.Code.string_of_status err) - body + Error + (`Msg + (Format.asprintf + "@[Error performing GraphQL query on GitHub: %s@,%s@]" + (Cohttp.Code.string_of_status err) + body)) diff --git a/lib/graphql.mli b/lib/graphql.mli index fc457bb..57899fb 100644 --- a/lib/graphql.mli +++ b/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 diff --git a/test/lib/alcotest_ext.ml b/test/lib/alcotest_ext.ml new file mode 100644 index 0000000..84ffb5a --- /dev/null +++ b/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 diff --git a/test/lib/alcotest_ext.mli b/test/lib/alcotest_ext.mli new file mode 100644 index 0000000..41657cc --- /dev/null +++ b/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 diff --git a/test/lib/dune b/test/lib/dune new file mode 100644 index 0000000..162d0b1 --- /dev/null +++ b/test/lib/dune @@ -0,0 +1,4 @@ +(test + (name main) + (package get-activity-lib) + (libraries get-activity-lib alcotest)) diff --git a/test/lib/main.ml b/test/lib/main.ml new file mode 100644 index 0000000..1172be5 --- /dev/null +++ b/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; + ] diff --git a/test/lib/test_contributions.ml b/test/lib/test_contributions.ml new file mode 100644 index 0000000..5cc37db --- /dev/null +++ b/test/lib/test_contributions.ml @@ -0,0 +1,388 @@ +open Get_activity + +module Testable = struct + module Datetime = struct + let pp fs x = Format.fprintf fs "%S" x + let eq = String.equal + end + + module Item = struct + module Kind = struct + type t = [ `Issue | `PR | `Review of string | `New_repo ] + + let pp fs = function + | `Issue -> Format.fprintf fs "`Issue" + | `PR -> Format.fprintf fs "`PR" + | `Review x -> Format.fprintf fs "`Review %S" x + | `New_repo -> Format.fprintf fs "`New_repo" + + let eq (x : t) (y : t) = + match (x, y) with + | `Issue, `Issue | `PR, `PR | `New_repo, `New_repo -> true + | `Review x, `Review y -> String.equal x y + | _ -> false + end + + type t = Contributions.item + + let pp fs (x : t) = + Format.fprintf fs + "@[{@;\ + repo = %S;@;\ + kind = %a;@;\ + date = %a;@;\ + url = %S;@;\ + title = %S;@;\ + body = %S;@]@;\ + }@," + x.repo Kind.pp x.kind Datetime.pp x.date x.url x.title x.body + + let eq (x : t) (y : t) = + String.equal x.repo y.repo && Kind.eq x.kind y.kind + && Datetime.eq x.date y.date && String.equal x.url y.url + && String.equal x.title y.title + && String.equal x.body y.body + end + + module Repo_map = struct + type 'a t = 'a Contributions.Repo_map.t + + let pp f fs (x : 'a t) = + Contributions.Repo_map.iter + (fun key v -> + Format.fprintf fs + "@[{@;key = %S;@;value =@ @[%a@];@]@;}@," key f v) + x + + let eq = Contributions.Repo_map.equal + end + + module Contributions = struct + type t = Contributions.t + + let pp fs (x : t) = + Format.fprintf fs + "@[{@;username = %S;@;activity =@ @[%a@];@]@;}" x.username + (Repo_map.pp (Format.pp_print_list Item.pp)) + x.activity + + let eq (x : t) (y : t) = + String.equal x.username y.username + && Repo_map.eq (List.equal Item.eq) x.activity y.activity + + let testable = Alcotest.testable pp eq + end + + let contributions = Contributions.testable +end + +let test_fetch = + let make_test name ~period ~token ~expected = + let name = Printf.sprintf "fetch: %s" name in + let test_fun () = + let actual = Contributions.fetch ~period ~token in + Alcotest.(check Alcotest_ext.(or_msg yojson)) name expected actual + in + (name, `Quick, test_fun) + in + [ + make_test "no token" ~token:"" ~period:("", "") + ~expected: + (Error + (`Msg + {|Error performing GraphQL query on GitHub: 401 Unauthorized + {"message":"Bad credentials","documentation_url":"https://docs.github.com/graphql"}|})); + ] + +let activity_example = + {| +{ + "data": { + "viewer": { + "login": "gpetiot", + "contributionsCollection": { + "issueContributions": { + "nodes": [ + { + "occurredAt": "2024-03-04T11:55:37Z", + "issue": { + "url": "https://github.com/tarides/get-activity/issues/8", + "title": "Add the PR/issues comments to the result of okra generate", + "body": "xxx", + "repository": { + "nameWithOwner": "tarides/get-activity" + } + } + }, + { + "occurredAt": "2024-02-27T12:05:04Z", + "issue": { + "url": "https://github.com/tarides/okra/issues/165", + "title": "Make the `get-activity` package known to ocaml-ci", + "body": "xxx", + "repository": { + "nameWithOwner": "tarides/okra" + } + } + } + ] + }, + "pullRequestContributions": { + "nodes": [ + { + "occurredAt": "2024-03-05T11:21:22Z", + "pullRequest": { + "url": "https://github.com/ocaml-ppx/ocamlformat/pull/2533", + "title": "Represent the expr sequence as a list", + "body": "xxx", + "repository": { + "nameWithOwner": "ocaml-ppx/ocamlformat" + } + } + }, + { + "occurredAt": "2024-03-04T17:20:11Z", + "pullRequest": { + "url": "https://github.com/realworldocaml/mdx/pull/450", + "title": "Add an 'exec' label to execute include OCaml blocks", + "body": "xxx", + "repository": { + "nameWithOwner": "realworldocaml/mdx" + } + } + } + ] + }, + "pullRequestReviewContributions": { + "nodes": [ + { + "occurredAt": "2024-03-05T11:43:04Z", + "pullRequestReview": { + "url": "https://github.com/realworldocaml/mdx/pull/449#pullrequestreview-1916654244", + "pullRequest": { + "title": "Add upgrade instructions in the changelog for #446" + }, + "body": "xxx", + "state": "APPROVED", + "comments": { + "nodes": [] + }, + "repository": { + "nameWithOwner": "realworldocaml/mdx" + } + } + }, + { + "occurredAt": "2024-02-28T11:09:41Z", + "pullRequestReview": { + "url": "https://github.com/tarides/okra/pull/166#pullrequestreview-1905972361", + "pullRequest": { + "title": "Make README.md more precise" + }, + "body": "xxx", + "state": "APPROVED", + "comments": { + "nodes": [] + }, + "repository": { + "nameWithOwner": "tarides/okra" + } + } + } + ] + }, + "repositoryContributions": { + "nodes": [ + { + "occurredAt": "2024-03-02T09:40:41Z", + "repository": { + "url": "https://github.com/gpetiot/config.ml", + "nameWithOwner": "gpetiot/config.ml" + } + }, + { + "occurredAt": "2024-03-01T10:43:33Z", + "repository": { + "url": "https://github.com/gpetiot/js_of_ocaml", + "nameWithOwner": "gpetiot/js_of_ocaml" + } + } + ] + } + } + } + } +} +|} + +let activity_example_json = Yojson.Safe.from_string activity_example + +let contributions_example = + let open Contributions in + { + username = "gpetiot"; + activity = + Repo_map.empty + |> Repo_map.add "gpetiot/config.ml" + [ + { + repo = "gpetiot/config.ml"; + kind = `New_repo; + date = "2024-03-02T09:40:41Z"; + url = "https://github.com/gpetiot/config.ml"; + title = "Created new repository"; + body = ""; + }; + ] + |> Repo_map.add "gpetiot/js_of_ocaml" + [ + { + repo = "gpetiot/js_of_ocaml"; + kind = `New_repo; + date = "2024-03-01T10:43:33Z"; + url = "https://github.com/gpetiot/js_of_ocaml"; + title = "Created new repository"; + body = ""; + }; + ] + |> Repo_map.add "ocaml-ppx/ocamlformat" + [ + { + repo = "ocaml-ppx/ocamlformat"; + kind = `PR; + date = "2024-03-05T11:21:22Z"; + url = "https://github.com/ocaml-ppx/ocamlformat/pull/2533"; + title = "Represent the expr sequence as a list"; + body = "xxx"; + }; + ] + |> Repo_map.add "realworldocaml/mdx" + [ + { + repo = "realworldocaml/mdx"; + kind = `Review "APPROVED"; + date = "2024-03-05T11:43:04Z"; + url = + "https://github.com/realworldocaml/mdx/pull/449#pullrequestreview-1916654244"; + title = "Add upgrade instructions in the changelog for #446"; + body = "xxx"; + }; + { + repo = "realworldocaml/mdx"; + kind = `PR; + date = "2024-03-04T17:20:11Z"; + url = "https://github.com/realworldocaml/mdx/pull/450"; + title = "Add an 'exec' label to execute include OCaml blocks"; + body = "xxx"; + }; + ] + |> Repo_map.add "tarides/get-activity" + [ + { + repo = "tarides/get-activity"; + kind = `Issue; + date = "2024-03-04T11:55:37Z"; + url = "https://github.com/tarides/get-activity/issues/8"; + title = + "Add the PR/issues comments to the result of okra generate"; + body = "xxx"; + }; + ] + |> Repo_map.add "tarides/okra" + [ + { + repo = "tarides/okra"; + kind = `Review "APPROVED"; + date = "2024-02-28T11:09:41Z"; + url = + "https://github.com/tarides/okra/pull/166#pullrequestreview-1905972361"; + title = "Make README.md more precise"; + body = "xxx"; + }; + { + repo = "tarides/okra"; + kind = `Issue; + date = "2024-02-27T12:05:04Z"; + url = "https://github.com/tarides/okra/issues/165"; + title = "Make the `get-activity` package known to ocaml-ci"; + body = "xxx"; + }; + ]; + } + +let test_of_json = + let make_test name ~from json ~expected = + let name = Printf.sprintf "of_json: %s" name in + let test_fun () = + let actual = Contributions.of_json ~from json in + Alcotest.(check Testable.contributions) name expected actual + in + (name, `Quick, test_fun) + in + [ + make_test "no token" ~from:"" activity_example_json + ~expected:contributions_example; + ] + +let test_is_empty = + let make_test name ~input ~expected = + let name = Printf.sprintf "is_empty: %s" name in + let test_fun () = + let actual = Contributions.is_empty input in + Alcotest.(check bool) name expected actual + in + (name, `Quick, test_fun) + in + [ + make_test "empty" + ~input: + { Contributions.username = ""; activity = Contributions.Repo_map.empty } + ~expected:true; + make_test "not empty" ~input:contributions_example ~expected:false; + ] + +let test_pp = + let make_test name ~input ~expected = + let name = Printf.sprintf "pp: %s" name in + let test_fun () = + let actual = Format.asprintf "%a" Contributions.pp input in + Alcotest.(check string) name expected actual + in + (name, `Quick, test_fun) + in + [ + make_test "empty" + ~input: + { Contributions.username = ""; activity = Contributions.Repo_map.empty } + ~expected:"(no activity)"; + make_test "not empty" ~input:contributions_example + ~expected: + "### gpetiot/config.ml\n\ + Created repository \ + [gpetiot/config.ml](https://github.com/gpetiot/config.ml).\n\ + ### gpetiot/js_of_ocaml\n\ + Created repository \ + [gpetiot/js_of_ocaml](https://github.com/gpetiot/js_of_ocaml).\n\ + ### ocaml-ppx/ocamlformat\n\ + Represent the expr sequence as a list \ + [#2533](https://github.com/ocaml-ppx/ocamlformat/pull/2533). \n\ + xxx### realworldocaml/mdx\n\ + APPROVED Add upgrade instructions in the changelog for #446 \ + [#449](https://github.com/realworldocaml/mdx/pull/449#pullrequestreview-1916654244). \n\ + xxx\n\ + Add an 'exec' label to execute include OCaml blocks \ + [#450](https://github.com/realworldocaml/mdx/pull/450). \n\ + xxx### tarides/get-activity\n\ + Add the PR/issues comments to the result of okra generate \ + [#8](https://github.com/tarides/get-activity/issues/8). \n\ + xxx### tarides/okra\n\ + APPROVED Make README.md more precise \ + [#166](https://github.com/tarides/okra/pull/166#pullrequestreview-1905972361). \n\ + xxx\n\ + Make the `get-activity` package known to ocaml-ci \ + [#165](https://github.com/tarides/okra/issues/165). \n\ + xxx"; + ] + +let suite = + ("Contributions", test_fetch @ test_of_json @ test_is_empty @ test_pp) diff --git a/test/lib/test_graphql.ml b/test/lib/test_graphql.ml new file mode 100644 index 0000000..3d24067 --- /dev/null +++ b/test/lib/test_graphql.ml @@ -0,0 +1,23 @@ +open Get_activity + +let test_exec = + let make_test name ?variables ~token ~query ~expected () = + let name = Printf.sprintf "exec: %s" name in + let test_fun () = + let actual = Graphql.exec ?variables ~token ~query () in + Alcotest.(check Alcotest_ext.(lwt @@ or_msg yojson)) name expected actual + in + (name, `Quick, test_fun) + in + [ + make_test "no token" ~token:"" ~query:"" + ~expected: + (Lwt.return + (Error + (`Msg + {|Error performing GraphQL query on GitHub: 401 Unauthorized + {"message":"Bad credentials","documentation_url":"https://docs.github.com/graphql"}|}))) + (); + ] + +let suite = ("Graphql", test_exec) diff --git a/test/lib/test_period.ml b/test/lib/test_period.ml new file mode 100644 index 0000000..4814366 --- /dev/null +++ b/test/lib/test_period.ml @@ -0,0 +1,35 @@ +open Get_activity + +let test_one_week = + let make_test name ~expected = + let name = Printf.sprintf "one_week: %s" name in + let test_fun () = + let actual = Period.one_week in + Alcotest.(check (float 0.)) name expected actual + in + (name, `Quick, test_fun) + in + [ make_test "default" ~expected:604800. ] + +let test_to_8601 = + let make_test name ~input ~expected = + let name = Printf.sprintf "to_8601: %s" name in + let test_fun () = + let actual = Period.to_8601 input in + Alcotest.(check string) name expected actual + in + (name, `Quick, test_fun) + in + [ + make_test "zero" ~input:0. ~expected:"1970-01-01T00:00:00Z"; + make_test "negative" ~input:(-1.) ~expected:"1969-12-31T23:59:59Z"; + make_test "ten" ~input:10. ~expected:"1970-01-01T00:00:10Z"; + make_test "one million" ~input:1_000_000. ~expected:"1970-01-12T13:46:40Z"; + make_test "one billion" ~input:1_000_000_000. + ~expected:"2001-09-09T01:46:40Z"; + make_test "one trillion" ~input:1_000_000_000_000. + ~expected:"33658-09-27T01:46:40Z"; + ] + +let test_with_period = [] +let suite = ("Period", test_one_week @ test_to_8601 @ test_with_period) diff --git a/test/lib/test_token.ml b/test/lib/test_token.ml new file mode 100644 index 0000000..c339d75 --- /dev/null +++ b/test/lib/test_token.ml @@ -0,0 +1,25 @@ +open Get_activity + +let test_load = + let make_test name ~input ~expected = + let name = Printf.sprintf "load: %s" name in + let test_fun () = + let actual = Token.load input in + Alcotest.(check (Alcotest_ext.or_msg string)) name expected actual + in + (name, `Quick, test_fun) + in + let error_test name path = + let msg = + Format.sprintf + {|Can't open GitHub token file (%s: No such file or directory). +Go to https://github.com/settings/tokens to generate one.|} + path + in + make_test name ~input:path ~expected:(Error (`Msg msg)) + in + [ + error_test "empty" ""; error_test "invalid path" "invalid-path/invalid-path"; + ] + +let suite = ("Token", test_load)