sv.zp

(define-record-type semver:semantic-version
  (semver:make-semantic-version major minor patch comp)
  semver:semantic-version?
  (major semver:get-major)
  (minor semver:get-minor)
  (patch semver:get-patch)
  (comp semver:get-comp))

(module "semver"
  (export
    (list "matches" matches)
    (list "gt" gt)
    (list "lt" lt)
    (list "eq" eq)
    (list "ne" ne)
    (list "ge" ge)
    (list "le" le)
    (list "valid?" valid)
    (list "parse" parse))

  (comparators {">=" "<=" ">" "<" "==" "!="})

  (matches (lambda (x y)
    (let* ((x (if (string? x) (parse x) x))
           (y (if (string? y) (parse y) y))
           (constraint (let ((comp (semver:get-comp y)))
                        (if (null? comp) eq (or (comparator-map comp) eq)))))
      (constraint x y))))

  (gt (lambda (x y)
    (let ((x (if (string? x) (parse x) x))
          (y (if (string? y) (parse y) y)))
      (if (> (semver:get-major x)
             (semver:get-major y))
        #t
        (if (< (semver:get-major x)
               (semver:get-major y))
          #f
          (if (> (semver:get-minor x)
                 (semver:get-minor y))
            #t
            (if (< (semver:get-minor x)
                   (semver:get-minor y))
              #f
              (> (semver:get-patch x)
                 (semver:get-patch y)))))))))
  (lt (lambda (x y) (not (or (gt x y) (eq x y)))))
  (eq (lambda (x y)
    (let ((x (if (string? x) (parse x) x))
          (y (if (string? y) (parse y) y)))
      (and
        (= (semver:get-major x)
           (semver:get-major y))
        (= (semver:get-minor x)
           (semver:get-minor y))
        (= (semver:get-patch x)
           (semver:get-patch y))))))
  (ne (lambda (x y) (not (eq x y))))
  (ge (lambda (x y) (or (eq x y) (gt x y))))
  (le (lambda (x y) (or (eq x y) (lt x y))))

  (comparator-map (make-hash ">=" ge "<=" le ">" gt "<" lt "==" eq "!=" ne))

  (parse (lambda (str)
    (let* ((split (string:split str #\.))
           (minor (get-from split 1))
           (patch (get-from split 2))
           (majc (let ((m (get-from split 0)))
              (and (truthy? m)
                (if (string:num? m)
                  (list (nil) m)
                  (let* ((l (map (curry string:starts-with str)
                                 (vector->list comparators)))
                         (i (index-of l #t)))
                  (if (any? truthy? l)
                    (list 
                      (substring m 0 (length (comparators i)))
                      (substring m (length (comparators i)) (length m)))
                    (list (nil) (nil))))))))
           (major (cadr majc))
           (comp (car majc)))
      (if (all? (lambda (x) (and (truthy? x) (string:num? x)))
                (list major minor patch))
        (semver:make-semantic-version
          (string->integer major)
          (string->integer minor)
          (string->integer patch)
          comp)
        (nil)))))

  (valid (lambda (str)
    (semver:semantic-version? (parse str)))))

(import-all "semver")
(defimpl ord semver:semantic-version?
  ((compare (lambda (x y) (if (semver:eq x y) 0 (if (semver:lt x y) -1 1))))))
(defimpl stringify semver:semantic-version?
  ((->string (lambda (s) (++ "semver: " (->string (semver:get-major s)) "." (->string (semver:get-minor s)) "." (->string (semver:get-patch s)))))))