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

manage snapshots: don't fail due to mangled previous build

Browse Source
This commit is contained in:
Matthew Flatt 2015-01-18 06:53:39 -07:00
parent e2fde3acbf
commit 8047476af3
1 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
distro-build-server/manage-snapshots.rkt
View File

@ -62,16 +62,20 @@
(define past-successes (define past-successes
(let ([current-table (get-installers-table table-file)]) (let ([current-table (get-installers-table table-file)])
(for/fold ([table (hash)]) ([s (in-list (reverse (remove current-snapshot (get-snapshots))))]) (for/fold ([table (hash)]) ([s (in-list (reverse (remove current-snapshot (get-snapshots))))])
(define past-table (get-installers-table (with-handlers ([exn:fail? (lambda (exn)
(build-path snapshots-dir s installers-dir "table.rktd"))) (log-error "failure getting installer table: ~a"
(for/fold ([table table]) ([(k v) (in-hash past-table)]) (exn-message exn))
(if (or (hash-ref current-table k #f) table)])
(hash-ref table k #f) (define past-table (get-installers-table
(not (file-exists? (build-path site-dir "log" k)))) (build-path snapshots-dir s installers-dir "table.rktd")))
table (for/fold ([table table]) ([(k v) (in-hash past-table)])
(hash-set table k (past-success s (if (or (hash-ref current-table k #f)
(string-append s "/index.html") (hash-ref table k #f)
v))))))) (not (file-exists? (build-path site-dir "log" k))))
table
(hash-set table k (past-success s
(string-append s "/index.html")
v))))))))
(define current-rx (regexp (regexp-quote (version)))) (define current-rx (regexp (regexp-quote (version))))