hold metadata in memory instead of in git
This commit is contained in:
parent
8c52717d5d
commit
fa7cc3f267
5 changed files with 11 additions and 42 deletions
|
@ -41,21 +41,5 @@
|
||||||
posts)
|
posts)
|
||||||
hash))
|
hash))
|
||||||
|
|
||||||
(define (build-categories-tree master posts)
|
|
||||||
(if (null? posts)
|
|
||||||
#f
|
|
||||||
(let* ((hash (compute-categories posts))
|
|
||||||
(tree (make-tree (hash-map->list
|
|
||||||
(lambda (k v) (cons k (make-tree v)))
|
|
||||||
hash)))
|
|
||||||
(ts (commit-utc-timestamp master))
|
|
||||||
(env (list "GIT_COMMMITTER=tekuti"
|
|
||||||
;; this quoting is a hack
|
|
||||||
(format #f "'GIT_COMMITTER_DATE=~a +0000'" ts)
|
|
||||||
(format #f "'GIT_AUTHOR_DATE=~a +0000'" ts))))
|
|
||||||
(string-trim-both
|
|
||||||
(git/input+env "categories\n" env "commit-tree" tree
|
|
||||||
"-p" master))))) ;; FIXME: keep history?
|
|
||||||
|
|
||||||
(define (reindex-categories master)
|
(define (reindex-categories master)
|
||||||
(build-categories-tree master (all-published-posts master)))
|
(compute-categories (all-published-posts master)))
|
||||||
|
|
|
@ -43,13 +43,13 @@
|
||||||
(debug-enable 'backtrace)
|
(debug-enable 'backtrace)
|
||||||
|
|
||||||
(define *comment-spec*
|
(define *comment-spec*
|
||||||
`((timestamp ,string->number)))
|
`((timestamp . ,string->number)))
|
||||||
(define (comment-from-tree encoded-name sha1)
|
(define (comment-from-tree encoded-name sha1)
|
||||||
(acons 'encoded-name encoded-name
|
(acons 'encoded-name encoded-name
|
||||||
(parse-metadata (string-append sha1 ":" "metadata") *comment-spec*)))
|
(parse-metadata (string-append sha1 ":" "metadata") *comment-spec*)))
|
||||||
|
|
||||||
(define (comment-timestamp comment-alist)
|
(define (comment-timestamp comment-alist)
|
||||||
(or (assq-ref x 'timestamp) #f))
|
(or (assq-ref comment-alist 'timestamp) #f))
|
||||||
|
|
||||||
(define (build-comment-skeleton comments)
|
(define (build-comment-skeleton comments)
|
||||||
(fold (lambda (sha1 parent)
|
(fold (lambda (sha1 parent)
|
||||||
|
|
|
@ -99,13 +99,13 @@
|
||||||
"^(.+) tree (.+)\t(.+)$" (_ mode object name)
|
"^(.+) tree (.+)\t(.+)$" (_ mode object name)
|
||||||
(cons name object)))
|
(cons name object)))
|
||||||
|
|
||||||
(define (parse-metadata treeish . specs)
|
(define (parse-metadata treeish specs)
|
||||||
(filter
|
(filter
|
||||||
identity
|
identity
|
||||||
(match-lines (git "cat-file" "blob" treeish)
|
(match-lines (git "cat-file" "blob" treeish)
|
||||||
"^([^: ]+): +(.*)$" (_ k v)
|
"^([^: ]+): +(.*)$" (_ k v)
|
||||||
(let* ((k (string->symbol k))
|
(let* ((k (string->symbol k))
|
||||||
(parse (assq-ref k specs)))
|
(parse (assq-ref specs k)))
|
||||||
(if parse
|
(if parse
|
||||||
(catch 'parse-error
|
(catch 'parse-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
|
|
@ -97,5 +97,6 @@
|
||||||
(sockaddr (cdr pair)))
|
(sockaddr (cdr pair)))
|
||||||
(receive
|
(receive
|
||||||
(cookie index) (maybe-reindex old-cookie old-index)
|
(cookie index) (maybe-reindex old-cookie old-index)
|
||||||
|
(pk cookie index)
|
||||||
(connection-received (car pair) (cdr pair) index handle-request)
|
(connection-received (car pair) (cdr pair) index handle-request)
|
||||||
(lp cookie index)))))))
|
(lp cookie index)))))))
|
||||||
|
|
|
@ -40,14 +40,14 @@
|
||||||
(equal? (assq-ref post-alist 'status) "published"))
|
(equal? (assq-ref post-alist 'status) "published"))
|
||||||
|
|
||||||
(define (post-timestamp post-alist)
|
(define (post-timestamp post-alist)
|
||||||
(or (assq-ref x 'timestamp) #f))
|
(or (assq-ref post-alist 'timestamp) #f))
|
||||||
|
|
||||||
(define (post-categories post-alist)
|
(define (post-categories post-alist)
|
||||||
(or (assq-ref x 'categories) '()))
|
(or (assq-ref post-alist 'categories) '()))
|
||||||
|
|
||||||
(define *post-spec*
|
(define *post-spec*
|
||||||
`((timestamp ,string->number)
|
`((timestamp . ,string->number)
|
||||||
(categories ,(lambda (v) (map string-trim-both (string-split v #\,))))))
|
(categories . ,(lambda (v) (map string-trim-both (string-split v #\,))))))
|
||||||
|
|
||||||
(define (post-from-tree encoded-name sha1)
|
(define (post-from-tree encoded-name sha1)
|
||||||
(acons 'url encoded-name
|
(acons 'url encoded-name
|
||||||
|
@ -72,21 +72,5 @@
|
||||||
comment-timestamp
|
comment-timestamp
|
||||||
<))
|
<))
|
||||||
|
|
||||||
(define (build-post-skeleton master posts)
|
|
||||||
(fold (lambda (sha1 parent)
|
|
||||||
(let* ((ts (post-timestamp sha1))
|
|
||||||
(comments (build-comment-skeleton (post-comments sha1)))
|
|
||||||
(env (list "GIT_COMMMITTER=tekuti"
|
|
||||||
;; this quoting is a hack
|
|
||||||
(format #f "'GIT_COMMITTER_DATE=~a +0100'" ts)
|
|
||||||
(format #f "'GIT_AUTHOR_DATE=~a +0100'" ts))))
|
|
||||||
(string-trim-both
|
|
||||||
(git* `("commit-tree" ,sha1
|
|
||||||
,@(if parent (list "-p" parent) '())
|
|
||||||
,@(if comments (list "-p" comments) '()))
|
|
||||||
#:input "post\n" #:env env))))
|
|
||||||
#f
|
|
||||||
(map cdr posts)))
|
|
||||||
|
|
||||||
(define (reindex-posts master)
|
(define (reindex-posts master)
|
||||||
(build-post-skeleton master (all-published-posts master)))
|
(all-published-posts master))
|
||||||
|
|
Loading…
Reference in a new issue