89 lines
2.9 KiB
Racket
89 lines
2.9 KiB
Racket
#lang racket
|
|
(require "path-utils.rkt")
|
|
|
|
; (symbols 'always 'cache 'no-cache)
|
|
(define cache/file-mode (make-parameter 'cache))
|
|
(define (cache/file pth thnk)
|
|
(define mode (cache/file-mode))
|
|
(define (recompute!)
|
|
(define v (thnk))
|
|
(write-cache! pth v)
|
|
v)
|
|
(case mode
|
|
[(always) (recompute!)]
|
|
[(cache no-cache)
|
|
(with-handlers
|
|
([exn:fail?
|
|
(lambda (x)
|
|
(case mode
|
|
[(no-cache) (error 'cache/file "No cache available: ~a" pth)]
|
|
[(cache always)
|
|
#;(printf "cache/file: running ~S for ~a\n" thnk pth)
|
|
(recompute!)]))])
|
|
(read-cache pth))]))
|
|
|
|
(define (cache/file/timestamp pth thnk)
|
|
(cache/file
|
|
pth
|
|
(lambda ()
|
|
(thnk)
|
|
(current-seconds)))
|
|
(void))
|
|
|
|
(require "archive.rkt"
|
|
"dirstruct.rkt")
|
|
|
|
(define (consult-archive pth)
|
|
(define rev (path->revision pth))
|
|
(define archive-path (revision-archive rev))
|
|
(define file-bytes
|
|
(archive-extract-file archive-path pth))
|
|
(with-input-from-bytes file-bytes read))
|
|
|
|
(define (consult-archive/directory-list* pth)
|
|
(define rev (path->revision pth))
|
|
(define archive-path (revision-archive rev))
|
|
(directory-list->directory-list* (archive-directory-list archive-path pth)))
|
|
|
|
(define (consult-archive/directory-exists? pth)
|
|
(define rev (path->revision pth))
|
|
(define archive-path (revision-archive rev))
|
|
(archive-directory-exists? archive-path pth))
|
|
|
|
(define (cached-directory-list* dir-pth)
|
|
(if (directory-exists? dir-pth)
|
|
(directory-list* dir-pth)
|
|
(or (with-handlers ([exn:fail? (lambda _ #f)]) (consult-archive/directory-list* dir-pth))
|
|
(error 'cached-directory-list* "Directory list is not cached: ~e" dir-pth))))
|
|
|
|
(define (cached-directory-exists? dir-pth)
|
|
(if (file-exists? dir-pth)
|
|
#f
|
|
(or (directory-exists? dir-pth)
|
|
(with-handlers ([exn:fail? (lambda _ #f)]) (consult-archive/directory-exists? dir-pth)))))
|
|
|
|
(define (read-cache pth)
|
|
(if (file-exists? pth)
|
|
(file->value pth)
|
|
(or (with-handlers ([exn:fail? (lambda _ #f)]) (consult-archive pth))
|
|
(error 'read-cache "File is not cached: ~e" pth))))
|
|
(define (read-cache* pth)
|
|
(with-handlers ([exn:fail? (lambda (x) #f)])
|
|
(read-cache pth)))
|
|
(define (write-cache! pth v)
|
|
(write-to-file* v pth))
|
|
(define (delete-cache! pth)
|
|
(with-handlers ([exn:fail? void])
|
|
(delete-file pth)))
|
|
|
|
(provide/contract
|
|
[cache/file-mode (parameter/c (symbols 'always 'cache 'no-cache))]
|
|
[cache/file (path-string? (-> any/c) . -> . any/c)]
|
|
[cache/file/timestamp (path-string? (-> void) . -> . void)]
|
|
[cached-directory-list* (path-string? . -> . (listof path-string?))]
|
|
[cached-directory-exists? (path-string? . -> . boolean?)]
|
|
[read-cache (path-string? . -> . any/c)]
|
|
[read-cache* (path-string? . -> . any/c)]
|
|
[write-cache! (path-string? any/c . -> . void)]
|
|
[delete-cache! (path-string? . -> . void)])
|