suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Delay running git, to avoid a premature warning about $GIT_DIR.

Browse Source
This commit is contained in:
Eli Barzilay 2013-07-09 20:45:41 -04:00
parent 8b7a9c6b9e
commit 41c0156fe3
3 changed files with 29 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
pkgs/plt-services/meta/web/download/data.rkt
View File

@ -111,7 +111,7 @@
set-announcements-file!) set-announcements-file!)
(require racket/list racket/file version/utils racket/runtime-path (require racket/list racket/file version/utils racket/runtime-path
"release-info.rkt") racket/promise "release-info.rkt")
;; ---------------------------------------------------------------------------- ;; ----------------------------------------------------------------------------
;; Mirror information ;; Mirror information
@ -204,8 +204,17 @@
[else (loop (cdr l) (add1 n))]))) [else (loop (cdr l) (add1 n))])))
(λ (x y) (< (num-of x) (num-of y)))) (λ (x y) (< (num-of x) (num-of y))))
;; use this to avoid parsing the installers until generation starts
(define-syntax-rule (define-lazy name expr)
(begin (define p (lazy expr))
(define-syntax name
(syntax-id-rules (set!)
[(set! _ x) (error 'name "unmodifiable binding")]
[(_ x (... ...)) ((force p) x (... ...))]
[_ (force p)]))))
;; sorted by version (newest first), and then by -installer-orders- ;; sorted by version (newest first), and then by -installer-orders-
(define all-installers (define-lazy all-installers
(sort (sort
(call-with-input-file installers-data parse-installers) (call-with-input-file installers-data parse-installers)
(let ([fns `([,(λ (i) (let ([fns `([,(λ (i)
@ -220,11 +229,11 @@
(let* ([get (caar fns)] [<? (cdar fns)] [x1 (get i1)] [x2 (get i2)]) (let* ([get (caar fns)] [<? (cdar fns)] [x1 (get i1)] [x2 (get i2)])
(or (<? x1 x2) (and (equal? x1 x2) (loop (cdr fns))))))))))) (or (<? x1 x2) (and (equal? x1 x2) (loop (cdr fns)))))))))))
(define all-releases ; still sorted from newest to oldest (define-lazy all-releases ; still sorted from newest to oldest
(remove-duplicates (map installer-release all-installers))) (remove-duplicates (map installer-release all-installers)))
(define all-packages ; also sorted (define-lazy all-packages ; also sorted
(remove-duplicates (map installer-package all-installers))) (remove-duplicates (map installer-package all-installers)))
(define current-release (car all-releases)) (define-lazy current-release (car all-releases))
(define package->name (define package->name
(let ([t (make-hasheq)]) (let ([t (make-hasheq)])

23
pkgs/plt-services/meta/web/download/release-info.rkt
View File

@ -1,8 +1,9 @@
#lang racket/base #lang racket/base
(require racket/system racket/port racket/match racket/runtime-path) (require racket/system racket/port racket/match racket/runtime-path
racket/promise)
(define-runtime-path THIS-GIT "../../../../.git") (define-runtime-path THIS-GIT "../../../../../.git")
(define (warn fmt . xs) (define (warn fmt . xs)
(eprintf "Warning: ~a\a\n" (apply format fmt xs)) (eprintf "Warning: ~a\a\n" (apply format fmt xs))
@ -10,14 +11,15 @@
(sleep 1) (sleep 1)
#f) #f)
(define git (define git*
(let* ([exe (or (find-executable-path "git") (lazy
(warn "no `git' executable => no release info"))] (define exe (or (find-executable-path "git")
[try (λ (dir) (and dir (directory-exists? dir) dir))] (warn "no `git' executable => no release info")))
[dir (and exe (or (ormap try (list (getenv "GIT_DIR") THIS-GIT)) (define (try dir) (and dir (directory-exists? dir) dir))
(warn "no git dir found => no release info\n (~a)" (define dir (and exe (or (ormap try (list (getenv "GIT_DIR") THIS-GIT))
"set $GIT_DIR to a racket repo .git dir")))] (warn "no git dir found => no release info\n (~a)"
[nowhere (open-output-nowhere)]) "set $GIT_DIR to a racket repo .git dir"))))
(define nowhere (open-output-nowhere))
(and dir (λ args (define o (open-output-string)) (and dir (λ args (define o (open-output-string))
(parameterize ([current-directory dir] (parameterize ([current-directory dir]
[current-output-port o] [current-output-port o]
@ -27,6 +29,7 @@
(provide get-version-tag-info) (provide get-version-tag-info)
(define (get-version-tag-info version) (define (get-version-tag-info version)
(define git (force git*))
(let/ec return (let/ec return
(unless git (return #f)) (unless git (return #f))
(define (bad . args) (apply warn args) (return #f)) (define (bad . args) (apply warn args) (return #f))

4
pkgs/plt-services/meta/web/download/version.rkt
View File

@ -3,5 +3,5 @@
(require "resources.rkt" "data.rkt") (require "resources.rkt" "data.rkt")
(define version.txt (define version.txt
(let ([v (release-version current-release)]) (plain (lazy (let ([v (release-version current-release)])
(plain (format "~s" `((recent ,v) (stable ,v)))))) (format "~s" `((recent ,v) (stable ,v)))))))