1 ! Copyright (C) 2020 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs combinators combinators.smart io
4 kernel math math.order math.parser multiline peg.ebnf sequences
5 sequences.deep sequences.extras splitting strings ;
8 ! caret - up to next major versions, aka only major version needs to match as long as minor/patch are >=
9 ! tilde - last number can increment, e.g. ~1.2 is <2.0, ~1.2.3 is <1.3
11 : ?string>number ( str -- number/str )
12 dup string>number dup not -rot ? ;
14 : split-numbers ( str -- seq )
15 [ { } ] [ "." split [ ?string>number ] map ] if-empty ;
17 : ?inc-string ( str -- str' )
18 string>number 1 + number>string ;
20 SINGLETONS: major minor patch prerelease build prepatch preminor premajor ;
23 { major integer initial: 0 }
24 { minor integer initial: 0 }
25 { patch integer initial: 0 }
26 { prerelease initial: "" }
27 { build initial: "" } ;
29 : parse-semver ( str -- semver )
32 [ "." split [ string>number ] map first3 ] 2dip
35 : <semver> ( str -- semver ) parse-semver ; inline
37 : first-semver-slot ( semver -- class )
39 { [ dup major>> 0 > ] [ drop major ] }
40 { [ dup minor>> 0 > ] [ drop minor ] }
41 { [ dup patch>> 0 > ] [ drop patch ] }
42 { [ dup prerelease>> length 0 > ] [ drop prerelease ] }
43 { [ dup build>> length 0 > ] [ drop build ] }
47 : last-semver-slot ( semver -- class )
49 { [ dup build>> length 0 > ] [ drop build ] }
50 { [ dup prerelease>> length 0 > ] [ drop prerelease ] }
51 { [ dup patch>> 0 > ] [ drop patch ] }
52 { [ dup minor>> 0 > ] [ drop minor ] }
53 { [ dup major>> 0 > ] [ drop major ] }
57 : semver>string ( semver -- string )
60 [ major>> number>string "." ]
61 [ minor>> number>string "." ]
62 [ patch>> number>string ]
63 [ prerelease>> [ "" "" ] [ "-" swap ] if-empty ]
64 [ build>> [ "" "" ] [ "+" swap ] if-empty ]
66 ] "" append-outputs-as ;
68 : semver. ( semver -- )
71 : semver-inc-major ( semver -- semver )
84 : semver-inc-minor ( semver -- semver )
96 : semver-inc-patch ( semver -- semver )
107 : semver-inc-prerelease ( semver -- semver )
112 dup [ string>number ] find-last [
113 over [ ?inc-string ] change-nth
118 ] if-empty >>prerelease
121 : semver-inc-prerelease-id ( semver id -- semver )
127 dup [ string>number ] find-last [
128 over [ ?inc-string ] change-nth
136 ] if-empty >>prerelease
139 : semver-inc-prepatch ( semver -- semver )
144 : semver-inc-preminor ( semver -- semver )
150 : semver-inc-premajor ( semver -- semver )
157 GENERIC: lower-range ( obj -- str )
159 M: string lower-range ( obj -- semver )
160 parse-semver semver>string ">=" prepend ;
162 M: array lower-range ( obj -- semver )
163 parse-semver semver>string ">=" prepend ;
165 GENERIC: upper-range ( obj -- str )
167 M: string upper-range ( obj -- semver )
168 parse-semver semver>string "<=" prepend ;
170 M: array upper-range ( obj -- semver )
171 parse-semver semver>string "<=" prepend ;
173 : major-minor-patch-compare ( s1 s2 -- <=> part )
174 2dup [ major>> ] compare
176 drop 2dup [ minor>> ] compare
178 drop [ patch>> ] compare patch
186 : compare-prelreases ( semver1 semver2 -- <=> )
187 [ prerelease>> ] bi@ over empty? [
188 nip empty? +eq+ +gt+ ?
190 dup empty? [ 2drop +lt+ ] [
191 [ split-numbers ] bi@
195 { [ 2dup [ integer? ] both? ] [ <=> ] }
196 { [ 2dup [ string? ] both? ] [ <=> ] }
197 { [ over integer? ] [ 2drop +lt+ ] }
198 { [ dup integer? ] [ 2drop +gt+ ] }
199 { [ over f = ] [ 2drop +lt+ ] }
200 { [ dup f = ] [ 2drop +gt+ ] }
210 2dup major-minor-patch-compare drop
211 dup +eq+ = [ drop compare-prelreases ] [ 2nip ] if ;
213 EBNF: parse-range [=[
214 logical-or = [\s\t]*~ '||' [\s\t]*~
215 range = hyphen | simple ( [\s\t]*~ simple )* => [[ first2 swap prefix ]]
216 hyphen = partial:p1 [\s\t]*~ '-':t [\s\t]*~ partial:p2 => [[ p1 t p2 3array ]]
217 simple = primitive | partial | tilde | caret
218 primitive = ( '~>' | '>=' | '<=' | '>' | '<' | '=' ) [\s\t]*~ partial
219 partial = xr ( '.' xr ( '.' xr qualifier? )? )? => [[ flatten concat ]]
220 xr = 'x' | 'X' | "*" | nr
221 nr = [0-9]+ => [[ string>number number>string ]]
222 tilde = '~' [\s\t]*~ partial
223 caret = '^' [\s\t]*~ partial
224 qualifier = ( '-' pre )? ( '+' build )?
227 parts = part ( '.' part )*
228 part = nr | [-0-9A-Za-z]+ => [[ >string ]]
229 range-set = range? ( logical-or range? )* => [[ first2 swap prefix ]]