├── bin ├── main.mli ├── config.mli ├── delegate_info.mli ├── check.mli ├── undraft.mli ├── dune ├── delegate_info.ml ├── help.mli ├── lint.mli ├── tag.mli ├── bistro.mli ├── publish.mli ├── distrib.mli ├── main.ml ├── lint.ml ├── check.ml ├── opam.mli ├── bistro.ml ├── cli.mli └── config.ml ├── tests ├── lib │ ├── test_pkg.mli │ ├── test_opam_file.mli │ ├── test_github_repo.mli │ ├── test_uri_helpers.mli │ ├── dune │ ├── alcotest_ext.mli │ ├── tests.ml │ ├── alcotest_ext.ml │ ├── test_uri_helpers.ml │ ├── test_vcs.ml │ ├── test_stdext.ml │ ├── test_sos.ml │ ├── create_release_response.ml │ ├── test_github.ml │ ├── test_opam_file.ml │ ├── upload_response.ml │ ├── test_github_repo.ml │ ├── test_text.ml │ ├── test_github_v4_api.ml │ └── test_pkg.ml └── bin │ ├── draft │ ├── dune │ └── run.t │ ├── tag │ ├── dune │ └── run.t │ ├── errors │ ├── dune │ └── run.t │ ├── no-doc │ ├── dune │ └── run.t │ ├── url-file │ ├── dune │ └── run.t │ ├── delegate-info │ ├── dune │ └── run.t │ ├── non-github-uri │ ├── dune │ └── run.t │ ├── tag-2-packages │ ├── dune │ └── run.t │ ├── x-commit-hash │ ├── dune │ └── run.t │ ├── include-submodules │ ├── dune │ └── run.t │ ├── non-github-doc-uri │ ├── dune │ └── run.t │ ├── version-from-tag │ ├── dune │ └── run.t │ ├── invalid-version-number │ ├── dune │ └── run.t │ ├── opam-pkg-distrib-file-opt │ ├── dune │ └── run.t │ ├── opam-pkg-distrib-multiple │ ├── dune │ └── run.t │ ├── opam-pkg-distrib-uri-opt │ ├── dune │ └── run.t │ ├── include-versioned-dotfiles │ ├── dune │ └── run.t │ ├── helpers │ ├── dune │ └── make_dune_release_deterministic.ml │ ├── check │ └── dune │ ├── distrib-name │ ├── dune │ └── run.t │ └── opam-file-locations │ ├── dune │ └── run.t ├── .ocp-indent ├── .ocamlformat ├── .gitignore ├── lib ├── curl.ml ├── curl.mli ├── dune ├── github_v4_api.mli ├── xdg.mli ├── opam_file.mli ├── lint.mli ├── version.ml ├── app_log.ml ├── github_repo.mli ├── opam_file.ml ├── xdg.ml ├── app_log.mli ├── json.mli ├── deprecate.mli ├── uri_helpers.mli ├── version.mli ├── json.ml ├── curl_option.ml ├── distrib.mli ├── distrib.ml ├── check.mli ├── deprecate.ml ├── prompt.mli ├── curl_option.mli ├── github_repo.ml ├── uri_helpers.ml ├── prompt.ml ├── github_v3_api.mli ├── archive.mli ├── stdext.mli ├── github.mli ├── stdext.ml ├── opam.mli ├── github_v4_api.ml ├── config.mli ├── text.mli ├── sos.mli ├── check.ml └── vcs.mli ├── Makefile ├── .github └── workflows │ ├── pr-number.yml │ └── changelog.yml ├── CODE_OF_CONDUCT.md ├── LICENSE ├── dune-project ├── dune-release.opam └── CONTRIBUTING.md /bin/main.mli: -------------------------------------------------------------------------------- 1 | (* empty *) 2 | -------------------------------------------------------------------------------- /bin/config.mli: -------------------------------------------------------------------------------- 1 | val cmd : int Cmdliner.Cmd.t 2 | -------------------------------------------------------------------------------- /bin/delegate_info.mli: -------------------------------------------------------------------------------- 1 | val cmd : int Cmdliner.Cmd.t 2 | -------------------------------------------------------------------------------- /tests/lib/test_pkg.mli: -------------------------------------------------------------------------------- 1 | val suite : unit Alcotest.test 2 | -------------------------------------------------------------------------------- /tests/bin/draft/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/tag/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/lib/test_opam_file.mli: -------------------------------------------------------------------------------- 1 | val suite : unit Alcotest.test 2 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never 2 | -------------------------------------------------------------------------------- /tests/bin/errors/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/no-doc/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/url-file/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/lib/test_github_repo.mli: -------------------------------------------------------------------------------- 1 | val suite : unit Alcotest.test 2 | -------------------------------------------------------------------------------- /tests/lib/test_uri_helpers.mli: -------------------------------------------------------------------------------- 1 | val suite : unit Alcotest.test 2 | -------------------------------------------------------------------------------- /tests/bin/delegate-info/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/non-github-uri/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/tag-2-packages/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/x-commit-hash/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/include-submodules/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/non-github-doc-uri/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/version-from-tag/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.22.4 2 | profile=conventional 3 | parse-docstrings=true 4 | -------------------------------------------------------------------------------- /bin/check.mli: -------------------------------------------------------------------------------- 1 | (** The [check] command. *) 2 | 3 | val cmd : int Cmdliner.Cmd.t 4 | -------------------------------------------------------------------------------- /tests/bin/invalid-version-number/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/opam-pkg-distrib-file-opt/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/opam-pkg-distrib-multiple/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /tests/bin/opam-pkg-distrib-uri-opt/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /bin/undraft.mli: -------------------------------------------------------------------------------- 1 | (** The [undraft] command. *) 2 | 3 | val cmd : int Cmdliner.Cmd.t 4 | -------------------------------------------------------------------------------- /tests/bin/include-versioned-dotfiles/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps %{bin:dune-release})) 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | .merlin 3 | *.install 4 | _build 5 | _opam 6 | .#* 7 | \#* 8 | .*.swp 9 | -------------------------------------------------------------------------------- /lib/curl.ml: -------------------------------------------------------------------------------- 1 | type t = { url : string; meth : Curly.Meth.t; args : Curl_option.t list } 2 | -------------------------------------------------------------------------------- /lib/curl.mli: -------------------------------------------------------------------------------- 1 | type t = { url : string; meth : Curly.Meth.t; args : Curl_option.t list } 2 | -------------------------------------------------------------------------------- /tests/bin/helpers/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name make_dune_release_deterministic) 3 | (libraries re)) 4 | -------------------------------------------------------------------------------- /tests/lib/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name tests) 3 | (libraries dune-release alcotest) 4 | (action 5 | (run %{test} -e))) 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean test 2 | 3 | all: 4 | dune build 5 | 6 | clean: 7 | dune clean 8 | 9 | test: 10 | dune runtest 11 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (public_name dune-release) 4 | (libraries dune-release re logs.fmt fmt.tty logs.cli fmt.cli)) 5 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dune_release) 3 | (public_name dune-release) 4 | (libraries fmt fpath bos curly opam-state rresult bos.setup yojson 5 | opam-file-format re)) 6 | -------------------------------------------------------------------------------- /tests/bin/check/dune: -------------------------------------------------------------------------------- 1 | (env 2 | (_ 3 | (binaries 4 | (../helpers/make_dune_release_deterministic.exe as 5 | make_dune_release_deterministic)))) 6 | 7 | (cram 8 | (deps %{bin:dune-release} %{bin:make_dune_release_deterministic})) 9 | -------------------------------------------------------------------------------- /tests/bin/distrib-name/dune: -------------------------------------------------------------------------------- 1 | (env 2 | (_ 3 | (binaries 4 | (../helpers/make_dune_release_deterministic.exe as 5 | make_dune_release_deterministic)))) 6 | 7 | (cram 8 | (deps %{bin:dune-release} %{bin:make_dune_release_deterministic})) 9 | -------------------------------------------------------------------------------- /tests/bin/opam-file-locations/dune: -------------------------------------------------------------------------------- 1 | (env 2 | (_ 3 | (binaries 4 | (../helpers/make_dune_release_deterministic.exe as 5 | make_dune_release_deterministic)))) 6 | 7 | (cram 8 | (deps %{bin:dune-release} %{bin:make_dune_release_deterministic})) 9 | -------------------------------------------------------------------------------- /.github/workflows/pr-number.yml: -------------------------------------------------------------------------------- 1 | name: PR number update 2 | 3 | on: [pull_request_target] 4 | 5 | jobs: 6 | PR-Number-Update: 7 | name: Update PR number 8 | runs-on: ubuntu-20.04 9 | steps: 10 | - uses: tarides/pr-number-action@v1.1 11 | -------------------------------------------------------------------------------- /tests/lib/alcotest_ext.mli: -------------------------------------------------------------------------------- 1 | open Alcotest 2 | open Bos_setup 3 | 4 | val path : Fpath.t testable 5 | val result_msg : 'a testable -> ('a, R.msg) result testable 6 | val tag : Dune_release.Vcs.Tag.t testable 7 | val changelog_version : Dune_release.Version.Changelog.t testable 8 | val curl : Dune_release.Curl.t testable 9 | -------------------------------------------------------------------------------- /.github/workflows/changelog.yml: -------------------------------------------------------------------------------- 1 | name: Changelog check 2 | 3 | on: 4 | pull_request: 5 | branches: [ main ] 6 | types: [ opened, synchronize, reopened, labeled, unlabeled ] 7 | 8 | jobs: 9 | Changelog-Entry-Check: 10 | name: Check Changelog Action 11 | runs-on: ubuntu-20.04 12 | steps: 13 | - uses: tarides/changelog-check-action@v1 14 | -------------------------------------------------------------------------------- /tests/lib/tests.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | Alcotest.run "dune-release" 3 | [ 4 | Test_github.suite; 5 | Test_github_v3_api.suite; 6 | Test_github_v4_api.suite; 7 | Test_opam_file.suite; 8 | Test_pkg.suite; 9 | Test_stdext.suite; 10 | Test_text.suite; 11 | Test_sos.suite; 12 | Test_vcs.suite; 13 | Test_uri_helpers.suite; 14 | Test_github_repo.suite; 15 | ] 16 | -------------------------------------------------------------------------------- /lib/github_v4_api.mli: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | val with_auth : token:string -> Curl.t -> Curl.t 4 | 5 | module Pull_request : sig 6 | module Request : sig 7 | val node_id : user:string -> repo:string -> id:int -> Curl.t 8 | val ready_for_review : node_id:string -> Curl.t 9 | end 10 | 11 | module Response : sig 12 | val node_id : Yojson.Basic.t -> (string, R.msg) result 13 | val url : Yojson.Basic.t -> (string, R.msg) result 14 | end 15 | end 16 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Code of Conduct 2 | 3 | This project has adopted the [OCaml Code of Conduct](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md). 4 | 5 | # Enforcement 6 | 7 | This project follows the OCaml Code of Conduct [enforcement policy](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md#enforcement). 8 | 9 | To report any violations, please contact: 10 | 11 | * Marek Kubica 12 | * Etienne Millon 13 | -------------------------------------------------------------------------------- /lib/xdg.mli: -------------------------------------------------------------------------------- 1 | (* From dune API. TODO: use the API directly once it's public. *) 2 | 3 | (** Implement the XDG specification 4 | http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html *) 5 | 6 | val config_dir : string 7 | (** The directory where the application should read/write config files. *) 8 | 9 | val data_dir : string 10 | (** The directory where the application should read/write data files. *) 11 | 12 | val cache_dir : string 13 | (** The directory where the application should read/write cached files. *) 14 | 15 | val home : string 16 | -------------------------------------------------------------------------------- /lib/opam_file.mli: -------------------------------------------------------------------------------- 1 | val upgrade : 2 | filename:OpamTypes.filename -> 3 | url:OpamFile.URL.t -> 4 | id:string -> 5 | version:[ `V1 of OpamFile.Descr.t | `V2 ] -> 6 | OpamFile.OPAM.t -> 7 | OpamFile.OPAM.t 8 | (** [upgrade ~filename ~url ~id ~version opam_t] produces the content of the 9 | opam file for the opam package, from the old [opam_t] content, migrating to 10 | the most supported format if needed (depending on [version]), setting the 11 | 'url' field with [url], setting the 'x-commit-hash' to [id], and stripping 12 | the 'version' and 'name' fields. *) 13 | -------------------------------------------------------------------------------- /lib/lint.mli: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | type t = [ `Std_files | `Opam ] 4 | (** The type for lints. *) 5 | 6 | val all : t list 7 | (** [all] is a list with all lint values. *) 8 | 9 | val lint_packages : 10 | dry_run:bool -> 11 | dir:Fpath.t -> 12 | todo:[ `Opam | `Std_files ] list -> 13 | Pkg.t -> 14 | string list -> 15 | (int, [ `Msg of string ]) result 16 | (** [lint_packages ~dry_run ~dir ~todo pkg pkg_names] performs the lint checks 17 | in [todo] on [pkg] located in [dir] for all opam files whose name is in 18 | [pkg_names], or - if [pkg_names] is empty - for all packages in [dir]. *) 19 | -------------------------------------------------------------------------------- /lib/version.ml: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | type t = string 4 | 5 | let drop_initial_v version = 6 | match String.head version with 7 | | Some ('v' | 'V') -> String.with_index_range ~first:1 version 8 | | None | Some _ -> version 9 | 10 | let from_tag ~keep_v vcs t = 11 | let s = Vcs.unescape_tag vcs t in 12 | if keep_v then s else drop_initial_v s 13 | 14 | let to_tag = Vcs.escape_tag 15 | let of_string x = x 16 | let pp = Fmt.string 17 | let to_string x = x 18 | 19 | module Changelog = struct 20 | type t = string 21 | type t' = string 22 | 23 | let of_string x = x 24 | let to_version ~keep_v x = if keep_v then x else drop_initial_v x 25 | let equal = String.equal 26 | let pp = Fmt.string 27 | let to_tag = Vcs.escape_tag 28 | end 29 | -------------------------------------------------------------------------------- /lib/app_log.ml: -------------------------------------------------------------------------------- 1 | let header style c fmt () = 2 | Fmt.string fmt "["; 3 | Fmt.(styled style (const char c)) fmt (); 4 | Fmt.string fmt "]" 5 | 6 | let app_log ?src pp_header f = 7 | Logs.app ?src (fun l -> 8 | f (fun ?header ?tags fmt -> l ?header ?tags ("%a " ^^ fmt) pp_header ())) 9 | 10 | let status ?src f = app_log ?src (header `Yellow '-') f 11 | let question ?src f = app_log ?src (header `Magenta '?') f 12 | let success ?src f = app_log ?src (header `Green '+') f 13 | let unhappy ?src f = app_log ?src (header `Red '!') f 14 | let blank_line () = Logs.app (fun l -> l "") 15 | 16 | let report_status status f = 17 | Logs.app (fun l -> 18 | f (fun ?header ?tags fmt -> 19 | l ?header ?tags ("%a " ^^ fmt) Text.Pp.status status)) 20 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Daniel C. Bünzli 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH 8 | REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY 9 | AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, 10 | INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM 11 | LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR 12 | OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 13 | PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /lib/github_repo.mli: -------------------------------------------------------------------------------- 1 | type t = { owner : string; repo : string } 2 | 3 | val equal : t -> t -> bool 4 | val pp : Format.formatter -> t -> unit 5 | 6 | val from_uri : string -> t option 7 | (** Parse a github URI into owner and repo. Return [None] if the given URI isn't 8 | a github one. *) 9 | 10 | val from_gh_pages : string -> (t * Fpath.t) option 11 | (** Parse a github pages URI of the form .github.io// 12 | into [({owner; repo}, extra_path)]. [extra_path] is [Fpath.v "."] if there 13 | is no such component in the URI. Return [None] if the URI isn't a gh-pages 14 | one. *) 15 | 16 | val https_uri : t -> string 17 | (** Returns the HTTPS URI, in string form for the given repo *) 18 | 19 | val ssh_uri : t -> string 20 | (** Returns the ["git@github"] SSH URI, in string form for the given repo *) 21 | -------------------------------------------------------------------------------- /lib/opam_file.ml: -------------------------------------------------------------------------------- 1 | let upgrade ~filename ~url ~id ~version opam_t = 2 | let commit_hash = 3 | { 4 | OpamParserTypes.FullPos.pelem = OpamParserTypes.FullPos.String id; 5 | pos = OpamTypesBase.pos_file filename; 6 | } 7 | in 8 | match version with 9 | | `V1 descr -> 10 | opam_t |> OpamFormatUpgrade.opam_file_from_1_2_to_2_0 11 | |> OpamFile.OPAM.with_url url 12 | |> OpamFile.OPAM.with_descr descr 13 | |> OpamFile.OPAM.with_version_opt None 14 | |> OpamFile.OPAM.with_name_opt None 15 | |> fun x -> OpamFile.OPAM.add_extension x "x-commit-hash" commit_hash 16 | | `V2 -> 17 | opam_t |> OpamFile.OPAM.with_url url 18 | |> OpamFile.OPAM.with_version_opt None 19 | |> OpamFile.OPAM.with_name_opt None 20 | |> fun x -> OpamFile.OPAM.add_extension x "x-commit-hash" commit_hash 21 | -------------------------------------------------------------------------------- /tests/lib/alcotest_ext.ml: -------------------------------------------------------------------------------- 1 | open Alcotest 2 | 3 | let path = testable Fpath.pp Fpath.equal 4 | 5 | let error_msg = 6 | testable Bos_setup.R.pp_msg (fun (`Msg e1) (`Msg e2) -> String.equal e1 e2) 7 | 8 | let result_msg testable = result testable error_msg 9 | 10 | module Tag = Dune_release.Vcs.Tag 11 | 12 | let tag = Alcotest.testable Tag.pp Tag.equal 13 | 14 | module Version = Dune_release.Version 15 | 16 | let changelog_version = 17 | Alcotest.testable Version.Changelog.pp Version.Changelog.equal 18 | 19 | let curl = 20 | let pp fs Dune_release.Curl.{ url; meth; args } = 21 | let args = Dune_release.Curl_option.to_string_list args in 22 | Format.fprintf fs "url = %S;@ " url; 23 | Format.fprintf fs "meth = %a@ " Curly.Meth.pp meth; 24 | Format.fprintf fs "args = %a@\n" (Fmt.list ~sep:Fmt.sp Fmt.string) args 25 | in 26 | testable pp ( = ) 27 | -------------------------------------------------------------------------------- /lib/xdg.ml: -------------------------------------------------------------------------------- 1 | (* From dune API. TODO: use the API directly once it's public. *) 2 | 3 | let home = 4 | try Sys.getenv "HOME" 5 | with Not_found -> ( 6 | try (Unix.getpwuid (Unix.getuid ())).Unix.pw_dir 7 | with Unix.Unix_error _ | Not_found -> 8 | if Sys.win32 then try Sys.getenv "AppData" with Not_found -> "" else "") 9 | 10 | let ( / ) = Filename.concat 11 | 12 | let get env_var unix_default win32_default = 13 | try Sys.getenv env_var 14 | with Not_found -> if Sys.win32 then win32_default else unix_default 15 | 16 | let cache_dir = 17 | get "XDG_CACHE_HOME" (home / ".cache") (home / "Local Settings" / "Cache") 18 | 19 | let config_dir = 20 | get "XDG_CONFIG_HOME" (home / ".config") (home / "Local Settings") 21 | 22 | let data_dir = 23 | get "XDG_DATA_HOME" 24 | (home / ".local" / "share") 25 | (try Sys.getenv "AppData" with Not_found -> "") 26 | -------------------------------------------------------------------------------- /bin/delegate_info.ml: -------------------------------------------------------------------------------- 1 | open Cmdliner 2 | open Dune_release 3 | 4 | let run var = 5 | let open Rresult in 6 | (let pkg = Pkg.v ~dry_run:false () in 7 | let result = 8 | match var with 9 | | "tarball" -> 10 | Pkg.distrib_archive_path pkg >>| fun distrib_file -> 11 | Format.printf "%a\n" Fpath.pp distrib_file 12 | | "docdir" -> Ok (Format.printf "%a\n" Fpath.pp Pkg.doc_dir) 13 | | "publication-message" -> 14 | Pkg.publish_msg pkg >>| fun msg -> Format.printf "%s\n" msg 15 | | _ -> Rresult.R.error_msgf "Unknown variable %S" var 16 | in 17 | result >>= fun () -> Ok 0) 18 | |> Cli.handle_error 19 | 20 | let var = 21 | let doc = "The variable to print." in 22 | Arg.(required & pos 0 (some string) None & info [] ~doc ~docv:"VAR") 23 | 24 | let term = Term.(const run $ var) 25 | 26 | let info = 27 | Cmd.info "delegate-info" ~doc:"Prints out the given variable to stdout" 28 | 29 | let cmd = Cmd.v info term 30 | -------------------------------------------------------------------------------- /lib/app_log.mli: -------------------------------------------------------------------------------- 1 | (** App level logs with distinct headers based on the nature of the message *) 2 | 3 | val status : ?src:Logs.src -> 'a Logs.log 4 | (** For informative messages about what's currently happening such as 5 | ["doing this"] *) 6 | 7 | val question : ?src:Logs.src -> 'a Logs.log 8 | (** For prompts *) 9 | 10 | val success : ?src:Logs.src -> 'a Logs.log 11 | (** To report successfully completed tasks *) 12 | 13 | val unhappy : ?src:Logs.src -> 'a Logs.log 14 | (** To report something that went wrong but isn't worth a warning *) 15 | 16 | val blank_line : unit -> unit 17 | (** Output an empty line *) 18 | 19 | (** Check logs *) 20 | 21 | val report_status : 22 | [ `Fail | `Ok ] -> 23 | ((?header:string -> 24 | ?tags:Logs.Tag.set -> 25 | ('a, Format.formatter, unit) format -> 26 | 'a) -> 27 | unit) -> 28 | unit 29 | (** To report one check of a list of checks. [report st f] is formatted as "\[ 30 | status\] more_information", where status and more_information are specified 31 | by st and f, respectively *) 32 | -------------------------------------------------------------------------------- /lib/json.mli: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | val from_string : string -> (Yojson.Basic.t, R.msg) result 4 | (** [from_string s] parses [s] and builds a Yojson.Basic.t type accordingly, or 5 | returns the associated error message if the input is not a valid JSON value. *) 6 | 7 | val string_field : field:string -> Yojson.Basic.t -> (string, R.msg) result 8 | (** [string_field ~field j] returns the value of field [field] from the JSON 9 | value [j] if it is a string, or returns the associated error message 10 | otherwise. *) 11 | 12 | val int_field : field:string -> Yojson.Basic.t -> (int, R.msg) result 13 | (** [int_field ~field j] returns the value of field [field] from the JSON value 14 | [j] if it is an integer, or returns the associated error message otherwise. *) 15 | 16 | val list_field : 17 | field:string -> Yojson.Basic.t -> (Yojson.Basic.t list, R.msg) result 18 | (** [list_field ~field j] returns the list of values of field [field] from the 19 | JSON value [j] if it is a list, or returns the associated error message 20 | otherwise. *) 21 | -------------------------------------------------------------------------------- /lib/deprecate.mli: -------------------------------------------------------------------------------- 1 | module Opam_1_x : sig 2 | val file_format_warning : string 3 | (** Message warning users that they need to upgrade their opam files from the 4 | 1.x to the 2.x format to be compatible with dune-release 2.0.0 *) 5 | 6 | val remove_me : _ 7 | (** Dummy value used to flag part of the code we should remove when dropping 8 | support for opam 1.x *) 9 | end 10 | 11 | module Config_user : sig 12 | val option_doc : string 13 | (** Documentation bit indicating the --user option is deprecated because it is 14 | redundant with the --remote-repo option. *) 15 | 16 | val option_use : string 17 | (** Message warning users they used the deprecated --user option and that they 18 | should use --remote-repo only. *) 19 | 20 | val config_field_doc : string 21 | (** Documentation bit indicating the user configuration field is deprecated 22 | because it is redundant with the remote field. *) 23 | 24 | val config_field_use : string 25 | (** Message warning users they are setting the deprecated user field of their 26 | configuration. *) 27 | end 28 | -------------------------------------------------------------------------------- /tests/bin/include-submodules/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ touch whatever.opam 13 | $ cat > dune-project << EOF 14 | > (lang dune 2.4) 15 | > (name whatever) 16 | > EOF 17 | $ cat > .gitignore << EOF 18 | > _build 19 | > run.t 20 | > EOF 21 | 22 | We need to set up a git project for dune-release to work properly 23 | 24 | $ git init > /dev/null 2>&1 25 | $ git config user.name "dune-release-test" 26 | $ git config user.email "pseudo@pseudo.invalid" 27 | $ git add CHANGES.md whatever.opam dune-project .gitignore 28 | $ git commit -m "Initial commit" > /dev/null 29 | $ dune-release tag -y > /dev/null 30 | 31 | Generating the tarball with `--include-submodules` should call `git submodule 32 | update --init` from within the tarball build dir: 33 | 34 | $ dune-release distrib --skip-lint --skip-build --skip-test --include-submodule --dry-run | grep -- "--init" 35 | -: exec: git --git-dir .git submodule update --init 36 | -------------------------------------------------------------------------------- /tests/bin/include-versioned-dotfiles/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ touch whatever.opam 13 | $ cat > dune-project << EOF 14 | > (lang dune 2.4) 15 | > (name whatever) 16 | > EOF 17 | $ cat > .gitignore << EOF 18 | > _build 19 | > dune 20 | > run.t 21 | > EOF 22 | 23 | We also need a dotfile that we will properly version 24 | 25 | $ echo "hello" > .somedotfile 26 | 27 | We need to set up a git project for dune-release to work properly 28 | 29 | $ git init > /dev/null 2>&1 30 | $ git config user.name "dune-release-test" 31 | $ git config user.email "pseudo@pseudo.invalid" 32 | $ git add CHANGES.md whatever.opam dune-project .somedotfile .gitignore 33 | $ git commit -m "Initial commit" > /dev/null 34 | $ dune-release tag -y > /dev/null 35 | 36 | The generated tarball should contain the dotfile 37 | 38 | $ dune-release distrib --skip-lint --skip-build --skip-test > /dev/null 39 | $ tar -xjf _build/whatever-0.1.0.tbz 40 | $ cat whatever-0.1.0/.somedotfile 41 | hello 42 | -------------------------------------------------------------------------------- /tests/bin/delegate-info/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ touch whatever.opam 13 | $ cat > dune-project << EOF 14 | > (lang dune 2.4) 15 | > (name whatever) 16 | > EOF 17 | 18 | We need to set up a git project for dune-release to work properly 19 | 20 | $ git init 2> /dev/null > /dev/null 21 | $ git config user.name "dune-release-test" 22 | $ git config user.email "pseudo@pseudo.invalid" 23 | $ git add CHANGES.md whatever.opam dune-project 24 | $ git commit -m "Initial commit" > /dev/null 25 | $ dune-release tag -y > /dev/null 26 | 27 | Dune-release delegate-info tarball should print the path to the tarball: 28 | 29 | $ dune-release delegate-info tarball 30 | _build/whatever-0.1.0.tbz 31 | 32 | Dune-release delegate-info docdir should print the path to the docdir: 33 | 34 | $ dune-release delegate-info docdir 35 | _build/default/_doc/_html 36 | 37 | Dune-release delegate-info publication-message should print the publication-message: 38 | 39 | $ dune-release delegate-info publication-message 40 | CHANGES: 41 | 42 | - Some other feature 43 | 44 | 45 | -------------------------------------------------------------------------------- /lib/uri_helpers.mli: -------------------------------------------------------------------------------- 1 | (** Helper functions to manipulate URIs as OCaml strings *) 2 | 3 | type uri = { scheme : string option; domain : string list; path : string list } 4 | (** Helper type describing the content of an URI to facilitate parsing. Scheme 5 | is None if no explicit scheme was specified. The domain is a non empty list 6 | in hierarchical order, e.g. [\["io"; "github"; "me"\]] for ["me.github.io"]. 7 | The path is [\[\]] if there was no path and a list of the path components, 8 | e.g. [\["some"; "path"\]] for ["domain.com/some/path"]. *) 9 | 10 | val pp_uri : Format.formatter -> uri -> unit 11 | val equal_uri : uri -> uri -> bool 12 | 13 | val parse : string -> uri option 14 | (** Parses an URI as a string. Returns [None] if the URI can't be properly 15 | parsed. The domain and path are determined based on the first ['/'] or [':'] 16 | separator to support either regular URIs or ["github.com:owner/..."] URIs. *) 17 | 18 | val get_sld : string -> string option 19 | (** Get the URI's second level domain, if it has one. *) 20 | 21 | val append_to_base : rel_path:string -> string -> string 22 | (** Append a relative path to a base URI. *) 23 | 24 | val chop_git_prefix : string -> string 25 | (** Chop the prefix [git+] from a URI, if any. *) 26 | -------------------------------------------------------------------------------- /lib/version.mli: -------------------------------------------------------------------------------- 1 | type t 2 | (** [t] represents the high-level version of a project *) 3 | 4 | val from_tag : keep_v:bool -> Vcs.t -> Vcs.Tag.t -> t 5 | (** Constructs a [t] from a [Vcs.Tag.t], possibly dropping the leading v. *) 6 | 7 | val to_tag : Vcs.t -> t -> Vcs.Tag.t 8 | (** Converts a project version into a valid tag for VCS. *) 9 | 10 | val of_string : string -> t 11 | (** [of_string s] reads a value as-is as the project version. *) 12 | 13 | val to_string : t -> string 14 | (** [to_string v] converts the project version into a string. *) 15 | 16 | val pp : t Fmt.t 17 | (** Pretty print a [t]. *) 18 | 19 | module Changelog : sig 20 | type t' 21 | 22 | type t 23 | (** [t] represents a project version read from the project changelog. *) 24 | 25 | val of_string : string -> t 26 | (** [of_string s] reads the changelog value from a string. *) 27 | 28 | val to_version : keep_v:bool -> t -> t' 29 | (** [to_version ~keep_v v] converts the changelog version into the actual 30 | project version. *) 31 | 32 | val equal : t -> t -> bool 33 | (** [equal a b] is [true] when [a] and [b] are equal. *) 34 | 35 | val pp : t Fmt.t 36 | (** Pretty print a [t]. *) 37 | 38 | val to_tag : Vcs.t -> t -> Vcs.Tag.t 39 | (** [to_tag vcs v] converts the change log version into a tag for VCS. *) 40 | end 41 | with type t' = t 42 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.7) 2 | (name dune-release) 3 | 4 | (cram enable) 5 | 6 | (generate_opam_files true) 7 | 8 | (source (github tarides/dune-release)) 9 | (license ISC) 10 | (authors 11 | "Daniel Bünzli" 12 | "Thomas Gazagnaire" 13 | "Nathan Rebours" 14 | "Guillaume Petiot" 15 | "Sonja Heinze") 16 | (maintainers "Nathan Rebours ") 17 | 18 | (package 19 | (name dune-release) 20 | (synopsis "Release dune packages in opam") 21 | (description 22 | "`dune-release` is a tool to streamline the release of Dune packages in 23 | [opam](https://opam.ocaml.org). It supports projects built 24 | with [Dune](https://github.com/ocaml/dune) and hosted on 25 | [GitHub](https://github.com).") 26 | (depends 27 | (ocaml (>= 4.08.0)) 28 | ;; two dependencies on dune to work around 29 | ;; https://github.com/ocaml/dune/issues/3431 30 | dune 31 | ;; the tests require dune 3.8 32 | (dune (and (>= 3.8) :with-test)) 33 | (curly (>= 0.3.0)) 34 | (fmt (>= 0.8.7)) 35 | (fpath (>= 0.7.3)) 36 | (bos (>= 0.1.3)) 37 | (cmdliner (>= 1.1.0)) 38 | (re (>= 1.7.2)) 39 | astring 40 | (opam-file-format (>= 2.1.2)) 41 | (opam-format (>= 2.1.0)) 42 | (opam-state (>= 2.1.0)) 43 | (opam-core (>= 2.1.0)) 44 | (rresult (>= 0.6.0)) 45 | logs 46 | odoc 47 | (alcotest :with-test) 48 | (yojson (>= 1.6))) 49 | (conflicts 50 | (result (< 1.5)))) 51 | -------------------------------------------------------------------------------- /lib/json.ml: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | let from_string str = 4 | match Yojson.Basic.from_string str with 5 | | exception Yojson.Json_error msg -> R.error_msg msg 6 | | json -> Ok json 7 | 8 | let string_field ~field json = 9 | match Yojson.Basic.Util.member field json with 10 | | exception _ -> 11 | R.error_msgf "Could not find %S from:@ %a" field Yojson.Basic.pp json 12 | | `Null -> 13 | R.error_msgf "Could not find %S from:@ %a" field Yojson.Basic.pp json 14 | | `String s -> R.ok s 15 | | _ -> R.error_msgf "Could not parse %S from:@ %a" field Yojson.Basic.pp json 16 | 17 | let int_field ~field json = 18 | match Yojson.Basic.Util.member field json with 19 | | exception _ -> 20 | R.error_msgf "Could not find %S from:@ %a" field Yojson.Basic.pp json 21 | | `Null -> 22 | R.error_msgf "Could not find %S from:@ %a" field Yojson.Basic.pp json 23 | | `Int i -> R.ok i 24 | | _ -> R.error_msgf "Could not parse %S from:@ %a" field Yojson.Basic.pp json 25 | 26 | let list_field ~field json = 27 | match Yojson.Basic.Util.member field json with 28 | | exception _ -> 29 | R.error_msgf "Could not find %S from:@ %a" field Yojson.Basic.pp json 30 | | `Null -> 31 | R.error_msgf "Could not find %S from:@ %a" field Yojson.Basic.pp json 32 | | `List l -> R.ok l 33 | | _ -> R.error_msgf "Could not parse %S from:@ %a" field Yojson.Basic.pp json 34 | -------------------------------------------------------------------------------- /bin/help.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** The [help] command. *) 8 | 9 | val cmd : int Cmdliner.Cmd.t 10 | 11 | (*--------------------------------------------------------------------------- 12 | Copyright (c) 2016 Daniel C. Bünzli 13 | 14 | Permission to use, copy, modify, and/or distribute this software for any 15 | purpose with or without fee is hereby granted, provided that the above 16 | copyright notice and this permission notice appear in all copies. 17 | 18 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 19 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 20 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 21 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 22 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 23 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 24 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 25 | ---------------------------------------------------------------------------*) 26 | -------------------------------------------------------------------------------- /bin/lint.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** The [lint] command. *) 8 | 9 | val cmd : int Cmdliner.Cmd.t 10 | 11 | (*--------------------------------------------------------------------------- 12 | Copyright (c) 2016 Daniel C. Bünzli 13 | 14 | Permission to use, copy, modify, and/or distribute this software for any 15 | purpose with or without fee is hereby granted, provided that the above 16 | copyright notice and this permission notice appear in all copies. 17 | 18 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 19 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 20 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 21 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 22 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 23 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 24 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 25 | ---------------------------------------------------------------------------*) 26 | -------------------------------------------------------------------------------- /bin/tag.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** The [tag] command. *) 8 | 9 | val cmd : int Cmdliner.Cmd.t 10 | 11 | (*--------------------------------------------------------------------------- 12 | Copyright (c) 2016 Daniel C. Bünzli 13 | 14 | Permission to use, copy, modify, and/or distribute this software for any 15 | purpose with or without fee is hereby granted, provided that the above 16 | copyright notice and this permission notice appear in all copies. 17 | 18 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 19 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 20 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 21 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 22 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 23 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 24 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 25 | ---------------------------------------------------------------------------*) 26 | -------------------------------------------------------------------------------- /lib/curl_option.ml: -------------------------------------------------------------------------------- 1 | open Astring 2 | 3 | type auth = { user : string; token : string } 4 | 5 | type t = 6 | | Location 7 | | User of auth 8 | | Silent 9 | | Show_error 10 | | Config of [ `Stdin | `File of string ] 11 | | Dump_header of [ `Ignore | `File of string ] 12 | | Data of [ `Data of string | `File of string ] 13 | | Data_binary of [ `Data of string | `File of string ] 14 | | Header of string 15 | 16 | let to_string_list opts = 17 | List.fold_left 18 | (fun acc -> function 19 | | Location -> "--location" :: acc 20 | | User { user; token } -> "--user" :: strf "%s:%s" user token :: acc 21 | | Silent -> "--silent" :: acc 22 | | Show_error -> "--show-error" :: acc 23 | | Config `Stdin -> "--config" :: "-" :: acc 24 | | Config (`File f) -> "--config" :: f :: acc 25 | | Dump_header `Ignore -> "--dump-header" :: "-" :: acc 26 | | Dump_header (`File f) -> "--dump-header" :: f :: acc 27 | | Data (`Data d) -> "--data" :: d :: acc 28 | (* Filenames should start with the letter [@]. *) 29 | | Data (`File f) -> "--data" :: strf "@@%s" f :: acc 30 | | Data_binary (`Data d) -> "--data-binary" :: d :: acc 31 | (* Filenames should start with the letter [@]. *) 32 | | Data_binary (`File f) -> "--data-binary" :: strf "@@%s" f :: acc 33 | | Header h -> "--header" :: h :: acc) 34 | [] (List.rev opts) 35 | -------------------------------------------------------------------------------- /tests/bin/opam-pkg-distrib-uri-opt/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ cat > whatever.opam << EOF 13 | > opam-version: "2.0" 14 | > EOF 15 | $ cat > dune-project << EOF 16 | > (lang dune 2.4) 17 | > (name whatever) 18 | > EOF 19 | 20 | We need to set up a git project for dune-release to work properly 21 | 22 | $ git init 2> /dev/null > /dev/null 23 | $ git config user.name "dune-release-test" 24 | $ git config user.email "pseudo@pseudo.invalid" 25 | $ git add CHANGES.md whatever.opam dune-project 26 | $ git commit -m "Initial commit" > /dev/null 27 | 28 | We also need a dummy distrib file to keep the test simple: 29 | 30 | $ mkdir _build 31 | $ touch _build/whatever-0.1.0.tbz 32 | 33 | And a url file as if we just successfully ran dune-release publish distrib: 34 | 35 | $ echo "https://some.fake.url/mytarball.tbz" > _build/whatever-0.1.0.url 36 | 37 | Running the following should use the --dist-uri url even if the .url file is present: 38 | 39 | $ dune-release opam pkg \ 40 | > --dist-uri "https://my.custom.url/mytarball.tbz" \ 41 | > --pkg-version 0.1.0 \ 42 | > > /dev/null 2>&1 43 | $ cat _build/whatever.0.1.0/opam | grep "mytarball.tbz" 44 | src: "https://my.custom.url/mytarball.tbz" 45 | -------------------------------------------------------------------------------- /tests/lib/test_uri_helpers.ml: -------------------------------------------------------------------------------- 1 | let uri = 2 | let open Dune_release.Uri_helpers in 3 | Alcotest.testable pp_uri equal_uri 4 | 5 | let test_parse = 6 | let make_test ~input ~expected = 7 | let name = Printf.sprintf "parse: %s" input in 8 | let test_fun () = 9 | let actual = Dune_release.Uri_helpers.parse input in 10 | Alcotest.(check (option uri)) name expected actual 11 | in 12 | (name, `Quick, test_fun) 13 | in 14 | [ 15 | make_test ~input:"scheme://domain.com/some/path" 16 | ~expected: 17 | (Some 18 | { 19 | scheme = Some "scheme"; 20 | domain = [ "com"; "domain" ]; 21 | path = [ "some"; "path" ]; 22 | }); 23 | make_test ~input:"noscheme.com/some/path" 24 | ~expected: 25 | (Some 26 | { 27 | scheme = None; 28 | domain = [ "com"; "noscheme" ]; 29 | path = [ "some"; "path" ]; 30 | }); 31 | make_test ~input:"nopath.com" 32 | ~expected: 33 | (Some { scheme = None; domain = [ "com"; "nopath" ]; path = [] }); 34 | make_test ~input:"git@github.com:some/path" 35 | ~expected: 36 | (Some 37 | { 38 | scheme = None; 39 | domain = [ "com"; "git@github" ]; 40 | path = [ "some"; "path" ]; 41 | }); 42 | ] 43 | 44 | let suite = ("Uri_helpers", test_parse) 45 | -------------------------------------------------------------------------------- /lib/distrib.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | val exclude_paths : Fpath.t list 8 | (** List of paths to exclude from the distribution tarball *) 9 | 10 | (*--------------------------------------------------------------------------- 11 | Copyright (c) 2016 Daniel C. Bünzli 12 | 13 | Permission to use, copy, modify, and/or distribute this software for any 14 | purpose with or without fee is hereby granted, provided that the above 15 | copyright notice and this permission notice appear in all copies. 16 | 17 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 18 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 19 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 20 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 21 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 22 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 23 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 24 | ---------------------------------------------------------------------------*) 25 | -------------------------------------------------------------------------------- /bin/bistro.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** The [bistro] command. *) 8 | 9 | val term : int Cmdliner.Term.t 10 | val cmd : int Cmdliner.Cmd.t 11 | 12 | (*--------------------------------------------------------------------------- 13 | Copyright (c) 2016 Daniel C. Bünzli 14 | 15 | Permission to use, copy, modify, and/or distribute this software for any 16 | purpose with or without fee is hereby granted, provided that the above 17 | copyright notice and this permission notice appear in all copies. 18 | 19 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 20 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 21 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 22 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 23 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 24 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 25 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 26 | ---------------------------------------------------------------------------*) 27 | -------------------------------------------------------------------------------- /lib/distrib.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | let default_exclude_paths = List.map Fpath.v [ ".git"; ".hg" ] 8 | let exclude_paths = default_exclude_paths 9 | 10 | (*--------------------------------------------------------------------------- 11 | Copyright (c) 2016 Daniel C. Bünzli 12 | 13 | Permission to use, copy, modify, and/or distribute this software for any 14 | purpose with or without fee is hereby granted, provided that the above 15 | copyright notice and this permission notice appear in all copies. 16 | 17 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 18 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 19 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 20 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 21 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 22 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 23 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 24 | ---------------------------------------------------------------------------*) 25 | -------------------------------------------------------------------------------- /lib/check.mli: -------------------------------------------------------------------------------- 1 | val dune_checks : 2 | dry_run:bool -> 3 | skip_build:bool -> 4 | skip_tests:bool -> 5 | pkg_names:string list -> 6 | Fpath.t -> 7 | (int, [ `Msg of string ]) result 8 | (** Checks if the packages in [dir] build and pass their tests. It returns an 9 | error if any of the checks couldn't be performed. Otherwise, it returns 10 | [Ok 0] if checking positive and [Ok 1] if checking negative. If [pkg_names] 11 | is not empty, it limits which packages get checked. If [skip_build] or 12 | [skip_tests] are [true], the correspondent checks are skipped. *) 13 | 14 | val check_project : 15 | pkg_names:string list -> 16 | skip_lint:bool -> 17 | skip_build:bool -> 18 | skip_tests:bool -> 19 | skip_change_log:bool -> 20 | ?tag:Vcs.Tag.t -> 21 | ?version:Version.t -> 22 | keep_v:bool -> 23 | ?build_dir:Fpath.t -> 24 | dir:Fpath.t -> 25 | unit -> 26 | (int, [ `Msg of string ]) result 27 | (** Checks 28 | 29 | - if the project in [dir] is compatible with dune-release \ 30 | - if the user is connected to internet \ 31 | - if the packages in [dir] can be built and pass their tests; tweakable by 32 | [skip_build] and [skip_tests]\ 33 | - if the packages in [dir] pass the linting; tweakable by [skip_linting]\ 34 | 35 | the arguments [pkg_names], [tag], [version], [keep_v], [build_dir] and [dir] 36 | are used to create a [Pkg.t] the same way it would be created running other 37 | dune-release commands. *) 38 | -------------------------------------------------------------------------------- /tests/bin/opam-pkg-distrib-file-opt/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ cat > whatever.opam << EOF 13 | > opam-version: "2.0" 14 | > EOF 15 | $ cat > dune-project << EOF 16 | > (lang dune 2.4) 17 | > (name whatever) 18 | > EOF 19 | 20 | We need to set up a git project for dune-release to work properly 21 | 22 | $ git init 2> /dev/null > /dev/null 23 | $ git config user.name "dune-release-test" 24 | $ git config user.email "pseudo@pseudo.invalid" 25 | $ git add CHANGES.md whatever.opam dune-project 26 | $ git commit -m "Initial commit" > /dev/null 27 | 28 | We want to use our custom distribution archive instead of the one dune-release would have 29 | generated: 30 | 31 | $ touch our-custom-distrib.tbz 32 | 33 | Running the following should not fail if the dune-release generated tarball 34 | (i.e. here _build/whatever-0.1.0.tbz) is not present: 35 | 36 | $ dune-release opam pkg \ 37 | > --dist-file ./our-custom-distrib.tbz \ 38 | > --dist-uri "https://my.custom.url/mytarball.tbz" \ 39 | > --pkg-version 0.1.0 40 | [-] Creating opam package description for whatever 41 | [+] Wrote opam package description _build/whatever.0.1.0/opam 42 | dune-release: [WARNING] The repo is dirty. The opam package may be 43 | inconsistent with the distribution. 44 | -------------------------------------------------------------------------------- /tests/bin/tag-2-packages/run.t: -------------------------------------------------------------------------------- 1 | Set up a project with two packaged libraries, no name in `dune-project`. 2 | 3 | $ mkdir liba libb 4 | $ cat > CHANGES.md << EOF 5 | > ## 0.42.0 6 | > 7 | > - Some other feature 8 | > 9 | > EOF 10 | $ echo "let f x = x" > liba/main.ml 11 | $ echo "(library (public_name liba))" > liba/dune 12 | $ echo "let f x = x" > libb/main.ml 13 | $ echo "(library (public_name libb))" > libb/dune 14 | $ touch liba.opam libb.opam 15 | $ echo "(lang dune 2.7)" > dune-project 16 | $ git init > /dev/null 2>&1 17 | $ git config user.name "dune-release-test" 18 | $ git config user.email "pseudo@pseudo.invalid" 19 | $ git add liba/* libb*/ CHANGES.md *.opam dune-project 20 | $ git commit -m 'Commit.' > /dev/null 21 | 22 | Expect an error message about the name in `dune-project`. 23 | 24 | $ dune-release tag -y 25 | dune-release: [ERROR] cannot determine distribution name automatically: add (name ) to dune-project 26 | [1] 27 | 28 | Use `(name )` in `dune-project` (not committed). 29 | 30 | $ cat > CHANGES.md << EOF 31 | > ## 0.44.0 32 | > 33 | > - Some other feature 34 | > 35 | > EOF 36 | $ git add CHANGES.md 37 | $ git commit -m '0.44' > /dev/null 38 | $ echo "(name titi)" >> dune-project 39 | 40 | Expect the tagging to work now: 41 | 42 | $ dune-release tag -y 43 | [-] Extracting tag from first entry in CHANGES.md 44 | [-] Using tag "0.44.0" 45 | [+] Tagged HEAD with version 0.44.0 46 | -------------------------------------------------------------------------------- /tests/lib/test_vcs.ml: -------------------------------------------------------------------------------- 1 | module Vcs = Dune_release.Vcs 2 | 3 | let make_test name ~input ~expected ~prefix ~f = 4 | let name = Printf.sprintf "%s: %s" prefix name in 5 | let test_fun () = Alcotest.(check string) name expected (f input) in 6 | (name, `Quick, test_fun) 7 | 8 | let test_git_escape_tag = 9 | let make_test name ~input ~expected = 10 | let name = Printf.sprintf "git_escape_tag: %s" name in 11 | let expected = Vcs.Tag.of_string expected in 12 | let test_fun () = 13 | Alcotest.(check Alcotest_ext.tag) name expected (Vcs.git_escape_tag input) 14 | in 15 | (name, `Quick, test_fun) 16 | in 17 | [ 18 | make_test "empty" ~input:"" ~expected:""; 19 | make_test "valid" ~input:"3.3.4" ~expected:"3.3.4"; 20 | make_test "tilde" ~input:"3.3.4~4.10preview1" ~expected:"3.3.4_4.10preview1"; 21 | ] 22 | 23 | let test_git_unescape_tag = 24 | let make_test name ~input ~expected = 25 | let name = Printf.sprintf "git_unescape_tag: %s" name in 26 | let input = Vcs.Tag.of_string input in 27 | let test_fun () = 28 | Alcotest.(check string) name expected (Vcs.git_unescape_tag input) 29 | in 30 | (name, `Quick, test_fun) 31 | in 32 | [ 33 | make_test "empty" ~input:"" ~expected:""; 34 | make_test "valid" ~input:"3.3.4" ~expected:"3.3.4"; 35 | make_test "tilde" ~input:"3.3.4_4.10preview1" ~expected:"3.3.4~4.10preview1"; 36 | ] 37 | 38 | let suite = ("Vcs", test_git_escape_tag @ test_git_unescape_tag) 39 | -------------------------------------------------------------------------------- /lib/deprecate.ml: -------------------------------------------------------------------------------- 1 | module Opam_1_x = struct 2 | let file_format_warning = 3 | "The opam file format 1.x is deprecated and its support will be dropped in \ 4 | dune-release 2.0.0, please switch to opam 2" 5 | 6 | let remove_me : _ = Obj.magic () 7 | end 8 | 9 | module Config_user = struct 10 | let option_doc = 11 | "This option is deprecated and will be removed in 2.0.0 as the user is \ 12 | redundant with the remote opam-repository fork from your configuration's \ 13 | $(b,remote) field or from the $(b,--remote-repo) option. Please use those \ 14 | instead." 15 | 16 | let option_use = 17 | "The --user option is deprecated and will be removed in 2.0.0 as the user \ 18 | is redundant with the remote opam-repository fork from your \ 19 | configuration's `remote` field or from the --remote-repo option. Please \ 20 | use those instead.\n\ 21 | Note that the user you provided will be ignored in favor of the above \ 22 | mentioned config field or command line option." 23 | 24 | let config_field_doc = 25 | "This configuration field is deprecated and will be removed in 2.0.0 as it \ 26 | is redundant with the $(b,remote) field. Its value will be ignored." 27 | 28 | let config_field_use = 29 | "The user configuration field is deprecated and will be removed in 2.0.0 \ 30 | as it is redundant with the remote field. Setting it to the wrong value \ 31 | can lead to bugs. Please use the remote field only." 32 | end 33 | -------------------------------------------------------------------------------- /lib/prompt.mli: -------------------------------------------------------------------------------- 1 | type answer = Yes | No 2 | 3 | val confirm : 4 | question:('a, unit) Logs.msgf -> yes:bool -> default_answer:answer -> bool 5 | (** Prompts the user for confirmation. [confirm ~question ~yes ~default_answer] 6 | uses the message formatting function [question] to format and log a message 7 | with the app level and wait for a yes or no answer from the user. Returns 8 | [true] for yes. Defaults to [default_answer] if the user just presses enter. 9 | If [yes], then it just skips the prompt and returns [true]. E.g. 10 | [confirm ~question:(fun l -> l "Do you want some %a?" Fmt.(styled `Bold 11 | string) "coffee")] *) 12 | 13 | val confirm_or_abort : 14 | question:('a, unit) Logs.msgf -> 15 | yes:bool -> 16 | default_answer:answer -> 17 | (unit, Rresult.R.msg) result 18 | (** Same as [confirm] but returns [Ok ()] for yes and 19 | [Error (`Msg "Aborting on user demand")] for no *) 20 | 21 | val try_again : 22 | ?limit:int -> 23 | question:('a, unit) Logs.msgf -> 24 | yes:bool -> 25 | default_answer:answer -> 26 | (unit -> ('b, Rresult.R.msg) result) -> 27 | ('b, Rresult.R.msg) result 28 | (** [try_again ?limit ~question ~yes ~default_answer f] prompts the user to try 29 | running [f] again if it failed, until [f] eventually succeeds or the user 30 | aborts the process by answering no or the maximum number of retries [limit] 31 | is reached (retries only once by default). *) 32 | 33 | val user_input : ?default_answer:string -> question:string -> unit -> string 34 | -------------------------------------------------------------------------------- /lib/curl_option.mli: -------------------------------------------------------------------------------- 1 | type auth = { user : string; token : string } 2 | 3 | type t = 4 | | Location 5 | (** If the server reports that the requested page has moved to a different 6 | location, this option will make curl redo the request on the new 7 | place. *) 8 | | User of auth 9 | (** Specify the user name and password for server authentication. *) 10 | | Silent 11 | (** Silent or quiet mode. Don't show progress meter or error messages. 12 | Makes Curl mute. It will still output the data you ask for, 13 | potentially even to the terminal/stdout unless you redirect it. *) 14 | | Show_error 15 | (** When used with -s, --silent, it makes curl show an error message if it 16 | fails. *) 17 | | Config of [ `Stdin | `File of string ] 18 | (** Specify a text file to read curl arguments from. The command line 19 | arguments found in the text file will be used as if they were provided 20 | on the command line. *) 21 | | Dump_header of [ `Ignore | `File of string ] 22 | (** Write the received protocol headers to the specified file. *) 23 | | Data of [ `Data of string | `File of string ] 24 | (** Sends the specified data in a POST request to the HTTP server. *) 25 | | Data_binary of [ `Data of string | `File of string ] 26 | (** This posts data exactly as specified with no extra processing 27 | whatsoever. *) 28 | | Header of string 29 | (** Extra header to include in the request when sending HTTP. *) 30 | 31 | val to_string_list : t list -> string list 32 | -------------------------------------------------------------------------------- /dune-release.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Release dune packages in opam" 4 | description: """ 5 | `dune-release` is a tool to streamline the release of Dune packages in 6 | [opam](https://opam.ocaml.org). It supports projects built 7 | with [Dune](https://github.com/ocaml/dune) and hosted on 8 | [GitHub](https://github.com).""" 9 | maintainer: ["Nathan Rebours "] 10 | authors: [ 11 | "Daniel Bünzli" 12 | "Thomas Gazagnaire" 13 | "Nathan Rebours" 14 | "Guillaume Petiot" 15 | "Sonja Heinze" 16 | ] 17 | license: "ISC" 18 | homepage: "https://github.com/tarides/dune-release" 19 | bug-reports: "https://github.com/tarides/dune-release/issues" 20 | depends: [ 21 | "ocaml" {>= "4.08.0"} 22 | "dune" {>= "2.7"} 23 | "dune" {>= "3.8" & with-test} 24 | "curly" {>= "0.3.0"} 25 | "fmt" {>= "0.8.7"} 26 | "fpath" {>= "0.7.3"} 27 | "bos" {>= "0.1.3"} 28 | "cmdliner" {>= "1.1.0"} 29 | "re" {>= "1.7.2"} 30 | "astring" 31 | "opam-file-format" {>= "2.1.2"} 32 | "opam-format" {>= "2.1.0"} 33 | "opam-state" {>= "2.1.0"} 34 | "opam-core" {>= "2.1.0"} 35 | "rresult" {>= "0.6.0"} 36 | "logs" 37 | "odoc" 38 | "alcotest" {with-test} 39 | "yojson" {>= "1.6"} 40 | ] 41 | conflicts: [ 42 | "result" {< "1.5"} 43 | ] 44 | build: [ 45 | ["dune" "subst"] {dev} 46 | [ 47 | "dune" 48 | "build" 49 | "-p" 50 | name 51 | "-j" 52 | jobs 53 | "@install" 54 | "@runtest" {with-test} 55 | "@doc" {with-doc} 56 | ] 57 | ] 58 | dev-repo: "git+https://github.com/tarides/dune-release.git" 59 | -------------------------------------------------------------------------------- /tests/lib/test_stdext.ml: -------------------------------------------------------------------------------- 1 | let is_backup_file () = 2 | let check ~input ~expected = 3 | let name = "Path.is_backup_file " ^ input in 4 | let actual = Dune_release.Stdext.Path.is_backup_file input in 5 | Alcotest.(check bool) name expected actual 6 | in 7 | check ~input:"" ~expected:false; 8 | check ~input:"fooooooooooooo" ~expected:false; 9 | check ~input:"fooooooooo#" ~expected:false; 10 | check ~input:"#fooooooooo#" ~expected:true; 11 | check ~input:"foooooooooooo~" ~expected:true 12 | 13 | let find_files () = 14 | let check ~name ~paths ~names_wo_ext ~expected = 15 | let paths = List.map Fpath.v paths in 16 | let expected = List.map Fpath.v expected in 17 | let actual = Dune_release.Stdext.Path.find_files ~names_wo_ext paths in 18 | let open Alcotest in 19 | let open Alcotest_ext in 20 | (check (list path)) name expected actual 21 | in 22 | check ~name:"Path.find_files no alternative" ~names_wo_ext:[] 23 | ~paths:[ "foo"; ".foo"; "foo~" ] ~expected:[]; 24 | check ~name:"Path.find_files empty" ~paths:[] ~names_wo_ext:[ "" ] 25 | ~expected:[]; 26 | check ~name:"Path.find_files does not contain" ~names_wo_ext:[ "foo" ] 27 | ~paths:[ "aaa"; "bbb"; "#foo#"; "foo~"; ".foo.md.swp" ] 28 | ~expected:[]; 29 | check ~name:"Path.find_files contains" ~names_wo_ext:[ "foo" ] 30 | ~paths:[ "aaa"; "bbb"; "#foo#"; "foo~"; ".foo.md.swp"; "foo"; "foo.ml" ] 31 | ~expected:[ "foo"; "foo.ml" ] 32 | 33 | let suite = 34 | ( "Stdext", 35 | [ 36 | ("Path.is_backup_file", `Quick, is_backup_file); 37 | ("Path.find_files", `Quick, find_files); 38 | ] ) 39 | -------------------------------------------------------------------------------- /tests/lib/test_sos.ml: -------------------------------------------------------------------------------- 1 | let cmd_error () = 2 | let check ~name ~cmd ~err_msg ~status ~expected () = 3 | let name = "cmd_error: " ^ name in 4 | match Dune_release.Sos.cmd_error cmd err_msg status with 5 | | Ok _ -> Alcotest.fail name (* Vcs.cmd_error always returns an Error *) 6 | | Error (`Msg e) -> Alcotest.(check string) name expected e 7 | in 8 | let cmd = 9 | Bos_setup.Cmd.( 10 | v "git" % "--git-dir" % ".git" % "--work-tree" % "." % "diff-index" 11 | % "--quiet" % "HEAD") 12 | in 13 | check ~name:"cmd exited" ~cmd ~err_msg:None ~status:(`Exited 2) 14 | ~expected: 15 | "The following command exited with code 2:\n\ 16 | \ git --git-dir .git --work-tree . diff-index --quiet HEAD" (); 17 | check ~name:"cmd signaled" ~cmd ~err_msg:None ~status:(`Signaled 3) 18 | ~expected: 19 | "The following command exited with signal 3:\n\ 20 | \ git --git-dir .git --work-tree . diff-index --quiet HEAD" (); 21 | check ~name:"cmd exited verbose" ~cmd 22 | ~err_msg:(Some "fatal: This is all made up\n") ~status:(`Exited 2) 23 | ~expected: 24 | "Exit code 2 from command\n\ 25 | \ `git --git-dir .git --work-tree . diff-index --quiet HEAD`:\n\ 26 | fatal: This is all made up\n" 27 | (); 28 | check ~name:"cmd signaled verbose" ~cmd 29 | ~err_msg:(Some "fatal: This is all made up\n") ~status:(`Signaled 3) 30 | ~expected: 31 | "Signal 3 from command \n\ 32 | \ `git --git-dir .git --work-tree . diff-index --quiet HEAD`:\n\ 33 | fatal: This is all made up\n" 34 | () 35 | 36 | let suite = ("Sos", [ ("cmd_error", `Quick, cmd_error) ]) 37 | -------------------------------------------------------------------------------- /tests/bin/errors/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ touch whatever.opam 13 | $ cat > dune-project << EOF 14 | > (lang dune 2.4) 15 | > (name whatever) 16 | > EOF 17 | 18 | We need to set up a git project for dune-release to work properly 19 | 20 | $ git init 2> /dev/null > /dev/null 21 | $ git config user.name "dune-release-test" 22 | $ git config user.email "pseudo@pseudo.invalid" 23 | $ git add CHANGES.md whatever.opam dune-project 24 | $ git commit -m "Initial commit" > /dev/null 25 | 26 | Let's provoke a one-line error 27 | 28 | $ dune-release delegate-info hi 29 | dune-release: [ERROR] Unknown variable "hi" 30 | [3] 31 | 32 | Let's provoke a multi-line error 33 | 34 | $ dune-release config hi 35 | dune-release: [ERROR] Invalid dune-release config invocation. Usage: 36 | dune-release config 37 | dune-release config show [KEY] 38 | dune-release config set KEY VALUE 39 | [3] 40 | 41 | Let's make `dune-release` run a `git`-command that's doomed to fail. After the customized error line, the error log should contain 42 | - the exit code/signal, 43 | - the external command that has failed, 44 | - the error message the external command has posted on its stderr. 45 | 46 | $ dune-release tag --commit=1 47 | [-] Extracting tag from first entry in CHANGES.md 48 | [-] Using tag "0.1.0" 49 | dune-release: [ERROR] Due to invalid commit-ish `1`: 50 | Exit code 128 from command 51 | `git --git-dir .git rev-parse --verify 1^0`: 52 | fatal: Needed a single revision 53 | 54 | [3] 55 | -------------------------------------------------------------------------------- /tests/bin/no-doc/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton with an empty doc field 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Change A 7 | > - Change B 8 | > 9 | > ## 0.0.0 10 | > 11 | > - Some feature 12 | > EOF 13 | $ cat > whatever.opam << EOF 14 | > opam-version: "2.0" 15 | > homepage: "https://github.com/foo/whatever" 16 | > dev-repo: "git+https://github.com/foo/whatever.git" 17 | > synopsis: "whatever" 18 | > EOF 19 | $ cat > whatever-lib.opam << EOF 20 | > opam-version: "2.0" 21 | > homepage: "https://github.com/foo/whatever" 22 | > dev-repo: "git+https://github.com/foo/whatever.git" 23 | > synopsis: "whatever-lib" 24 | > doc: "" 25 | > EOF 26 | $ touch README 27 | $ touch LICENSE 28 | $ cat > dune-project << EOF 29 | > (lang dune 2.4) 30 | > (name whatever) 31 | > EOF 32 | 33 | We need to set up a git project for dune-release to work properly 34 | 35 | $ git init > /dev/null 2>&1 36 | $ git config user.name "dune-release-test" 37 | $ git config user.email "pseudo@pseudo.invalid" 38 | $ git add CHANGES.md whatever.opam whatever-lib.opam dune-project README LICENSE 39 | $ git commit -m "Initial commit" > /dev/null 40 | $ dune-release tag -y > /dev/null 41 | 42 | Trying to publish the documentation explicitly should fail: 43 | 44 | $ dune-release publish doc -y --dry-run > /dev/null 45 | dune-release: [ERROR] directory contents _build/whatever-0.1.0: No such file or directory 46 | [3] 47 | 48 | By default it should skip the documentation generation: 49 | 50 | $ dune-release publish -y --dry-run | grep Skipping 51 | [-] Skipping documentation publication for package whatever: no doc field in whatever.opam 52 | -------------------------------------------------------------------------------- /tests/bin/draft/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ cat > whatever.opam << EOF 13 | > opam-version: "2.0" 14 | > homepage: "https://github.com/foo/whatever" 15 | > dev-repo: "git+https://github.com/foo/whatever.git" 16 | > description: "whatever" 17 | > EOF 18 | $ touch README 19 | $ touch LICENSE 20 | $ cat > dune-project << EOF 21 | > (lang dune 2.4) 22 | > (name whatever) 23 | > EOF 24 | 25 | We need to set up a git project for dune-release to work properly 26 | 27 | $ cat > .gitignore << EOF 28 | > _build 29 | > /dune 30 | > run.t 31 | > EOF 32 | $ git init > /dev/null 2>&1 33 | $ git config user.name "dune-release-test" 34 | $ git config user.email "pseudo@pseudo.invalid" 35 | $ git add CHANGES.md whatever.opam dune-project README LICENSE .gitignore 36 | $ git commit -m "Initial commit" > /dev/null 37 | $ dune-release tag -y > /dev/null 38 | 39 | We do the whole `dune-release` process but create a draft release on GitHub. 40 | 41 | (1) `distrib` as normal 42 | 43 | $ dune-release distrib --dry-run > /dev/null 44 | 45 | (2) `publish` when asking for the release to be created as a draft should 46 | create a draft release and submit it as such to GitHub. It should also write a 47 | `draft_release` file for `undraft`. 48 | 49 | $ dune-release publish --dry-run --yes --draft | grep draft 50 | [-] Creating draft release 0.1.0 on https://github.com/foo/whatever.git via github's API 51 | {"tag_name":"0.1.0","name":"0.1.0","body":"CHANGES:\n\n- Some other feature\n","draft":true} 52 | [+] Successfully created draft release with id 1 53 | -: write _build/whatever-0.1.0.draft_release 54 | -------------------------------------------------------------------------------- /tests/bin/x-commit-hash/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ cat > whatever.opam << EOF 13 | > opam-version: "2.0" 14 | > homepage: "https://github.com/foo/whatever" 15 | > dev-repo: "git+https://github.com/foo/whatever.git" 16 | > doc: "https://foo.github.io/whatever/" 17 | > synopsis: "whatever" 18 | > EOF 19 | $ touch README 20 | $ touch LICENSE 21 | $ cat > dune-project << EOF 22 | > (lang dune 2.4) 23 | > (name whatever) 24 | > EOF 25 | 26 | We need to set up a git project for dune-release to work properly 27 | 28 | $ cat > .gitignore << EOF 29 | > _build 30 | > /dune 31 | > run.t 32 | > EOF 33 | $ git init > /dev/null 2>&1 34 | $ git config user.name "dune-release-test" 35 | $ git config user.email "pseudo@pseudo.invalid" 36 | $ git add CHANGES.md whatever.opam dune-project README LICENSE .gitignore 37 | $ git commit -m "Initial commit" > /dev/null 38 | $ dune-release tag -y > /dev/null 39 | 40 | We make a dry-run release 41 | 42 | $ dune-release distrib --dry-run > /dev/null 43 | 44 | We create an opam package: 45 | 46 | $ dune-release opam pkg 47 | [-] Creating opam package description for whatever 48 | dune-release: [WARNING] Could not find _build/asset-0.1.0.url. 49 | dune-release: [WARNING] using https://github.com/foo/whatever/releases/download/0.1.0/whatever-0.1.0.tbz for as url.src. Note that it might differ from the one generated by Github 50 | [+] Wrote opam package description _build/whatever.0.1.0/opam 51 | 52 | We make sure that `x-commit-hash` has been set in the OPAM file: 53 | 54 | $ cat _build/whatever.0.1.0/opam | grep -o ^x-commit-hash: 55 | x-commit-hash: 56 | -------------------------------------------------------------------------------- /tests/bin/opam-pkg-distrib-multiple/run.t: -------------------------------------------------------------------------------- 1 | Set up a project with two opam packages 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ cat > whatever.opam << EOF 13 | > opam-version: "2.0" 14 | > dev-repo: "git+https://github.com/user/whatever.git" 15 | > homepage: "https://github.com/user/whatever" 16 | > synopsis: "Whatever" 17 | > EOF 18 | $ cat > whatever-sub.opam << EOF 19 | > opam-version: "2.0" 20 | > dev-repo: "git+https://github.com/user/whatever.git" 21 | > homepage: "https://github.com/user/whatever" 22 | > synopsis: "Whatever" 23 | > EOF 24 | $ cat > dune-project << EOF 25 | > (lang dune 2.4) 26 | > (name whatever) 27 | > EOF 28 | $ cat > .gitignore << EOF 29 | > run.t 30 | > _build 31 | > EOF 32 | 33 | Set up a git project for dune-release to work properly 34 | 35 | $ git init 2> /dev/null > /dev/null 36 | $ git config user.name "dune-release-test" 37 | $ git config user.email "pseudo@pseudo.invalid" 38 | $ git add CHANGES.md whatever.opam whatever-sub.opam dune-project .gitignore 39 | $ git commit -m "Initial commit" > /dev/null 40 | 41 | Do the release and create a tarball 42 | 43 | $ dune-release tag -y v0.1.0 > /dev/null 44 | $ dune-release distrib --dry-run > /dev/null 45 | [1] 46 | 47 | To avoid having to interact with the outside world, we set the URL of the asset 48 | manually 49 | 50 | $ echo "https://some.fake.url/mytarball.tbz" > _build/asset-0.1.0.url 51 | 52 | Generating the OPAM files should pick up the right URL for both OPAM files: 53 | 54 | $ dune-release opam pkg > /dev/null 55 | $ cat _build/whatever.0.1.0/opam | grep 'src:' 56 | src: "https://some.fake.url/mytarball.tbz" 57 | $ cat _build/whatever-sub.0.1.0/opam | grep 'src:' 58 | src: "https://some.fake.url/mytarball.tbz" 59 | -------------------------------------------------------------------------------- /tests/bin/non-github-uri/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | 13 | $ touch README 14 | $ touch LICENSE 15 | $ cat > dune-project << EOF 16 | > (lang dune 2.4) 17 | > (name whatever) 18 | > EOF 19 | 20 | Here we want the opam file not to point to github 21 | 22 | $ cat > whatever.opam << EOF 23 | > opam-version: "2.0" 24 | > homepage: "https://whatever.io" 25 | > dev-repo: "git+https://whatever.io/dev/whatever.git" 26 | > synopsis: "whatever" 27 | > EOF 28 | 29 | We need to set up a git project for dune-release to work properly 30 | 31 | $ cat > .gitignore << EOF 32 | > _build 33 | > /dune 34 | > run.t 35 | > EOF 36 | $ git init 2> /dev/null > /dev/null 37 | $ git config user.name "dune-release-test" 38 | $ git config user.email "pseudo@pseudo.invalid" 39 | $ git add CHANGES.md whatever.opam dune-project README LICENSE .gitignore 40 | $ git commit -m "Initial commit" > /dev/null 41 | $ dune-release tag -y 42 | [-] Extracting tag from first entry in CHANGES.md 43 | [-] Using tag "0.1.0" 44 | [+] Tagged HEAD with version 0.1.0 45 | 46 | Since the repo is not hosted on github, attempting to publish the distribution 47 | archive should fail as only publishing to github is supported. 48 | 49 | (1) distrib 50 | 51 | $ dune-release distrib --dry-run 2>&1 | grep -E "FAIL|ERROR" 52 | [FAIL] opam fields homepage and dev-repo can be parsed by dune-release 53 | dune-release: [ERROR] Github development repository URL could not be inferred 54 | [FAIL] lint of _build/whatever-0.1.0 and package whatever failure: 1 errors. 55 | 56 | (2) publish distrib 57 | 58 | $ dune-release publish distrib --dry-run > /dev/null 59 | dune-release: [ERROR] Github development repository URL could not be inferred from opam files. 60 | [3] 61 | -------------------------------------------------------------------------------- /tests/bin/non-github-doc-uri/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ touch README 13 | $ touch LICENSE 14 | $ cat > dune-project << EOF 15 | > (lang dune 2.4) 16 | > (name whatever) 17 | > EOF 18 | 19 | Here we want the opam file doc not to point to github 20 | 21 | $ cat > whatever.opam << EOF 22 | > opam-version: "2.0" 23 | > homepage: "https://whatever.io" 24 | > dev-repo: "git+https://whatever.io/dev/whatever.git" 25 | > doc: "https://whatever.io/doc/main.html" 26 | > synopsis: "whatever" 27 | > EOF 28 | 29 | We need to set up a git project for dune-release to work properly 30 | 31 | $ cat > .gitignore << EOF 32 | > /dune 33 | > run.t 34 | > EOF 35 | $ git init > /dev/null 2>&1 36 | $ git config user.name "dune-release-test" 37 | $ git config user.email "pseudo@pseudo.invalid" 38 | $ git add CHANGES.md whatever.opam dune-project README LICENSE .gitignore 39 | $ git commit -m "Initial commit" > /dev/null 40 | $ dune-release tag -y > /dev/null 41 | 42 | When trying to publish the documentation, it should fail as it cannot find 43 | a github URI to publish the documentation to. 44 | 45 | (1) distrib 46 | 47 | $ dune-release distrib --dry-run 2>&1 | grep -E "FAIL|ERROR" 48 | [FAIL] opam fields homepage and dev-repo can be parsed by dune-release 49 | dune-release: [ERROR] Github development repository URL could not be inferred 50 | [FAIL] opam field doc cannot be parsed by dune-release 51 | [FAIL] lint of _build/whatever-0.1.0 and package whatever failure: 1 errors. 52 | 53 | (2) publish doc 54 | 55 | $ dune-release publish doc --dry-run > /dev/null 56 | dune-release: [ERROR] Could not derive publication directory $PATH from opam doc field value "https://whatever.io/doc/main.html"; expected the pattern $SCHEME://$USER.github.io/$REPO/$PATH 57 | [3] 58 | -------------------------------------------------------------------------------- /tests/lib/create_release_response.ml: -------------------------------------------------------------------------------- 1 | let gh_v3_api_example = 2 | {| 3 | { 4 | "url": "https://api.github.com/repos/octocat/Hello-World/releases/1", 5 | "html_url": "https://github.com/octocat/Hello-World/releases/v1.0.0", 6 | "assets_url": "https://api.github.com/repos/octocat/Hello-World/releases/1/assets", 7 | "upload_url": "https://uploads.github.com/repos/octocat/Hello-World/releases/1/assets{?name,label}", 8 | "tarball_url": "https://api.github.com/repos/octocat/Hello-World/tarball/v1.0.0", 9 | "zipball_url": "https://api.github.com/repos/octocat/Hello-World/zipball/v1.0.0", 10 | "id": 1, 11 | "node_id": "MDc6UmVsZWFzZTE=", 12 | "tag_name": "v1.0.0", 13 | "target_commitish": "master", 14 | "name": "v1.0.0", 15 | "body": "Description of the release", 16 | "draft": false, 17 | "prerelease": false, 18 | "created_at": "2013-02-27T19:35:32Z", 19 | "published_at": "2013-02-27T19:35:32Z", 20 | "author": { 21 | "login": "octocat", 22 | "id": 1, 23 | "node_id": "MDQ6VXNlcjE=", 24 | "avatar_url": "https://github.com/images/error/octocat_happy.gif", 25 | "gravatar_id": "", 26 | "url": "https://api.github.com/users/octocat", 27 | "html_url": "https://github.com/octocat", 28 | "followers_url": "https://api.github.com/users/octocat/followers", 29 | "following_url": "https://api.github.com/users/octocat/following{/other_user}", 30 | "gists_url": "https://api.github.com/users/octocat/gists{/gist_id}", 31 | "starred_url": "https://api.github.com/users/octocat/starred{/owner}{/repo}", 32 | "subscriptions_url": "https://api.github.com/users/octocat/subscriptions", 33 | "organizations_url": "https://api.github.com/users/octocat/orgs", 34 | "repos_url": "https://api.github.com/users/octocat/repos", 35 | "events_url": "https://api.github.com/users/octocat/events{/privacy}", 36 | "received_events_url": "https://api.github.com/users/octocat/received_events", 37 | "type": "User", 38 | "site_admin": false 39 | }, 40 | "assets": [ 41 | 42 | ] 43 | } 44 | |} 45 | -------------------------------------------------------------------------------- /lib/github_repo.ml: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | type t = { owner : string; repo : string } 4 | 5 | let equal t t' = 6 | let { owner; repo } = t in 7 | let { owner = owner'; repo = repo' } = t' in 8 | String.equal owner owner' && String.equal repo repo' 9 | 10 | let pp fmt { owner; repo } = 11 | Format.fprintf fmt "@[{ owner = %S;@ repo = %S }@]" owner repo 12 | 13 | let drop_git_ext repo = 14 | let affix = ".git" in 15 | if String.is_suffix ~affix repo then 16 | let len = String.length repo - String.length affix in 17 | StringLabels.sub ~pos:0 ~len repo 18 | else repo 19 | 20 | let from_uri uri = 21 | let uri = Uri_helpers.parse uri in 22 | match uri with 23 | | Some 24 | { 25 | scheme = Some ("git+https" | "https") | None; 26 | domain = [ "com"; "github" ]; 27 | path = [ owner; repo ]; 28 | } 29 | | Some 30 | { 31 | scheme = Some "https" | None; 32 | domain = [ "io"; "github"; owner ]; 33 | path = repo :: _; 34 | } 35 | | Some 36 | { 37 | scheme = Some ("git+ssh" | "ssh") | None; 38 | domain = [ "com"; "git@github" ]; 39 | path = [ owner; repo ]; 40 | } -> 41 | let repo = drop_git_ext repo in 42 | Some { owner; repo } 43 | | _ -> None 44 | 45 | let fpath_of_list l = 46 | let rec aux acc l = 47 | match l with [] | [ "" ] -> acc | hd :: tl -> aux Fpath.(acc / hd) tl 48 | in 49 | match l with [] | [ "" ] -> Fpath.v "." | hd :: tl -> aux (Fpath.v hd) tl 50 | 51 | let from_gh_pages uri = 52 | let uri = Uri_helpers.parse uri in 53 | match uri with 54 | | Some 55 | { 56 | scheme = Some "https" | None; 57 | domain = [ "io"; "github"; owner ]; 58 | path = repo :: rest; 59 | } -> 60 | Some ({ owner; repo }, fpath_of_list rest) 61 | | _ -> None 62 | 63 | let https_uri { owner; repo } = 64 | Printf.sprintf "https://github.com/%s/%s" owner repo 65 | 66 | let ssh_uri { owner; repo } = 67 | Printf.sprintf "git@github.com:%s/%s.git" owner repo 68 | -------------------------------------------------------------------------------- /tests/lib/test_github.ml: -------------------------------------------------------------------------------- 1 | let test_ssh_uri_from_http = 2 | let check inp expected = 3 | let test_name = "Parse.ssh_uri_from_http " ^ inp in 4 | let result = Dune_release.Github.Parse.ssh_uri_from_http inp in 5 | let test_fun () = Alcotest.(check (option string)) inp expected result in 6 | (test_name, `Quick, test_fun) 7 | in 8 | [ 9 | (* Use cases *) 10 | check "https://github.com/tarides/dune-release" 11 | (Some "git@github.com:tarides/dune-release"); 12 | check "git@github.com:tarides/dune-release" 13 | (Some "git@github.com:tarides/dune-release"); 14 | (* This function only works for github https urls, returns its input 15 | otherwise *) 16 | check "https://not-github.com/dune-release" None; 17 | check "git@not-github.com:dune-release" None; 18 | check "git://github.com/user/repo.git" (Some "git@github.com:user/repo.git"); 19 | check "git+https://github.com/user/repo.git" None; 20 | ] 21 | 22 | let test_pr_title = 23 | let check test_name ~project_name ~names ?selected ~expected () = 24 | let version = Dune_release.Version.of_string "1.2.3" in 25 | let pkgs_to_submit = 26 | match selected with None -> [] | Some selected -> selected 27 | in 28 | let got = 29 | Dune_release.Github.pr_title ~names ~version ~project_name ~pkgs_to_submit 30 | in 31 | let test_fun () = Alcotest.(check string) __LOC__ expected got in 32 | (test_name, `Quick, test_fun) 33 | in 34 | [ 35 | check "No project name" ~project_name:None ~names:[ "a"; "b"; "c" ] 36 | ~expected:"[new release] a, b and c (1.2.3)" (); 37 | check "With project name" ~project_name:(Some "b") ~names:[ "a"; "b"; "c" ] 38 | ~expected:"[new release] b (3 packages) (1.2.3)" (); 39 | check "1 package with project name" ~project_name:(Some "a") ~names:[ "a" ] 40 | ~expected:"[new release] a (1.2.3)" (); 41 | check "Multiple packages, just some selected" ~project_name:(Some "a") 42 | ~names:[ "a"; "b"; "c" ] ~selected:[ "a"; "b" ] 43 | ~expected:"[new release] a and b (1.2.3)" (); 44 | ] 45 | 46 | let suite = ("Github", test_ssh_uri_from_http @ test_pr_title) 47 | -------------------------------------------------------------------------------- /tests/bin/url-file/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ cat > whatever.opam << EOF 13 | > opam-version: "2.0" 14 | > homepage: "https://github.com/foo/whatever" 15 | > dev-repo: "git+https://github.com/foo/whatever.git" 16 | > synopsis: "whatever" 17 | > EOF 18 | $ touch README 19 | $ touch LICENSE 20 | $ cat > dune-project << EOF 21 | > (lang dune 2.4) 22 | > (name whatever) 23 | > EOF 24 | 25 | We need to set up a git project for dune-release to work properly 26 | 27 | $ cat > .gitignore << EOF 28 | > _build 29 | > /dune 30 | > run.t 31 | > EOF 32 | $ git init > /dev/null 2>&1 33 | $ git config user.name "dune-release-test" 34 | $ git config user.email "pseudo@pseudo.invalid" 35 | $ git add CHANGES.md whatever.opam dune-project README LICENSE .gitignore 36 | $ git commit -m "Initial commit" > /dev/null 37 | $ dune-release tag -y > /dev/null 38 | 39 | We make a dry-run release and check that the opam file is correct: 40 | 41 | (1) Creating the distribution archive 42 | 43 | $ dune-release distrib --dry-run > /dev/null 44 | 45 | (2) Publishing the distribution 46 | 47 | $ dune-release publish --dry-run --yes > /dev/null 48 | 49 | (3) Creating an opam package with a pre-set URL (since we did not upload to GitHub) 50 | 51 | $ echo "https://foo.fr/archive/foo/foo.tbz" > _build/asset-0.1.0.url 52 | $ dune-release opam pkg 53 | [-] Creating opam package description for whatever 54 | [+] Wrote opam package description _build/whatever.0.1.0/opam 55 | 56 | (4) Check that the OPAM file contains the right data 57 | 58 | $ cat _build/whatever.0.1.0/opam | sed -e 's/\(x-commit-hash:\) "[0-9a-f]*"/\1 "1abe11ed"/' | sed -n '1h;1!H;${g;s/checksum: \[.*\]/checksum: []/;p;}' 59 | opam-version: "2.0" 60 | homepage: "https://github.com/foo/whatever" 61 | dev-repo: "git+https://github.com/foo/whatever.git" 62 | synopsis: "whatever" 63 | url { 64 | src: "https://foo.fr/archive/foo/foo.tbz" 65 | checksum: [] 66 | } 67 | x-commit-hash: "1abe11ed" 68 | -------------------------------------------------------------------------------- /tests/bin/version-from-tag/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## whatever 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## whatever 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ cat > whatever.opam << EOF 13 | > opam-version: "2.0" 14 | > homepage: "https://github.com/foo/whatever" 15 | > dev-repo: "git+https://github.com/foo/whatever.git" 16 | > description: "whatever" 17 | > EOF 18 | $ touch README.md LICENSE 19 | $ cat > dune-project << EOF 20 | > (lang dune 2.4) 21 | > (name whatever) 22 | > EOF 23 | $ cat > .gitignore << EOF 24 | > _build/ 25 | > run.t 26 | > EOF 27 | 28 | We need to set up a git project with two commits to test trying to tag different commits with the same tag name. 29 | 30 | $ git init 2> /dev/null > /dev/null 31 | $ git config user.name "dune-release-test" 32 | $ git config user.email "pseudo@pseudo.invalid" 33 | $ git add whatever.opam dune-project .gitignore CHANGES.md README.md LICENSE 34 | $ git commit -m "Testing" --quiet 35 | 36 | Creating a `git tag` manually since the project might be using this workflow 37 | 38 | $ git tag -a 23.0 -m "Release 23.0" 39 | $ dune-release distrib --dry-run | grep "Archive _build/" 40 | [+] Archive _build/whatever-23.0.tbz 41 | 42 | Also, while not the preferred way, unannotated tags should be possible as well 43 | 44 | $ git commit --allow-empty -m "Testing" --quiet 45 | $ git tag 42.0 46 | $ dune-release distrib --dry-run | grep "Archive _build/" 47 | [+] Archive _build/whatever-42.0.tbz 48 | 49 | It should also properly map back tags to releases 50 | 51 | $ git commit --allow-empty -m "Testing" --quiet 52 | $ git tag -a 1337.0_beta1 -m 'Release 1337~beta1' 53 | $ dune-release distrib --dry-run | grep "Archive _build/" 54 | [+] Archive _build/whatever-1337.0~beta1.tbz 55 | 56 | Also, specifying the tag manually should work 57 | 58 | $ git commit --allow-empty -m 'Testing' --quiet 59 | $ dune-release tag -y 9000_alpha3 60 | [-] Using tag "9000_alpha3" 61 | [+] Tagged HEAD with version 9000_alpha3 62 | $ dune-release distrib --dry-run | grep "Archive _build/" 63 | [+] Archive _build/whatever-9000~alpha3.tbz 64 | -------------------------------------------------------------------------------- /tests/lib/test_opam_file.ml: -------------------------------------------------------------------------------- 1 | let test_upgrade = 2 | let make_test ~url ~opam ~v ~expected = 3 | let test_name = "upgrade" in 4 | let url = OpamFile.URL.create (OpamUrl.of_string url) in 5 | let test_fun () = 6 | let opam_t = OpamFile.OPAM.read_from_string opam in 7 | let filename = OpamFilename.of_string "opam" in 8 | let id = "6814f8b26946358c72b926706f210025f36619b0" in 9 | let actual = 10 | Dune_release.Opam_file.upgrade ~filename ~url ~id opam_t ~version:v 11 | in 12 | let actual = OpamFile.OPAM.write_to_string actual in 13 | Alcotest.(check string) test_name expected actual 14 | in 15 | (test_name, `Quick, test_fun) 16 | in 17 | let url = "https://github.com/foo/foo/foo/foo/bar" in 18 | let opam = 19 | {| 20 | opam-version: "2.0" 21 | version: "0.5" 22 | maintainer: "Foo" 23 | authors: ["Foo" "Bar"] 24 | homepage: "https://github.com/foo/bar" 25 | url: "https://github.com/foo/bar" 26 | license: "ISC" 27 | name: "Foo" 28 | dev-repo: "git+https://github.com/foo/bar.git" 29 | depends: [ "foo" "bar" ] 30 | description: "This package is nice" 31 | |} 32 | in 33 | let expected_v1 = 34 | {|opam-version: "2.0" 35 | synopsis: "This package is great" 36 | maintainer: "Foo" 37 | authors: ["Foo" "Bar"] 38 | license: "ISC" 39 | homepage: "https://github.com/foo/bar" 40 | depends: ["foo" "bar"] 41 | dev-repo: "git+https://github.com/foo/bar.git" 42 | url { 43 | src: "https://github.com/foo/foo/foo/foo/bar" 44 | } 45 | x-commit-hash: "6814f8b26946358c72b926706f210025f36619b0"|} 46 | in 47 | let expected_v2 = 48 | {|opam-version: "2.0" 49 | synopsis: "" 50 | description: "This package is nice" 51 | maintainer: "Foo" 52 | authors: ["Foo" "Bar"] 53 | license: "ISC" 54 | homepage: "https://github.com/foo/bar" 55 | depends: ["foo" "bar"] 56 | dev-repo: "git+https://github.com/foo/bar.git" 57 | url { 58 | src: "https://github.com/foo/foo/foo/foo/bar" 59 | } 60 | x-commit-hash: "6814f8b26946358c72b926706f210025f36619b0"|} 61 | in 62 | let descr = OpamFile.Descr.create "This package is great" in 63 | [ 64 | make_test ~url ~opam ~v:(`V1 descr) ~expected:expected_v1; 65 | make_test ~url ~opam ~v:`V2 ~expected:expected_v2; 66 | ] 67 | 68 | let suite = ("Opam_file", test_upgrade) 69 | -------------------------------------------------------------------------------- /lib/uri_helpers.ml: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | type uri = { scheme : string option; domain : string list; path : string list } 4 | 5 | let pp_uri fmt { scheme; domain; path } = 6 | Format.fprintf fmt "@[{ scheme = %a;@ domain = %a;@ path = %a }@]" 7 | Stdext.(Option.pp String.pp) 8 | scheme 9 | Stdext.(List.pp String.pp) 10 | domain 11 | Stdext.(List.pp String.pp) 12 | path 13 | 14 | let equal_uri uri uri' = 15 | let { scheme; domain; path } = uri in 16 | let { scheme = s; domain = d; path = p } = uri' in 17 | Stdext.Option.equal String.equal scheme s 18 | && Stdext.List.equal String.equal domain d 19 | && Stdext.List.equal String.equal path p 20 | 21 | let parse_domain domain = List.rev (String.cuts ~sep:"." domain) 22 | 23 | let parse uri = 24 | let scheme, remainder = 25 | match String.cut ~sep:"://" uri with 26 | | None -> (None, uri) 27 | | Some (scheme, remainder) -> (Some scheme, remainder) 28 | in 29 | let raw_domain, raw_path = 30 | (* We mark the separation between domain and path at the first 31 | occurrence of [':'] or ['/'] to support git@github.com: format 32 | as well as regular URIs *) 33 | let separator_index = 34 | String.find (function ':' | '/' -> true | _ -> false) remainder 35 | in 36 | match separator_index with 37 | | None -> (remainder, "") 38 | | Some i -> 39 | let domain = String.with_index_range ~first:0 ~last:(i - 1) remainder in 40 | let path = String.with_range ~first:(i + 1) remainder in 41 | (domain, path) 42 | in 43 | match (raw_domain, raw_path) with 44 | | "", _ -> None 45 | | _, "" -> Some { scheme; domain = parse_domain raw_domain; path = [] } 46 | | _, _ -> 47 | Some 48 | { 49 | scheme; 50 | domain = parse_domain raw_domain; 51 | path = String.cuts ~sep:"/" raw_path; 52 | } 53 | 54 | let get_sld uri = 55 | match parse uri with 56 | | Some { domain = _ :: sld :: _; _ } -> Some sld 57 | | _ -> None 58 | 59 | let append_to_base ~rel_path base = 60 | match String.head ~rev:true base with 61 | | None -> rel_path 62 | | Some '/' -> strf "%s%s" base rel_path 63 | | Some _ -> strf "%s/%s" base rel_path 64 | 65 | let chop_git_prefix uri = 66 | match String.cut ~sep:"git+" uri with Some ("", rest) -> rest | _ -> uri 67 | -------------------------------------------------------------------------------- /bin/publish.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** The entrypoint for the [distro] command. *) 8 | 9 | val publish : 10 | ?build_dir:Fpath.t -> 11 | ?opam:Fpath.t -> 12 | ?change_log:Fpath.t -> 13 | ?distrib_file:Fpath.t -> 14 | ?publish_msg:string -> 15 | ?token:string Dune_release.Config.Cli.t -> 16 | pkg_names:string list -> 17 | version:Dune_release.Version.t option -> 18 | tag:Dune_release.Vcs.Tag.t option -> 19 | keep_v:bool Dune_release.Config.Cli.t -> 20 | dry_run:bool -> 21 | publish_artefacts:[ `Distrib | `Doc ] list -> 22 | yes:bool -> 23 | draft:bool -> 24 | unit -> 25 | (int, Bos_setup.R.msg) result 26 | (** [publish ~build_dir ~opam ~change_log ~distrib_uri ~distrib_file 27 | ~publish_msg ~name ~pkg_names ~version ~tag ~keep_v ~dry_run 28 | ~publish_artefacts ~yes ~draft ()] 29 | publishes the artefacts [publish_artefacts] of the package built with 30 | [name], [version] and [tag]. Returns the exit code (0 for success, 1 for 31 | failure) or error messages. 32 | 33 | - [keep_v] indicates whether the version is prefixed by 'v'. *) 34 | 35 | (** The [publish] command. *) 36 | 37 | val cmd : int Cmdliner.Cmd.t 38 | 39 | (*--------------------------------------------------------------------------- 40 | Copyright (c) 2016 Daniel C. Bünzli 41 | 42 | Permission to use, copy, modify, and/or distribute this software for any 43 | purpose with or without fee is hereby granted, provided that the above 44 | copyright notice and this permission notice appear in all copies. 45 | 46 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 47 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 48 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 49 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 50 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 51 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 52 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 53 | ---------------------------------------------------------------------------*) 54 | -------------------------------------------------------------------------------- /lib/prompt.ml: -------------------------------------------------------------------------------- 1 | type answer = Yes | No 2 | 3 | open Bos_setup.R.Infix 4 | 5 | let ask_yes_no f ~default_answer = 6 | let options : ('a, Format.formatter, unit, unit) format4 = 7 | match default_answer with Yes -> " [Y/n]" | No -> " [y/N]" 8 | in 9 | App_log.question (fun l -> 10 | f (fun ?header ?tags fmt -> l ?header ?tags (fmt ^^ options))) 11 | 12 | let rec loop_yes_no ~question ~default_answer = 13 | ask_yes_no question ~default_answer; 14 | match String.lowercase_ascii (read_line ()) with 15 | | "" when default_answer = Yes -> true 16 | | "" when default_answer = No -> false 17 | | "y" | "yes" -> true 18 | | "n" | "no" -> false 19 | | _ -> 20 | App_log.unhappy (fun l -> 21 | l 22 | "Please answer with \"y\" for yes, \"n\" for no or just hit enter \ 23 | for the default"); 24 | loop_yes_no ~question ~default_answer 25 | 26 | let confirm ~question ~yes ~default_answer = 27 | if yes then true else loop_yes_no ~question ~default_answer 28 | 29 | let confirm_or_abort ~question ~yes ~default_answer = 30 | if confirm ~question ~yes ~default_answer then Ok () 31 | else Error (`Msg "Aborting on user demand") 32 | 33 | let rec try_again ?(limit = 1) ~question ~yes ~default_answer f = 34 | match f () with 35 | | Ok x -> Ok x 36 | | Error (`Msg err) when limit > 0 -> 37 | App_log.unhappy (fun l -> l "%s" err); 38 | confirm_or_abort ~yes ~question ~default_answer >>= fun () -> 39 | try_again ~limit:(limit - 1) ~question ~yes ~default_answer f 40 | | Error x -> Error x 41 | 42 | let ask ~question ~default_answer = 43 | let pp_default fmt default = 44 | match default with 45 | | Some default -> 46 | Fmt.pf fmt "[press ENTER to use '%a']" Fmt.(styled `Bold string) default 47 | | None -> () 48 | in 49 | App_log.question (fun l -> l "%s%a" question pp_default default_answer) 50 | 51 | let rec loop ~question ~default_answer = 52 | ask ~question ~default_answer; 53 | let answer = 54 | match read_line () with 55 | | "" -> None 56 | | s -> Some s 57 | | exception End_of_file -> None 58 | in 59 | match (answer, default_answer) with 60 | | Some s, _ -> s 61 | | None, Some default -> default 62 | | None, None -> 63 | App_log.unhappy (fun l -> l "dune-release needs an answer to proceed."); 64 | loop ~question ~default_answer 65 | 66 | let user_input ?default_answer ~question () = loop ~question ~default_answer 67 | -------------------------------------------------------------------------------- /lib/github_v3_api.mli: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | val with_auth : token:string -> Curl.t -> Curl.t 4 | 5 | module Release : sig 6 | module Request : sig 7 | val get : tag:Vcs.Tag.t -> user:string -> repo:string -> Curl.t 8 | 9 | val create : 10 | version:Version.t -> 11 | tag:Vcs.Tag.t -> 12 | msg:string -> 13 | user:string -> 14 | repo:string -> 15 | draft:bool -> 16 | Curl.t 17 | 18 | val undraft : owner:string -> repo:string -> release_id:int -> Curl.t 19 | end 20 | 21 | module Response : sig 22 | val browser_download_url : 23 | name:string -> Yojson.Basic.t -> (string, R.msg) result 24 | (** [browser_download_url ~release_id response] extracts the 25 | browser_download_url field from a github release asset upload response 26 | named [name], or error messages. *) 27 | 28 | val release_id : Yojson.Basic.t -> (int, R.msg) result 29 | (** [release_id response] extracts the id field from a github response, or 30 | error messages. *) 31 | end 32 | end 33 | 34 | module Archive : sig 35 | module Request : sig 36 | val upload : 37 | archive:Fpath.t -> user:string -> repo:string -> release_id:int -> Curl.t 38 | end 39 | 40 | module Response : sig 41 | val browser_download_url : Yojson.Basic.t -> (string, R.msg) result 42 | (** [browser_download_url response] extracts the browser_download_url field 43 | from a github release asset upload response, or error messages. *) 44 | 45 | val name : Yojson.Basic.t -> (string, R.msg) result 46 | (** [name response] extracts the github name for the asset, which might 47 | differ from the filename for the archive we uploaded. *) 48 | end 49 | end 50 | 51 | module Pull_request : sig 52 | module Request : sig 53 | val open_ : 54 | title:string -> 55 | fork_owner:string -> 56 | branch:string -> 57 | body:string -> 58 | opam_repo:string * string -> 59 | draft:bool -> 60 | Curl.t 61 | end 62 | 63 | module Response : sig 64 | val html_url : 65 | Yojson.Basic.t -> ([ `Already_exists | `Url of string ], R.msg) result 66 | (** [html_url response] extracts the html_url field from a github json 67 | response, or [`Already_exists] if the corresponding pull request already 68 | exists, or error messages. *) 69 | 70 | val number : Yojson.Basic.t -> (int, R.msg) result 71 | (** [number response] extracts the number field from a github json response, 72 | or error messages. *) 73 | end 74 | end 75 | -------------------------------------------------------------------------------- /bin/distrib.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** The entrypoint for the [distro] command. *) 8 | 9 | val distrib : 10 | ?build_dir:Fpath.t -> 11 | dry_run:bool -> 12 | pkg_names:string list -> 13 | version:Dune_release.Version.t option -> 14 | tag:Dune_release.Vcs.Tag.t option -> 15 | keep_v:bool Dune_release.Config.Cli.t -> 16 | keep_dir:bool -> 17 | skip_lint:bool -> 18 | skip_build:bool -> 19 | skip_tests:bool -> 20 | include_submodules:bool -> 21 | unit -> 22 | (int, Bos_setup.R.msg) result 23 | (** [distrib ~build_dir ~dry_run ~name ~pkg_names ~version ~tag ~keep_v 24 | ~keep_dir ~skip_lint ~skip_build ~skip_tests ()] 25 | creates a distribution archive for the package built with [name], [version] 26 | and [tag], in [build_dir]. Returns the exit code (0 for success, 1 for 27 | failure) or error messages. 28 | 29 | - [keep_v] indicates whether the version is prefixed by 'v' 30 | - If [keep_dir] is [true] the repository checkout used to create the 31 | distribution archive is kept in the build directory. 32 | - Unless [skip_lint] is set, lint checks are performed on the generated 33 | archive. 34 | - Unless [skip_build] is set the archive is built. 35 | - Unless [skip_tests] is set the tests of the package are executed from the 36 | archive. *) 37 | 38 | (** The [distrib] command. *) 39 | 40 | val cmd : int Cmdliner.Cmd.t 41 | 42 | (*--------------------------------------------------------------------------- 43 | Copyright (c) 2016 Daniel C. Bünzli 44 | 45 | Permission to use, copy, modify, and/or distribute this software for any 46 | purpose with or without fee is hereby granted, provided that the above 47 | copyright notice and this permission notice appear in all copies. 48 | 49 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 50 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 51 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 52 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 53 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 54 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 55 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 56 | ---------------------------------------------------------------------------*) 57 | -------------------------------------------------------------------------------- /bin/main.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | open Cmdliner 8 | 9 | let cmds = 10 | [ 11 | Tag.cmd; 12 | Distrib.cmd; 13 | Publish.cmd; 14 | Opam.cmd; 15 | Help.cmd; 16 | Bistro.cmd; 17 | Lint.cmd; 18 | Check.cmd; 19 | Delegate_info.cmd; 20 | Config.cmd; 21 | Undraft.cmd; 22 | ] 23 | 24 | (* Command line interface *) 25 | 26 | let doc = "Release dune packages to opam" 27 | let sdocs = Manpage.s_common_options 28 | let exits = Cli.exits 29 | 30 | let man = 31 | [ 32 | `S Manpage.s_description; 33 | `P "$(mname) releases dune packages to opam."; 34 | `P 35 | "Without arguments, $(mname) acts like $(b,dune-release bistro): refer \ 36 | to $(b,dune-release help bistro) for help about the default behavior."; 37 | `P "Use '$(mname) help release' for help to release a package."; 38 | `Noblank; 39 | `P "Use '$(mname) help troubleshoot' for a few troubleshooting tips."; 40 | `Noblank; 41 | `P "Use '$(mname) help $(i,COMMAND)' for help about $(i,COMMAND)."; 42 | `S Manpage.s_bugs; 43 | `P "Report them, see $(i,%%PKG_HOMEPAGE%%) for contact information."; 44 | `S Manpage.s_authors; 45 | `P "Daniel C. Buenzli, $(i,http://erratique.ch)"; 46 | ] 47 | 48 | let main = 49 | Cmd.group ~default:Bistro.term 50 | (Cmd.info "dune-release" ~version:"%%VERSION%%" ~doc ~sdocs ~exits ~man) 51 | cmds 52 | 53 | let main () = Stdlib.exit @@ Cmd.eval' main 54 | let () = main () 55 | 56 | (*--------------------------------------------------------------------------- 57 | Copyright (c) 2016 Daniel C. Bünzli 58 | 59 | Permission to use, copy, modify, and/or distribute this software for any 60 | purpose with or without fee is hereby granted, provided that the above 61 | copyright notice and this permission notice appear in all copies. 62 | 63 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 64 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 65 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 66 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 67 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 68 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 69 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 70 | ---------------------------------------------------------------------------*) 71 | -------------------------------------------------------------------------------- /tests/bin/helpers/make_dune_release_deterministic.ml: -------------------------------------------------------------------------------- 1 | open Re 2 | 3 | let hex = alt [ rg 'a' 'f'; digit ] 4 | 5 | (* git describe returns g *) 6 | let shorthash = seq [ char 'g'; rep hex ] 7 | let dash = char '-' 8 | let without_dash = diff any dash 9 | let pkg_name = rep without_dash 10 | let version = rep without_dash 11 | 12 | let version_set = 13 | [ group @@ version; dash; group @@ rep digit; dash; shorthash ] 14 | 15 | let make_build_deterministic line = 16 | let build = "_build/" in 17 | let re = 18 | compile @@ seq @@ [ str build; group @@ rep pkg_name; dash ] @ version_set 19 | in 20 | replace re 21 | ~f:(fun group -> 22 | let pkg_name = Group.get group 1 in 23 | let ver = Group.get group 2 in 24 | let since = Group.get group 3 in 25 | let commit = "" in 26 | let replacement = 27 | Format.asprintf "%s%s-%s-%s-%s" build pkg_name ver since commit 28 | in 29 | replacement) 30 | line 31 | 32 | let make_commit_deterministic line = 33 | let re = compile @@ seq [ str "Commit "; rep hex ] in 34 | replace_string re ~by:"Commit " line 35 | 36 | let make_distribution_deterministic line = 37 | let dist_for = "Distribution for " in 38 | let re = 39 | compile @@ seq 40 | @@ [ str dist_for; group @@ rep pkg_name; space ] 41 | @ version_set 42 | in 43 | replace re 44 | ~f:(fun group -> 45 | let pkg_name = Group.get group 1 in 46 | let ver = Group.get group 2 in 47 | let since = Group.get group 3 in 48 | let commit = "" in 49 | let replacement = 50 | Format.asprintf "%s%s %s-%s-%s" dist_for pkg_name ver since commit 51 | in 52 | replacement) 53 | line 54 | 55 | let make_lint_directory_deterministic line = 56 | (* OCaml implementation of bash's 57 | sed "s/lint of .* and/lint of and/" *) 58 | let re = compile @@ seq [ str "lint of "; rep any; str " and" ] in 59 | replace_string re ~by:"lint of and" line 60 | 61 | let make_test_directory_deterministic line = 62 | (* OCaml implementation of bash's 63 | sed 's/\/.*\/tests\/bin\/check//' *) 64 | let re = compile @@ seq [ str "/"; rep any; str "/tests/bin/check" ] in 65 | replace_string re ~by:"" line 66 | 67 | let transforms = 68 | [ 69 | make_build_deterministic; 70 | make_commit_deterministic; 71 | make_distribution_deterministic; 72 | make_lint_directory_deterministic; 73 | make_test_directory_deterministic; 74 | ] 75 | 76 | let () = 77 | try 78 | while true do 79 | let line = read_line () in 80 | List.fold_left ( |> ) line transforms |> print_endline 81 | done 82 | with End_of_file -> () 83 | -------------------------------------------------------------------------------- /lib/archive.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** Archive creation. *) 8 | 9 | open Bos_setup 10 | 11 | (** {1 Ustar archives} *) 12 | 13 | val tar : 14 | Fpath.t -> 15 | exclude_paths:Fpath.set -> 16 | root:Fpath.t -> 17 | mtime:int64 -> 18 | (string, R.msg) result 19 | (** [tar dir ~exclude_paths ~root ~mtime] is a (us)tar archive that contains the 20 | file hierarchy [dir] except the relative hierarchies present in 21 | [exclude_paths]. In the archive, members of [dir] are rerooted at [root] and 22 | sorted according to {!Fpath.compare}. They have their modification time set 23 | to [mtime] and their file permissions are [0o775] for directories and files 24 | executable by the user and [0o664] for other files. No other file metadata 25 | is preserved. 26 | 27 | {b Note.} This is a pure OCaml implementation, no [tar] tool is needed. *) 28 | 29 | (** {1 Bzip2 compression and unarchiving} *) 30 | 31 | val ensure_bzip2 : unit -> (unit, R.msg) result 32 | (** [ensure_bzip2 ()] makes sure the [bzip2] utility is available. *) 33 | 34 | val bzip2 : 35 | dry_run:bool -> ?force:bool -> dst:Fpath.t -> string -> (unit, R.msg) result 36 | (** [bzip2 dst s] compresses [s] to [dst] using bzip2. *) 37 | 38 | val untbz : dry_run:bool -> ?clean:bool -> Fpath.t -> (Fpath.t, R.msg) result 39 | (** [untbz ~clean ar] untars the tar bzip2 archive [ar] in the same directory as 40 | [ar] and returns a base directory for [ar]. If [clean] is [true] (defaults 41 | to [false]) first delete the base directory if it exists. *) 42 | 43 | (*--------------------------------------------------------------------------- 44 | Copyright (c) 2016 Daniel C. Bünzli 45 | 46 | Permission to use, copy, modify, and/or distribute this software for any 47 | purpose with or without fee is hereby granted, provided that the above 48 | copyright notice and this permission notice appear in all copies. 49 | 50 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 51 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 52 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 53 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 54 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 55 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 56 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 57 | ---------------------------------------------------------------------------*) 58 | -------------------------------------------------------------------------------- /lib/stdext.mli: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | (** Safe wrapping for some Bytes functions. *) 4 | module Sbytes : sig 5 | type t = Bytes.t 6 | (** An alias for the type of byte sequences. *) 7 | 8 | val make : int -> char -> (t, [> R.msg ]) result 9 | (** [make n c] returns a new byte sequence of length [n], filled with the byte 10 | [c]. Returns an error message if [n < 0] or [n > Sys.max_string_length]. *) 11 | 12 | val blit_string : 13 | string -> int -> t -> int -> int -> (unit, [> R.msg ]) result 14 | (** [blit src srcoff dst dstoff len] copies [len] bytes from string [src], 15 | starting at index [srcoff], to byte sequence [dst], starting at index 16 | [dstoff]. Returns an error message if [srcoff] and [len] do not designate 17 | a valid range of [src], or if [dstoff] and [len] do not designate a valid 18 | range of [dst]. *) 19 | end 20 | 21 | module Path : sig 22 | val is_backup_file : string -> bool 23 | (** [is_backup_file s] returns [true] iff the filename [s]: 24 | 25 | - ends with ['~'] 26 | - or begins with ['#'] and ends with ['#']. *) 27 | 28 | val find_files : names_wo_ext:string list -> Fpath.t list -> Fpath.t list 29 | (** [find_files ~names_wo_ext files] returns the list of files among [files] 30 | whose name without extension is equal to an element of [names_wo_ext]. 31 | Backup files are ignored. *) 32 | end 33 | 34 | (** Interface to the Unix system. *) 35 | module Unix : sig 36 | val read_line : ?echo_input:bool -> unit -> string 37 | (** [read_line ?echo_input ()] reads a line (terminated before a CR) on the 38 | standard input. If [echo_input] is [true] (by default) input characters 39 | are echoed on the standard output. *) 40 | end 41 | 42 | module Option : sig 43 | val pp : 44 | (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit 45 | 46 | val equal : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool 47 | val map : f:('a -> 'b) -> 'a option -> 'b option 48 | val bind : f:('a -> 'b option) -> 'a option -> 'b option 49 | val value : default:'a -> 'a option -> 'a 50 | 51 | module O : sig 52 | val ( >>= ) : 'a option -> ('a -> 'b option) -> 'b option 53 | val ( >|= ) : 'a option -> ('a -> 'b) -> 'b option 54 | end 55 | end 56 | 57 | module String : sig 58 | val pp : Format.formatter -> string -> unit 59 | end 60 | 61 | module List : sig 62 | val pp : 63 | (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a list -> unit 64 | 65 | val equal : ('a -> 'a -> bool) -> 'a list -> 'a list -> bool 66 | val filter_map : f:('a -> 'b option) -> 'a list -> 'b list 67 | end 68 | 69 | module Result : sig 70 | module List : sig 71 | val iter : 72 | f:('a -> (unit, 'e) Result.result) -> 'a list -> (unit, 'e) Result.result 73 | (** [iter ~f l] applies [f] on each element of list [l] until an error 74 | occurs. *) 75 | end 76 | end 77 | -------------------------------------------------------------------------------- /tests/bin/distrib-name/run.t: -------------------------------------------------------------------------------- 1 | Set up a project with two packaged libraries, no name in `dune-project`. This 2 | goes with the fix for #320, where: 3 | 4 | - one sets a name in `dune-project` but does not commit it 5 | - `dune-release distrib` ignores this name and fails, complaining that you 6 | should set a name. 7 | 8 | $ mkdir liba libb 9 | $ cat > CHANGES.md << EOF 10 | > ## 0.42.0 11 | > 12 | > - Some other feature 13 | > 14 | > EOF 15 | $ echo "(library (public_name liba))" > liba/dune 16 | $ echo "(library (public_name libb))" > libb/dune 17 | $ cat > liba.opam << EOF 18 | > opam-version: "2.0" 19 | > EOF 20 | $ cp liba.opam libb.opam 21 | $ touch README LICENSE 22 | $ echo "(lang dune 2.7)" > dune-project 23 | $ cat > .gitignore << EOF 24 | > _build 25 | > .bin 26 | > /dune 27 | > run.t 28 | > EOF 29 | $ git init 2> /dev/null . > /dev/null 30 | $ git config user.name "dune-release-test" 31 | $ git config user.email "pseudo@pseudo.invalid" 32 | $ git add liba/* libb*/ CHANGES.md README LICENSE *.opam dune-project .gitignore 33 | $ git commit -m 'Commit.' > /dev/null 34 | 35 | Try `dune-release distrib` with no project name, it should fail since it does 36 | not know how to call the project. 37 | 38 | $ dune-release distrib --skip-lint > /dev/null 39 | dune-release: [ERROR] cannot determine distribution name automatically: add (name ) to dune-project 40 | [1] 41 | 42 | dune-release distrib --dry-run with no project name should fail as well. 43 | 44 | $ dune-release distrib --skip-lint --dry-run > /dev/null 45 | dune-release: [ERROR] cannot determine distribution name automatically: add (name ) to dune-project 46 | [1] 47 | 48 | Add an uncommitted name to dune-project. (Because of a dune limitation 49 | this name must be one the .opam file names.) 50 | 51 | $ echo "(name liba)" >> dune-project 52 | 53 | Run dune-release distrib with the uncommitted name in dune-project. 54 | 55 | $ dune-release tag -y > /dev/null 56 | $ dune-release distrib --skip-lint > /dev/null 57 | dune-release: [WARNING] The repo is dirty. Uncommitted changes to files 58 | (including dune-project) will not be included in the 59 | distribution archive. 60 | Error: The project name is not defined, please add a (name ) field to 61 | your dune-project file. 62 | dune-release: [ERROR] run ['dune' 'subst']: exited with 1 63 | [3] 64 | 65 | Commit the change in dune-project and run distrib. 66 | 67 | $ git add dune-project && git commit -m 'add name' > /dev/null 68 | $ dune-release distrib --skip-lint | make_dune_release_deterministic 69 | [-] Building source archive 70 | [+] Wrote archive _build/liba-0.42.0-1-.tbz 71 | 72 | [-] Building package in _build/liba-0.42.0-1- 73 | [ OK ] package(s) build 74 | 75 | [-] Running package tests in _build/liba-0.42.0-1- 76 | [ OK ] package(s) pass the tests 77 | 78 | [+] Distribution for liba 0.42.0-1- 79 | [+] Commit 80 | [+] Archive _build/liba-0.42.0-1-.tbz 81 | -------------------------------------------------------------------------------- /lib/github.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** Interface with Github. *) 8 | 9 | open Bos_setup 10 | 11 | module Parse : sig 12 | val ssh_uri_from_http : string -> string option 13 | (** [ssh_uri_from_http] Guess an SSH URI from a Github HTTP url. *) 14 | end 15 | 16 | (** {1 Publish} *) 17 | 18 | val publish_distrib : 19 | token:string -> 20 | dry_run:bool -> 21 | msg:string -> 22 | archive:Fpath.t -> 23 | yes:bool -> 24 | draft:bool -> 25 | Pkg.t -> 26 | (string, R.msg) Result.result 27 | (** Push the tag, create a Github release, upload the distribution archive and 28 | return the release archive download URL *) 29 | 30 | val publish_doc : 31 | dry_run:bool -> 32 | msg:string -> 33 | docdir:Fpath.t -> 34 | yes:bool -> 35 | Pkg.t -> 36 | (unit, R.msg) Result.result 37 | 38 | val undraft_release : 39 | token:string -> 40 | dry_run:bool -> 41 | owner:string -> 42 | repo:string -> 43 | release_id:string -> 44 | name:string -> 45 | (string, R.msg) Result.result 46 | (** [undraft_release] updates an existing release to undraft it and returns the 47 | release archive download URL. *) 48 | 49 | val open_pr : 50 | token:string -> 51 | dry_run:bool -> 52 | title:string -> 53 | fork_owner:string -> 54 | branch:Vcs.commit_ish -> 55 | opam_repo:string * string -> 56 | draft:bool -> 57 | string -> 58 | Pkg.t -> 59 | ([ `Url of string | `Already_exists ], R.msg) result 60 | 61 | val undraft_pr : 62 | token:string -> 63 | dry_run:bool -> 64 | opam_repo:string * string -> 65 | pr_id:string -> 66 | (string, R.msg) result 67 | (** [undraft_pr] updates an existing pull request to undraft it and returns the 68 | pull request URL. *) 69 | 70 | val pr_title : 71 | names:string list -> 72 | version:Version.t -> 73 | project_name:string option -> 74 | pkgs_to_submit:string list -> 75 | string 76 | 77 | (*--------------------------------------------------------------------------- 78 | Copyright (c) 2016 Daniel C. Bünzli 79 | 80 | Permission to use, copy, modify, and/or distribute this software for any 81 | purpose with or without fee is hereby granted, provided that the above 82 | copyright notice and this permission notice appear in all copies. 83 | 84 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 85 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 86 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 87 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 88 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 89 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 90 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 91 | ---------------------------------------------------------------------------*) 92 | -------------------------------------------------------------------------------- /tests/bin/tag/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ touch whatever.opam 13 | $ cat > dune-project << EOF 14 | > (lang dune 2.4) 15 | > (name whatever) 16 | > EOF 17 | 18 | We need to set up a git project with two commits to test trying to tag different commits with the same tag name. 19 | 20 | $ export GIT_AUTHOR_DATE="2000-01-01 00:00:00 +0000" 21 | $ git init > /dev/null 2>&1 22 | $ git config user.name "dune-release-test" 23 | $ git config user.email "pseudo@pseudo.invalid" 24 | $ git add whatever.opam dune-project 25 | $ git commit -m "Initial commit" > /dev/null 26 | $ git add CHANGES.md 27 | $ git commit -m "Add CHANGES.md" > /dev/null 28 | 29 | Having branch named the same as version tag should have no impact. 30 | $ git branch 0.1.0 > /dev/null 31 | 32 | Running `dune-release tag` for the first time should tag HEAD with the current version number. 33 | 34 | $ dune-release tag -y > /dev/null 35 | 36 | Checking the message attached to the tag. 37 | 38 | $ git show 0.1.0 | grep -E "(tag|Release|CHANGES:|Some other feature)" 39 | warning: refname '0.1.0' is ambiguous. 40 | tag 0.1.0 41 | Release 0.1.0 42 | CHANGES: 43 | - Some other feature 44 | +- Some other feature 45 | 46 | Running `dune-release tag` again should inform the user that that tag already exists. 47 | 48 | $ dune-release tag 49 | [-] Extracting tag from first entry in CHANGES.md 50 | [-] Using tag "0.1.0" 51 | [-] Nothing to be done: tag already exists. 52 | 53 | Running `dune-release tag` again, but providing a different commit should inform the user that that tag already exists but points to a different commit. 54 | 55 | $ dune-release tag --commit=HEAD^ 56 | [-] Extracting tag from first entry in CHANGES.md 57 | [-] Using tag "0.1.0" 58 | dune-release: [ERROR] A tag with name 0.1.0 already exists, but points to a different commit. You can delete that tag using the `-d` flag. 59 | [3] 60 | 61 | Trying to delete the created tag providing a different commit should give a warning. The answer to the question 62 | asking for confirmation should default to "no". 63 | 64 | $ echo "" | dune-release tag -d --commit=HEAD^ 65 | [-] Extracting tag from first entry in CHANGES.md 66 | [-] Using tag "0.1.0" 67 | [?] Warning: Tag 0.1.0 does not point to the commit you've provided (default: HEAD). Do you want to delete it anyways? [y/N] 68 | dune-release: [ERROR] Aborting on user demand 69 | [3] 70 | 71 | Deleting the created tag providing the commit it points to (here the default, so HEAD) should work without warning. 72 | The answer to the question asking for confirmation should default to "yes". 73 | 74 | $ echo "" | dune-release tag -d 75 | [-] Extracting tag from first entry in CHANGES.md 76 | [-] Using tag "0.1.0" 77 | [?] Delete tag 0.1.0? [Y/n] 78 | [+] Deleted tag 0.1.0 79 | 80 | Trying to delete a commit that doesn't exist should inform the user that there's nothing to be deleted. 81 | 82 | $ dune-release tag -d -y 83 | [-] Extracting tag from first entry in CHANGES.md 84 | [-] Using tag "0.1.0" 85 | [-] Nothing to be deleted: there is no tag 0.1.0. 86 | -------------------------------------------------------------------------------- /tests/bin/opam-file-locations/run.t: -------------------------------------------------------------------------------- 1 | Set up a project with an `.opam` file in the toplevel folder: 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 0.1.0 5 | > 6 | > - Initial release 7 | > 8 | > EOF 9 | $ cat > dune-project << EOF 10 | > (lang dune 3.8) 11 | > (name myproject) 12 | > EOF 13 | $ cat > myproject.opam << EOF 14 | > opam-version: "2.0" 15 | > EOF 16 | $ git init 2> /dev/null . > /dev/null 17 | $ touch README LICENSE 18 | $ cat > .gitignore << EOF 19 | > _build 20 | > .bin 21 | > /dune 22 | > run.t 23 | > EOF 24 | $ git add CHANGES.md README LICENSE *.opam dune-project .gitignore 25 | $ git commit -m 'Initial commit' > /dev/null 26 | 27 | Tagging should work 28 | 29 | $ dune-release tag -y 30 | [-] Extracting tag from first entry in CHANGES.md 31 | [-] Using tag "0.1.0" 32 | [+] Tagged HEAD with version 0.1.0 33 | 34 | `dune-release distrib` should work. 35 | 36 | $ dune-release distrib --skip-lint | make_dune_release_deterministic 37 | [-] Building source archive 38 | [+] Wrote archive _build/myproject-0.1.0.tbz 39 | 40 | [-] Building package in _build/myproject-0.1.0 41 | [ OK ] package(s) build 42 | 43 | [-] Running package tests in _build/myproject-0.1.0 44 | [ OK ] package(s) pass the tests 45 | 46 | [+] Distribution for myproject 0.1.0 47 | [+] Commit 48 | [+] Archive _build/myproject-0.1.0.tbz 49 | 50 | Now let's move the `.opam` file to the `opam/` subfolder. OPAM supports `.opam` 51 | files in the `opam/` subfolder, but for dune to pick it up we need to tell it 52 | to look in that folder. 53 | 54 | Importantly, dune requires the packages in the `opam/` folder to be declared in 55 | `dune-project` as `package`. 56 | 57 | $ cat > CHANGES.md << EOF 58 | > ## 0.2.0 59 | > 60 | > - Use dune to generate opam file in opam subfolder 61 | > 62 | > EOF 63 | $ cat >> dune-project << EOF 64 | > (package 65 | > (name myproject) 66 | > (allow_empty)) 67 | > (generate_opam_files true) 68 | > (opam_file_location inside_opam_directory) 69 | > EOF 70 | $ git rm myproject.opam 71 | rm 'myproject.opam' 72 | $ dune build opam/myproject.opam 73 | $ git add opam/myproject.opam CHANGES.md dune-project 74 | $ git commit -m 'Opam file in subfolder' > /dev/null 75 | 76 | Now we should still be able to tag: 77 | 78 | $ dune-release tag -y 79 | [-] Extracting tag from first entry in CHANGES.md 80 | [-] Using tag "0.2.0" 81 | [+] Tagged HEAD with version 0.2.0 82 | 83 | And as well have a release tarball 84 | 85 | $ dune-release distrib --skip-lint | make_dune_release_deterministic 86 | [-] Building source archive 87 | [+] Wrote archive _build/myproject-0.2.0.tbz 88 | 89 | [-] Building package in _build/myproject-0.2.0 90 | [ OK ] package(s) build 91 | 92 | [-] Running package tests in _build/myproject-0.2.0 93 | [ OK ] package(s) pass the tests 94 | 95 | [+] Distribution for myproject 0.2.0 96 | [+] Commit 97 | [+] Archive _build/myproject-0.2.0.tbz 98 | 99 | Which contains the `.opam` file in the right location: 100 | 101 | $ tar tf _build/myproject-0.2.0.tbz | grep \\.opam 102 | myproject-0.2.0/opam/myproject.opam 103 | -------------------------------------------------------------------------------- /bin/lint.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | open Bos_setup 8 | open Dune_release 9 | 10 | let lint () (`Dry_run dry_run) (`Package_names pkg_names) 11 | (`Package_version version) (`Dist_tag tag) (`Keep_v keep_v) (`Lints lints) = 12 | Cli.handle_error 13 | ( Config.keep_v ~keep_v >>= fun keep_v -> 14 | let pkg = Pkg.v ~dry_run ?version ~keep_v ?tag () in 15 | OS.Dir.current () >>= fun dir -> 16 | Lint.lint_packages ~dry_run ~dir ~todo:lints pkg pkg_names ) 17 | 18 | (* Command line interface *) 19 | 20 | open Cmdliner 21 | 22 | let lints = 23 | let test = [ ("std-files", `Std_files); ("opam", `Opam) ] in 24 | let doc = 25 | strf 26 | "Test to perform. $(docv) must be one of %s. If unspecified all tests \ 27 | are performed." 28 | (Arg.doc_alts_enum test) 29 | in 30 | let test = Arg.enum test in 31 | let docv = "TEST" in 32 | Cli.named 33 | (fun x -> `Lints x) 34 | Arg.(value & pos_all test Lint.all & info [] ~doc ~docv) 35 | 36 | let doc = "Check package distribution consistency and conventions" 37 | let sdocs = Manpage.s_common_options 38 | let exits = Cmd.Exit.info 1 ~doc:"on lint failure" :: Cli.exits 39 | let man_xrefs = [ `Main; `Cmd "distrib" ] 40 | 41 | let man = 42 | [ 43 | `S Manpage.s_description; 44 | `P 45 | "The $(tname) command makes tests on a package distribution or source \ 46 | repository. It checks that standard files exist, that ocamlfind META \ 47 | files pass the ocamlfind lint test, that opam package files pass the \ 48 | opam lint test and that the opam dependencies are consistent with those \ 49 | of the build system."; 50 | `P 51 | "Linting is automatically performed on distribution generation, see \ 52 | dune-release-distrib(1) for more details."; 53 | ] 54 | 55 | let term = 56 | Term.( 57 | const lint $ Cli.setup $ Cli.dry_run $ Cli.pkg_names $ Cli.pkg_version 58 | $ Cli.dist_tag $ Cli.keep_v $ lints) 59 | 60 | let info = Cmd.info "lint" ~doc ~sdocs ~exits ~man ~man_xrefs 61 | let cmd = Cmd.v info term 62 | 63 | (*--------------------------------------------------------------------------- 64 | Copyright (c) 2016 Daniel C. Bünzli 65 | 66 | Permission to use, copy, modify, and/or distribute this software for any 67 | purpose with or without fee is hereby granted, provided that the above 68 | copyright notice and this permission notice appear in all copies. 69 | 70 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 71 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 72 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 73 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 74 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 75 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 76 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 77 | ---------------------------------------------------------------------------*) 78 | -------------------------------------------------------------------------------- /lib/stdext.ml: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | module Sbytes = struct 4 | type t = Bytes.t 5 | 6 | let make size char = 7 | try R.ok (Bytes.make size char) with Invalid_argument e -> R.error_msg e 8 | 9 | let blit_string src srcoff dst dstoff len = 10 | try R.ok (Bytes.blit_string src srcoff dst dstoff len) 11 | with Invalid_argument e -> R.error_msg e 12 | end 13 | 14 | module Path = struct 15 | let is_backup_file str = 16 | let len = String.length str in 17 | len > 0 18 | && 19 | let first = str.[0] in 20 | let last = str.[len - 1] in 21 | Char.equal last '~' || (Char.equal first '#' && Char.equal last '#') 22 | 23 | let find_files ~names_wo_ext files = 24 | let open Fpath in 25 | List.filter 26 | (fun file -> 27 | if is_backup_file (filename file) then false 28 | else 29 | let normalized = to_string (normalize (rem_ext file)) in 30 | List.exists 31 | (String.equal (String.Ascii.lowercase normalized)) 32 | names_wo_ext) 33 | files 34 | end 35 | 36 | module Unix = struct 37 | let maybe_echo_input echo_input f x = 38 | if echo_input then f x 39 | else 40 | let open Unix in 41 | let term_io = tcgetattr stdin in 42 | tcsetattr stdin TCSANOW { term_io with c_echo = false }; 43 | let input = f x in 44 | tcsetattr stdin TCSANOW term_io; 45 | input 46 | 47 | let read_line ?(echo_input = true) () = 48 | maybe_echo_input echo_input read_line () 49 | end 50 | 51 | module Option = struct 52 | let pp pp_a fmt opt = 53 | match opt with 54 | | None -> Format.fprintf fmt "None" 55 | | Some a -> Format.fprintf fmt "Some %a" pp_a a 56 | 57 | let equal equal_a opt opt' = 58 | match (opt, opt') with 59 | | None, None -> true 60 | | Some a, Some a' -> equal_a a a' 61 | | _ -> false 62 | 63 | let map ~f = function None -> None | Some x -> Some (f x) 64 | let bind ~f = function None -> None | Some x -> f x 65 | let value ~default opt = match opt with Some x -> x | None -> default 66 | 67 | module O = struct 68 | let ( >>= ) opt f = bind ~f opt 69 | let ( >|= ) opt f = map ~f opt 70 | end 71 | end 72 | 73 | module Result = struct 74 | module List = struct 75 | let iter ~f l = 76 | List.fold_left (fun acc x -> acc >>= fun () -> f x) (Ok ()) l 77 | end 78 | end 79 | 80 | module String = struct 81 | let pp fmt t = Format.fprintf fmt "%S" t 82 | end 83 | 84 | module List = struct 85 | let pp pp_a fmt l = 86 | match l with 87 | | [] -> Format.fprintf fmt "[]" 88 | | [ a ] -> Format.fprintf fmt "@[[ %a ]@]" pp_a a 89 | | hd :: tl -> 90 | Format.fprintf fmt "@[[ %a" pp_a hd; 91 | List.iter (fun a -> Format.fprintf fmt ";@ %a" pp_a a) tl; 92 | Format.fprintf fmt " ]@]" 93 | 94 | let rec equal equal_a l l' = 95 | match (l, l') with 96 | | [], [] -> true 97 | | hd :: tl, hd' :: tl' -> equal_a hd hd' && equal equal_a tl tl' 98 | | _, _ -> false 99 | 100 | let filter_map ~f l = 101 | let rec fmap acc = function 102 | | [] -> List.rev acc 103 | | hd :: tl -> ( 104 | match f hd with None -> fmap acc tl | Some x -> fmap (x :: acc) tl) 105 | in 106 | fmap [] l 107 | end 108 | -------------------------------------------------------------------------------- /tests/lib/upload_response.ml: -------------------------------------------------------------------------------- 1 | let gh_v3_api_DR_example = 2 | {| 3 | { 4 | "url":"https://api.github.com/repos/NathanReb/dune-release-testing/releases/assets/12789323", 5 | "id":12789323, 6 | "node_id":"MDEyOlJlbGVhc2VBc3NldDEyNzg5MzIz", 7 | "name":"dummy-v0.0.0.tbz", 8 | "label":"", 9 | "uploader":{ 10 | "login":"NathanReb", 11 | "id":7419360, 12 | "node_id":"MDQ6VXNlcjc0MTkzNjA=", 13 | "avatar_url":"https://avatars2.githubusercontent.com/u/7419360?v=4", 14 | "gravatar_id":"", 15 | "url":"https://api.github.com/users/NathanReb", 16 | "html_url":"https://github.com/NathanReb", 17 | "followers_url":"https://api.github.com/users/NathanReb/followers", 18 | "following_url":"https://api.github.com/users/NathanReb/following{/other_user}", 19 | "gists_url":"https://api.github.com/users/NathanReb/gists{/gist_id}", 20 | "starred_url":"https://api.github.com/users/NathanReb/starred{/owner}{/repo}", 21 | "subscriptions_url":"https://api.github.com/users/NathanReb/subscriptions", 22 | "organizations_url":"https://api.github.com/users/NathanReb/orgs", 23 | "repos_url":"https://api.github.com/users/NathanReb/repos", 24 | "events_url":"https://api.github.com/users/NathanReb/events{/privacy}", 25 | "received_events_url":"https://api.github.com/users/NathanReb/received_events", 26 | "type":"User", 27 | "site_admin":false}, 28 | "content_type":"application/x-tar", 29 | "state":"uploaded", 30 | "size":811, 31 | "download_count":0, 32 | "created_at":"2019-05-21T09:27:22Z", 33 | "updated_at":"2019-05-21T09:27:22Z", 34 | "browser_download_url":"https://github.com/NathanReb/dune-release-testing/releases/download/v0.0.0/dummy-v0.0.0.tbz" 35 | } 36 | |} 37 | 38 | let gh_v3_api_example = 39 | {| 40 | { 41 | "url": "https://api.github.com/repos/octocat/Hello-World/releases/assets/1", 42 | "browser_download_url": "https://github.com/octocat/Hello-World/releases/download/v1.0.0/example.zip", 43 | "id": 1, 44 | "node_id": "MDEyOlJlbGVhc2VBc3NldDE=", 45 | "name": "example.zip", 46 | "label": "short description", 47 | "state": "uploaded", 48 | "content_type": "application/zip", 49 | "size": 1024, 50 | "download_count": 42, 51 | "created_at": "2013-02-27T19:35:32Z", 52 | "updated_at": "2013-02-27T19:35:32Z", 53 | "uploader": { 54 | "login": "octocat", 55 | "id": 1, 56 | "node_id": "MDQ6VXNlcjE=", 57 | "avatar_url": "https://github.com/images/error/octocat_happy.gif", 58 | "gravatar_id": "", 59 | "url": "https://api.github.com/users/octocat", 60 | "html_url": "https://github.com/octocat", 61 | "followers_url": "https://api.github.com/users/octocat/followers", 62 | "following_url": "https://api.github.com/users/octocat/following{/other_user}", 63 | "gists_url": "https://api.github.com/users/octocat/gists{/gist_id}", 64 | "starred_url": "https://api.github.com/users/octocat/starred{/owner}{/repo}", 65 | "subscriptions_url": "https://api.github.com/users/octocat/subscriptions", 66 | "organizations_url": "https://api.github.com/users/octocat/orgs", 67 | "repos_url": "https://api.github.com/users/octocat/repos", 68 | "events_url": "https://api.github.com/users/octocat/events{/privacy}", 69 | "received_events_url": "https://api.github.com/users/octocat/received_events", 70 | "type": "User", 71 | "site_admin": false 72 | } 73 | } 74 | |} 75 | -------------------------------------------------------------------------------- /bin/check.ml: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | open Dune_release 3 | 4 | let assert_tag_exists repo tag = 5 | if Vcs.tag_exists ~dry_run:false repo tag then Ok () 6 | else R.error_msgf "%a is not a valid tag" Vcs.Tag.pp tag 7 | 8 | let clone_and_checkout_tag repo ~dir ~tag = 9 | Sos.delete_dir ~dry_run:false ~force:true dir >>= fun () -> 10 | Vcs.clone ~dry_run:false ~force:true repo ~dir >>= fun () -> 11 | Vcs.get ~dir () >>= fun clone_vcs -> 12 | Vcs.checkout ~dry_run:false clone_vcs ~branch:"dune-release-check" 13 | ~commit_ish:tag 14 | 15 | let check (`Package_names pkg_names) (`Package_version version) (`Dist_tag tag) 16 | (`Keep_v keep_v) (`Build_dir build_dir) (`Skip_lint skip_lint) 17 | (`Skip_build skip_build) (`Skip_tests skip_tests) 18 | (`Skip_change_log skip_change_log) (`Working_tree on_working_tree) = 19 | (let dir, clean_up = 20 | if on_working_tree then (OS.Dir.current (), fun _ -> ()) 21 | else 22 | let dir = 23 | let pkg = Pkg.v ~dry_run:true ?tag ?version ?build_dir () in 24 | Pkg.tag pkg >>= fun inferred_tag -> 25 | Vcs.get () >>= fun repo -> 26 | assert_tag_exists repo inferred_tag >>= fun () -> 27 | (match build_dir with 28 | | Some dir -> Ok dir 29 | | None -> Fpath.of_string "_build") 30 | >>= fun build_directory -> 31 | let dir = Fpath.(build_directory // v ".dune-release-check") in 32 | clone_and_checkout_tag repo ~dir ~tag:(Tag inferred_tag) >>| fun () -> 33 | dir 34 | in 35 | let clean_up dir = 36 | match Sos.delete_dir ~dry_run:false ~force:true dir with 37 | | Ok _ -> () 38 | | Error (`Msg err) -> 39 | App_log.unhappy (fun l -> 40 | l "Auxiliary directory %a could not be deleted: %s" 41 | Text.Pp.path dir err) 42 | in 43 | (dir, clean_up) 44 | in 45 | dir >>= fun dir -> 46 | Config.keep_v ~keep_v >>= fun keep_v -> 47 | let check_result = 48 | Check.check_project ~pkg_names ?tag ?version ~keep_v ?build_dir ~skip_lint 49 | ~skip_build ~skip_tests ~skip_change_log ~dir () 50 | in 51 | let () = clean_up dir in 52 | check_result) 53 | |> R.reword_error_msg (fun err -> 54 | R.msgf "Error while running `check`: %s" err) 55 | |> Cli.handle_error 56 | 57 | open Cmdliner 58 | 59 | let working_tree = 60 | let doc = "Perform the check on the current working tree." in 61 | Cli.named 62 | (fun x -> `Working_tree x) 63 | Arg.(value & flag & info [ "working-tree" ] ~doc) 64 | 65 | let doc = "Check dune-release compatibility" 66 | 67 | let man = 68 | [ 69 | `S Manpage.s_description; 70 | `P 71 | "$(tname) checks if the release process with dune-release will be \ 72 | smooth, assuming that in other dune-release commands you'll provide the \ 73 | same options as here (with the exception of [--working-tree]). With the \ 74 | [--working-tree] option, you can perform the check on the current \ 75 | working tree; otherwise, it is performed on the tag from which \ 76 | dune-release creates the distribution tarball."; 77 | ] 78 | 79 | let term = 80 | Term.( 81 | const check $ Cli.pkg_names $ Cli.pkg_version $ Cli.dist_tag $ Cli.keep_v 82 | $ Cli.build_dir $ Cli.skip_lint $ Cli.skip_build $ Cli.skip_tests 83 | $ Cli.skip_change_log $ working_tree) 84 | 85 | let info = Cmd.info "check" ~doc ~man 86 | let cmd = Cmd.v info term 87 | -------------------------------------------------------------------------------- /lib/opam.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** opam helpers. *) 8 | 9 | open Bos_setup 10 | 11 | (** {1:cmd Command} *) 12 | 13 | val cmd : Cmd.t 14 | (** [cmd] is a command for [opam]. *) 15 | 16 | (** {1:publish Publish} *) 17 | 18 | val prepare_package : 19 | build_dir:Fpath.t -> 20 | dry_run:bool -> 21 | version:Version.t -> 22 | Vcs.t -> 23 | string -> 24 | (unit, R.msg) result 25 | 26 | val prepare : 27 | dry_run:bool -> 28 | ?msg:string -> 29 | local_repo:Fpath.t -> 30 | remote_repo:string -> 31 | opam_repo:string * string -> 32 | version:Version.t -> 33 | tag:Vcs.Tag.t -> 34 | project_name:string option -> 35 | string list -> 36 | (Vcs.commit_ish, R.msg) result 37 | (** [prepare ~local_repo ~version pkgs] adds the packages [pkg.version] to a new 38 | branch in the local opam repository [local_repo], using the commit message 39 | [msg] (if any). Return the new branch. *) 40 | 41 | (** {1:files Files} *) 42 | 43 | (** opam files *) 44 | module File : sig 45 | (** {1:file opam file} *) 46 | 47 | val fields : dry_run:bool -> Fpath.t -> (string list String.map, R.msg) result 48 | (** [fields f] returns a simplified model of the fields of the opam file [f]. 49 | Note that the [depends:] and [depopts:] fields are returned without 50 | version constraints. *) 51 | end 52 | 53 | (** [descr] files. *) 54 | module Descr : sig 55 | (** {1:descr Descr file} *) 56 | 57 | type t = string * string option 58 | (** The type for opam [descr] files, the package synopsis and the description. *) 59 | 60 | val of_string : string -> (t, R.msg) result 61 | (** [of_string s] is a description from the string [s]. *) 62 | 63 | val to_string : t -> string 64 | (** [to_string d] is [d] as a string. *) 65 | 66 | val of_readme_file : Fpath.t -> (t, R.msg) result 67 | (** [of_readme_file f] extracts an opam description file from a readme file 68 | [f] using {!Text.flavour_of_fpath}. *) 69 | end 70 | 71 | (** [url] files. *) 72 | module Url : sig 73 | (** {1:url Url file} *) 74 | 75 | val with_distrib_file : 76 | dry_run:bool -> uri:string -> Fpath.t -> (OpamFile.URL.t, R.msg) result 77 | (** [with_distrib_file ~uri f] is an URL file for URI [uri] with the checksum 78 | of file [f]. *) 79 | end 80 | 81 | (*--------------------------------------------------------------------------- 82 | Copyright (c) 2016 Daniel C. Bünzli 83 | 84 | Permission to use, copy, modify, and/or distribute this software for any 85 | purpose with or without fee is hereby granted, provided that the above 86 | copyright notice and this permission notice appear in all copies. 87 | 88 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 89 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 90 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 91 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 92 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 93 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 94 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 95 | ---------------------------------------------------------------------------*) 96 | -------------------------------------------------------------------------------- /lib/github_v4_api.ml: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | let is_handled errors (affix, _) = 4 | List.exists 5 | (fun error -> 6 | match Json.string_field ~field:"message" error with 7 | | Ok x -> String.is_prefix ~affix x 8 | | Error _ -> false) 9 | errors 10 | 11 | let pp_errors fs errors = 12 | List.iter 13 | (fun error -> 14 | match Json.string_field ~field:"message" error with 15 | | Ok message -> Fmt.string fs message 16 | | Error _ -> ()) 17 | errors 18 | 19 | let handle_errors json ~try_ ~on_ok ~default_msg ~handled_errors = 20 | match try_ json with 21 | | Ok x -> Ok (on_ok x) 22 | | Error _ -> ( 23 | let errors = 24 | match Json.list_field ~field:"errors" json with 25 | | Ok errors -> errors 26 | | Error _ -> [] 27 | in 28 | match List.find_opt (is_handled errors) handled_errors with 29 | | Some (_, ret) -> Ok ret 30 | | None -> 31 | R.error_msgf "@[Github API error:@ %s@;Github API returned: %a@]" 32 | default_msg pp_errors errors) 33 | 34 | let with_auth ~token Curl.{ url; meth; args } = 35 | Curl. 36 | { 37 | url; 38 | meth; 39 | args = Curl_option.Header (strf "Authorization: bearer %s" token) :: args; 40 | } 41 | 42 | let client = "dune-release" 43 | let url = "https://api.github.com/graphql" 44 | 45 | module Pull_request = struct 46 | module Request = struct 47 | let node_id ~user ~repo ~id = 48 | let json = 49 | strf 50 | {|{ "query": "query { repository(owner:\"%s\", name:\"%s\") { pullRequest(number:%i) { id } } }" }|} 51 | user repo id 52 | in 53 | let args = Curl_option.[ Data (`Data json) ] in 54 | Curl.{ url; meth = `POST; args } 55 | 56 | let ready_for_review ~node_id = 57 | let json = 58 | strf 59 | {|{ "query": "mutation { markPullRequestReadyForReview (input : {clientMutationId:\"%s\",pullRequestId:\"%s\"}) { pullRequest { url } } }" }|} 60 | client node_id 61 | in 62 | let args = Curl_option.[ Data (`Data json) ] in 63 | Curl.{ url; meth = `POST; args } 64 | end 65 | 66 | module Response = struct 67 | let node_id json = 68 | let default_msg = "Could not retrieve node_id from pull request" in 69 | let try_ json = 70 | match 71 | Yojson.Basic.Util.member "data" json 72 | |> Yojson.Basic.Util.member "repository" 73 | |> Yojson.Basic.Util.member "pullRequest" 74 | |> Json.string_field ~field:"id" 75 | with 76 | | exception _ -> R.error_msg default_msg 77 | | Ok node_id -> Ok node_id 78 | | Error _ -> R.error_msg default_msg 79 | in 80 | handle_errors json ~try_ 81 | ~on_ok:(fun x -> x) 82 | ~default_msg ~handled_errors:[] 83 | 84 | let url json = 85 | let default_msg = "Could not retrieve url from pull request" in 86 | let try_ json = 87 | match 88 | Yojson.Basic.Util.member "data" json 89 | |> Yojson.Basic.Util.member "markPullRequestReadyForReview" 90 | |> Yojson.Basic.Util.member "pullRequest" 91 | |> Json.string_field ~field:"url" 92 | with 93 | | exception _ -> R.error_msg default_msg 94 | | Ok node_id -> Ok node_id 95 | | Error _ -> R.error_msg default_msg 96 | in 97 | handle_errors json ~try_ 98 | ~on_ok:(fun x -> x) 99 | ~default_msg ~handled_errors:[] 100 | end 101 | end 102 | -------------------------------------------------------------------------------- /tests/lib/test_github_repo.ml: -------------------------------------------------------------------------------- 1 | let t = 2 | let open Dune_release.Github_repo in 3 | Alcotest.testable pp equal 4 | 5 | let test_from_uri = 6 | let make_test ~input ~expected = 7 | let name = Printf.sprintf "from_uri %S" input in 8 | let test_fun () = 9 | let actual = Dune_release.Github_repo.from_uri input in 10 | Alcotest.(check (option t)) name expected actual 11 | in 12 | (name, `Quick, test_fun) 13 | in 14 | [ 15 | make_test ~input:"https://github.com/owner/repo" 16 | ~expected:(Some { owner = "owner"; repo = "repo" }); 17 | make_test ~input:"https://github.com/owner/repo.git" 18 | ~expected:(Some { owner = "owner"; repo = "repo" }); 19 | make_test ~input:"git+https://github.com/owner/repo.git" 20 | ~expected:(Some { owner = "owner"; repo = "repo" }); 21 | make_test ~input:"git@github.com:owner/repo.git" 22 | ~expected:(Some { owner = "owner"; repo = "repo" }); 23 | make_test ~input:"ssh://git@github.com:owner/repo.git" 24 | ~expected:(Some { owner = "owner"; repo = "repo" }); 25 | make_test ~input:"git+ssh://git@github.com:owner/repo.git" 26 | ~expected:(Some { owner = "owner"; repo = "repo" }); 27 | make_test ~input:"https://owner.github.io/repo" 28 | ~expected:(Some { owner = "owner"; repo = "repo" }); 29 | make_test ~input:"https://owner.github.io/repo/path" 30 | ~expected:(Some { owner = "owner"; repo = "repo" }); 31 | make_test ~input:"https://gitlab.com/owner/repo" ~expected:None; 32 | ] 33 | 34 | let test_https_uri = 35 | let make_test ~name ~input ~expected = 36 | let name = Printf.sprintf "https_uri: %S" name in 37 | let test_fun () = 38 | let actual = Dune_release.Github_repo.https_uri input in 39 | Alcotest.(check string) name expected actual 40 | in 41 | (name, `Quick, test_fun) 42 | in 43 | [ 44 | make_test ~name:"Simple" 45 | ~input:{ owner = "owner"; repo = "repo" } 46 | ~expected:"https://github.com/owner/repo"; 47 | ] 48 | 49 | let test_ssh_uri = 50 | let make_test ~name ~input ~expected = 51 | let name = Printf.sprintf "ssh_uri: %S" name in 52 | let test_fun () = 53 | let actual = Dune_release.Github_repo.ssh_uri input in 54 | Alcotest.(check string) name expected actual 55 | in 56 | (name, `Quick, test_fun) 57 | in 58 | [ 59 | make_test ~name:"Simple" 60 | ~input:{ owner = "owner"; repo = "repo" } 61 | ~expected:"git@github.com:owner/repo.git"; 62 | ] 63 | 64 | let test_from_gh_pages = 65 | let make_test ~input ~expected = 66 | let name = "from_gh_pages: " ^ input in 67 | let test_fun () = 68 | let actual = Dune_release.Github_repo.from_gh_pages input in 69 | Alcotest.(check (option (pair t Alcotest_ext.path))) name expected actual 70 | in 71 | (name, `Quick, test_fun) 72 | in 73 | [ 74 | make_test ~input:"https://user.github.io/repo" 75 | ~expected:(Some ({ owner = "user"; repo = "repo" }, Fpath.v ".")); 76 | make_test ~input:"https://user.github.io/repo/" 77 | ~expected:(Some ({ owner = "user"; repo = "repo" }, Fpath.v ".")); 78 | make_test ~input:"https://user.github.io/repo/path" 79 | ~expected:(Some ({ owner = "user"; repo = "repo" }, Fpath.v "path")); 80 | make_test ~input:"https://user.github.io/repo/path/" 81 | ~expected:(Some ({ owner = "user"; repo = "repo" }, Fpath.v "path")); 82 | make_test ~input:"https://user.github.io/repo/long/path/" 83 | ~expected: 84 | (Some ({ owner = "user"; repo = "repo" }, Fpath.(v "long" / "path"))); 85 | ] 86 | 87 | let suite = 88 | ( "Github_repo", 89 | test_from_uri @ test_https_uri @ test_ssh_uri @ test_from_gh_pages ) 90 | -------------------------------------------------------------------------------- /tests/bin/invalid-version-number/run.t: -------------------------------------------------------------------------------- 1 | We need a basic opam project skeleton 2 | 3 | $ cat > CHANGES.md << EOF 4 | > ## 3.3.4~4.10preview1 5 | > 6 | > - Some other feature 7 | > 8 | > ## 0.0.0 9 | > 10 | > - Some feature 11 | > EOF 12 | $ cat > whatever.opam << EOF 13 | > opam-version: "2.0" 14 | > homepage: "https://github.com/user/repo" 15 | > dev-repo: "git+https://github.com/user/repo.git" 16 | > description: "whatever" 17 | > EOF 18 | $ touch README 19 | $ touch LICENSE 20 | $ cat > dune-project << EOF 21 | > (lang dune 2.4) 22 | > (name whatever) 23 | > EOF 24 | 25 | We need to set up a git project for dune-release to work properly 26 | 27 | $ cat > .gitignore << EOF 28 | > _build 29 | > /dune 30 | > run.t 31 | > EOF 32 | $ git init > /dev/null 2>&1 33 | $ git config user.name "dune-release-test" 34 | $ git config user.email "pseudo@pseudo.invalid" 35 | $ git add CHANGES.md whatever.opam dune-project README LICENSE .gitignore 36 | $ git commit -m "Initial commit" > /dev/null 37 | $ dune-release tag -y > /dev/null 38 | 39 | We do the whole dune-release process 40 | 41 | (1) distrib 42 | 43 | $ dune-release distrib --dry-run | grep preview1 44 | => rmdir _build/whatever-3.3.4~4.10preview1.build 45 | -: exec: git --git-dir .git rev-parse --verify refs/tags/3.3.4_4.10preview1 46 | => exec: git --git-dir .git show -s --format=%ct 3.3.4_4.10preview1^0 47 | git --git-dir .git clone --local .git _build/whatever-3.3.4~4.10preview1.build 48 | git --git-dir _build/whatever-3.3.4~4.10preview1.build/.git --work-tree _build/whatever-3.3.4~4.10preview1.build/ checkout --quiet -b dune-release-dist-3.3.4_4.10preview1 3.3.4_4.10preview1 49 | => chdir _build/whatever-3.3.4~4.10preview1.build 50 | [in _build/whatever-3.3.4~4.10preview1.build] 51 | -: rmdir _build/whatever-3.3.4~4.10preview1.build 52 | [+] Wrote archive _build/whatever-3.3.4~4.10preview1.tbz 53 | => exec: tar -xjf whatever-3.3.4~4.10preview1.tbz 54 | [-] Performing lint for package whatever in _build/whatever-3.3.4~4.10preview1 55 | => chdir _build/whatever-3.3.4~4.10preview1 56 | [in _build/whatever-3.3.4~4.10preview1] 57 | [ OK ] lint of _build/whatever-3.3.4~4.10preview1 and package whatever success 58 | [-] Building package in _build/whatever-3.3.4~4.10preview1 59 | => chdir _build/whatever-3.3.4~4.10preview1 60 | [-] Running package tests in _build/whatever-3.3.4~4.10preview1 61 | => chdir _build/whatever-3.3.4~4.10preview1 62 | -: rmdir _build/whatever-3.3.4~4.10preview1 63 | [+] Distribution for whatever 3.3.4~4.10preview1 64 | [+] Archive _build/whatever-3.3.4~4.10preview1.tbz 65 | 66 | (2) publish distrib 67 | 68 | $ dune-release publish distrib --dry-run --yes | grep preview1 69 | => must exists _build/whatever-3.3.4~4.10preview1.tbz 70 | -: exec: git --git-dir .git rev-parse --verify refs/tags/3.3.4_4.10preview1 71 | -: exec: git --git-dir .git rev-parse --verify refs/tags/3.3.4_4.10preview1 72 | git --git-dir .git ls-remote --quiet --tags https://github.com/user/repo.git 3.3.4_4.10preview1 73 | [-] Pushing tag 3.3.4_4.10preview1 to git@github.com:user/repo.git 74 | git --git-dir .git push --force git@github.com:user/repo.git 3.3.4_4.10preview1 75 | [-] Creating release 3.3.4~4.10preview1 on https://github.com/user/repo.git via github's API 76 | {"tag_name":"3.3.4_4.10preview1","name":"3.3.4~4.10preview1","body":"CHANGES:\n\n- Some other feature\n","draft":false} 77 | [-] Uploading _build/whatever-3.3.4~4.10preview1.tbz as a release asset for 3.3.4~4.10preview1 via github's API 78 | @_build/whatever-3.3.4~4.10preview1.tbz 79 | -: write _build/asset-3.3.4~4.10preview1.url 80 | 81 | Check the changelog 82 | 83 | $ cat _build/whatever-3.3.4~4.10preview1/CHANGES.md 84 | ## 3.3.4~4.10preview1 85 | 86 | - Some other feature 87 | 88 | ## 0.0.0 89 | 90 | - Some feature 91 | -------------------------------------------------------------------------------- /bin/opam.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** Entrypoints for the [distro] command. *) 8 | 9 | val get_pkgs : 10 | ?build_dir:Fpath.t -> 11 | ?opam:Fpath.t -> 12 | ?distrib_file:Fpath.t -> 13 | ?readme:Fpath.t -> 14 | ?change_log:Fpath.t -> 15 | ?publish_msg:string -> 16 | ?pkg_descr:Fpath.t -> 17 | dry_run:bool -> 18 | keep_v:bool Dune_release.Config.Cli.t -> 19 | tag:Dune_release.Vcs.Tag.t option -> 20 | pkg_names:string list -> 21 | version:Dune_release.Version.t option -> 22 | unit -> 23 | (Dune_release.Pkg.t list, Bos_setup.R.msg) result 24 | (** [get_pkgs ~build_dir ~opam ~distrib_uri ~distrib_file ~readme ~change_log 25 | ~publish_msg ~pkg_descr ~dry_run ~keep_v ~tag ~name ~pkg_names ~version ()] 26 | returns the list of packages built from the [distrib_file] or the associated 27 | error messages. *) 28 | 29 | val descr : pkgs:Dune_release.Pkg.t list -> (int, Bos_setup.R.msg) result 30 | (** [descr ~pkgs] prints the opam description of packages [pkgs]. Returns the 31 | exit code (0 for success, 1 for failure) or error messages. *) 32 | 33 | val pkg : 34 | ?distrib_uri:string -> 35 | dry_run:bool -> 36 | pkgs:Dune_release.Pkg.t list -> 37 | unit -> 38 | (int, Bos_setup.R.msg) result 39 | (** [pkg ~dry_run ~pkgs] creates the opam package descriptions for packages 40 | [pkgs] and upgrades them to opam 2.0 if necessary. Returns the exit code (0 41 | for success, 1 for failure) or error messages. *) 42 | 43 | val submit : 44 | ?local_repo:Fpath.t Dune_release.Config.Cli.t -> 45 | ?remote_repo:string Dune_release.Config.Cli.t -> 46 | ?opam_repo:string * string -> 47 | ?user:string -> 48 | ?token:string Dune_release.Config.Cli.t -> 49 | dry_run:bool -> 50 | pkgs:Dune_release.Pkg.t list -> 51 | pkg_names:string list -> 52 | no_auto_open:bool Dune_release.Config.Cli.t -> 53 | yes:bool -> 54 | draft:bool -> 55 | unit -> 56 | (int, Bos_setup.R.msg) result 57 | (** [submit ?distrib_uri ?local_repo ?remote_repo ?opam_repo ?user ~dry_run 58 | ~pkgs ~pkg_names ~no_auto_open ~yes ~draft ()] 59 | opens a pull request on the opam repository for the packages [pkgs]. Returns 60 | the exit code (0 for success, 1 for failure) or error messages. *) 61 | 62 | val field : 63 | pkgs:Dune_release.Pkg.t list -> 64 | field_name:string option -> 65 | (int, Bos_setup.R.msg) result 66 | (** [field ~pkgs ~field_name] prints the value of the field [field_name] in the 67 | opam file of packages [pkgs]. Returns the exit code (0 for success, 1 for 68 | failure) or error messages. *) 69 | 70 | (** The [opam] command. *) 71 | 72 | val cmd : int Cmdliner.Cmd.t 73 | 74 | (*--------------------------------------------------------------------------- 75 | Copyright (c) 2016 Daniel C. Bünzli 76 | 77 | Permission to use, copy, modify, and/or distribute this software for any 78 | purpose with or without fee is hereby granted, provided that the above 79 | copyright notice and this permission notice appear in all copies. 80 | 81 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 82 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 83 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 84 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 85 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 86 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 87 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 88 | ---------------------------------------------------------------------------*) 89 | -------------------------------------------------------------------------------- /bin/bistro.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | open Bos_setup.R.Infix 8 | 9 | (* Only carry on when the first operation returns 0 *) 10 | let ( >! ) x f = match x with Ok 0 -> f () | _ -> x 11 | 12 | let bistro () (`Dry_run dry_run) (`Package_names pkg_names) 13 | (`Package_version version) (`Dist_tag tag) (`Keep_v keep_v) (`Token token) 14 | (`Include_submodules include_submodules) (`Draft draft) 15 | (`Keep_build_dir keep_dir) (`Skip_lint skip_lint) (`Skip_build skip_build) 16 | (`Skip_tests skip_tests) (`Local_repo local_repo) (`Remote_repo remote_repo) 17 | (`Opam_repo opam_repo) (`No_auto_open no_auto_open) = 18 | Cli.handle_error 19 | ( Dune_release.Config.token ~token ~dry_run () >>= fun token -> 20 | let token = Dune_release.Config.Cli.make token in 21 | Distrib.distrib ~dry_run ~pkg_names ~version ~tag ~keep_v ~keep_dir 22 | ~skip_lint ~skip_build ~skip_tests ~include_submodules () 23 | >! fun () -> 24 | Publish.publish ~token ~pkg_names ~version ~tag ~keep_v ~dry_run 25 | ~publish_artefacts:[] ~yes:false ~draft () 26 | >! fun () -> 27 | Opam.get_pkgs ~dry_run ~keep_v ~tag ~pkg_names ~version () >>= fun pkgs -> 28 | Opam.pkg ~dry_run ~pkgs () >! fun () -> 29 | Opam.submit ~token ~dry_run ~pkgs ~pkg_names ~no_auto_open ~yes:false 30 | ~draft () ?local_repo ?remote_repo ?opam_repo ) 31 | 32 | (* Command line interface *) 33 | 34 | open Cmdliner 35 | 36 | let doc = "For when you are in a hurry or need to go for a drink" 37 | let sdocs = Manpage.s_common_options 38 | let exits = Cli.exits 39 | let man_xrefs = [ `Main; `Cmd "distrib"; `Cmd "publish"; `Cmd "opam" ] 40 | 41 | let man = 42 | [ 43 | `S Manpage.s_description; 44 | `P "The $(tname) command (quick in Russian) is equivalent to invoke:"; 45 | `Pre 46 | "dune-release distrib # Create the distribution archive\n\ 47 | dune-release publish # Publish it to Github with its documentation\n\ 48 | dune-release opam pkg # Create an opam package\n\ 49 | dune-release opam submit # Submit it to OCaml's opam repository"; 50 | `P "See dune-release(7) for more information."; 51 | ] 52 | 53 | let term = 54 | Term.( 55 | const bistro $ Cli.setup $ Cli.dry_run $ Cli.pkg_names $ Cli.pkg_version 56 | $ Cli.dist_tag $ Cli.keep_v $ Cli.token $ Cli.include_submodules $ Cli.draft 57 | $ Cli.keep_build_dir $ Cli.skip_lint $ Cli.skip_build $ Cli.skip_tests 58 | $ Cli.local_repo $ Cli.remote_repo $ Cli.opam_repo $ Cli.no_auto_open) 59 | 60 | let info = Cmd.info "bistro" ~doc ~sdocs ~exits ~man ~man_xrefs 61 | let cmd = Cmd.v info term 62 | 63 | (*--------------------------------------------------------------------------- 64 | Copyright (c) 2016 Daniel C. Bünzli 65 | 66 | Permission to use, copy, modify, and/or distribute this software for any 67 | purpose with or without fee is hereby granted, provided that the above 68 | copyright notice and this permission notice appear in all copies. 69 | 70 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 71 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 72 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 73 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 74 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 75 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 76 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 77 | ---------------------------------------------------------------------------*) 78 | -------------------------------------------------------------------------------- /tests/lib/test_text.ml: -------------------------------------------------------------------------------- 1 | let ch = Dune_release.Version.Changelog.of_string 2 | 3 | let test_change_log_last_entry = 4 | let make_test ~name ~input ~expected = 5 | let name = "change_log_last_entry " ^ name in 6 | let test_fun () = 7 | let changelog_version = Alcotest_ext.changelog_version in 8 | Alcotest.(check (option (pair changelog_version (pair string string)))) 9 | name expected 10 | (Dune_release.Text.change_log_last_entry input) 11 | in 12 | (name, `Quick, test_fun) 13 | in 14 | [ 15 | make_test ~name:"empty" ~input:"" ~expected:None; 16 | make_test ~name:"change list 0" 17 | ~input:{| 18 | # v0.1 19 | - change A 20 | - change B 21 | |} 22 | ~expected:(Some (ch "v0.1", ("# v0.1", " - change A\n - change B"))); 23 | make_test ~name:"change list 1" 24 | ~input:{| 25 | # v0.1 26 | 27 | - change A 28 | - change B 29 | |} 30 | ~expected:(Some (ch "v0.1", ("# v0.1", " - change A\n - change B"))); 31 | make_test ~name:"change list 2" 32 | ~input:{| 33 | # v0.1 34 | 35 | 36 | - change A 37 | - change B 38 | |} 39 | ~expected:(Some (ch "v0.1", ("# v0.1", "\n - change A\n - change B"))); 40 | make_test ~name:"many entries" 41 | ~input:{| 42 | # v0.1 43 | 44 | change A 45 | 46 | # v0.0.1 47 | 48 | change B 49 | |} 50 | ~expected:(Some (ch "v0.1", ("# v0.1", "change A"))); 51 | make_test ~name:"keepachangelog.com 1" 52 | ~input: 53 | {| 54 | # Changelog 55 | All notable changes to this project will be documented in this file. 56 | 57 | The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), 58 | and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). 59 | 60 | ## [Unreleased] 61 | 62 | ## [1.0.0] - 2021-12-26 63 | ### Added 64 | - Added 3 65 | - Added 2 66 | 67 | ### Changed 68 | - Changed 1 69 | 70 | ### Removed 71 | - Removed 1 72 | 73 | ## [0.3.0] - 2021-12-03 74 | ### Added 75 | - Added 1 76 | |} 77 | ~expected:(Some (ch "Unreleased", ("## [Unreleased]", ""))); 78 | make_test ~name:"keepachangelog.com 2" 79 | ~input: 80 | {| 81 | # Changelog 82 | All notable changes to this project will be documented in this file. 83 | 84 | The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), 85 | and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). 86 | 87 | ## [1.0.0] - 2021-12-26 88 | ### Added 89 | - Added 3 90 | - Added 2 91 | 92 | ### Changed 93 | - Changed 1 94 | 95 | ### Removed 96 | - Removed 1 97 | 98 | ## [0.3.0] - 2021-12-03 99 | ### Added 100 | - Added 1 101 | |} 102 | ~expected: 103 | (Some 104 | ( ch "1.0.0", 105 | ( "## [1.0.0] - 2021-12-26", 106 | "### Added\n\ 107 | - Added 3\n\ 108 | - Added 2\n\n\ 109 | ### Changed\n\ 110 | - Changed 1\n\n\ 111 | ### Removed\n\ 112 | - Removed 1" ) )); 113 | ] 114 | 115 | let test_rewrite_github_refs = 116 | let user = "user" and repo = "repo" in 117 | let make_test name (input, expected) = 118 | let name = "rewrite_github_refs " ^ name in 119 | let test_fun () = 120 | Alcotest.(check string) 121 | name expected 122 | (Dune_release.Text.rewrite_github_refs ~user ~repo input) 123 | in 124 | (name, `Quick, test_fun) 125 | in 126 | [ 127 | make_test "rewritten 0" ("... #123 ...", "... user/repo#123 ..."); 128 | make_test "rewritten 1" ("... (#123 ...", "... (user/repo#123 ..."); 129 | make_test "not rewritten 0" ("... xyz#123 ...", "... xyz#123 ..."); 130 | make_test "not rewritten 1" ("... (xyz#123 ...", "... (xyz#123 ..."); 131 | make_test "not rewritten 2" ("... xy0#123 ...", "... xy0#123 ..."); 132 | make_test "not rewritten 3" ("... (xy0#123 ...", "... (xy0#123 ..."); 133 | ] 134 | 135 | let suite = ("Text", test_change_log_last_entry @ test_rewrite_github_refs) 136 | -------------------------------------------------------------------------------- /lib/config.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | type t = { 18 | user : string option; 19 | remote : string; 20 | local : Fpath.t; 21 | keep_v : bool option; 22 | auto_open : bool option; 23 | } 24 | 25 | module Opam_repo_fork : sig 26 | type t = { remote : string; local : Fpath.t } 27 | end 28 | 29 | val create : ?pkgs:Pkg.t list -> unit -> (unit, Bos_setup.R.msg) result 30 | 31 | module Cli : sig 32 | type 'a t 33 | (** Type for configuration values passed through the CLI. *) 34 | 35 | val make : 'a -> 'a t 36 | end 37 | 38 | val token : 39 | token:string Cli.t option -> 40 | dry_run:bool -> 41 | unit -> 42 | (string, Bos_setup.R.msg) result 43 | (** Returns the token value that should be used for github API requests. If a 44 | [token] was provided via the CLI, it is returned. Otherwise the token file 45 | in the config dir is looked up. If it exists, its content is returned, if it 46 | does not, the user is prompted for a token which will be then saved to that 47 | file. When [dry_run] is [true] it always returns [Ok "${token}"] but still 48 | looks up the relevant config file as it would normally have. *) 49 | 50 | val keep_v : keep_v:bool Cli.t -> (bool, Bos_setup.R.msg) result 51 | val auto_open : no_auto_open:bool Cli.t -> (bool, Bos_setup.R.msg) result 52 | 53 | val opam_repo_fork : 54 | ?pkgs:Pkg.t list -> 55 | remote:string Cli.t option -> 56 | local:Fpath.t Cli.t option -> 57 | unit -> 58 | (Opam_repo_fork.t, Bos_setup.R.msg) result 59 | (** Returns the opam-repository fork to use, based on the CLI provided values 60 | [remote] and [local] and the user's configuration. 61 | 62 | If both [remote] and [local] are provided, they are returned without reading 63 | any local configuration. 64 | 65 | If either or both of them are [None], the configuration is looked up. If it 66 | doesn't exist, the interactive creation quizz is started. The configuration 67 | values are used to fill up the blanks in [remote] and [local]. 68 | 69 | [pkgs] is only used to offer suggestions to the user during the creation 70 | quizz. *) 71 | 72 | val load : unit -> (t option, Bos_setup.R.msg) result 73 | val save : t -> (unit, Bos_setup.R.msg) result 74 | 75 | val pretty_fields : t -> (string * string option) list 76 | (** [pretty_fields t] returns the list of pretty-printed key-value pairs for the 77 | config [t]. *) 78 | 79 | module type S = sig 80 | val path : build_dir:Fpath.t -> name:string -> version:Version.t -> Fpath.t 81 | 82 | val set : 83 | dry_run:bool -> 84 | build_dir:Fpath.t -> 85 | name:string -> 86 | version:Version.t -> 87 | string -> 88 | (unit, Bos_setup.R.msg) result 89 | 90 | val is_set : 91 | dry_run:bool -> 92 | build_dir:Fpath.t -> 93 | name:string -> 94 | version:Version.t -> 95 | (bool, Bos_setup.R.msg) result 96 | 97 | val get : 98 | dry_run:bool -> 99 | build_dir:Fpath.t -> 100 | name:string -> 101 | version:Version.t -> 102 | (string, Bos_setup.R.msg) result 103 | 104 | val unset : 105 | dry_run:bool -> 106 | build_dir:Fpath.t -> 107 | name:string -> 108 | version:Version.t -> 109 | (unit, Bos_setup.R.msg) result 110 | end 111 | 112 | module Draft_release : S 113 | module Draft_pr : S 114 | module Release_asset_name : S 115 | -------------------------------------------------------------------------------- /lib/text.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** Text processing helpers. *) 8 | 9 | open Bos_setup 10 | 11 | (** {1 Marked-up text files} 12 | 13 | {b Warning.} Some of the following functions are not serious and can break 14 | on certain valid inputs in all sorts of fashion. To understand breakage bear 15 | in mind that they operate line-wise. *) 16 | 17 | type flavour = [ `Markdown | `Asciidoc ] 18 | (** The type for text document formats. *) 19 | 20 | val flavour_of_fpath : Fpath.t -> flavour option 21 | (** [flavour_of_fpath p] determines a flavour according to the extension of [p] 22 | as follows: 23 | 24 | - [Some `Markdown] for [.md] 25 | - [Some `Asciidoc] for [.asciidoc] or [.adoc] 26 | - [None] otherwise *) 27 | 28 | val head : ?flavour:flavour -> string -> (string * string) option 29 | (** [head ~flavour text] extracts the {e head} of the document [text] of flavour 30 | [flavour] (defaults to [`Markdown]). 31 | 32 | The head is defined as follows: 33 | 34 | - Anything before the first header is discarded. 35 | - The first header is kept in the first component 36 | - Everything that follows until the next header of the same or greater level 37 | is kept discarding trailing blank lines. *) 38 | 39 | val header_title : ?flavour:flavour -> string -> string 40 | (** [header_title ~flavour text] extract the title of a header [text] of flavour 41 | [flavour] (defaults to [`Markdown]). *) 42 | 43 | (** {1 Toy change log parsing} *) 44 | 45 | val change_log_last_entry : 46 | ?flavour:[< `Asciidoc | `Markdown > `Markdown ] -> 47 | string -> 48 | (Version.Changelog.t * (string * string)) option 49 | (** [change_log_last_entry ?flavour changes] tries to parse the last change log 50 | entry of the string [changes] using the [flavour] syntax. *) 51 | 52 | val change_log_file_last_entry : 53 | Fpath.t -> (Version.Changelog.t * (string * string), R.msg) result 54 | (** [change_log_file_last_entry file] tries to parse the last change log entry 55 | of the file [file] using {!flavour_of_fpath} and {!change_log_last_entry}. *) 56 | 57 | val rewrite_github_refs : user:string -> repo:string -> string -> string 58 | (** [rewrite_github_refs ~user ~repo s] replaces references like [#yyy] with 59 | [user/repo#yyy]. *) 60 | 61 | (** Pretty printers. *) 62 | module Pp : sig 63 | (** {1 Pretty printers} *) 64 | 65 | val name : string Fmt.t 66 | (** [name] formats a package name. *) 67 | 68 | val version : Version.t Fmt.t 69 | (** [version] formats a package version. *) 70 | 71 | val tag : Vcs.Tag.t Fmt.t 72 | (** [tag] formats a VCS tag. *) 73 | 74 | val commit : Vcs.commit_ish Fmt.t 75 | (** [commit] formats a commit-ish. *) 76 | 77 | val dirty : unit Fmt.t 78 | (** [dirty] formats a "dirty" string. *) 79 | 80 | val path : Fpath.t Fmt.t 81 | (** [path] formats a bold normalized path *) 82 | 83 | val url : string Fmt.t 84 | (** [url] formats an underlined URL *) 85 | 86 | val status : [ `Ok | `Fail ] Fmt.t 87 | (** [status] formats a result status. *) 88 | 89 | val maybe_draft : (bool * string) Fmt.t 90 | end 91 | 92 | (*--------------------------------------------------------------------------- 93 | Copyright (c) 2016 Daniel C. Bünzli 94 | 95 | Permission to use, copy, modify, and/or distribute this software for any 96 | purpose with or without fee is hereby granted, provided that the above 97 | copyright notice and this permission notice appear in all copies. 98 | 99 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 100 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 101 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 102 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 103 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 104 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 105 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 106 | ---------------------------------------------------------------------------*) 107 | -------------------------------------------------------------------------------- /lib/sos.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2018 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Safe OS operations. 18 | 19 | All the commands in that module can have side-effects. They also all take a 20 | [--dry-run] parameter which cause the side-effect to be discarded and to 21 | display a message instead. Some of these commands also have a `[--force]` 22 | option: this causes the message to be printed AND the side-effects to be 23 | caused. *) 24 | 25 | type error = Bos_setup.R.msg 26 | 27 | val show : 28 | ?sandbox:bool -> 29 | ?action:[ `Done | `Skip ] -> 30 | ('a, Format.formatter, unit, (unit, 'b) result) format4 -> 31 | 'a 32 | 33 | val cmd_error : 34 | Bos.Cmd.t -> string option -> Bos.OS.Cmd.status -> ('a, Rresult.R.msg) result 35 | (** [cmd_error cmd ~stderr status] returns an error message describing the 36 | failing command [cmd], the exit status [status] and, if existent, also the 37 | error message [err_msg]. *) 38 | 39 | val run : 40 | dry_run:bool -> 41 | ?force:bool -> 42 | ?sandbox:bool -> 43 | Bos.Cmd.t -> 44 | (unit, error) result 45 | 46 | val run_quiet : 47 | dry_run:bool -> 48 | ?force:bool -> 49 | ?sandbox:bool -> 50 | Bos.Cmd.t -> 51 | (unit, error) result 52 | (** Same as run but redirects err and out to null *) 53 | 54 | val run_io : 55 | dry_run:bool -> 56 | ?force:bool -> 57 | ?sandbox:bool -> 58 | default:'a -> 59 | Bos.Cmd.t -> 60 | Bos.OS.Cmd.run_in -> 61 | (Bos.OS.Cmd.run_out -> ('a, 'b) result) -> 62 | ('a, 'b) result 63 | 64 | val run_out : 65 | dry_run:bool -> 66 | ?force:bool -> 67 | ?sandbox:bool -> 68 | ?err:Bos.OS.Cmd.run_err -> 69 | default:'a -> 70 | Bos.Cmd.t -> 71 | (Bos.OS.Cmd.run_out -> ('a, 'b) result) -> 72 | ('a, 'b) result 73 | 74 | type 'a response = { 75 | output : 'a; 76 | err_msg : string; 77 | status : Bos.OS.Cmd.status; 78 | run_info : Bos.OS.Cmd.run_info; 79 | } 80 | 81 | val run_out_err : 82 | dry_run:bool -> 83 | ?force:bool -> 84 | ?sandbox:bool -> 85 | default:'a * Bos.OS.Cmd.run_status -> 86 | Bos.Cmd.t -> 87 | (Bos.OS.Cmd.run_out -> 88 | ('a * Bos.OS.Cmd.run_status, ([> Rresult.R.msg ] as 'b)) result) -> 89 | ('a response, 'b) result 90 | 91 | val run_status : 92 | dry_run:bool -> 93 | ?force:bool -> 94 | ?sandbox:bool -> 95 | Bos.Cmd.t -> 96 | (Bos.OS.Cmd.status, error) result 97 | 98 | val delete_dir : dry_run:bool -> ?force:bool -> Fpath.t -> (unit, error) result 99 | val delete_path : dry_run:bool -> Fpath.t -> (unit, error) result 100 | val read_file : dry_run:bool -> Fpath.t -> (string, error) result 101 | 102 | val write_file : 103 | dry_run:bool -> ?force:bool -> Fpath.t -> string -> (unit, error) result 104 | 105 | val with_dir : dry_run:bool -> Fpath.t -> ('a -> 'b) -> 'a -> ('b, error) result 106 | val file_exists : dry_run:bool -> Fpath.t -> (bool, error) result 107 | val dir_exists : dry_run:bool -> Fpath.t -> (bool, error) result 108 | val file_must_exist : dry_run:bool -> Fpath.t -> (Fpath.t, error) result 109 | val out : 'a -> 'a * Bos.OS.Cmd.run_status 110 | val mkdir : dry_run:bool -> Fpath.t -> (bool, error) result 111 | 112 | val cp : 113 | dry_run:bool -> 114 | rec_:bool -> 115 | force:bool -> 116 | src:Fpath.t -> 117 | dst:Fpath.t -> 118 | (unit, error) result 119 | (** [cp ~dry_run ~rec ~force ~src ~dst] copies [src] to [dst]. If [rec] is true, 120 | copies directories recursively. If [force] is true, overwrite existing 121 | files. The usual [force] arguments from other functions in this module is 122 | renamed [force_side_effects] here. *) 123 | 124 | val relativize : src:Fpath.t -> dst:Fpath.t -> (Fpath.t, error) result 125 | (** [relativize ~src ~dst] return a relative path from [src] to [dst]. If such a 126 | path can't be expressed, i.e. [srs] and [dst] don't have a common root, 127 | returns an error. *) 128 | -------------------------------------------------------------------------------- /tests/lib/test_github_v4_api.ml: -------------------------------------------------------------------------------- 1 | open Dune_release.Github_v4_api 2 | 3 | let test_with_auth = 4 | let token = "token" in 5 | let make_test ~test_name ~curl_t ~expected = 6 | let test_fun () = 7 | let actual = with_auth ~token curl_t in 8 | Alcotest.check Alcotest_ext.curl test_name expected actual 9 | in 10 | (test_name, `Quick, test_fun) 11 | in 12 | [ 13 | make_test ~test_name:"basic" 14 | ~curl_t: 15 | { 16 | url = "https://api.github.com/graphql"; 17 | meth = `POST; 18 | args = [ Config `Stdin; Dump_header `Ignore ]; 19 | } 20 | ~expected: 21 | { 22 | url = "https://api.github.com/graphql"; 23 | meth = `POST; 24 | args = 25 | [ 26 | Header (Bos_setup.strf "Authorization: bearer %s" token); 27 | Config `Stdin; 28 | Dump_header `Ignore; 29 | ]; 30 | }; 31 | ] 32 | 33 | let test_pr_request_node_id = 34 | let make_test ~name ~user ~repo ~id ~expected = 35 | let test_name = "Pull_request.Request.node_id: " ^ name in 36 | let test_fun () = 37 | let actual = Pull_request.Request.node_id ~user ~repo ~id in 38 | Alcotest.check Alcotest_ext.curl test_name expected actual 39 | in 40 | (test_name, `Quick, test_fun) 41 | in 42 | [ 43 | make_test ~name:"simple" ~user:"you" ~repo:"some-repo" ~id:4 44 | ~expected: 45 | { 46 | url = "https://api.github.com/graphql"; 47 | meth = `POST; 48 | args = 49 | [ 50 | Data 51 | (`Data 52 | {|{ "query": "query { repository(owner:\"you\", name:\"some-repo\") { pullRequest(number:4) { id } } }" }|}); 53 | ]; 54 | }; 55 | ] 56 | 57 | let test_pr_ready_for_review = 58 | let make_test ~name ~node_id ~expected = 59 | let test_name = "Pull_request.Request.ready_for_review: " ^ name in 60 | let test_fun () = 61 | let actual = Pull_request.Request.ready_for_review ~node_id in 62 | Alcotest.check Alcotest_ext.curl test_name expected actual 63 | in 64 | (test_name, `Quick, test_fun) 65 | in 66 | [ 67 | make_test ~name:"simple" ~node_id:"node_id" 68 | ~expected: 69 | { 70 | url = "https://api.github.com/graphql"; 71 | meth = `POST; 72 | args = 73 | [ 74 | Data 75 | (`Data 76 | {|{ "query": "mutation { markPullRequestReadyForReview (input : {clientMutationId:\"dune-release\",pullRequestId:\"node_id\"}) { pullRequest { url } } }" }|}); 77 | ]; 78 | }; 79 | ] 80 | 81 | let test_pr_response_node_id = 82 | let make_test name json expected = 83 | let test_name = "Pull_request.Response.node_id: " ^ name in 84 | let test_fun () = 85 | let json = Yojson.Basic.from_string json in 86 | match Pull_request.Response.node_id json with 87 | | Ok id -> Alcotest.(check string) __LOC__ expected id 88 | | Error (`Msg msg) -> Alcotest.(check string) __LOC__ expected msg 89 | in 90 | (test_name, `Quick, test_fun) 91 | in 92 | [ 93 | make_test "passing" Pull_request_response.gh_v4_api_node_id_example 94 | "MDExOlB1bGxSZXF1ZXN0NTUxODAxMTU2"; 95 | make_test "unhandled failure" 96 | Pull_request_response.gh_v4_api_node_id_unhandled_failure 97 | "Github API error:\n\ 98 | \ Could not retrieve node_id from pull request\n\ 99 | \ Github API returned: Could not resolve to a Repository with the name \ 100 | 'user/foo'."; 101 | ] 102 | 103 | let test_pr_response_url = 104 | let make_test name json expected = 105 | let test_name = "Pull_request.Response.url: " ^ name in 106 | let test_fun () = 107 | let json = Yojson.Basic.from_string json in 108 | match Pull_request.Response.url json with 109 | | Ok id -> Alcotest.(check string) __LOC__ expected id 110 | | Error (`Msg msg) -> Alcotest.(check string) __LOC__ expected msg 111 | in 112 | (test_name, `Quick, test_fun) 113 | in 114 | [ 115 | make_test "passing" Pull_request_response.gh_v4_api_url_example 116 | "https://github.com/user/opam-repository/pull/8"; 117 | make_test "unhandled failure" 118 | Pull_request_response.gh_v4_api_url_unhandled_failure 119 | "Github API error:\n\ 120 | \ Could not retrieve url from pull request\n\ 121 | \ Github API returned: Could not resolve to a node with the global id \ 122 | of 'foo'"; 123 | ] 124 | 125 | let suite = 126 | ( "Github_v4_api", 127 | test_with_auth @ test_pr_request_node_id @ test_pr_response_node_id 128 | @ test_pr_ready_for_review @ test_pr_response_url ) 129 | -------------------------------------------------------------------------------- /lib/check.ml: -------------------------------------------------------------------------------- 1 | open Bos_setup 2 | 3 | let build ~dry_run ~dir pkg_names = 4 | let out = OS.Cmd.out_string in 5 | let build_result = 6 | App_log.blank_line (); 7 | App_log.status (fun m -> m "Building package in %a" Fpath.pp dir); 8 | Pkg.build ~dry_run pkg_names ~dir ~args:Cmd.empty ~out 9 | in 10 | build_result >>= function 11 | | _, (_, `Exited 0) -> 12 | App_log.report_status `Ok (fun m -> m "package(s) build"); 13 | Ok 0 14 | | stdout, _ -> 15 | Logs.app (fun m -> m "%s" stdout); 16 | App_log.report_status `Fail (fun m -> m "package(s) build"); 17 | Ok 1 18 | 19 | let test ~dry_run ~dir pkg_names = 20 | let out = OS.Cmd.out_string in 21 | let test_result = 22 | App_log.blank_line (); 23 | App_log.status (fun m -> m "Running package tests in %a" Fpath.pp dir); 24 | Pkg.test ~dry_run ~dir ~args:Cmd.empty ~out pkg_names 25 | in 26 | test_result >>= function 27 | | _, (_, `Exited 0) -> 28 | App_log.report_status `Ok (fun m -> m "package(s) pass the tests"); 29 | Ok 0 30 | | stdout, _ -> 31 | Logs.app (fun m -> m "%s" stdout); 32 | App_log.report_status `Fail (fun m -> m "package(s) pass the tests"); 33 | Ok 1 34 | 35 | let dune_checks ~dry_run ~skip_build ~skip_tests ~pkg_names dir = 36 | Pkg.infer_pkg_names dir pkg_names >>= fun pkg_names -> 37 | (if skip_build then Ok 0 else build ~dry_run ~dir pkg_names) >>= fun c1 -> 38 | (if skip_tests || skip_build then Ok 0 else test ~dry_run ~dir pkg_names) 39 | >>| fun c2 -> if c1 + c2 = 0 then 0 else 1 40 | 41 | let pkg_creation_check ?tag ?version ~keep_v ?build_dir dir = 42 | let check_creation () = 43 | Pkg.try_infer_name Fpath.(v ".") >>= function 44 | | None -> Rresult.R.error_msgf Pkg.infer_name_err 45 | | Some _ -> ( 46 | match Pkg.v ~dry_run:false ?tag ?version ~keep_v ?build_dir () with 47 | | pkg -> Ok pkg 48 | | exception Invalid_argument err -> Rresult.R.error_msgf "%s" err) 49 | in 50 | R.join @@ Sos.with_dir ~dry_run:false dir check_creation () 51 | 52 | let opam_file_check ~dir pkg = 53 | let check () = 54 | let ok_needed = Pkg.infer_github_repo pkg in 55 | Pkg.opam pkg >>| fun main_opam -> 56 | (* Pkg.opam only returns an error if something is wrong internally *) 57 | match ok_needed with 58 | | Ok _ -> 59 | App_log.report_status `Ok (fun m -> 60 | m "The dev-repo field of %a contains a github uri." Text.Pp.path 61 | main_opam); 62 | 0 63 | | Error (`Msg err) -> 64 | App_log.report_status `Fail (fun m -> 65 | m 66 | "main package %a is not dune-release compatible. %s\n\ 67 | Have you provided a github uri in the dev-repo field of your \ 68 | main opam file? If you don't use github, you can still use \ 69 | dune-release for everything but for publishing your release on \ 70 | the web. In that case, have a look at `dune-release \ 71 | delegate-info`." 72 | Text.Pp.path main_opam err); 73 | 1 74 | in 75 | R.join @@ Sos.with_dir ~dry_run:false dir check () 76 | 77 | let dune_project_check dir = 78 | let check () = 79 | Pkg.dune_project_name (Fpath.v ".") >>| function 80 | | Some _ -> 81 | App_log.report_status `Ok (fun m -> 82 | m "The dune project contains a name stanza."); 83 | 0 84 | | None -> 85 | App_log.report_status `Fail (fun m -> 86 | m "The dune project doesn't contain a name stanza. Please, add one."); 87 | 1 88 | in 89 | R.join @@ Sos.with_dir ~dry_run:false dir check () 90 | 91 | let change_log_check pkg = 92 | App_log.blank_line (); 93 | App_log.status (fun m -> m "Validating change log."); 94 | let result = 95 | Pkg.change_log pkg >>= Text.change_log_file_last_entry >>| Fun.const 0 96 | in 97 | if Result.is_ok result then 98 | App_log.report_status `Ok (fun m -> m "Change log is valid.") 99 | else App_log.report_status `Fail (fun m -> m "Change log is not valid."); 100 | result 101 | 102 | let check_project ~pkg_names ~skip_lint ~skip_build ~skip_tests ~skip_change_log 103 | ?tag ?version ~keep_v ?build_dir ~dir () = 104 | match pkg_creation_check ?tag ?version ~keep_v ?build_dir dir with 105 | | Error (`Msg err) -> 106 | App_log.report_status `Fail (fun m -> m "%s" err); 107 | Ok 1 108 | | Ok pkg -> 109 | App_log.status (fun m -> m "Checking dune-release compatibility."); 110 | opam_file_check ~dir pkg >>= fun opam_file_exit -> 111 | dune_project_check dir >>= fun dune_project_exit -> 112 | dune_checks ~dry_run:false ~skip_build ~skip_tests ~pkg_names dir 113 | >>= fun dune_exit -> 114 | (if skip_lint then Ok 0 115 | else Lint.lint_packages ~dry_run:false ~dir ~todo:Lint.all pkg pkg_names) 116 | >>= fun lint_exit -> 117 | (if skip_change_log then Ok 0 else change_log_check pkg) 118 | >>| fun change_log_exit -> 119 | opam_file_exit + dune_project_exit + dune_exit + lint_exit 120 | + change_log_exit 121 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | ## Setting up your working environment 2 | 3 | If you want to contribute to the project you'll first need to install the dependencies. 4 | You can do it via `opam`: 5 | 6 | ```sh 7 | $ git clone git@github.com:tarides/dune-release.git 8 | $ cd dune-release 9 | $ opam switch create ./ ocaml-base-compiler.4.14.0 --deps-only -t 10 | ``` 11 | 12 | This will create a local switch with a fresh compiler, the dependencies of 13 | `dune-release` and the dependencies for running the tests. The exact OCaml 14 | version is just an example, you should be able to use any reasonably recent 15 | version of OCaml. 16 | 17 | From there you can build `dune-release` by simply running: 18 | 19 | ```sh 20 | $ dune build 21 | ``` 22 | 23 | and run the test suite with: 24 | 25 | ```sh 26 | $ dune runtest 27 | ``` 28 | 29 | ## Tests 30 | 31 | In a effort to cover as much of the codebase with tests as possible, new contributions 32 | should come with tests when possible/it makes sense. 33 | 34 | dune-release uses [dune's cram 35 | tests](https://dune.readthedocs.io/en/stable/tests.html#cram-tests) extensively 36 | to make sure the workflows work as expected and don't break for our users. 37 | 38 | ### Unit testing 39 | 40 | We should aim at improving the unit tests coverage as much as possible. Our 41 | unit tests can be found in [`tests/lib/`](tests/lib). They are written using 42 | the [alcotest](https://github.com/mirage/alcotest) testing framework. If you 43 | want to add new tests, we encourage you to reuse the style used in the existing 44 | tests ([`test_vcs.ml`](tests/lib/test_vcs.ml) is a good example). 45 | 46 | There should be one test module per actual module there. The test runner is 47 | [`tests.ml`](tests/lib/tests.ml). If you add tests for a new or so far untested 48 | module, don't forget to add its test suite to the runner. 49 | 50 | For each function we test, we build a list of Alcotest `unit test_case`. It's 51 | important to try to be consistent in that regard as it makes the output of the 52 | test runner more readable and helps with fixing or investigating broken tests. 53 | 54 | For each module, we then have one Alcotest `unit test` that contains the 55 | concatenation of all the test cases. 56 | 57 | That results in the following test output for a successful run: 58 | 59 | ```sh 60 | $ dune runtest 61 | tests alias tests/lib/runtest 62 | Testing `dune-release'. 63 | This run has ID `14602E98-BFF4-4D74-A50A-56466A3F2C5B'. 64 | 65 | [OK] Github 0 Parse.ssh_uri_from_http https://gi... 66 | ... 67 | [OK] Github_repo 15 from_gh_pages: https://user.github... 68 | 69 | Full test results in `.../_build/default/tests/lib/_build/_tests/dune-release'. 70 | Test Successful in 0.017s. 95 tests run. 71 | ``` 72 | 73 | ### End-to-end testing 74 | 75 | End-to-end tests directly call the `dune-release` binary and make sure it 76 | behaves in the expected way. They live in the [`tests/bin/`](tests/bin) 77 | directory. 78 | 79 | We have one folder there per aspect we want to test, for instance the tests for 80 | determining the version from a tag live in 81 | [`version-from-tag/`](tests/bin/version-from-tag). 82 | 83 | Make sure to only output relevant information in your test by e.g. 84 | postprocessing the output with `grep` and the usual POSIX tools. This makes the 85 | test more relevant, easier to read and less fragile should other things change. 86 | 87 | If these tools don't suffice/are not portable there is an OCaml helper binary 88 | [`tests/bin/helpers/make_dune_release_deterministic`](tests/bin/helpers/make_dune_release_deterministic.ml) 89 | that can be extended to make the output more deterministic and can be used to 90 | filter output in the `cram` tests. 91 | 92 | If your tests change behavior but the change is correct you can use `dune 93 | promote` to update your test file so the next run of `dune runtest` will expect 94 | the new behavior. 95 | 96 | ## Code formatting 97 | 98 | Submitted code should be formatted using the supplied ocamlformat config. To do 99 | so easily use dune's [automated 100 | formatting](https://dune.readthedocs.io/en/stable/formatting.html#formatting-a-project): 101 | 102 | ```sh 103 | $ dune fmt 104 | ``` 105 | 106 | This will automatically reformat all source files to fit the configuation. 107 | 108 | When submitting a PR, the CI will check for formatting, so if the formatting is 109 | wrong it will issue an error. 110 | 111 | ## Changelog 112 | 113 | User-visible changes should come with an entry in the [changelog](CHANGES.md) 114 | under the appropriate part of the **unreleased** section. They should describe 115 | the change from the point of view of a user and include the PR number and 116 | username of the contributor. Check the existing entries for reference. 117 | 118 | The PR number is only known at submit time, so the placeholder `#` 119 | can be used, which will then trigger a bot to suggest the right number of the 120 | PR when submitting. 121 | 122 | When submitting a PR the PR check require an entry, although for changes that 123 | are not user-visible this can be overridden using the "no changelog" label. 124 | -------------------------------------------------------------------------------- /tests/lib/test_pkg.ml: -------------------------------------------------------------------------------- 1 | open Rresult 2 | open Dune_release 3 | module Stdext = Dune_release.Stdext 4 | 5 | let test_version_line_re = 6 | let make_test ~input ~expected = 7 | let test_name = 8 | if expected then input ^ "is a valid version field line" 9 | else input ^ "is not a valid version field line" 10 | in 11 | let test_fun () = 12 | let re = Re.compile Dune_release.Pkg.version_line_re in 13 | let actual = Re.execp re input in 14 | Alcotest.(check bool) test_name expected actual 15 | in 16 | (test_name, `Quick, test_fun) 17 | in 18 | [ 19 | make_test ~input:"" ~expected:false; 20 | make_test ~input:{|version:""|} ~expected:false; 21 | make_test ~input:{|version:"1"|} ~expected:true; 22 | make_test ~input:{|version: "1" |} ~expected:true; 23 | make_test ~input:{|version:"1.jfpojef.adp921709"|} ~expected:true; 24 | ] 25 | 26 | let test_prepare_opam_for_distrib = 27 | let make_test ~name ~version ~content ~expected () = 28 | let version = Version.of_string version in 29 | let test_name = "prepare_opam_for_distrib: " ^ name in 30 | let test_fun () = 31 | let actual = 32 | Dune_release.Pkg.prepare_opam_for_distrib ~version ~content 33 | in 34 | Alcotest.(check (list string)) test_name expected actual 35 | in 36 | (test_name, `Quick, test_fun) 37 | in 38 | [ 39 | make_test ~name:"empty" ~content:[] ~version:"1" 40 | ~expected:[ {|version: "1"|} ] (); 41 | make_test ~name:"replace version" ~content:[ {|version: "1"|} ] ~version:"2" 42 | ~expected:[ {|version: "2"|} ] (); 43 | make_test ~name:"only replace version field" 44 | ~content: 45 | [ 46 | {|version: "1"|}; 47 | {|description: """|}; 48 | {|version: "1" blablabla|}; 49 | {|"""|}; 50 | ] 51 | ~version:"2" 52 | ~expected: 53 | [ 54 | {|version: "2"|}; 55 | {|description: """|}; 56 | {|version: "1" blablabla|}; 57 | {|"""|}; 58 | ] 59 | (); 60 | ] 61 | 62 | let make_test f ?version ?tag ?keep_v ?opam ~test_name ~name expected = 63 | let tag = Stdext.Option.map ~f:Vcs.Tag.of_string tag in 64 | let version = Stdext.Option.map ~f:Version.of_string version in 65 | let test () = 66 | let expected = Ok (Fpath.v expected) in 67 | let actual = 68 | (match opam with 69 | | None -> Ok None 70 | | Some lines -> 71 | let file = Fpath.(v "opam-tmp") in 72 | let lines = ("opam-version", "1.2") :: lines in 73 | let lines = List.map (fun (k, v) -> Fmt.str "%s: %S" k v) lines in 74 | Bos.OS.File.write_lines file lines >>| fun () -> Some file) 75 | >>= fun opam -> 76 | let p = Pkg.v ~dry_run:false ~name ?tag ?version ?keep_v ?opam () in 77 | f p 78 | in 79 | Alcotest.(check Alcotest_ext.(result_msg path)) test_name expected actual 80 | in 81 | (test_name, `Quick, test) 82 | 83 | let distrib_uri = 84 | let make_test ~test_name = 85 | let test_name = "distrib_uri:" ^ test_name in 86 | make_test ~test_name ~name:"yo" (fun x -> 87 | Pkg.infer_github_distrib_uri x >>| Fpath.v) 88 | in 89 | let dev_repo = [ ("dev-repo", "git@github.com:foo/bar.git") ] in 90 | let homepage = [ ("homepage", "https://github.com/foo/bar") ] in 91 | let url = "https://github.com/foo/bar/releases/download/v0/yo-v0.tbz" in 92 | [ 93 | make_test ~test_name:"1" ~opam:dev_repo ~tag:"v0" url; 94 | make_test ~test_name:"2" ~opam:homepage ~tag:"v0" url; 95 | make_test ~test_name:"3" ~opam:dev_repo ~version:"v0" url; 96 | make_test ~test_name:"4" ~opam:homepage ~version:"v0" url; 97 | make_test ~test_name:"5" ~opam:dev_repo ~tag:"v0" ~keep_v:false url; 98 | make_test ~test_name:"6" ~opam:homepage ~tag:"v0" ~keep_v:true url; 99 | make_test ~test_name:"7" ~opam:dev_repo ~tag:"v0" ~version:"x" url; 100 | make_test ~test_name:"8" ~opam:homepage ~tag:"v0" ~version:"x" url; 101 | make_test ~test_name:"9" 102 | ~opam:[ ("homepage", "https://foo.github.io/bar") ] 103 | ~tag:"v0" url; 104 | ] 105 | 106 | let test_dune_project_name = 107 | let test ~name contents ~expected = 108 | ( name, 109 | `Quick, 110 | fun () -> 111 | let got = Pkg.dune_project_name_string contents in 112 | Alcotest.check Alcotest.(option string) __LOC__ expected got ) 113 | in 114 | let unlines l = String.concat "\n" l in 115 | [ 116 | test ~name:"ok" "(lang dune 2.4)\n(name xyz)" ~expected:(Some "xyz"); 117 | test ~name:"no name" "(lang dune 2.4)" ~expected:None; 118 | test ~name:"opam file generation" 119 | (unlines 120 | [ 121 | "(lang dune 2.7)"; 122 | "(name first)"; 123 | "(generate_opam_files true)"; 124 | "(package"; 125 | " (name first))"; 126 | "(package"; 127 | " (name second))"; 128 | ]) 129 | ~expected:(Some "first"); 130 | test ~name:"leading whitespace" "(lang dune 2.4)\n (name xyz)" 131 | ~expected:(Some "xyz"); 132 | ] 133 | 134 | let test_main = 135 | let pkg ~name ~project_name ~msg = 136 | Pkg.v ~dry_run:true ~name ~project_name ~publish_msg:msg () 137 | in 138 | let test ~name pkgs ~expected_msg = 139 | ( Printf.sprintf "Pkg.main: %s" name, 140 | `Quick, 141 | fun () -> 142 | let got = Pkg.main pkgs in 143 | let got_msg = Pkg.publish_msg got |> Rresult.R.failwith_error_msg in 144 | Alcotest.check Alcotest.string __LOC__ expected_msg got_msg ) 145 | in 146 | [ 147 | test ~name:"single package" 148 | [ pkg ~name:"a" ~project_name:(Some "a") ~msg:"message for a" ] 149 | ~expected_msg:"message for a"; 150 | test ~name:"two packages with a name" 151 | [ 152 | pkg ~name:"a" ~project_name:(Some "b") ~msg:"message for a"; 153 | pkg ~name:"b" ~project_name:(Some "b") ~msg:"message for b"; 154 | ] 155 | ~expected_msg:"message for b"; 156 | test ~name:"two packages, no name" 157 | [ 158 | pkg ~name:"a" ~project_name:None ~msg:"message for a"; 159 | pkg ~name:"b" ~project_name:None ~msg:"message for b"; 160 | ] 161 | ~expected_msg:"message for a"; 162 | ] 163 | 164 | let suite = 165 | ( "Pkg", 166 | List.concat 167 | [ 168 | test_version_line_re; 169 | test_prepare_opam_for_distrib; 170 | distrib_uri; 171 | test_dune_project_name; 172 | test_main; 173 | ] ) 174 | -------------------------------------------------------------------------------- /bin/cli.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** {!Cmdliner} and common definitions for commands. *) 8 | 9 | open Cmdliner 10 | open Rresult 11 | 12 | (** {1 Converters and options} *) 13 | 14 | val path_arg : Fpath.t Arg.conv 15 | (** [path_arg] is a path argument converter. *) 16 | 17 | val named : ('a -> 'b) -> 'a Cmdliner.Term.t -> 'b Cmdliner.Term.t 18 | (** Use this to wrap your arguments in a polymorphic variant constructor to 19 | avoid confusion when they are later passed to your main function. Example: 20 | [named (fun x -> `My_arg x) Arg.(value ...)] *) 21 | 22 | val no_auto_open : [ `No_auto_open of bool Dune_release.Config.Cli.t ] Term.t 23 | (** A [--no-auto-open] option to disable opening of the opam-repository PR in 24 | the browser. *) 25 | 26 | val version : Dune_release.Version.t Arg.conv 27 | (** [version] is a converter for parsing version specifiers *) 28 | 29 | val pkg_names : [ `Package_names of string list ] Term.t 30 | (** A [--pkg-names] option to specify the packages to release. *) 31 | 32 | val pkg_version : [ `Package_version of Dune_release.Version.t option ] Term.t 33 | (** A [--pkg-version] option to specify the packages version. *) 34 | 35 | val keep_v : [ `Keep_v of bool Dune_release.Config.Cli.t ] Term.t 36 | (** A [--keep-v] option to not drop the 'v' at the beginning of version strings. *) 37 | 38 | val dist_tag : [ `Dist_tag of Dune_release.Vcs.Tag.t option ] Term.t 39 | (** A [--tag] option to define the tag from which the distribution is or will be 40 | built. *) 41 | 42 | val dist_file : [ `Dist_file of Fpath.t option ] Term.t 43 | (** A [--dist-file] option to define the distribution archive file. *) 44 | 45 | val dist_uri : [ `Dist_uri of string option ] Term.t 46 | (** A [--dist-uri] option to define the distribution archive URI on the WWW. *) 47 | 48 | val dist_opam : [ `Dist_opam of Fpath.t option ] Term.t 49 | (** An [--dist-opam] option to define the opam file. *) 50 | 51 | val readme : [ `Readme of Fpath.t option ] Term.t 52 | (** A [--readme] option to define the readme. *) 53 | 54 | val change_log : [ `Change_log of Fpath.t option ] Term.t 55 | (** A [--change-log] option to define the change log. *) 56 | 57 | val opam : [ `Opam of Fpath.t option ] Term.t 58 | (** An [--opam] option to define an opam file. *) 59 | 60 | val build_dir : [ `Build_dir of Fpath.t option ] Term.t 61 | (** A [--build-dir] option to define the build directory. *) 62 | 63 | val publish_msg : [ `Publish_msg of string option ] Term.t 64 | (** A [--msg] option to define a publication message. *) 65 | 66 | val token : [ `Token of string Dune_release.Config.Cli.t option ] Term.t 67 | (** A [--token] option to define the github token. *) 68 | 69 | val dry_run : [ `Dry_run of bool ] Term.t 70 | (** A [--dry-run] option to do not perform any action. *) 71 | 72 | val draft : [ `Draft of bool ] Term.t 73 | (** A [--draft] option to produce a draft release. *) 74 | 75 | val yes : [ `Yes of bool ] Term.t 76 | (** A [--yes] option to skip confirmation prompts. *) 77 | 78 | val include_submodules : [ `Include_submodules of bool ] Term.t 79 | (** A [--include-submodules] flag to include submodules in the distrib tarball *) 80 | 81 | val user : [ `User of string option ] Term.t 82 | (** A [--user] option to define the name of the GitHub account where to push new 83 | opam-repository branches. *) 84 | 85 | val local_repo : 86 | [ `Local_repo of Fpath.t Dune_release.Config.Cli.t option ] Term.t 87 | (** A [--local-repo] option to define the location of the local fork of 88 | opam-repository. *) 89 | 90 | val remote_repo : 91 | [ `Remote_repo of string Dune_release.Config.Cli.t option ] Term.t 92 | (** A [--remote-repo] option to define the location of the remote fork of 93 | opam-repository. *) 94 | 95 | val opam_repo : [ `Opam_repo of (string * string) option ] Term.t 96 | (** A [--opam_repo] option to define the Github opam-repository to which 97 | packages should be released. *) 98 | 99 | val skip_lint : [> `Skip_lint of bool ] Term.t 100 | (** a [--skip-lint] option to skip the linting *) 101 | 102 | val skip_build : [> `Skip_build of bool ] Term.t 103 | (** a [--skip-build] option to skip checking the build *) 104 | 105 | val skip_tests : [> `Skip_tests of bool ] Term.t 106 | (** a [--skip-test] option to skip checking the tests *) 107 | 108 | val skip_change_log : [> `Skip_change_log of bool ] Term.t 109 | (** a [--skip-change-log] option to skip validation of change-log *) 110 | 111 | val keep_build_dir : [> `Keep_build_dir of bool ] Term.t 112 | (** a [--keep-build-dir] flag to keep the build directory used for the archive 113 | check. *) 114 | 115 | (** {1 Terms} *) 116 | 117 | val setup : unit Term.t 118 | (** [setup env] defines a basic setup common to all commands. The setup does, by 119 | side effect, set {!Logs} log verbosity, adjusts colored output and sets the 120 | current working directory. *) 121 | 122 | (** {1 Warnings and errors} *) 123 | 124 | val warn_if_vcs_dirty : string -> (unit, R.msg) result 125 | (** [warn_if_vcs_dirty msg] warns with [msg] if the VCS is dirty. *) 126 | 127 | val handle_error : (int, R.msg) result -> int 128 | (** [handle_error r] is [r]'s result or logs [r]'s error and returns [3]. *) 129 | 130 | val exits : Cmd.Exit.info list 131 | (** [exits] is are the exit codes common to all commands. *) 132 | 133 | (*--------------------------------------------------------------------------- 134 | Copyright (c) 2016 Daniel C. Bünzli 135 | 136 | Permission to use, copy, modify, and/or distribute this software for any 137 | purpose with or without fee is hereby granted, provided that the above 138 | copyright notice and this permission notice appear in all copies. 139 | 140 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 141 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 142 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 143 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 144 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 145 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 146 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 147 | ---------------------------------------------------------------------------*) 148 | -------------------------------------------------------------------------------- /bin/config.ml: -------------------------------------------------------------------------------- 1 | open Dune_release 2 | 3 | let invalid_config_key key = 4 | Rresult.R.error_msgf "%S is not a valid global config field" key 5 | 6 | let show_val = function None -> "" | Some x -> x 7 | 8 | let log_val s = 9 | Logs.app (fun l -> l "%s" s); 10 | Ok () 11 | 12 | let log_val_opt string_opt = 13 | Logs.app (fun l -> l "%s" (show_val string_opt)); 14 | Ok () 15 | 16 | let no_config_message = 17 | "You don't have a dune-release config file yet. You can create one by \ 18 | running `dune-release config create` or simply wait for dune-release to \ 19 | prompt you when it will actually need it." 20 | 21 | let show key = 22 | let open Rresult.R.Infix in 23 | Config.load () >>= function 24 | | None -> 25 | App_log.status (fun l -> l "%s" no_config_message); 26 | Ok () 27 | | Some config -> ( 28 | match key with 29 | | None -> 30 | let pretty_fields = Config.pretty_fields config in 31 | StdLabels.List.iter pretty_fields ~f:(fun (key, value) -> 32 | Logs.app (fun l -> l "%s: %s" key (show_val value))); 33 | Ok () 34 | | Some "user" -> 35 | Logs.warn (fun l -> l "%s" Deprecate.Config_user.config_field_use); 36 | log_val_opt config.user 37 | | Some "remote" -> log_val config.remote 38 | | Some "local" -> log_val (Fpath.to_string config.local) 39 | | Some "keep-v" -> 40 | log_val_opt (Stdext.Option.map ~f:string_of_bool config.keep_v) 41 | | Some "auto-open" -> 42 | log_val_opt (Stdext.Option.map ~f:string_of_bool config.auto_open) 43 | | Some key -> invalid_config_key key) 44 | 45 | let to_bool ~field value = 46 | match String.lowercase_ascii value with 47 | | "true" -> Ok true 48 | | "false" -> Ok false 49 | | _ -> Rresult.R.error_msgf "Invalid value %S for field %s" value field 50 | 51 | let set key value = 52 | let open Rresult.R.Infix in 53 | Config.load () >>= function 54 | | None -> Rresult.R.error_msgf "%s" no_config_message 55 | | Some config -> 56 | let updated = 57 | match key with 58 | | "user" -> 59 | App_log.unhappy (fun l -> 60 | l "%s" Deprecate.Config_user.config_field_use); 61 | Ok { config with user = Some value } 62 | | "remote" -> Ok { config with remote = value } 63 | | "local" -> 64 | Fpath.of_string value >>| fun v -> { config with local = v } 65 | | "keep-v" -> 66 | to_bool ~field:key value >>| fun v -> 67 | { config with keep_v = Some v } 68 | | "auto-open" -> 69 | to_bool ~field:key value >>| fun v -> 70 | { config with auto_open = Some v } 71 | | _ -> invalid_config_key key 72 | in 73 | updated >>= Config.save >>= fun () -> Ok () 74 | 75 | let create () = 76 | let open Rresult.R.Infix in 77 | Config.load () >>= function 78 | | None -> Config.create () 79 | | Some _ -> 80 | App_log.status (fun l -> 81 | l 82 | "You already have a dune-release configuration file. Use \ 83 | `dune-release config set` to modify it."); 84 | Ok () 85 | 86 | let default_usage ?raw () = 87 | let cmd = "dune-release config" in 88 | match raw with Some () -> cmd | None -> Printf.sprintf "$(b,%s)" cmd 89 | 90 | let show_usage ?raw () = 91 | let cmd = "dune-release config show" in 92 | let key = "KEY" in 93 | match raw with 94 | | Some () -> Printf.sprintf "%s [%s]" cmd key 95 | | None -> Printf.sprintf "$(b,%s) [$(i,%s)]" cmd key 96 | 97 | let set_usage ?raw () = 98 | let cmd = "dune-release config set" in 99 | let key = "KEY" in 100 | let value = "VALUE" in 101 | match raw with 102 | | Some () -> Printf.sprintf "%s %s %s" cmd key value 103 | | None -> Printf.sprintf "$(b,%s) $(i,%s) $(i,%s)" cmd key value 104 | 105 | let create_usage ?raw () = 106 | let cmd = "dune-release config create" in 107 | match raw with Some () -> cmd | None -> Printf.sprintf "$(b,%s)" cmd 108 | 109 | let invalid_usage () = 110 | Rresult.R.error_msgf 111 | "Invalid dune-release config invocation. Usage:\n%s\n%s\n%s" 112 | (default_usage ~raw:() ()) (show_usage ~raw:() ()) (set_usage ~raw:() ()) 113 | 114 | let run action key_opt value_opt = 115 | let open Rresult in 116 | (let res = 117 | match (action, key_opt, value_opt) with 118 | | "show", key, None -> show key 119 | | "set", Some key, Some value -> set key value 120 | | "create", None, None -> create () 121 | | _ -> invalid_usage () 122 | in 123 | res >>= fun () -> Ok 0) 124 | |> Cli.handle_error 125 | 126 | let man = 127 | let open Cmdliner in 128 | [ 129 | `S Manpage.s_synopsis; 130 | `P (default_usage ()); 131 | `P (show_usage ()); 132 | `P (set_usage ()); 133 | `P (create_usage ()); 134 | `S "GLOBAL CONFIGURATION FIELDS"; 135 | `P 136 | "Here are the existing fields of dune-release's global config file. Only \ 137 | those values should be used as $(i,KEY):"; 138 | `P 139 | ("$(b,user): The Github username of the opam-repository fork. Used to \ 140 | open the final PR to opam-repository." 141 | ^ Deprecate.Config_user.config_field_doc); 142 | `P 143 | "$(b,remote): The URL to your remote Github opam-repository fork. Used \ 144 | to open the final PR to opam-repository."; 145 | `P 146 | "$(b,local): The path to your local clone of opam-repository. Used to \ 147 | open the final PR to opam-repository."; 148 | `P 149 | "$(b,keep-v): Whether or not the 'v' prefix in git tags should make it \ 150 | to the final version number."; 151 | `P 152 | "$(b,auto-open): Whether dune-release should open your browser to the \ 153 | newly created opam-repository PR or not."; 154 | ] 155 | 156 | let action = 157 | let docv = "ACTION" in 158 | let doc = 159 | "The action to perform, either $(b,show) the config or $(b,set) a config \ 160 | field" 161 | in 162 | Cmdliner.Arg.(value & pos 0 string "show" & info ~doc ~docv []) 163 | 164 | let key = 165 | let docv = "KEY" in 166 | let doc = 167 | "The configuration field to set or print. For $(b,show), if no key is \ 168 | provided, the entire config will be printed." 169 | in 170 | Cmdliner.Arg.(value & pos 1 (some string) None & info ~doc ~docv []) 171 | 172 | let value = 173 | let docv = "VALUE" in 174 | let doc = "The new field value" in 175 | Cmdliner.Arg.(value & pos 2 (some string) None & info ~doc ~docv []) 176 | 177 | let term = Cmdliner.Term.(const run $ action $ key $ value) 178 | 179 | let info = 180 | let doc = "Displays or update dune-release global configuration" in 181 | Cmdliner.Cmd.info ~doc ~man "config" 182 | 183 | let cmd = Cmdliner.Cmd.v info term 184 | -------------------------------------------------------------------------------- /lib/vcs.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | Distributed under the ISC license, see terms at the end of the file. 4 | %%NAME%% %%VERSION%% 5 | ---------------------------------------------------------------------------*) 6 | 7 | (** VCS repositories. *) 8 | 9 | (** {1 VCS} *) 10 | 11 | open Rresult 12 | 13 | (** {1:vcsops Version control system repositories} *) 14 | 15 | module Tag : sig 16 | type t 17 | 18 | val pp : t Fmt.t 19 | 20 | val equal : t -> t -> bool 21 | (** [equal a b] returns [true] if [a] and [b] are the same tag. No check 22 | whether these commits point to the same data is done. *) 23 | 24 | val to_string : t -> string 25 | (** [to_string v] returns the [string] representation of the tag. *) 26 | 27 | val of_string : string -> t 28 | (** [of_string v] reads the specified [v] without any validation. This should 29 | be done only in rare cases, for most usages it is better to derive a 30 | [Tag.t] from a [Version.t] via [Version.to_tag]. *) 31 | end 32 | 33 | type commit_ish = string 34 | (** The type for symbols resolving to a commit. The module uses ["HEAD"] for 35 | specifying the current checkout; use this symbol even if the underlying VCS 36 | is [`Hg]. *) 37 | 38 | module Tag_or_commit_ish : sig 39 | type t = Tag of Tag.t | Commit_ish of commit_ish 40 | end 41 | 42 | type t 43 | (** The type for version control systems repositories. *) 44 | 45 | val cmd : t -> Bos.Cmd.t 46 | (** [cmd r] is the base VCS command to use to act on [r]. 47 | 48 | {b Warning} Prefer the functions below to remain VCS independent. *) 49 | 50 | val get : ?dir:Fpath.t -> unit -> (t, R.msg) result 51 | (** [get ~dir ()] looks for a VCS repository in working directory [dir] (not the 52 | repository directory like [.git], default is guessed automatically). Returns 53 | an error if no VCS was found. *) 54 | 55 | val run_git_quiet : 56 | dry_run:bool -> ?force:bool -> t -> Bos_setup.Cmd.t -> (unit, R.msg) result 57 | 58 | val run_git_string : 59 | dry_run:bool -> 60 | ?force:bool -> 61 | default:string * Bos.OS.Cmd.run_status -> 62 | t -> 63 | Bos_setup.Cmd.t -> 64 | (string, R.msg) result 65 | 66 | (** {1:state Repository state} *) 67 | 68 | val is_dirty : t -> (bool, R.msg) result 69 | (** [is_dirty r] is [Ok true] iff the working tree of [r] has uncommitted 70 | changes. *) 71 | 72 | val commit_id : 73 | ?dirty:bool -> ?commit_ish:commit_ish -> t -> (commit_ish, R.msg) result 74 | (** [commit_id ~dirty ~commit_ish r] is the object name (identifier) of 75 | [commit_ish] (defaults to ["HEAD"]). If [commit_ish] is ["HEAD"] and [dirty] 76 | is [true] (default) an indicator is appended to the identifier if the 77 | working tree is dirty. *) 78 | 79 | val commit_ptime_s : 80 | dry_run:bool -> ?commit_ish:Tag_or_commit_ish.t -> t -> (int64, R.msg) result 81 | (** [commit_ptime_s t ~commit_ish] is the POSIX time in seconds of commit 82 | [commit_ish] (defaults to ["HEAD"]) of repository [r]. *) 83 | 84 | val describe : 85 | ?dirty:bool -> ?commit_ish:commit_ish -> t -> (string, R.msg) result 86 | (** [describe ~dirty ~commit_ish r] identifies [commit_ish] (defaults to 87 | ["HEAD"]) using tags from the repository [r]. If [commit_ish] is ["HEAD"] 88 | and [dirty] is [true] (default) an indicator is appended to the identifier 89 | if the working tree is dirty. *) 90 | 91 | val get_tag : t -> (Tag.t, R.msg) result 92 | val tag_exists : dry_run:bool -> t -> Tag.t -> bool 93 | val tag_points_to : t -> Tag.t -> string option 94 | val branch_exists : dry_run:bool -> t -> commit_ish -> bool 95 | 96 | (** {1:ops Repository operations} *) 97 | 98 | val clone : 99 | dry_run:bool -> 100 | ?force:bool -> 101 | ?branch:string -> 102 | dir:Fpath.t -> 103 | t -> 104 | (unit, R.msg) result 105 | (** [clone ~dir r] clones [r] in directory [dir]. *) 106 | 107 | val checkout : 108 | dry_run:bool -> 109 | ?branch:commit_ish -> 110 | t -> 111 | commit_ish:Tag_or_commit_ish.t -> 112 | (unit, R.msg) result 113 | (** [checkout r ~branch commit_ish] checks out [commit_ish]. Checks out in a new 114 | branch [branch] if provided. *) 115 | 116 | val change_branch : dry_run:bool -> branch:string -> t -> (unit, R.msg) result 117 | (** [change_branch ~branch r] moves the head to an existing branch [branch]. *) 118 | 119 | val tag : 120 | dry_run:bool -> 121 | ?force:bool -> 122 | ?sign:bool -> 123 | ?msg:string -> 124 | ?commit_ish:string -> 125 | t -> 126 | Tag.t -> 127 | (unit, R.msg) result 128 | (** [tag r ~force ~sign ~msg ~commit_ish t] tags [commit_ish] with [t] and 129 | message [msg] (if unspecified the VCS should prompt). if [sign] is [true] 130 | (defaults to [false]) signs the tag ([`Git] repos only). If [force] is 131 | [true] (default to [false]) doesn't fail if the tag already exists. *) 132 | 133 | val delete_tag : dry_run:bool -> t -> Tag.t -> (unit, R.msg) result 134 | (** [delete_tag r t] deletes tag [t] in repo [r]. *) 135 | 136 | val ls_remote : 137 | dry_run:bool -> 138 | t -> 139 | ?kind:[ `Branch | `Tag | `All ] -> 140 | ?filter:string -> 141 | string -> 142 | ((string * string) list, R.msg) result 143 | (** [ls_remote ~dry_run t ?filter upstream] queries the remote server [upstream] 144 | and returns the result as a list of pairs [commit_hash, ref_name]. [filter] 145 | filters results by matching on ref names, the default is no filtering. 146 | [kind] filters results on their kind (branch or tag), the default is [`All]. 147 | Only implemented for Git. *) 148 | 149 | val submodule_update : dry_run:bool -> t -> (unit, R.msg) result 150 | (** [submodule r] pulls in all submodules in [r]. Only works for git 151 | repositories *) 152 | 153 | val git_escape_tag : string -> Tag.t 154 | (** Exposed for tests. *) 155 | 156 | val escape_tag : t -> string -> Tag.t 157 | 158 | val git_unescape_tag : Tag.t -> string 159 | (** Exposed for tests. *) 160 | 161 | val unescape_tag : t -> Tag.t -> string 162 | 163 | (*--------------------------------------------------------------------------- 164 | Copyright (c) 2016 Daniel C. Bünzli 165 | 166 | Permission to use, copy, modify, and/or distribute this software for any 167 | purpose with or without fee is hereby granted, provided that the above 168 | copyright notice and this permission notice appear in all copies. 169 | 170 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 171 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 172 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 173 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 174 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 175 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 176 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 177 | ---------------------------------------------------------------------------*) 178 | --------------------------------------------------------------------------------