47 lines
2.2 KiB
Text
47 lines
2.2 KiB
Text
|
(define-library (zilch lang go version)
|
||
|
|
(import
|
||
|
|
(scheme base) (srfi 152))
|
||
|
|
|
||
|
|
(export parse-version version<?)
|
||
|
|
(begin
|
||
|
|
(define (parse-version vstr)
|
||
|
|
(unless (char=? (string-ref vstr 0) #\v) (error "not a valid version" vstr))
|
||
|
|
(define first-period (string-index vstr (lambda (ch) (char=? ch #\.)) 1))
|
||
|
|
(define second-period (string-index vstr (lambda (ch) (char=? ch #\.)) (+ 1 first-period)))
|
||
|
|
(define prerelease-dash (string-index vstr (lambda (ch) (char=? ch #\-)) (+ 1 second-period)))
|
||
|
|
(define build-dash (string-index vstr (lambda (ch) (char=? ch #\+)) (+ 1 (or prerelease-dash second-period))))
|
||
|
|
(define major (string->number (string-copy vstr 1 first-period)))
|
||
|
|
(define minor (string->number (string-copy vstr (+ first-period 1) second-period)))
|
||
|
|
(define patch (string->number (string-copy vstr (+ second-period 1) (or prerelease-dash build-dash (string-length vstr)))))
|
||
|
|
(define prerelease (and prerelease-dash (string-copy vstr (+ prerelease-dash 1) (or build-dash (string-length vstr)))))
|
||
|
|
(define build (and build-dash (string-copy vstr (+ build-dash 1))))
|
||
|
|
(list major minor patch prerelease build))
|
||
|
|
|
||
|
|
(define (version<? left right)
|
||
|
|
(set! left (parse-version left))
|
||
|
|
(set! right (parse-version right))
|
||
|
|
(or
|
||
|
|
; left.major < right.major, or
|
||
|
|
(< (list-ref left 0) (list-ref right 0))
|
||
|
|
(and
|
||
|
|
; left.major = right.major, and
|
||
|
|
(= (list-ref left 0) (list-ref right 0))
|
||
|
|
(or
|
||
|
|
; left.minor < right.minor, or
|
||
|
|
(< (list-ref left 1) (list-ref right 1))
|
||
|
|
(and
|
||
|
|
; left.minor = right.minor, and
|
||
|
|
(= (list-ref left 1) (list-ref right 1))
|
||
|
|
(or
|
||
|
|
; left.patch < right.patch, or
|
||
|
|
(< (list-ref left 2) (list-ref right 2))
|
||
|
|
(and
|
||
|
|
; left.patch = right.patch, and
|
||
|
|
(= (list-ref left 2) (list-ref right 2))
|
||
|
|
(or
|
||
|
|
; left has prerelease, right doesn't
|
||
|
|
(and (list-ref left 3) (not (list-ref right 3)))
|
||
|
|
; or both have a prerelease and it's comparable
|
||
|
|
(and (list-ref left 3) (string<? (list-ref left 3) (list-ref right 3)))))))))))))
|
||
|
|
|