From 3af3ed087ad37e8c70b2343cacb3d0ea48ff16f1 Mon Sep 17 00:00:00 2001 From: Benedikt Reinartz Date: Sun, 16 Apr 2023 21:39:44 +0200 Subject: [PATCH] Add verl dependency and vendor it --- apps/rebar/rebar.config | 3 +- rebar.lock | 9 +- vendor/verl/LICENSE | 191 +++++++++++++ vendor/verl/README.md | 142 ++++++++++ vendor/verl/hex_metadata.config | 12 + vendor/verl/rebar.config | 48 ++++ vendor/verl/rebar.lock | 1 + vendor/verl/src/verl.app.src | 11 + vendor/verl/src/verl.erl | 332 +++++++++++++++++++++++ vendor/verl/src/verl_parser.erl | 456 ++++++++++++++++++++++++++++++++ 10 files changed, 1203 insertions(+), 2 deletions(-) create mode 100644 vendor/verl/LICENSE create mode 100644 vendor/verl/README.md create mode 100644 vendor/verl/hex_metadata.config create mode 100644 vendor/verl/rebar.config create mode 100644 vendor/verl/rebar.lock create mode 100644 vendor/verl/src/verl.app.src create mode 100644 vendor/verl/src/verl.erl create mode 100644 vendor/verl/src/verl_parser.erl diff --git a/apps/rebar/rebar.config b/apps/rebar/rebar.config index 245c95ff4..45d933f59 100644 --- a/apps/rebar/rebar.config +++ b/apps/rebar/rebar.config @@ -10,7 +10,8 @@ {relx, "4.7.0"}, {cf, "0.3.1"}, {cth_readable, "1.5.1"}, - {eunit_formatters, "0.5.0"}]}. + {eunit_formatters, "0.5.0"}, + {verl, "1.1.1"}]}. {post_hooks, [{"(linux|darwin|solaris|freebsd|netbsd|openbsd)", escriptize, diff --git a/rebar.lock b/rebar.lock index 57afcca04..d71dc1aef 100644 --- a/rebar.lock +++ b/rebar.lock @@ -1 +1,8 @@ -[]. +{"1.2.0", +[{<<"verl">>,{pkg,<<"verl">>,<<"1.1.1">>},0}]}. +[ +{pkg_hash,[ + {<<"verl">>, <<"98F3EC48B943AA4AE8E29742DE86A7CD752513687911FE07D2E00ECDF3107E45">>}]}, +{pkg_hash_ext,[ + {<<"verl">>, <<"0925E51CD92A0A8BE271765B02430B2E2CFF8AC30EF24D123BD0D58511E8FB18">>}]} +]. diff --git a/vendor/verl/LICENSE b/vendor/verl/LICENSE new file mode 100644 index 000000000..50e0a132c --- /dev/null +++ b/vendor/verl/LICENSE @@ -0,0 +1,191 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + Copyright 2019, Bryan Paxton . + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + diff --git a/vendor/verl/README.md b/vendor/verl/README.md new file mode 100644 index 000000000..24468451d --- /dev/null +++ b/vendor/verl/README.md @@ -0,0 +1,142 @@ +# verl +[![Hex Version](https://img.shields.io/hexpm/v/verl.svg)](https://hex.pm/packages/verl) [![GitHub Actions CI](https://github.com/jelly-beam/verl/workflows/build/badge.svg)](https://github.com/jelly-beam/verl +) [![codecov](https://codecov.io/gh/jelly-beam/verl/branch/main/graph/badge.svg)](https://codecov.io/gh/jelly-beam/verl) + +SemVer 2.0 version and requirements parsing, matching, and comparisons. + +All parsing of versions and requirements adhere to the [SemVer 2.0 schema](http://semver.org/) + + - [Build](#build) + - [Usage](#usage) + * [Comparisons](#comparisons) + * [Version, Requirements, and Matching](#version--requirements--and-matching) + - [Matching](#matching) + - [Compiled requirements for ludicious speed matching](#compiled-requirements-for-ludicious-speed-matching) + - [Version parsing](#version-parsing) + * [Requirements parsing](#requirements-parsing) + - [Credits](#credits) + + +## Build + +```bash +$ rebar3 compile +``` + +## Test + +```bash +$ rebar3 test +``` + +## Usage + +Add to you deps configuration in rebar.config for your project : + +```erlang +{deps, [{verl, "1.1.0"}]}. +``` + +### Comparisons + +```erlang +1> verl:compare(<<"1.0.0">>, <<"1.0.1">>). +lt +2> verl:compare(<<"1.0.0">>, <<"1.0.0">>). +eq +3> verl:compare(<<"2.0.0">>, <<"1.0.0">>). +gt +4> verl:compare(<<"1.0.0-pre">>, <<"1.0.0">>). +lt +5> verl:compare(<<"1.0.0">>, <<"1.0.0-pre">>). +gt +``` + +### Version, Requirements, and Matching + +#### Matching + +```erlang +1> verl:is_match(<<"1.0.0">>, <<"~> 1.0.0">>). +true +2> verl:is_match(<<"1.0.0">>, <<"~> 2.0.0">>). +false +3> verl:is_match(<<"3.2.0">>, <<"~> 3.0.0">>). +false +4> verl:is_match(<<"3.2.0">>, <<"~> 3.0">>). +true +``` + +#### Compiled requirements for ludicious speed matching + +```erlang +1> {ok, Req} = verl:parse_requirement(<<"~> 3.0">>). +{ok,#{compiled => false, + string => <<"~> 3.0">>, + matchspec => [{{'$1','$2','$3','$4','$5'}...}], + string => <<"~> 3.0">>}} +2> verl:is_match(<<"3.0.0-dev">>, Req). + false +3> verl:is_match(<<"1.2.3">>, Req). + false +4> verl:is_match(<<"3.1.0">>, Req). + true +``` + +#### Version parsing + +```erlang +1> verl:parse(<<"1.2.3">>). +#{build => undefined,major => 1,minor => 2,patch => 3, + pre => []} +2> verl:parse(<<"1.2.3+build">>). +#{build => <<"build">>,major => 1,minor => 2,patch => 3, + pre => []} +3> verl:parse(<<"1.2.3-pre+build">>). +#{build => <<"build">>,major => 1,minor => 2,patch => 3, + pre => [<<"pre">>]} +4> verl:parse(<<"1">>). +{error, invalid_version} +5> verl:parse(<<"2">>). +{error, invalid_version} +``` + +Don't want a map? Use the `verl_parser` module... + +```erlang +1> verl_parser:parse_version(<<"1.2.3">>). +{ok,{1,2,3,[],[]}} +2> verl_parser:parse_version(<<"1.2.3+build">>). +{ok,{1,2,3,[],[<<"build">>]}} +3> verl_parser:parse_version(<<"1.2.3-pre+build">>). +{ok,{1,2,3,[<<"pre">>],[<<"build">>]}} +4> verl_parser:parse_version(<<"1">>). +{error, invalid_version} +``` + +##### Requirements parsing + +```erlang +1> verl:parse_requirement(<<"~> 2.1.0-dev">>). +{ok,#{compiled => false, + string => <<"~> 2.1.0-dev">>, + matchspec => + [{{'$1','$2','$3','$4','$5'}...] }} +2> verl:parse_requirement(<<"~> 2.1.0-">>). +{error,invalid_requirement} +``` + +Don't want a map? User the `verl_parser` module... + +```erlang +1> verl_parser:parse_requirement(<<"~> 2.1.0-dev">>). +{ok, [{{'$1','$2','$3','$4','$5'}...]} +2> verl:parse_requirement(<<"~> 2.1.0-">>). +{error,invalid_requirement} +``` + +## Credits + +- All credit goes to the Elixir team and contributors to Version and +Version.Parser in the Elixir standard lib for the algorithm and original +implementation. diff --git a/vendor/verl/hex_metadata.config b/vendor/verl/hex_metadata.config new file mode 100644 index 000000000..398960df2 --- /dev/null +++ b/vendor/verl/hex_metadata.config @@ -0,0 +1,12 @@ +{<<"app">>,<<"verl">>}. +{<<"build_tools">>,[<<"rebar3">>]}. +{<<"description">>, + <<"SemVer2 version and requirements parsing, matching, and comparison">>}. +{<<"files">>, + [<<"LICENSE">>,<<"README.md">>,<<"rebar.config">>,<<"rebar.lock">>, + <<"src/verl.app.src">>,<<"src/verl.erl">>,<<"src/verl_parser.erl">>]}. +{<<"licenses">>,[<<"Apache 2.0">>]}. +{<<"links">>,[{<<"Github">>,<<"https://github.com/jelly-beam/verl">>}]}. +{<<"name">>,<<"verl">>}. +{<<"requirements">>,[]}. +{<<"version">>,<<"1.1.1">>}. diff --git a/vendor/verl/rebar.config b/vendor/verl/rebar.config new file mode 100644 index 000000000..50e7a11c6 --- /dev/null +++ b/vendor/verl/rebar.config @@ -0,0 +1,48 @@ +{erl_opts, [ + debug_info, + warn_missing_spec, + warnings_as_errors +]}. +{minimum_otp_vsn, "19.3"}. +{deps, []}. +{project_plugins, [erlfmt, rebar3_proper, rebar3_hex, covertool, rebar3_lint, rebar3_hank]}. +{profiles, [ + {test, [ + {deps, [{proper, "1.3.0"}]}, + {erl_opts, [nowarn_missing_spec, nowarn_export_all]}, + {dialyzer, [{plt_extra_apps, [proper]}]}, + {cover_enabled, true}, + {cover_opts, [verbose]} + ]} +]}. + +{erlfmt, [ + {files, "{src,include,test}/*.{hrl,erl}"} + ]}. + +{edoc_opts, [ + {doclet, edoc_doclet_chunks}, + {layout, edoc_layout_chunks}, + {preprocess, true}, + {dir, "_build/default/lib/verl/doc"}]}. + +{xref_ignores, [verl, {verl_parser, parse_version, 2}]}. + +{alias, [{quick_test, [{proper, "--cover --numtests=3"}, + {eunit, "--cover"}, + {cover, "-v"}]}, + {test, [{ct, "-c"}, {proper, "--cover"}, {eunit, "--cover"}, {cover, "-v"}]}, + {check, [{proper, "--cover --numtests=3"}, + {eunit, "--cover"}, + xref, dialyzer, cover]}]}. + +{xref_checks,[undefined_function_calls,locals_not_used, + deprecated_function_calls,exports_not_used]}. + +{dialyzer, [ + {warnings, [ + error_handling, + unknown, + unmatched_returns + ]} +]}. diff --git a/vendor/verl/rebar.lock b/vendor/verl/rebar.lock new file mode 100644 index 000000000..57afcca04 --- /dev/null +++ b/vendor/verl/rebar.lock @@ -0,0 +1 @@ +[]. diff --git a/vendor/verl/src/verl.app.src b/vendor/verl/src/verl.app.src new file mode 100644 index 000000000..144d36e63 --- /dev/null +++ b/vendor/verl/src/verl.app.src @@ -0,0 +1,11 @@ +{application,verl, + [{description,"SemVer2 version and requirements parsing, matching, and comparison"}, + {vsn,"1.1.1"}, + {organization,"jelly-beam"}, + {registered,[]}, + {applications,[kernel,stdlib]}, + {env,[]}, + {modules,[]}, + {extra,{maintainers,["Bryan Paxton"]}}, + {licenses,["Apache 2.0"]}, + {links,[{"Github","https://github.com/jelly-beam/verl"}]}]}. diff --git a/vendor/verl/src/verl.erl b/vendor/verl/src/verl.erl new file mode 100644 index 000000000..f94f358cf --- /dev/null +++ b/vendor/verl/src/verl.erl @@ -0,0 +1,332 @@ +-module(verl). + +%% Main API +-export([ + compare/2, + is_match/2, + is_match/3, + parse/1, + parse_requirement/1, + compile_requirement/1 +]). + +%% Helpers +-export([ + between/3, + eq/2, + gt/2, + gte/2, + lt/2, + lte/2 +]). + +-type version() :: binary(). +-type requirement() :: binary(). + +-type major() :: non_neg_integer(). +-type minor() :: non_neg_integer(). +-type patch() :: non_neg_integer(). +-type pre() :: [binary() | non_neg_integer()]. +-type build() :: binary() | undefined. +-type version_t() :: #{ + major => major(), + minor => minor(), + patch => patch(), + pre => pre(), + build => build() +}. + +-type requirement_t() :: #{ + string => requirement(), + matchspec => list(), + compiled => boolean() +}. + +-type compiled_requirement() :: #{ + compiled => true, + matchspec => ets:comp_match_spec(), + string => requirement() +}. + +-type match_opts() :: [allow_pre | {allow_pre, true}]. + +-export_type([ + version/0, + requirement/0, + major/0, + minor/0, + patch/0, + pre/0, + build/0, + version_t/0, + requirement_t/0, + compiled_requirement/0 +]). + +%%% Primary API + +%%% @doc +%%% Compares two versions, returning whether the first argument is greater, equal, or +%%% less than the second argument. +%%% @end +-spec compare(version(), version()) -> gt | eq | lt | {error, invalid_version}. +compare(Version1, Version2) -> + ver_cmp(to_matchable(Version1, true), to_matchable(Version2, true)). + +%%% @doc +%%% Parses a semantic version, returning {ok, version_t()} or {error, invalid_version} +%%% @end +-spec parse(version()) -> {ok, version_t()} | {error, invalid_version}. +parse(Str) -> + build_version(Str). + +%%% @doc +%%% Parses a semantic version requirement, returning {ok, requirement_t()} or +%%% {error, invalid_requirement} +%%% @end +-spec parse_requirement(requirement()) -> {ok, requirement_t()} | {error, invalid_requirement}. +parse_requirement(Str) -> + case verl_parser:parse_requirement(Str) of + {ok, Spec} -> + {ok, #{string => Str, matchspec => Spec, compiled => false}}; + {error, invalid_requirement} -> + {error, invalid_requirement} + end. + +%%% @doc +%%% Compiles a version requirement as returned by `parse_requirement' for faster +%%% matches. +%%% @end +-spec compile_requirement(requirement_t()) -> compiled_requirement(). +compile_requirement(Req) when is_map(Req) -> + Ms = ets:match_spec_compile(maps:get(matchspec, Req)), + maps:put(compiled, true, maps:put(matchspec, Ms, Req)). + +%%% @doc +%%% Returns `true' if the dependency is in range of the requirement, otherwise +%%% `false', or an error. +%%% @end +-spec is_match(version() | version_t(), requirement() | requirement_t()) -> + boolean() | {error, badarg | invalid_requirement | invalid_version}. +is_match(Version, Requirement) -> + is_match(Version, Requirement, []). + +%%% @doc +%%% Works like `is_match/2' but takes extra options as an argument. +%%% @end +-spec is_match(version() | version_t(), requirement() | requirement_t(), match_opts()) -> + boolean() | {error, badarg | invalid_requirement | invalid_version}. +is_match(Version, Requirement, Opts) when is_binary(Version) andalso is_binary(Requirement) -> + case build_version(Version) of + {ok, Ver} -> + case build_requirement(Requirement) of + {ok, Req} -> + is_match(Ver, Req, Opts); + {error, invalid_requirement} -> + {error, invalid_requirement} + end; + {error, invalid_version} -> + {error, invalid_version} + end; +is_match(Version, Requirement, Opts) when is_binary(Version) andalso is_map(Requirement) -> + case build_version(Version) of + {ok, Ver} -> + is_match(Ver, Requirement, Opts); + {error, invalid_version} -> + {error, invalid_version} + end; +is_match(Version, Requirement, Opts) when is_map(Version) andalso is_binary(Requirement) -> + case build_requirement(Requirement) of + {ok, Req} -> + is_match(Version, Req, Opts); + {error, invalid_requirement} -> + {error, invalid_requirement} + end; +is_match(Version, #{matchspec := Spec, compiled := false} = R, Opts) when is_map(R) -> + AllowPre = proplists:get_value(allow_pre, Opts, true), + {ok, Result} = ets:test_ms(to_matchable(Version, AllowPre), Spec), + Result /= false; +is_match(Version, #{matchspec := Spec, compiled := true} = R, Opts) when + is_map(Version) andalso is_map(R) +-> + AllowPre = proplists:get_value(allow_pre, Opts, true), + ets:match_spec_run([to_matchable(Version, AllowPre)], Spec) /= []. + +to_matchable(#{major := Major, minor := Minor, patch := Patch, pre := Pre}, AllowPre) -> + {Major, Minor, Patch, Pre, AllowPre}; +to_matchable(String, AllowPre) when is_binary(String) -> + case verl_parser:parse_version(String) of + {ok, {Major, Minor, Patch, Pre, _Build}} -> + {Major, Minor, Patch, Pre, AllowPre}; + {error, invalid_version} -> + {error, invalid_version} + end. + +%%% Helper functions + +%%% @doc +%%% Helper function that returns true if the first version is greater than the third version and +%%% also the second version is less than the the third version, otherwise returns false. +%%% See `compare/2' for more details. +%%% @end +-spec between(version(), version(), version()) -> boolean() | {error, invalid_version}. +between(Vsn1, Vsn2, VsnMatch) -> + case {gte(VsnMatch, Vsn1), lte(VsnMatch, Vsn2)} of + {true, true} -> + true; + {{error, _} = Err, _} -> + Err; + {_, {error, _} = Err} -> + Err; + _ -> + false + end. + +%%% @doc +%%% Helper function that returns true if two versions are equal, otherwise +%%% false. See `compare/2' for more details. +%%% @end +-spec eq(version(), version()) -> boolean() | {error, invalid_version}. +eq(Vsn1, Vsn2) -> + case compare(Vsn1, Vsn2) of + eq -> true; + {error, _} = Err -> Err; + _ -> false + end. + +%%% @doc +%%% Helper function that returns true the first version given is greater than +%%% the second, otherwise returns false. See `compare/2' for more details. +%%% @end +-spec gt(version(), version()) -> boolean() | {error, invalid_version}. +gt(Vsn1, Vsn2) -> + case compare(Vsn1, Vsn2) of + gt -> true; + {error, _} = Err -> Err; + _ -> false + end. + +%%% @doc +%%% Helper function that returns true the first version given is greater than +%%% or equal to the second, otherwise returns false. +%%% See `compare/2' for more details. +%%% @end +-spec gte(version(), version()) -> boolean() | {error, invalid_version}. +gte(Vsn1, Vsn2) -> + case compare(Vsn1, Vsn2) of + gt -> true; + eq -> true; + {error, _} = Err -> Err; + _ -> false + end. + +%%% @doc +%%% Helper function that returns true the first version given is less than the +%%% second, otherwise returns false. See `compare/2' for more details. +%%% @end +-spec lt(version(), version()) -> boolean() | {error, invalid_version}. +lt(Vsn1, Vsn2) -> + case compare(Vsn1, Vsn2) of + lt -> true; + {error, _} = Err -> Err; + _ -> false + end. + +%%% @doc +%%% Helper function that returns true the first version given is less than or +%%% equal to the second, otherwise returns false. +%%% See `compare/2' for more details. +%%% @end +-spec lte(version(), version()) -> boolean() | {error, invalid_version}. +lte(Vsn1, Vsn2) -> + case compare(Vsn1, Vsn2) of + lt -> true; + eq -> true; + {error, _} = Err -> Err; + _ -> false + end. + +%% private api +%% + +%% @private +build_version(Version) -> + case verl_parser:parse_version(Version) of + {ok, {Major, Minor, Patch, Pre, Build}} -> + {ok, #{ + major => Major, + minor => Minor, + patch => Patch, + pre => Pre, + build => build_string(Build) + }}; + {error, invalid_version} -> + {error, invalid_version} + end. + +%% @private +build_requirement(Str) -> + case verl_parser:parse_requirement(Str) of + {ok, Spec} -> + {ok, #{string => Str, matchspec => Spec, compiled => false}}; + {error, invalid_requirement} -> + {error, invalid_requirement} + end. + +%% @private +build_string(Build) -> + case Build of + [] -> undefined; + _ -> binary:list_to_bin(Build) + end. + +%% @private +ver_cmp({Maj1, Min1, Patch1, Pre1, _}, {Maj2, Min2, Patch2, Pre2, _}) -> + case {Maj1, Min1, Patch1} > {Maj2, Min2, Patch2} of + true -> + gt; + false -> + case {Maj1, Min1, Patch1} < {Maj2, Min2, Patch2} of + true -> + lt; + false -> + test_pre(Pre1, Pre2) + end + end; +ver_cmp(_, _) -> + {error, invalid_version}. + +%% @private +test_pre(Pre1, Pre2) -> + case pre_is_eq(Pre1, Pre2) of + true -> + gt; + false -> + case pre_is_eq(Pre2, Pre1) of + true -> + lt; + false -> + pre_cmp(Pre1, Pre2) + end + end. + +%% @private +pre_cmp(Pre1, Pre2) -> + case Pre1 > Pre2 of + true -> + gt; + false -> + case Pre1 < Pre2 of + true -> + lt; + false -> + eq + end + end. + +%% @private +pre_is_eq(Pre1, Pre2) -> + case Pre1 == [] of + false -> false; + true -> Pre2 /= [] + end. diff --git a/vendor/verl/src/verl_parser.erl b/vendor/verl/src/verl_parser.erl new file mode 100644 index 000000000..614b5a190 --- /dev/null +++ b/vendor/verl/src/verl_parser.erl @@ -0,0 +1,456 @@ +-module(verl_parser). + +-export([parse_requirement/1, parse_version/1, parse_version/2]). + +-type operator() :: '!=' | '&&' | '<' | '<=' | '==' | '>' | '>=' | '||' | '~>' | bitstring(). + +-spec parse_version(verl:version()) -> + {ok, {verl:major(), verl:minor(), verl:patch(), verl:pre(), [verl:build()]}} + | {error, invalid_version}. +parse_version(Str) -> parse_version(Str, false). + +-spec parse_version(verl:version(), boolean()) -> + {ok, {verl:major(), verl:minor(), verl:patch(), verl:pre(), [verl:build()]}} + | {error, invalid_version}. +parse_version(Str, Approximate) when is_binary(Str) -> + try parse_and_convert(Str, Approximate) of + {ok, {_, _, undefined, _, _}} -> + {error, invalid_version}; + {ok, _} = V -> + V; + {error, invalid_version} -> + {error, invalid_version} + catch + error:{badmatch, {error, T}} when + T =:= invalid_version orelse + T =:= nan orelse + T =:= bad_part orelse + T =:= leading_zero + -> + {error, invalid_version} + end. + +-spec parse_requirement(verl:requirement()) -> + {ok, ets:match_spec()} | {error, invalid_requirement}. +parse_requirement(Source) -> + Lexed = lexer(Source, []), + to_matchspec(Lexed). + +%% @private +-spec lexer(binary(), [operator()]) -> [operator()]. +lexer(<<">=", Rest/binary>>, Acc) -> + lexer(Rest, ['>=' | Acc]); +lexer(<<"<=", Rest/binary>>, Acc) -> + lexer(Rest, ['<=' | Acc]); +lexer(<<"~>", Rest/binary>>, Acc) -> + lexer(Rest, ['~>' | Acc]); +lexer(<<">", Rest/binary>>, Acc) -> + lexer(Rest, ['>' | Acc]); +lexer(<<"<", Rest/binary>>, Acc) -> + lexer(Rest, ['<' | Acc]); +lexer(<<"==", Rest/binary>>, Acc) -> + lexer(Rest, ['==' | Acc]); +lexer(<<"!=", Rest/binary>>, Acc) -> + lexer(Rest, ['!=' | Acc]); +lexer(<<"!", Rest/binary>>, Acc) -> + lexer(Rest, ['!=' | Acc]); +lexer(<<" or ", Rest/binary>>, Acc) -> + lexer(Rest, ['||' | Acc]); +lexer(<<" and ", Rest/binary>>, Acc) -> + lexer(Rest, ['&&' | Acc]); +lexer(<<" ", Rest/binary>>, Acc) -> + lexer(Rest, Acc); +lexer(<>, []) -> + lexer(Rest, [<>, '==']); +lexer(<>, [Head | Acc]) -> + Acc1 = + case Head of + Head when is_binary(Head) -> + [<> | Acc]; + Head when Head =:= '&&' orelse Head =:= '||' -> + [<>, '==', Head | Acc]; + _Other -> + [<>, Head | Acc] + end, + lexer(Body, Acc1); +lexer(<<>>, Acc) -> + lists:reverse(Acc). + +%% @private +-spec parse_condition(verl:version()) -> + {integer(), integer(), 'undefined' | integer(), [binary() | integer()]}. +parse_condition(Version) -> parse_condition(Version, false). + +%% @private +-spec parse_condition(verl:version(), boolean()) -> + {integer(), integer(), 'undefined' | integer(), [binary() | integer()]}. +parse_condition(Version, Approximate) -> + try + case parse_and_convert(Version, Approximate) of + {ok, {Major, Minor, Patch, Pre, _Bld}} -> + {Major, Minor, Patch, Pre}; + _ -> + throw(invalid_matchspec) + end + catch + error:{badmatch, {error, T}} when + T =:= invalid_version orelse + T =:= nan orelse + T =:= bad_part orelse + T =:= leading_zero + -> + throw(invalid_matchspec) + end. + +%% @private +-spec approximate_upper({integer(), integer(), 'undefined' | integer(), [binary() | integer()]}) -> + {integer(), integer(), 0, [0, ...]}. +approximate_upper(Version) -> + case Version of + {Major, _Minor, undefined, _} -> + {Major + 1, 0, 0, [0]}; + {Major, Minor, _Patch, _Pre} -> + {Major, Minor + 1, 0, [0]} + end. + +%% @private +-spec matchable_to_string( + {integer(), integer(), 'undefined' | integer(), [binary() | integer()]} +) -> binary(). +matchable_to_string({Major, Minor, Patch, Pre}) -> + Patch1 = + case Patch of + P when P =:= undefined orelse P =:= false -> + <<"0">>; + _ -> + maybe_to_string(Patch) + end, + Pre1 = + case Pre == [] of + true -> + <<>>; + false -> + case Pre of + [0] -> + <<"-0">>; + _ -> + Pre0 = maybe_to_string(Pre), + <<<<"-">>/binary, Pre0/binary>> + end + end, + Major1 = maybe_to_string(Major), + Minor1 = maybe_to_string(Minor), + Patch2 = maybe_to_string(Patch1), + Joined = join_bins([Major1, Minor1, Patch2], <<".">>), + <>. + +%% @private +-spec pre_condition('<' | '>', [binary() | integer()]) -> tuple(). +pre_condition('>', Pre) -> + PreLength = length(Pre), + {'orelse', {'andalso', {'==', {length, '$4'}, 0}, {const, PreLength /= 0}}, + {'andalso', {const, PreLength /= 0}, + {'orelse', {'>', {length, '$4'}, PreLength}, + {'andalso', {'==', {length, '$4'}, PreLength}, {'>', '$4', {const, Pre}}}}}}; +pre_condition('<', Pre) -> + PreLength = length(Pre), + {'orelse', {'andalso', {'/=', {length, '$4'}, 0}, {const, PreLength == 0}}, + {'andalso', {'/=', {length, '$4'}, 0}, + {'orelse', {'<', {length, '$4'}, PreLength}, + {'andalso', {'==', {length, '$4'}, PreLength}, {'<', '$4', {const, Pre}}}}}}. + +%% @private +-spec no_pre_condition([binary() | integer()]) -> tuple(). +no_pre_condition([]) -> + {'orelse', '$5', {'==', {length, '$4'}, 0}}; +no_pre_condition(_) -> + {const, true}. + +%% @private +-spec to_matchspec([operator(), ...]) -> {error, invalid_requirement} | {ok, ets:match_spec()}. +to_matchspec(Lexed) -> + try + case is_valid_requirement(Lexed) of + true -> + First = to_condition(Lexed), + Rest = lists:nthtail(2, Lexed), + {ok, [{{'$1', '$2', '$3', '$4', '$5'}, [to_condition(First, Rest)], ['$_']}]}; + false -> + {error, invalid_requirement} + end + catch + invalid_matchspec -> {error, invalid_requirement} + end. + +%% @private +-spec to_condition([iodata(), ...]) -> tuple(). +to_condition(['==', Version | _]) -> + Matchable = parse_condition(Version), + main_condition('==', Matchable); +to_condition(['!=', Version | _]) -> + Matchable = parse_condition(Version), + main_condition('/=', Matchable); +to_condition(['~>', Version | _]) -> + From = parse_condition(Version, true), + To = approximate_upper(From), + {'andalso', to_condition(['>=', matchable_to_string(From)]), + to_condition(['<', matchable_to_string(To)])}; +to_condition(['>', Version | _]) -> + {Major, Minor, Patch, Pre} = + parse_condition(Version), + {'andalso', + {'orelse', main_condition('>', {Major, Minor, Patch}), + {'andalso', main_condition('==', {Major, Minor, Patch}), pre_condition('>', Pre)}}, + no_pre_condition(Pre)}; +to_condition(['>=', Version | _]) -> + Matchable = parse_condition(Version), + {'orelse', main_condition('==', Matchable), to_condition(['>', Version])}; +to_condition(['<', Version | _]) -> + {Major, Minor, Patch, Pre} = + parse_condition(Version), + {'orelse', main_condition('<', {Major, Minor, Patch}), + {'andalso', main_condition('==', {Major, Minor, Patch}), pre_condition('<', Pre)}}; +to_condition(['<=', Version | _]) -> + Matchable = parse_condition(Version), + {'orelse', main_condition('==', Matchable), to_condition(['<', Version])}. + +%% @private +-spec to_condition(tuple(), list()) -> tuple(). +to_condition(Current, []) -> + Current; +to_condition( + Current, + ['&&', Operator, Version | Rest] +) -> + to_condition( + {'andalso', Current, to_condition([Operator, Version])}, + Rest + ); +to_condition( + Current, + ['||', Operator, Version | Rest] +) -> + to_condition( + {'orelse', Current, to_condition([Operator, Version])}, + Rest + ). + +%% @private +-spec main_condition(any(), tuple()) -> tuple(). +main_condition(Op, Version) when tuple_size(Version) == 3 -> + {Op, {{'$1', '$2', '$3'}}, {const, Version}}; +main_condition(Op, Version) when tuple_size(Version) == 4 -> + {Op, {{'$1', '$2', '$3', '$4'}}, {const, Version}}. + +%% @private +-spec bisect(binary(), binary(), list()) -> [binary() | undefined, ...]. +bisect(Str, Delim, Opts) -> + [First | Rest] = binary:split(Str, [Delim], Opts), + Rest1 = + case Rest of + [] -> + undefined; + _ -> + join_bins(Rest, Delim) + end, + [First, Rest1]. + +%% @private +-spec has_leading_zero(error | undefined | binary() | [binary()]) -> boolean(). +has_leading_zero(<<48/integer, _/integer, _/binary>>) -> + true; +has_leading_zero(_) -> + false. + +%% @private +-spec is_valid_identifier(any()) -> boolean(). +is_valid_identifier(<>) when + is_integer(Char) andalso + Char >= 48 andalso Char =< 57; + is_integer(Char) andalso + Char >= 97 andalso Char =< 122; + is_integer(Char) andalso + Char >= 65 andalso Char =< 90; + Char == 45 +-> + is_valid_identifier(Rest); +is_valid_identifier(<<>>) -> + true; +is_valid_identifier(_) -> + false. + +%% @private +-spec join_bins([binary(), ...], binary()) -> binary(). +join_bins(List, Delim) -> + lists:foldl( + fun(Bin, Acc) -> + case bit_size(Acc) of + N when N > 0 -> + <>; + _ -> + Bin + end + end, + <<>>, + List + ). + +%% @private +-spec maybe_patch(undefined | binary() | integer(), boolean()) -> {ok, undefined | integer()}. +maybe_patch(undefined, true) -> + {ok, undefined}; +maybe_patch(Patch, _) -> + to_digits(Patch). + +%% @private +-spec parse_and_convert(verl:version(), boolean()) -> + {error, invalid_version} + | {ok, + { + integer(), + integer(), + 'undefined' + | integer(), + [ + binary() + | integer() + ], + [binary()] + }}. +parse_and_convert(Str, Approx) -> + [VerPre, Build] = bisect(Str, <<"+">>, [global]), + [Ver, Pre] = bisect(VerPre, <<"-">>, []), + [Maj1, Min1, Patch1, Other] = split_ver(Ver), + case Other of + undefined -> + {ok, Maj2} = to_digits(Maj1), + {ok, Min2} = to_digits(Min1), + {ok, Patch2} = maybe_patch(Patch1, Approx), + {ok, PreParts} = opt_dot_separated(Pre), + {ok, PreParts1} = parts_to_integers(PreParts, []), + {ok, Build2} = opt_dot_separated(Build), + {ok, {Maj2, Min2, Patch2, PreParts1, Build2}}; + _ -> + {error, invalid_version} + end. + +%% @private +-spec parse_digits('error' | 'undefined' | binary() | [binary()], bitstring()) -> + {'error', 'nan'} | {'ok', integer()}. +parse_digits(<>, Acc) when + is_integer(Char) andalso Char >= 48 andalso Char =< 57 +-> + parse_digits(Rest, <>); +parse_digits(<<>>, Acc) when byte_size(Acc) > 0 -> + {ok, binary_to_integer(Acc)}; +parse_digits(_, _) -> + {error, nan}. + +%% @private +-spec parts_to_integers([binary()], [binary() | integer()]) -> + {'error', 'nan'} | {'ok', [binary() | integer()]}. +parts_to_integers([Part | Rest], Acc) -> + case parse_digits(Part, <<>>) of + {ok, Int} -> + case has_leading_zero(Part) of + P when P =:= undefined orelse P =:= false -> + parts_to_integers(Rest, [Int | Acc]); + _ -> + {error, nan} + end; + {error, nan} -> + parts_to_integers(Rest, [Part | Acc]) + end; +parts_to_integers([], Acc) -> + {ok, lists:reverse(Acc)}. + +%% @private +-spec opt_dot_separated('undefined' | binary()) -> {'error', 'bad_part'} | {'ok', [binary()]}. +opt_dot_separated(undefined) -> + {ok, []}; +opt_dot_separated(Str) -> + Parts = binary:split(Str, <<".">>, [global]), + Fun = fun(P) -> + case P /= <<>> of + false -> false; + true -> is_valid_identifier(P) + end + end, + case lists:all(Fun, Parts) of + P when P =:= undefined orelse P =:= false -> + {error, bad_part}; + _ -> + {ok, Parts} + end. + +%% @private +-spec split_ver(binary()) -> ['error' | 'undefined' | binary() | [binary()], ...]. +split_ver(Str) -> + case binary:split(Str, [<<".">>], [global]) of + [Maj0, Min0] -> + [Maj0, Min0, undefined, undefined]; + [Maj, Min, P] -> + [Maj, Min, P, undefined]; + [Major, Minor, Patch | Rest] -> + [Major, Minor, Patch, Rest]; + _ -> + [error, error, error, error] + end. + +%% @private +-spec to_digits('error' | 'undefined' | binary() | [binary()]) -> + {'error', 'leading_zero' | 'nan'} | {'ok', integer()}. +to_digits(Str) -> + case has_leading_zero(Str) of + S when S =:= undefined orelse S =:= false -> + parse_digits(Str, <<>>); + true -> + {error, leading_zero} + end. + +%% @private +-spec maybe_to_string(binary() | [binary() | byte()] | integer()) -> binary(). +maybe_to_string(Part) -> + case Part of + Rewrite when is_binary(Rewrite) -> + Rewrite; + Int when is_integer(Int) -> + integer_to_binary(Int); + Rewrite when is_list(Rewrite) -> + list_to_binary(Rewrite) + end. + +%% @private +-spec is_valid_requirement([operator(), ...]) -> boolean(). +is_valid_requirement([]) -> false; +is_valid_requirement([A | Next]) -> is_valid_requirement(A, Next). + +%% @private +-spec is_valid_requirement(operator(), [operator()]) -> boolean(). +is_valid_requirement(A, []) when is_binary(A) -> + true; +is_valid_requirement(A, [B | Next]) when + (is_atom(A) andalso + is_atom(B)) andalso + (A =:= '&&' orelse A =:= '||') +-> + is_valid_requirement(B, Next); +is_valid_requirement(A, [B | Next]) when + (is_binary(A) andalso + is_atom(B)) andalso + (B =:= '&&' orelse B =:= '||') +-> + is_valid_requirement(B, Next); +is_valid_requirement(A, [B | Next]) when + (is_atom(A) andalso + is_binary(B)) andalso + (A =:= '&&' orelse A =:= '||') +-> + is_valid_requirement(B, Next); +is_valid_requirement(A, [B | Next]) when + is_atom(A) andalso + is_binary(B) +-> + is_valid_requirement(B, Next); +is_valid_requirement(_, _) -> + false.