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

make blueboxes library work properly when the blueboxes.rktd files content changes

Browse Source
This commit is contained in:
Robby Findler 2015-04-15 05:44:57 -05:00
parent e6630f0e97
commit ec50ab1afe
1 changed files with 69 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
scribble-lib/scribble/blueboxes.rkt
View File

@ -15,7 +15,14 @@
[fetch-blueboxes-method-tags (->* (symbol?) (#:blueboxes-cache blueboxes-cache?)
(listof method-tag?))]))
;; offset : (or/c exact-nonnegative-integer? #f)
;; tag-ht : (or/c valid-blueboxes-info? #f)
;; mod-time : (or/c exact-nonnegative-integer? #f)
(struct bluebox-info (blueboxes.rktd [offset #:mutable] [tag-ht #:mutable] [mod-time #:mutable]))
(struct blueboxes-cache (info-or-paths method->tags) #:mutable)
(define (make-blueboxes-cache
populate?
#:blueboxes-dirs
@ -45,25 +52,26 @@
(define (fetch-strs-for-single-tag tag cache)
(populate-cache! cache)
(for/or ([ent (in-list (blueboxes-cache-info-or-paths cache))])
(define offset+lens (hash-ref (list-ref ent 2) tag #f))
(cond
[offset+lens
(define lines
(apply
append
(for/list ([offset+len (in-list offset+lens)])
(define fn (list-ref ent 0))
(define offset (list-ref ent 1))
(call-with-input-file fn
(λ (port)
(port-count-lines! port)
(file-position port (+ (car offset+len) offset))
(for/list ([i (in-range (cdr offset+len))])
(read-line port)))))))
(check-and-update-bluebox-info! ent)
(match ent
[(bluebox-info blueboxes.rktd offset tag-ht _)
(define offset+lens (hash-ref tag-ht tag #f))
(cond
[(ormap eof-object? lines) #f]
[else lines])]
[else #f])))
[offset+lens
(define lines
(apply
append
(for/list ([offset+len (in-list offset+lens)])
(call-with-input-file blueboxes.rktd
(λ (port)
(port-count-lines! port)
(file-position port (+ (car offset+len) offset))
(for/list ([i (in-range (cdr offset+len))])
(read-line port)))))))
(cond
[(ormap eof-object? lines) #f]
[else lines])]
[else #f])])))
(define (fetch-blueboxes-method-tags sym #:blueboxes-cache [cache (make-blueboxes-cache #f)])
(populate-cache! cache)
@ -78,9 +86,9 @@
(define (compute-methods-table lst)
(define meth-ht (make-hash))
(for ([three-tuple (in-list lst)])
(match three-tuple
[`(,file-path ,i ,tag-ht)
(for ([a-bluebox-info (in-list lst)])
(match a-bluebox-info
[(bluebox-info blueboxes.rktd offset tag-ht mod-time)
(for ([(tag val) (in-hash tag-ht)])
(when (method-tag? tag)
(define-values (class/intf meth) (get-class/interface-and-method tag))
@ -93,29 +101,47 @@
values
(for*/list ([doc-dir-name (in-list blueboxes-dirs)])
(define blueboxes.rktd (build-path doc-dir-name "blueboxes.rktd"))
(and (file-exists? blueboxes.rktd)
(call-with-input-file blueboxes.rktd
(λ (port)
(port-count-lines! port)
(define first-line (read-line port))
(define pos (file-position port))
(define desed
(with-handlers ([exn:fail? (λ (x)
(log-warning "Failed to deserialize ~a: ~a"
x
(exn-message x))
#f)])
(define candidate (deserialize (read port)))
(unless (valid-blueboxes-info? candidate)
(error 'build-blueboxes-cache
"blueboxes info didn't have the right shape: ~s"
candidate))
candidate))
(and desed
(list blueboxes.rktd
(+ (string->number first-line) pos)
desed))))))))
(define a-bluebox-info (bluebox-info blueboxes.rktd #f #f #f))
(populate-bluebox-info! a-bluebox-info)
a-bluebox-info)))
(define (check-and-update-bluebox-info! a-bluebox-info)
(match a-bluebox-info
[(bluebox-info blueboxes.rktd offset tag-ht mod-time)
(when (or (not mod-time)
(and (file-exists? blueboxes.rktd)
(not (mod-time . = . (file-or-directory-modify-seconds blueboxes.rktd)))))
(populate-bluebox-info! a-bluebox-info))]))
(define (populate-bluebox-info! a-bluebox-info)
(define blueboxes.rktd (bluebox-info-blueboxes.rktd a-bluebox-info))
(cond
[(file-exists? blueboxes.rktd)
(call-with-input-file blueboxes.rktd
(λ (port)
(port-count-lines! port)
(define first-line (read-line port))
(define pos (file-position port))
(define desed
(with-handlers ([exn:fail? (λ (x)
(log-warning "Failed to deserialize ~a: ~a"
x
(exn-message x))
#f)])
(define candidate (deserialize (read port)))
(unless (valid-blueboxes-info? candidate)
(error 'build-blueboxes-cache
"blueboxes info didn't have the right shape: ~s"
candidate))
candidate))
(set-bluebox-info-offset! a-bluebox-info (and desed (+ (string->number first-line) pos)))
(set-bluebox-info-tag-ht! a-bluebox-info desed)
(set-bluebox-info-mod-time! a-bluebox-info
(file-or-directory-modify-seconds blueboxes.rktd))))]
[else
(set-bluebox-info-offset! a-bluebox-info #f)
(set-bluebox-info-tag-ht! a-bluebox-info #f)
(set-bluebox-info-mod-time! a-bluebox-info #f)]))
(define valid-blueboxes-info?
(hash/c