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

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

View File

@ -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)])

View File

@ -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))
(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")))]
[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))
(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))

View File

@ -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)))))))