Delay running git, to avoid a premature warning about $GIT_DIR.
This commit is contained in:
parent
8b7a9c6b9e
commit
41c0156fe3
|
@ -111,7 +111,7 @@
|
|||
set-announcements-file!)
|
||||
|
||||
(require racket/list racket/file version/utils racket/runtime-path
|
||||
"release-info.rkt")
|
||||
racket/promise "release-info.rkt")
|
||||
|
||||
;; ----------------------------------------------------------------------------
|
||||
;; Mirror information
|
||||
|
@ -204,8 +204,17 @@
|
|||
[else (loop (cdr l) (add1 n))])))
|
||||
(λ (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-
|
||||
(define all-installers
|
||||
(define-lazy all-installers
|
||||
(sort
|
||||
(call-with-input-file installers-data parse-installers)
|
||||
(let ([fns `([,(λ (i)
|
||||
|
@ -220,11 +229,11 @@
|
|||
(let* ([get (caar fns)] [<? (cdar fns)] [x1 (get i1)] [x2 (get i2)])
|
||||
(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)))
|
||||
(define all-packages ; also sorted
|
||||
(define-lazy all-packages ; also sorted
|
||||
(remove-duplicates (map installer-package all-installers)))
|
||||
(define current-release (car all-releases))
|
||||
(define-lazy current-release (car all-releases))
|
||||
|
||||
(define package->name
|
||||
(let ([t (make-hasheq)])
|
||||
|
|
|
@ -1,8 +1,9 @@
|
|||
#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)
|
||||
(eprintf "Warning: ~a\a\n" (apply format fmt xs))
|
||||
|
@ -10,14 +11,15 @@
|
|||
(sleep 1)
|
||||
#f)
|
||||
|
||||
(define git
|
||||
(let* ([exe (or (find-executable-path "git")
|
||||
(warn "no `git' executable => no release info"))]
|
||||
[try (λ (dir) (and dir (directory-exists? dir) dir))]
|
||||
[dir (and exe (or (ormap try (list (getenv "GIT_DIR") THIS-GIT))
|
||||
(warn "no git dir found => no release info\n (~a)"
|
||||
"set $GIT_DIR to a racket repo .git dir")))]
|
||||
[nowhere (open-output-nowhere)])
|
||||
(define git*
|
||||
(lazy
|
||||
(define exe (or (find-executable-path "git")
|
||||
(warn "no `git' executable => no release info")))
|
||||
(define (try dir) (and dir (directory-exists? dir) dir))
|
||||
(define dir (and exe (or (ormap try (list (getenv "GIT_DIR") THIS-GIT))
|
||||
(warn "no git dir found => no release info\n (~a)"
|
||||
"set $GIT_DIR to a racket repo .git dir"))))
|
||||
(define nowhere (open-output-nowhere))
|
||||
(and dir (λ args (define o (open-output-string))
|
||||
(parameterize ([current-directory dir]
|
||||
[current-output-port o]
|
||||
|
@ -27,6 +29,7 @@
|
|||
|
||||
(provide get-version-tag-info)
|
||||
(define (get-version-tag-info version)
|
||||
(define git (force git*))
|
||||
(let/ec return
|
||||
(unless git (return #f))
|
||||
(define (bad . args) (apply warn args) (return #f))
|
||||
|
|
|
@ -3,5 +3,5 @@
|
|||
(require "resources.rkt" "data.rkt")
|
||||
|
||||
(define version.txt
|
||||
(let ([v (release-version current-release)])
|
||||
(plain (format "~s" `((recent ,v) (stable ,v))))))
|
||||
(plain (lazy (let ([v (release-version current-release)])
|
||||
(format "~s" `((recent ,v) (stable ,v)))))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user