Enable more compiler errors in non-lib code and fixup errors

gist/gist.ml

@@ -34,13 +34,12 @@ let pretty_json pretty = if pretty then very_pretty_json else quite_pretty_json
 
 module Passwd = struct
   open Lwt_react
-  open LTerm_style
 
   class read_password term = object(self)
     inherit LTerm_read_line.read_password () as super
     inherit [Zed_utf8.t] LTerm_read_line.term term
 
-    method send_action = function
+    method! send_action = function
       | LTerm_read_line.Break ->
           (* Ignore Ctrl+C *)
           ()
@@ -71,7 +70,7 @@ exception Gist_file_not_found of string
    We could query github for it instead. *)
 let get_auth_token_from_jar auth_id =
   Github_cookie_jar.init () >>= fun jar ->
-  Github_cookie_jar.(get jar auth_id) >>= function
+  Github_cookie_jar.(get jar ~name:auth_id) >>= function
   | Some x -> return x
   | None -> Lwt.fail (Auth_token_not_found "given id not in cookie jar")
 
@@ -151,7 +150,7 @@ let list_user_gists auth_id user pass token_name json pretty username =
 
 (************************************************************************)
 (* Post gists *)
-let post_gist auth_id user pass token_name json pretty new_gist_public new_gist_description files =
+let post_gist auth_id user pass token_name _json _pretty new_gist_public new_gist_description files =
   Lwt_main.run (
     get_auth auth_id user pass token_name >>= fun code ->
     let token = G.Token.of_auth code in
@@ -161,7 +160,11 @@ let post_gist auth_id user pass token_name json pretty new_gist_public new_gist_
       Lwt.return (fname, {Github_t.new_gist_content})
     in
     Lwt_list.map_s contents files >>= fun new_gist_files ->
-    let gist = Github_t.{ new_gist_files; new_gist_description; new_gist_public } in
+    let gist = {
+      Github_t.new_gist_files;
+      new_gist_description;
+      new_gist_public;
+    } in
     M.(run (Gist.create ~token ~gist () >|= G.Response.value)) >>= fun gist ->
     return (describe_gist gist)
   )
@@ -186,7 +189,7 @@ let string_of_opt =
   function Some x -> x
          | None -> ""
 
-let rec comma_sep x =
+let comma_sep x =
   List.fold_left
     (fun a x ->
       match a,x with
@@ -238,7 +241,7 @@ let gist_file_info auth_id user pass token_name json pretty gist_id file =
 (************************************************************************)
 (* gists files *)
 
-let gist_get auth_id user pass token_name json pretty gist_id file_or_dir =
+let gist_get _auth_id _user _pass _token_name _json _pretty _gist_id _file_or_dir =
   ()
 
 (************************************************************************)

gist/jbuild

@@ -2,7 +2,8 @@
 
 (executables
  ((libraries (cohttp.lwt github_unix cmdliner lambda-term))
-  (flags (:standard -w "@5@8@10@11@12@14@23@24@26@29"))
+  (flags (:standard -principal -strict-sequence -g
+                    -warn-error "+1..47-D+49" -w "A-E-41-42-44-48"))
   (public_names (git-gist))
   (package github-unix)
   (names (gist))))

jar/create_release.ml

@@ -18,7 +18,6 @@
 
 open Lwt
 open Cmdliner
-open Printf
 
 let create_release ~token
       ~user ~repo ~tag ~release_name ~target_commitish ~body:new_release_body
@@ -48,7 +47,7 @@ let create_release ~token
       Release.upload_asset
         ~token ~user ~repo ~id ~filename ~content_type ~body ()
       >|= Response.value
-    ))) >>= fun a ->
+    ))) >>= fun () ->
     return_unit) assets
 
 let run token user repo tag release_name target_commitish body assets

jar/jar_cli.ml

@@ -24,7 +24,7 @@ let auth cookie = Lwt.(
   Lwt_main.run (
     Github_cookie_jar.init ()
     >>= fun jar ->
-    Github_cookie_jar.get jar cookie
+    Github_cookie_jar.get jar ~name:cookie
     >|= function
     | None ->
       eprintf "Missing cookie: use git-jar to create cookie `%s`.\n%!" cookie;

jar/jbuild

@@ -3,7 +3,8 @@
 (executables
  ((libraries (cohttp.lwt github_unix cmdliner lambda-term))
   (package github-unix)
-  (flags (:standard -w "@5@8@10@11@12@14@23@24@26@29"))
+  (flags (:standard -principal -strict-sequence -g
+                    -warn-error "+1..47-D+49" -w "A-E-41-42-44-48"))
   (public_names
    (git-create-release
     git-sync-releases

jar/list_events.ml

@@ -72,11 +72,11 @@ let print_event event =
   | `CommitComment { commit_comment_event_comment = comment } ->
     printf "CommitComment on %s/%s %s\n%!"
       user repo comment.commit_comment_commit_id
-  | `Create { create_event_ref = `Repository } ->
+  | `Create { create_event_ref = `Repository; _ } ->
     printf "CreateEvent on repository %s/%s\n%!" user repo
-  | `Create { create_event_ref = `Branch branch } ->
+  | `Create { create_event_ref = `Branch branch; _ } ->
     printf "CreateEvent on branch %s/%s %s\n%!" user repo branch
-  | `Create { create_event_ref = `Tag tag } ->
+  | `Create { create_event_ref = `Tag tag; _ } ->
     printf "CreateEvent on tag %s/%s %s\n%!" user repo tag
   | `Delete { delete_event_ref = `Repository } ->
     printf "DeleteEvent on repository %s/%s\n%!" user repo
@@ -86,15 +86,16 @@ let print_event event =
     printf "DeleteEvent on tag %s/%s %s\n%!" user repo tag
   | `Download -> printf "DownloadEvent deprecated\n%!"
   | `Follow -> printf "FollowEvent deprecated\n%!"
-  | `Fork { fork_event_forkee = { repository_full_name } } ->
+  | `Fork { fork_event_forkee = { repository_full_name; _ } } ->
     printf "ForkEvent on %s/%s to %s\n%!" user repo repository_full_name
   | `ForkApply -> printf "ForkApplyEvent deprecated\n%!"
   | `Gist -> printf "GistEvent deprecated\n%!"
   | `Gollum { gollum_event_pages } ->
     printf "GollumEvent on %s/%s: %s\n%!" user repo
-      (String.concat ", " (List.map (fun { wiki_page_title; wiki_page_action } ->
-        (string_of_wiki_page_action wiki_page_action)^" "^wiki_page_title
-       ) gollum_event_pages))
+      (String.concat ", "
+         (List.map (fun { wiki_page_title; wiki_page_action; _ } ->
+            (string_of_wiki_page_action wiki_page_action)^" "^wiki_page_title
+          ) gollum_event_pages))
   | `IssueComment {
     issue_comment_event_action;
     issue_comment_event_issue = issue;
@@ -103,7 +104,7 @@ let print_event event =
     printf "IssueCommentEvent %s on %s: %s\n%!"
       (string_of_issue_comment_event_action issue_comment_event_action)
       (string_of_issue user repo issue) comment.issue_comment_body
-  | `Issues { issues_event_action = action; issues_event_issue = issue } ->
+  | `Issues { issues_event_action = action; issues_event_issue = issue; _ } ->
     printf "IssuesEvent on %s: %s\n%!"
       (string_of_issue user repo issue) (string_of_issues_action action)
   | `Member { member_event_action; member_event_member = member } ->
@@ -114,7 +115,7 @@ let print_event event =
     printf "PublicEvent on %s/%s\n%!" user repo
   | `PullRequest {
     pull_request_event_action = action;
-    pull_request_event_number;
+    pull_request_event_number; _
   } ->
     printf "PullRequestEvent on %s: %s\n%!"
       (string_of_pull user repo pull_request_event_number)
@@ -128,7 +129,7 @@ let print_event event =
       (string_of_pull_request_review_comment_action action)
       (string_of_pull user repo pull.pull_number)
       comment.pull_request_review_comment_body
-  | `Push { push_event_ref; push_event_size } ->
+  | `Push { push_event_ref; push_event_size; _ } ->
     printf "PushEvent on %s/%s ref %s of %d commits\n%!"
       user repo push_event_ref push_event_size
   | `Release { release_event_action; release_event_release } ->
@@ -138,13 +139,13 @@ let print_event event =
   | `Repository {
     repository_event_action;
     repository_event_repository = {
-      repository_full_name;
-    };
+      repository_full_name; _
+    }
   } ->
     printf "RepositoryEvent %s on %s\n%!"
       (Github_j.string_of_repository_action repository_event_action)
       repository_full_name
-  | `Status { status_event_state; status_event_sha } ->
+  | `Status { status_event_state; status_event_sha; _ } ->
     printf "StatusEvent on %s/%s: %s %s\n%!" user repo status_event_sha
       (string_of_status_state status_event_state)
   | `Watch { watch_event_action } ->

jar/list_issues.ml

@@ -15,7 +15,6 @@
  *
  *)
 
-open Lwt
 open Cmdliner
 open Printf
 
@@ -24,7 +23,7 @@ module T = Github_t
 let ask_github fn = Github.(Monad.run (fn ()))
 
 let string_of_labels labels =
-  let names = List.map (fun { T.label_name } -> label_name) labels in
+  let names = List.map (fun { T.label_name; _ } -> label_name) labels in
   String.concat ", " names
 
 let print_issue user repo issue =
@@ -36,6 +35,7 @@ let print_issue user repo issue =
     issue_state;
     issue_created_at;
     issue_closed_at;
+    _
   } = issue in
   printf "%s/%s#%d %s\n" user repo issue_number issue_title;
   printf "  Labels: %s\n" (string_of_labels issue_labels);
@@ -60,8 +60,10 @@ let list_issues token repos ~all ~closed ~prs ~issues =
       let issues_s = Issue.for_repo ~token ~state ~user ~repo () in
       Stream.to_list issues_s (* TODO: bound?!?! *)
       >>= fun list -> return (List.iter (fun i -> match i with
-        | { T.issue_pull_request=None } when issues -> print_issue user repo i
-        | { T.issue_pull_request=Some _ } when prs -> print_issue user repo i
+        | { T.issue_pull_request = None; _ } when issues ->
+          print_issue user repo i
+        | { T.issue_pull_request = Some _; _ } when prs ->
+          print_issue user repo i
         | _ -> ()
       ) list))))
   ) repos

jar/list_releases.ml

@@ -20,7 +20,7 @@ open Cmdliner
 open Printf
 
 let parse_iso8601_from_github t =
-  (** This parses just a subset of ISO8601 that GitHub returns:
+  (* This parses just a subset of ISO8601 that GitHub returns:
         e.g. 2014-02-21T13:39:04Z *)
   Scanf.sscanf t "%4d-%2d-%2dT%2d:%2d:%2dZ"
     (fun tm_year tm_mon tm_mday tm_hour tm_min tm_sec ->

jar/listen_events.ml

@@ -72,11 +72,11 @@ let print_event event =
   | `CommitComment { commit_comment_event_comment = comment } ->
     printf "CommitComment on %s/%s %s\n%!"
       user repo comment.commit_comment_commit_id
-  | `Create { create_event_ref = `Repository } ->
+  | `Create { create_event_ref = `Repository; _ } ->
     printf "CreateEvent on repository %s/%s\n%!" user repo
-  | `Create { create_event_ref = `Branch branch } ->
+  | `Create { create_event_ref = `Branch branch; _ } ->
     printf "CreateEvent on branch %s/%s %s\n%!" user repo branch
-  | `Create { create_event_ref = `Tag tag } ->
+  | `Create { create_event_ref = `Tag tag; _ } ->
     printf "CreateEvent on tag %s/%s %s\n%!" user repo tag
   | `Delete { delete_event_ref = `Repository } ->
     printf "DeleteEvent on repository %s/%s\n%!" user repo
@@ -86,15 +86,16 @@ let print_event event =
     printf "DeleteEvent on tag %s/%s %s\n%!" user repo tag
   | `Download -> printf "DownloadEvent deprecated\n%!"
   | `Follow -> printf "FollowEvent deprecated\n%!"
-  | `Fork { fork_event_forkee = { repository_full_name } } ->
+  | `Fork { fork_event_forkee = { repository_full_name; _ } } ->
     printf "ForkEvent on %s/%s to %s\n%!" user repo repository_full_name
   | `ForkApply -> printf "ForkApplyEvent deprecated\n%!"
   | `Gist -> printf "GistEvent deprecated\n%!"
   | `Gollum { gollum_event_pages } ->
     printf "GollumEvent on %s/%s: %s\n%!" user repo
-      (String.concat ", " (List.map (fun { wiki_page_title; wiki_page_action } ->
-        (string_of_wiki_page_action wiki_page_action)^" "^wiki_page_title
-       ) gollum_event_pages))
+      (String.concat ", "
+         (List.map (fun { wiki_page_title; wiki_page_action; _ } ->
+            (string_of_wiki_page_action wiki_page_action)^" "^wiki_page_title
+          ) gollum_event_pages))
   | `IssueComment {
     issue_comment_event_action;
     issue_comment_event_issue = issue;
@@ -103,7 +104,7 @@ let print_event event =
     printf "IssueCommentEvent %s on %s: %s\n%!"
       (string_of_issue_comment_event_action issue_comment_event_action)
       (string_of_issue user repo issue) comment.issue_comment_body
-  | `Issues { issues_event_action = action; issues_event_issue = issue } ->
+  | `Issues { issues_event_action = action; issues_event_issue = issue; _ } ->
     printf "IssuesEvent on %s: %s\n%!"
       (string_of_issue user repo issue) (string_of_issues_action action)
   | `Member { member_event_action; member_event_member = member } ->
@@ -114,7 +115,7 @@ let print_event event =
     printf "PublicEvent on %s/%s\n%!" user repo
   | `PullRequest {
     pull_request_event_action = action;
-    pull_request_event_number;
+    pull_request_event_number; _
   } ->
     printf "PullRequestEvent on %s: %s\n%!"
       (string_of_pull user repo pull_request_event_number)
@@ -128,7 +129,7 @@ let print_event event =
       (string_of_pull_request_review_comment_action action)
       (string_of_pull user repo pull.pull_number)
       comment.pull_request_review_comment_body
-  | `Push { push_event_ref; push_event_size } ->
+  | `Push { push_event_ref; push_event_size; _ } ->
     printf "PushEvent on %s/%s ref %s of %d commits\n%!"
       user repo push_event_ref push_event_size
   | `Release { release_event_action; release_event_release } ->
@@ -138,13 +139,13 @@ let print_event event =
   | `Repository {
     repository_event_action;
     repository_event_repository = {
-      repository_full_name;
+      repository_full_name; _
     };
   } ->
     printf "RepositoryEvent %s on %s\n%!"
       (Github_j.string_of_repository_action repository_event_action)
       repository_full_name
-  | `Status { status_event_state; status_event_sha } ->
+  | `Status { status_event_state; status_event_sha; _ } ->
     printf "StatusEvent on %s/%s: %s %s\n%!" user repo status_event_sha
       (string_of_status_state status_event_state)
   | `Watch { watch_event_action } ->

jar/passwd.ml

@@ -16,13 +16,12 @@
  *)
 open Lwt
 open Lwt_react
-open LTerm_style
 
 class read_password term = object(self)
   inherit LTerm_read_line.read_password () as super
   inherit [Zed_utf8.t] LTerm_read_line.term term
 
-  method send_action = function
+  method! send_action = function
     | LTerm_read_line.Break ->
         (* Ignore Ctrl+C *)
         ()

jar/search.ml

@@ -15,9 +15,7 @@
  *
  *)
 
-open Lwt
 open Cmdliner
-open Printf
 
 module T = Github_t
 
@@ -32,6 +30,7 @@ let print_repository ({
   repository_stargazers_count;
   repository_language;
   repository_html_url;
+  _
 }) =
   let language = match repository_language with
     | None -> ""
@@ -52,7 +51,8 @@ let search token ?language ?sort keywords =
     let results = Github.Search.repos ~token ?sort ~qualifiers ~keywords () in
     Stream.next results (* TODO: option for count? *)
     >>= function
-    | Some ({ T.repository_search_items; repository_search_total_count }, _) ->
+    | Some ({ T.repository_search_items;
+              repository_search_total_count; _ }, _) ->
       embed (Lwt_io.printf "%d results returned of %d total\n\n"
                (List.length repository_search_items)
                repository_search_total_count)

jar/sync_releases.ml

@@ -28,7 +28,7 @@ let sync_releases token src_user src_repo dst_user dst_repo =
   Github.(Monad.(run (
     let releases = Release.for_repo ~token ~user:dst_user ~repo:dst_repo () in
     Stream.to_list releases
-  ))) >>= fun dst ->
+  ))) >>= fun _dst ->
   Github.(Monad.(run (
     let releases = Repo.tags ~token ~user:src_user ~repo:src_repo () in
     Stream.to_list releases

jar/upload_release.ml

@@ -29,7 +29,7 @@ let upload_release token user repo tag content_type filename =
   print_endline (sprintf "uploading to release id %Ld" id);
   begin
     Lwt_io.file_length filename >|= Int64.to_int >>= fun len ->
-    let buf = String.create len in
+    let buf = Bytes.create len in
     Lwt_io.with_file ~mode:Lwt_io.input filename
       (fun ic -> Lwt_io.read_into_exactly ic buf 0 len)
     >>= fun () -> return buf

js/jbuild

@@ -4,5 +4,6 @@
  ((name github_jsoo)
   (public_name github-jsoo)
   (wrapped false)
-  (flags (:standard -w "@5@8@10@11@12@14@23@24@26@29"))
+  (flags (:standard -principal -strict-sequence -g
+                    -warn-error "+1..47-D+49" -w "A-E-41-42-44-48"))
   (libraries (github lwt js_of_ocaml cohttp.lwt-core cohttp.js))))

lib_test/jbuild

@@ -3,7 +3,8 @@
 (executables
  ((libraries (cohttp.lwt github_unix atdgen stringext))
   (package github-unix)
-  (flags (:standard -w "@5@8@10@11@12@14@23@24@26@29"))
+  (flags (:standard -principal -strict-sequence -g
+                    -warn-error "+1..47-D+49" -w "A-E-41-42-44-48"))
   (names
    (current_user
     rwo