diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | haunt/pages/about.sxml | 39 |
2 files changed, 40 insertions, 1 deletions
@@ -7,3 +7,5 @@ /haunt/.venv/ /haunt-old/ + +/haunt/.bin-commit-counts.sexp diff --git a/haunt/pages/about.sxml b/haunt/pages/about.sxml index 88dece2..7003d4a 100644 --- a/haunt/pages/about.sxml +++ b/haunt/pages/about.sxml @@ -227,6 +227,43 @@ If `end' is specified, return `#t' iff `date' is prior to `end'." (increment-date-by-month date)) (reverse! (map string->number bin))))) +(define bin-commit-count-cache-file-name "./.bin-commit-counts.sexp") +(define* (bin-commit-counts-memoized repository-path #:key start end) + "Memoized (across multiple invocations of Haunt) `bin-commit-counts' + +Results are cached in an alist serialized to the path specified by +`bin-commit-count-cache-file-name', and are invalidated when more than a week +old." + (unless (file-exists? bin-commit-count-cache-file-name) + ;; Initialize the cache on disk with an empty alist if the cache file hasn't + ;; been created yet. + (call-with-output-file bin-commit-count-cache-file-name + (lambda (port) (write '() port)))) + (let* ((cache (call-with-input-file bin-commit-count-cache-file-name read)) + (key repository-path)) + (define result + (match (assoc-ref cache key) + ((age-timestamp . result) + (if (<= age-timestamp + ;; One week ago, as a UNIX timestamp. + (time-second + (subtract-duration + (current-time 'time-utc) + (make-time 'time-duration 0 (* 60 60 24 7))))) + (bin-commit-counts repository-path #:start start #:end end) + result)) + (_ (bin-commit-counts repository-path #:start start #:end end)))) + ;; When we've either retrieved or calculated the result, we'll update the + ;; cache on disk. It doesn't matter too much if we do this unconditionally + ;; because it isn't nearly as slow as walking the git logs. + (call-with-output-file bin-commit-count-cache-file-name + (lambda (port) + ;; Note that we use a UNIX timestamp rather than SRFI-19 time objects + ;; because the former is actually `read'able. + (let ((new-timestamp (time-second (current-time 'time-utc)))) + (write (assoc-set! cache key (cons new-timestamp result)) port)))) + result)) + (define* (render-histogram summary #:key (width 60) (height 25)) "Render a list of intervals as an SVG histogram." ;; Assuming an interval lasts a month, I'm lucky to get 50 commits in. @@ -267,7 +304,7 @@ If `end' is specified, return `#t' iff `date' is prior to `end'." (let ((start-date (date-of-first-commit repository-path))) `(tr (td ,(hyperlink url name)) (td ,(lang-to-button lang)) - (td ,(render-histogram (bin-commit-counts repository-path #:end end-date))) + (td ,(render-histogram (bin-commit-counts-memoized repository-path #:end end-date))) (td ,(if end-date (format #f "~a - ~a" (date->string start-date "~b ~e ~Y") |