1 ! Copyright (C) 2023 Doug Coleman.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs calendar calendar.format cli.git
4 combinators combinators.short-circuit continuations formatting
5 github html.parser html.parser.analyzer http.client io
6 io.directories io.encodings.string io.encodings.utf8 io.files
7 io.launcher io.pathnames json kernel layouts math namespaces qw
8 semver sequences sequences.extras sorting sorting.human
9 sorting.specification splitting system unicode ;
12 INITIALIZED-SYMBOL: use-gitlab-git-uris [ f ]
13 INITIALIZED-SYMBOL: use-github-git-uris [ f ]
15 INITIALIZED-SYMBOL: build-from-source-directory [ "resource:build-from-source/" ]
19 : dll-out-directory ( -- path )
20 vm-path parent-directory cell-bits "dlls%s-out" sprintf append-path
21 dup make-directories ;
23 : get-out-directory ( -- path )
24 out-directory get [ dll-out-directory ] unless* ;
26 : with-out-directory ( path quot -- )
27 [ out-directory ] dip with-variable ; inline
29 : remake-directory ( path -- )
30 [ ?delete-tree ] [ make-directories ] bi ;
32 : prepend-current-path ( path -- path' )
33 current-directory get prepend-path ;
35 : find-dlls ( path -- paths )
36 recursive-directory-files
37 [ file-name >lower ".dll" tail? ] filter ;
39 ERROR: no-output-file path ;
40 : copy-output-file-as ( name new-name -- )
41 [ prepend-current-path dup file-exists? [ no-output-file ] unless ]
42 [ get-out-directory prepend-path ] bi* copy-file ;
44 : copy-vm-file-as ( name new-name -- )
45 [ prepend-current-path ]
46 [ vm-path parent-directory prepend-path ] bi* copy-file ;
48 : copy-output-file ( name -- )
49 prepend-current-path get-out-directory copy-file-into ;
51 : copy-output-files ( seq -- )
52 [ copy-output-file ] each ;
54 : delete-output-file ( name -- )
55 get-out-directory prepend-path ?delete-file ;
57 : delete-output-files ( seq -- )
58 [ delete-output-file ] each ;
60 : with-build-directory-as ( name quot -- )
61 [ prepend-current-path dup remake-directory ] dip with-directory ; inline
63 : with-build-directory ( quot -- ) [ "build" ] dip with-build-directory-as ; inline
65 : get-build-from-source-directory ( -- path )
66 build-from-source-directory get ;
68 : build-from-source-directory-directory-cpu ( -- path )
69 get-build-from-source-directory cpu name>> append-path ;
71 : with-build-from-source-cpu-directory ( quot -- )
72 [ build-from-source-directory-directory-cpu dup make-directories ] dip with-directory ; inline
74 : build-from-source-directory-gitlab ( -- path )
75 get-build-from-source-directory "gitlab" append-path ;
77 : gitlab-disk-path ( base org/user project -- path )
79 build-from-source-directory-gitlab prepend-path absolute-path ;
81 : gitlab-tag-disk-checkout-path ( base org/user project tag -- path )
82 [ gitlab-disk-path ] dip append-path absolute-path ;
84 : with-build-from-source-gitlab-no-checkout-directory ( base org/user quot -- )
85 [ build-from-source-directory-gitlab prepend-path dup make-directories ] dip with-directory ; inline
87 : gitlab-git-uri ( base org/user project -- uri ) "git://%s/%s/%s" sprintf ;
88 : gitlab-http-uri ( base org/user project -- uri ) "http://%s/%s/%s" sprintf ;
89 : gitlab-https-uri ( base org/user project -- uri ) "https://%s/%s/%s" sprintf ;
91 : gitlab-uri ( base org/user project -- uri )
92 use-gitlab-git-uris get [ gitlab-git-uri ] [ gitlab-https-uri ] if ;
94 : sync-gitlab-no-checkout-repository ( base org/user project -- )
95 [ 2drop ] [ gitlab-uri ] [ nipd append-path ] 3tri
97 _ _ sync-no-checkout-repository-as wait-for-success
98 ] with-build-from-source-gitlab-no-checkout-directory ;
100 : with-no-checkout-gitlab-repo ( base org/user project quot -- )
102 [ sync-gitlab-no-checkout-repository ]
103 [ gitlab-disk-path ] 3bi
104 ] dip with-directory ; inline
106 : build-from-source-directory-github ( -- path )
107 get-build-from-source-directory "github" append-path ;
109 : github-disk-path ( org/user project -- path )
111 build-from-source-directory-github prepend-path absolute-path ;
113 : github-tag-disk-checkout-path ( org/user project tag -- path )
114 [ github-disk-path ] dip append-path absolute-path ;
116 : with-build-from-source-github-no-checkout-directory ( org/user quot -- )
117 [ build-from-source-directory-github prepend-path dup make-directories ] dip with-directory ; inline
119 : github-uri ( org/user project -- uri )
120 use-github-git-uris get [ github-git-uri ] [ github-https-uri ] if ;
122 : sync-github-no-checkout-repository ( org/user project -- )
123 [ drop ] [ github-uri ] [ nip git-directory-name ] 2tri
125 _ _ sync-no-checkout-repository-as wait-for-success
126 ] with-build-from-source-github-no-checkout-directory ;
128 : check-build-completed ( path -- path' file-contents/f )
129 "factor-build-completed" append-path
130 dup file-exists? [ dup utf8 file-contents ] [ f ] if ;
132 : with-github-worktree-tag ( org/user project tag quot -- )
135 [ drop sync-github-no-checkout-repository ]
136 [ drop github-disk-path ]
137 [ github-tag-disk-checkout-path ]
143 over "build-from-source considering github %s" sprintf print
144 over check-build-completed [
145 2nip "- %s already built at %s" sprintf print
148 over "%s\n- deleting old build..." sprintf write
149 2dup [ ?delete-tree "deleted!" print ]
150 [ "- %s building..." sprintf write ] bi*
151 [ git-worktree-force-add wait-for-success ] keepd
154 now timestamp>rfc3339
155 ] dip utf8 set-file-contents
157 ] with-directory ; inline
159 : with-gitlab-worktree-tag ( base org/user project tag quot -- )
162 [ drop sync-gitlab-no-checkout-repository ]
163 [ drop gitlab-disk-path ]
164 [ gitlab-tag-disk-checkout-path ]
170 dup "build-from-source considering gitlab %s" sprintf print
171 over check-build-completed [
172 2nip "- %s already built at %s" sprintf print
175 over "%s\n- deleting old build..." sprintf write
176 2dup [ ?delete-tree "deleted!" print ]
177 [ "- %s building..." sprintf write ] bi*
178 [ git-worktree-force-add wait-for-success ] keepd
181 now timestamp>rfc3339
182 ] dip utf8 set-file-contents
184 ] with-directory ; inline
186 : ?download ( path -- )
187 dup file-name file-exists? [ drop ] [ download ] if ; inline
189 : with-tar-gz ( path quot -- )
191 _ dup "build-from-source considering tar.gz %s" sprintf print
192 dup file-name ".tar.gz" ?tail drop check-build-completed [
193 2nip "- already built at %s" sprintf print
195 "- building..." write
198 [ file-name { "tar" "xvfz" } swap suffix try-process ]
199 [ file-name ".tar.gz" ?tail drop ] tri
200 prepend-current-path _ with-directory
201 now timestamp>rfc3339
202 ] dip utf8 set-file-contents
205 ] with-build-from-source-cpu-directory ; inline
207 : split-python-version ( version -- array )
209 { [ dup "a" swap subseq? ] [ [ "a" split1 "99" or "alpha" swap ] keep 4array ] }
210 { [ dup "b" swap subseq? ] [ [ "b" split1 "99" or "beta" swap ] keep 4array ] }
211 { [ dup "rc" swap subseq? ] [ [ "rc" split1 "99" or "rc" swap ] keep 4array ] }
212 [ "z" "99" pick 4array ]
215 : latest-python ( tags -- tag )
216 [ [ CHAR: . = ] count 2 >= ] filter
217 [ split-python-version ] map
219 { human<=> } sort-keys-with-spec
220 last second human-sort last fourth ;
222 : latest-semver-tags-matching ( owner repo tag-head -- ref-json/f semver/f )
223 list-repository-tags-matching
224 [ "ref" of "/" split1-last nip [ >semver ] [ 2drop f ] recover ] zip-with
225 sift-values sort-values ?last ?first2 ;
227 : latest-solr ( -- tag-json semver ) "apache" "solr" "releases/solr" latest-semver-tags-matching ;
228 : latest-lucene ( -- tag-json semver ) "apache" "lucene" "releases/lucene" latest-semver-tags-matching ;
230 : digit-or-dot? ( str -- ? )
231 { [ digit? ] [ CHAR: . = ] } 1|| ;
233 : tag-refs ( tags -- tags' )
235 [ "refs/tags/" ?head drop ] map ;
237 : python-tags ( -- tags )
238 "python" "cpython" "v" list-repository-tags-matching tag-refs ;
240 : tags>latest-python2 ( tags -- tag ) [ "v2." head? ] filter latest-python ;
241 : latest-python2 ( -- tag ) python-tags tags>latest-python2 ;
242 : tags>latest-python3 ( tags -- tag )
243 [ "v3." head? ] filter
244 [ "." split1-last nip [ digit? ] all? ] filter
246 : latest-python3 ( -- tag ) python-tags tags>latest-python3 ;
248 : rustup-update ( -- )
249 qw{ rustup update stable } try-process
250 qw{ rustup update nightly } try-process ;
252 : latest-fftw ( -- path )
253 "https://ftp.fftw.org/pub/fftw/" [
255 parse-html find-links concat
256 [ name>> text = ] filter
258 [ "fftw-" head? ] filter
259 [ ".tar.gz" tail? ] filter
261 ] keep prepend-path ;
263 : latest-libressl ( -- path )
264 "https://ftp.openbsd.org/pub/OpenBSD/LibreSSL/" [
265 http-get nip parse-html find-links concat
266 [ name>> text = ] filter
268 [ "libressl-" head? ] filter
269 [ ".tar.gz" tail? ] filter last
272 : latest-pcre-tar-gz ( -- path )
273 "https://ftp.exim.org/pub/pcre/" [
274 http-get nip parse-html find-links concat
275 [ name>> text = ] filter [ text>> ] map
276 [ "pcre-" head? ] filter
277 [ ".tar.gz" tail? ] filter last
280 : cairo-versions ( -- version )
281 "https://gitlab.freedesktop.org/api/v4/projects/956/repository/tags"
282 http-get nip utf8 decode json> [ "name" of ] map ;
284 : blas-versions ( -- seq )
285 "xianyi" "OpenBLAS" "v" list-repository-tags-matching
286 tag-refs human-sort ;
288 : duckdb-versions ( -- seq )
289 "duckdb" "duckdb" "v" list-repository-tags-matching
290 tag-refs human-sort ;
292 : grpc-versions ( -- seq )
293 "grpc" "grpc" "v" list-repository-tags-matching
294 tag-refs human-sort ;
296 : pcre2-versions ( -- seq )
297 "PCRE2Project" "pcre2" "" list-repository-tags-matching
298 tag-refs human-sort ;
300 : lz4-versions ( -- seq )
301 "lz4" "lz4" "v" list-repository-tags-matching
302 tag-refs human-sort ;
304 : openal-versions ( -- seq )
305 "kcat" "openal-soft" "" list-repository-tags-matching
307 [ [ digit-or-dot? ] all? ] filter
310 : openssl-versions ( -- seq )
311 "openssl" "openssl" "openssl-" list-repository-tags-matching
312 tag-refs human-sort ;
314 : postgres-versions ( -- seq )
315 "postgres" "postgres" "REL_" list-repository-tags-matching
317 ! [ "_" split1-last nip [ digit? ] all? ] filter ! no RC1 or BETA1
320 : raylib-versions ( -- seq )
321 "raysan5" "raylib" "" list-repository-tags-matching
322 tag-refs human-sort ;
324 : raygui-versions ( -- seq )
325 "raysan5" "raygui" "" list-repository-tags-matching
326 tag-refs human-sort ;
328 : ripgrep-versions ( -- seq )
329 "BurntSushi" "ripgrep" "" list-repository-tags-matching
331 [ [ digit-or-dot? ] all? ] filter
334 : snappy-versions ( -- seq )
335 "google" "snappy" "" list-repository-tags-matching
336 tag-refs human-sort ;
338 : sqlite-versions ( -- seq )
339 "sqlite" "sqlite" "version-" list-repository-tags-matching
340 tag-refs human-sort ;
342 : winflexbison-versions ( -- seq )
343 "lexxmark" "winflexbison" "v" list-repository-tags-matching
344 tag-refs [ "v." head? ] reject human-sort ;
346 : yaml-versions ( -- seq )
347 "yaml" "libyaml" "" list-repository-tags-matching
348 tag-refs [ [ digit-or-dot? ] all? ] filter human-sort ;
350 : zeromq-versions ( -- seq )
351 "zeromq" "libzmq" "" list-repository-tags-matching
352 tag-refs human-sort ;
354 : zlib-versions ( -- seq )
355 "madler" "zlib" "v" list-repository-tags-matching
356 tag-refs human-sort ;
358 : zstd-versions ( -- seq )
359 "facebook" "zstd" "v" list-repository-tags-matching