Source file ThunkSemver64.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
include ThunkSemver64Rep

(* ------------- begin [semver] ocaml package ------------------- *)
(* Almost verbatim from the OCaml [semver] package which uses Angstrom. *)
(* Copyright (c) 2012 Tikhon Jelvis. All rights reserved.

        Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

        1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

        2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.

        3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

        THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)

open struct
  (** Prerelease precedence rules:

      * Identifiers consisting of only digits are compared numerically and
      identifiers with letters or hyphens are compared lexically in ASCII sort
      order.

      * Numeric identifiers always have lower precedence than non-numeric
      identifiers.

      * A larger set of pre-release fields has a higher precedence than a
      smaller set, if all of the preceding identifiers are equal.

      <https://semver.org/#spec-item-11> *)
  let compare_identifiers ia ib =
    match
      ( ThunkParsers.SemverParsers.NatPL.parse `DirectDecode ia,
        ThunkParsers.SemverParsers.NatPL.parse `DirectDecode ib )
    with
    | Ok na, Ok nb -> compare na nb
    | Ok _, _ -> -1
    | _, Ok _ -> 1
    | _ -> compare ia ib

  let rec compare_prerelease is_first pra prb =
    match (pra, prb) with
    | [], [] -> 0
    | [], _ -> if is_first then 1 else -1
    | _, [] -> if is_first then -1 else 1
    | ia :: ta, ib :: tb ->
        if compare ia ib != 0 then compare_identifiers ia ib
        else compare_prerelease false ta tb

  let mk_version major minor patch prerelease build =
    { major; minor; patch; prerelease; build }

  let isOk = function Ok _ -> true | Error _ -> false
end

let from_parts major minor patch prerelease build =
  let check_prerelease_item s =
    ThunkParsers.SemverParsers.PrereleaseIdentifierPL.parse `DirectDecode s
    |> isOk
  in
  let check_build_item s =
    ThunkParsers.SemverParsers.BaseIdentifierPL.parse `DirectDecode s |> isOk
  in
  if
    major >= 0L && minor >= 0L && patch >= 0L
    && List.for_all check_prerelease_item prerelease
    && List.for_all check_build_item build
  then Some (mk_version major minor patch prerelease build)
  else None

let compare a b =
  if Int64.compare a.major b.major != 0 then Int64.compare a.major b.major
  else if Int64.compare a.minor b.minor != 0 then Int64.compare a.minor b.minor
  else if Int64.compare a.patch b.patch != 0 then Int64.compare a.patch b.patch
  else compare_prerelease true a.prerelease b.prerelease

(* ------------- end [semver] ocaml package ------------------- *)

let compare_nobuild a b =
  if Int64.compare a.nobuild_major b.nobuild_major != 0 then
    Int64.compare a.nobuild_major b.nobuild_major
  else if Int64.compare a.nobuild_minor b.nobuild_minor != 0 then
    Int64.compare a.nobuild_minor b.nobuild_minor
  else if Int64.compare a.nobuild_patch b.nobuild_patch != 0 then
    Int64.compare a.nobuild_patch b.nobuild_patch
  else compare_prerelease true a.nobuild_prerelease b.nobuild_prerelease