source: project/release/5/string-utils/trunk/semantic-version.scm @ 39830

Last change on this file since 39830 was 39830, checked in by Kon Lovett, 4 months ago

add semantic-version & support

File size: 2.8 KB
Line 
1;;;; semantic-version.scm  -*- Scheme -*-
2;;;; Kon Lovett, Apr '21
3
4(module semantic-version
5
6(;export
7  version-punctuation
8  ;version-compare
9  version-split
10  version-combine
11  version-valid?
12  version-inc!
13  version-dec!
14  version-inc
15  version-dec)
16
17(import scheme
18  utf8
19  (chicken base)
20  (chicken type)
21  (only (srfi 1) list-copy)
22  string-utils)
23
24;;
25
26(: version-punctuation (#!optional string -> string))
27
28(: version-split (string -> (list-of string) (list-of string)))
29(: version-combine ((list-of string) (list-of string) -> string))
30(: version-valid? ((list-of string) (list-of string) -> boolean))
31
32(: version-inc! ((list-of string) #!optional integer integer -> (list-of string)))
33(: version-dec! ((list-of string) #!optional integer integer -> (list-of string)))
34(: version-inc ((list-of string) #!optional integer integer -> (list-of string)))
35(: version-dec ((list-of string) #!optional integer integer -> (list-of string)))
36
37;;
38
39;(define-constant VERSION-PUNCT "!?@#$%^&*-_+=|/\\;:,. ")
40;(define-constant VERSION-PUNCT #$%^&-_+=/\\;:,. ")
41(define-constant VERSION-PUNCT "+-_;:,. ")
42
43(define version-punctuation (make-parameter VERSION-PUNCT))
44
45#; ;FIXME natural-sort?
46;parts1 parts2 => <0 | 0 | >0
47(define (version-compare parts1 parts2)
48  (let loop ((p1 parts1) (p2 parts2))
49    (cond
50      ((null? p1) (null? p2)  0)
51      ((null? p2)             1)
52      ((number? (car p1))
53       (and (number? (car p2))
54            (or (> (car p1) (car p2))
55                (and (= (car p1) (car p2))
56                     (loop (cdr p1) (cdr p2))))) )
57      ((number? (car p2)))
58      ((string>? (car p1) (car p2)))
59      (else
60       (and (string=? (car p1) (car p2))
61            (loop (cdr p1) (cdr p2))) ) ) ) )
62
63;punct parts => ?
64(define (version-valid? parts punct)
65  ;FIXME something more substantial?
66  (= (length punct) (sub1 (length parts))) )
67
68;"..." => parts punct
69(define (version-split str)
70  (string-unzip str (version-punctuation)) )
71
72;punct parts => "..." | "invalid"
73(define (version-combine parts punct)
74  (if (not (version-valid? parts punct))
75    "invalid"
76    (string-zip parts punct)) )
77
78;inc/dec nth ver - "IVX"/"ivx" & "abc"/"ABC"
79
80(define (version-inc! parts #!optional (idx (sub1 (length parts))) (amt 1))
81  (let loop ((idx idx) (ls parts))
82    (cond
83      ((zero? idx)
84        (let ((val (string->number (car ls))))
85          (set-car! ls (number->string (+ val amt)))
86          parts ) )
87      (else
88        (loop (sub1 idx) (cdr ls)) ) ) ) )
89
90(define (version-dec! parts #!optional (idx (sub1 (length parts))) (amt 1))
91  (version-inc! parts idx (- amt)) )
92
93(define (version-inc parts #!optional (idx (sub1 (length parts))) (amt 1))
94  (version-inc! (list-copy parts) idx amt) )
95
96(define (version-dec parts #!optional (idx (sub1 (length parts))) (amt 1))
97  (version-dec! (list-copy parts) idx amt) )
98
99) ;semantic-version
Note: See TracBrowser for help on using the repository browser.