stop hitting git when fetching post metadata
Inspired by a patch from Aleix Conchillo Flaqué. Thanks, Aleix! * tekuti/index.scm (index-specs): * tekuti/post.scm (reindex-posts, reindex-posts-by-date): Change to have the "posts" index be a hash table mapping key -> post. "posts-by-date" is a list of keys, from newest to oldest. (post-from-git): This is what post-from-key was. (post-from-key): New function, pulls out a post from the posts hash table. (munge-post): Use post-from-git. (delete-post): Take the post directly. (latest-posts): New awesome helper for fetching the lastest N posts that match some predicates. * tekuti/page-helpers.scm (find-posts-matching): Adapt to post-from-key change. (published-posts): Remove, replaced with latest-posts. * tekuti/page.scm (page-admin, page-admin-posts, page-admin-post) (page-archives, page-feed-atom): Use the new latest-posts helper. (page-admin-delete-post, page-admin-delete-comment, page-show-post) (page-new-comment, page-show-tag): Adapt to post-from-key change. * tekuti/tags.scm (compute-related-posts, compute-related-tags): Adapt to post-from-key change. (reindex-tags): Use latest-posts.
This commit is contained in:
Andy Wingo
parent
f89e4b128b
commit
afec0daa99
5 changed files with 86 additions and 90 deletions
|
|
@ -35,7 +35,8 @@
|
|||
#:export (maybe-reindex read-index update-index))
|
||||
|
||||
(define index-specs
|
||||
`((posts ,reindex-posts ,write ,read)
|
||||
`((posts ,reindex-posts ,write-hash ,read-hash)
|
||||
(posts-by-date ,reindex-posts-by-date ,write ,read)
|
||||
(tags ,reindex-tags ,write-hash ,read-hash)
|
||||
(cache ,(lambda _ (make-empty-cache)) ,(lambda (x) #f) ,(lambda () '()))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;; Tekuti
|
||||
;; Copyright (C) 2008, 2010 Andy Wingo <wingo at pobox dot com>
|
||||
;; Copyright (C) 2008, 2010, 2012 Andy Wingo <wingo at pobox dot com>
|
||||
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
|
|
@ -41,7 +41,6 @@
|
|||
#:export (respond
|
||||
relurl rellink
|
||||
post-url
|
||||
published-posts
|
||||
post-editing-form
|
||||
sidebar-ul top-tags tag-cloud
|
||||
main-sidebar post-sidebar related-tag-cloud
|
||||
|
|
@ -151,12 +150,6 @@
|
|||
(relative-path-link *public-path-base* path-components text #:query query
|
||||
#:fragment fragment))
|
||||
|
||||
(define (published-posts index n)
|
||||
(filter-mapn (lambda (post)
|
||||
(and (post-published? post) post))
|
||||
(assq-ref index 'posts)
|
||||
n))
|
||||
|
||||
(define (post-editing-form post)
|
||||
`(div
|
||||
(form (@ (method "POST")
|
||||
|
|
@ -371,7 +364,7 @@
|
|||
(git "grep" "-l" "-F" string master "--" "*/content"))
|
||||
"")
|
||||
":(.+)/content$" (_ key)
|
||||
(post-from-key master key)))
|
||||
(post-from-key index key)))
|
||||
post-timestamp
|
||||
>)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;; Tekuti
|
||||
;; Copyright (C) 2008, 2010, 2011 Andy Wingo <wingo at pobox dot com>
|
||||
;; Copyright (C) 2008, 2010, 2011, 2012 Andy Wingo <wingo at pobox dot com>
|
||||
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
|
|
@ -75,10 +75,9 @@
|
|||
(lambda ()
|
||||
;; here we need to be giving a dashboard view instead of this
|
||||
(define (post-links n)
|
||||
(mapn (lambda (post)
|
||||
`(li ,(admin-post-link post)))
|
||||
(assq-ref index 'posts)
|
||||
n))
|
||||
(map (lambda (post)
|
||||
`(li ,(admin-post-link post)))
|
||||
(latest-posts index #:allow-unpublished? #t #:limit n)))
|
||||
(define (recent-changes n)
|
||||
(map (lambda (rev)
|
||||
`(li ,(rellink `("admin" "changes" ,(car rev))
|
||||
|
|
@ -100,7 +99,7 @@
|
|||
(define (post-headers)
|
||||
(map (lambda (post)
|
||||
`(h3 ,(admin-post-link post)))
|
||||
(assq-ref index 'posts)))
|
||||
(latest-posts index #:allow-unpublished? #t #:limit -1)))
|
||||
(respond `((h1 "all your posts are belong to tekuti")
|
||||
,@(post-headers))))))
|
||||
|
||||
|
|
@ -108,7 +107,7 @@
|
|||
(with-authentication
|
||||
request
|
||||
(lambda ()
|
||||
(let ((post (post-from-key (assq-ref index 'master) key #t)))
|
||||
(let ((post (post-from-key index key #:allow-unpublished? #t)))
|
||||
(respond `((h1 ,(post-title post))
|
||||
,(post-editing-form post)))))))
|
||||
|
||||
|
|
@ -132,14 +131,14 @@
|
|||
(with-authentication
|
||||
request
|
||||
(lambda ()
|
||||
(delete-post key)
|
||||
(delete-post (post-from-key index key #:allow-unpublished? #t))
|
||||
(respond `((p "redirecting...")) #:redirect (relurl `("admin"))))))
|
||||
|
||||
(define (page-admin-delete-comment request body index key comment-id)
|
||||
(with-authentication
|
||||
request
|
||||
(lambda ()
|
||||
(let ((post (post-from-key (assq-ref index 'master) key #t)))
|
||||
(let ((post (post-from-key index key #:allow-unpublished? #t)))
|
||||
(delete-comment post comment-id)
|
||||
(respond `((p "redirecting...")) #:redirect (admin-post-url post))))))
|
||||
|
||||
|
|
@ -189,13 +188,12 @@
|
|||
(respond `(,(main-sidebar request index)
|
||||
,@(map (lambda (post)
|
||||
(show-post post #f))
|
||||
(published-posts index 10)))
|
||||
(latest-posts index #:limit 10)))
|
||||
#:etag (assq-ref index 'master)))
|
||||
|
||||
(define (page-show-post request body index year month day post)
|
||||
(cond
|
||||
((post-from-key (assq-ref index 'master)
|
||||
(make-post-key year month day post))
|
||||
((post-from-key index (make-post-key year month day post))
|
||||
=> (lambda (post)
|
||||
(respond `(,(post-sidebar post index)
|
||||
,(show-post post #t))
|
||||
|
|
@ -207,8 +205,7 @@
|
|||
(define (page-new-comment request body index year month day name)
|
||||
(let ((data (request-form-data request body)))
|
||||
(cond
|
||||
((post-from-key (assq-ref index 'master)
|
||||
(make-post-key year month day name))
|
||||
((post-from-key index (make-post-key year month day name))
|
||||
=> (lambda (post)
|
||||
(cond
|
||||
((bad-new-comment-post? data)
|
||||
|
|
@ -243,7 +240,7 @@
|
|||
(define (make-date-header post)
|
||||
(lambda (x) #f))
|
||||
|
||||
(let lp ((posts (published-posts index -1)))
|
||||
(let lp ((posts (latest-posts index #:limit -1)))
|
||||
(cond ((or (null? posts) (too-early? (car posts)))
|
||||
(respond `((h1 "No posts found")
|
||||
(p "No posts were found in the specified period."))
|
||||
|
|
@ -283,7 +280,7 @@
|
|||
(define (page-show-tag request body index tag)
|
||||
(let* ((tags (assq-ref index 'tags))
|
||||
(posts (map (lambda (key)
|
||||
(post-from-key (assq-ref index 'master) key))
|
||||
(post-from-key index key))
|
||||
(hash-ref tags tag '()))))
|
||||
(if (pair? posts)
|
||||
(respond `((h2 "posts tagged \"" ,tag "\" ("
|
||||
|
|
@ -343,9 +340,7 @@
|
|||
(define (page-feed-atom request body index)
|
||||
(let ((with (request-query-ref-all request "with"))
|
||||
(without (request-query-ref-all request "without"))
|
||||
(tags (assq-ref index 'tags))
|
||||
(posts (assq-ref index 'posts))
|
||||
(master (assq-ref index 'master)))
|
||||
(tags (assq-ref index 'tags)))
|
||||
(define include?
|
||||
(if (pair? with)
|
||||
(fold (lambda (tag cont)
|
||||
|
|
@ -369,9 +364,8 @@
|
|||
|
||||
(atom-feed-from-posts
|
||||
request body index
|
||||
(filter-mapn (lambda (post)
|
||||
(and (include? post) (not (exclude? post))
|
||||
(post-published? post)
|
||||
post))
|
||||
posts
|
||||
10))))
|
||||
(latest-posts index
|
||||
#:filter
|
||||
(lambda (post)
|
||||
(and (include? post) (not (exclude? post))))
|
||||
#:limit 10))))
|
||||
|
|
|
|||
104
tekuti/post.scm
104
tekuti/post.scm
|
|
@ -1,5 +1,5 @@
|
|||
;; Tekuti
|
||||
;; Copyright (C) 2008, 2010, 2011 Andy Wingo <wingo at pobox dot com>
|
||||
;; Copyright (C) 2008, 2010, 2011, 2012 Andy Wingo <wingo at pobox dot com>
|
||||
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
|
|
@ -35,7 +35,7 @@
|
|||
#:use-module (tekuti filters)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:export (post-from-tree post-from-key
|
||||
#:export (post-from-key
|
||||
|
||||
post-tags post-timestamp post-key post-published?
|
||||
post-comments-open? post-comments
|
||||
|
|
@ -44,14 +44,14 @@
|
|||
post-title
|
||||
|
||||
make-new-post modify-post delete-post
|
||||
|
||||
all-published-posts
|
||||
|
||||
reindex-posts))
|
||||
latest-posts
|
||||
|
||||
;;;
|
||||
reindex-posts reindex-posts-by-date))
|
||||
|
||||
;;;
|
||||
;;; pulling posts out of git
|
||||
;;;
|
||||
;;;
|
||||
|
||||
(define *post-spec*
|
||||
`((timestamp . ,string->number)
|
||||
|
|
@ -69,15 +69,21 @@
|
|||
identity)))
|
||||
(cons k (parse v))))))
|
||||
|
||||
(define (post-from-key master key . allow-unpublished)
|
||||
(define (post-from-git master key)
|
||||
(false-if-git-error
|
||||
(let ((pairs (git-ls-subdirs master key)))
|
||||
(and (= (length pairs) 1)
|
||||
(let ((post (post-from-tree key (cdar pairs))))
|
||||
(if (or (post-published? post)
|
||||
(and (pair? allow-unpublished) (car allow-unpublished)))
|
||||
post
|
||||
#f))))))
|
||||
(post-from-tree key (cdar pairs))))))
|
||||
|
||||
;;;
|
||||
;;; pulling posts out of the index
|
||||
;;;
|
||||
|
||||
(define* (post-from-key index key #:key allow-unpublished?)
|
||||
(let ((post (hash-ref (assq-ref index 'posts) key)))
|
||||
(if (and post (or (post-published? post) allow-unpublished?))
|
||||
post
|
||||
#f)))
|
||||
|
||||
;;;
|
||||
;;; accessors
|
||||
|
|
@ -156,13 +162,13 @@
|
|||
(maybe-clear
|
||||
`((create (,key) ("metadata" ,metadata blob))
|
||||
(create (,key) ("content" ,content blob)))))))
|
||||
(post-from-key
|
||||
(post-from-git
|
||||
(git-update-ref "refs/heads/master"
|
||||
(lambda (master)
|
||||
(git-commit-tree (munge-tree master ops)
|
||||
master message #f))
|
||||
5)
|
||||
key #t))))
|
||||
key))))
|
||||
|
||||
(define space-to-dash (s///g "[ .]" "-"))
|
||||
(define remove-extraneous (s///g "[^a-z0-9-]+" ""))
|
||||
|
|
@ -201,41 +207,45 @@
|
|||
(define (modify-post old-key post-data)
|
||||
(munge-post old-key (parse-post-data post-data)))
|
||||
|
||||
(define (delete-post key)
|
||||
(let* ((post (post-from-key "refs/heads/master" key))
|
||||
(message (format #f "~a: \"~a\"" "post deleted" (post-title post))))
|
||||
(define (delete-post post)
|
||||
(let ((message (format #f "~a: \"~a\"" "post deleted" (post-title post))))
|
||||
(git-update-ref "refs/heads/master"
|
||||
(lambda (master)
|
||||
(git-commit-tree (munge-tree1 master 'delete '() `(,key))
|
||||
master message #f))
|
||||
(git-commit-tree
|
||||
(munge-tree1 master 'delete '() `(,(post-key post)))
|
||||
master message #f))
|
||||
5)))
|
||||
|
||||
(define (all-posts master)
|
||||
(map (lambda (pair)
|
||||
(post-from-tree (car pair) (cdr pair)))
|
||||
(git-ls-subdirs master #f)))
|
||||
(define* (latest-posts index #:key allow-unpublished? (filter identity)
|
||||
(limit 10))
|
||||
(filter-mapn
|
||||
(lambda (key)
|
||||
(and=> (post-from-key index key #:allow-unpublished? allow-unpublished?)
|
||||
(lambda (post) (and post (filter post) post))))
|
||||
(assq-ref index 'posts-by-date)
|
||||
limit))
|
||||
|
||||
(define (all-published-posts master)
|
||||
(dsu-sort
|
||||
(filter post-published? (all-posts master))
|
||||
post-timestamp
|
||||
>))
|
||||
|
||||
(define (hash-fill proc list)
|
||||
(let ((table (make-hash-table)))
|
||||
(for-each (lambda (x) (proc x table))
|
||||
list)
|
||||
table))
|
||||
|
||||
(define (reindex-posts oldindex newindex)
|
||||
(let ((old (hash-fill (lambda (post h)
|
||||
(hash-set! h (assq-ref post 'sha1) post))
|
||||
(or (assq-ref oldindex 'posts) '()))))
|
||||
(dsu-sort (map (lambda (dent)
|
||||
(or (hash-ref old (cadr dent))
|
||||
(begin (pk 'updated dent)
|
||||
(post-from-tree (car dent) (cadr dent)))))
|
||||
(git-ls-tree (assq-ref newindex 'master) #f))
|
||||
post-timestamp
|
||||
>)))
|
||||
(define (reindex-posts old-index index)
|
||||
(let ((old (assq-ref old-index 'posts))
|
||||
(new (make-hash-table)))
|
||||
(for-each
|
||||
(lambda (dent)
|
||||
(let* ((key (car dent))
|
||||
(sha1 (cadr dent))
|
||||
(prev (and (hash-table? old) (hash-ref old key))))
|
||||
(hash-set! new key
|
||||
(if (and prev (equal? (assq-ref prev 'sha1) sha1))
|
||||
prev
|
||||
(begin
|
||||
(pk 'updated dent)
|
||||
(post-from-tree key sha1))))))
|
||||
(git-ls-tree (assq-ref index 'master) #f))
|
||||
new))
|
||||
|
||||
(define (reindex-posts-by-date old-index index)
|
||||
(map cdr
|
||||
(sort (hash-map->list (lambda (key post)
|
||||
(cons (post-timestamp post) key))
|
||||
(assq-ref index 'posts))
|
||||
(lambda (x y)
|
||||
(> (car x) (car y))))))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;; Tekuti
|
||||
;; Copyright (C) 2008, 2010 Andy Wingo <wingo at pobox dot com>
|
||||
;; Copyright (C) 2008, 2010, 2012 Andy Wingo <wingo at pobox dot com>
|
||||
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
|
|
@ -54,8 +54,7 @@
|
|||
hash))
|
||||
|
||||
(define (compute-related-posts post index)
|
||||
(let ((hash (assq-ref index 'tags))
|
||||
(master (assq-ref index 'master)))
|
||||
(let ((hash (assq-ref index 'tags)))
|
||||
(if hash
|
||||
(let ((accum (make-hash-table)))
|
||||
(for-each
|
||||
|
|
@ -69,7 +68,7 @@
|
|||
(dsu-sort (dsu-sort
|
||||
(hash-fold
|
||||
(lambda (key tags rest)
|
||||
(acons (post-from-key master key) tags rest))
|
||||
(acons (post-from-key index key) tags rest))
|
||||
'() accum)
|
||||
(lambda (x) (post-timestamp (car x)))
|
||||
>)
|
||||
|
|
@ -77,8 +76,7 @@
|
|||
'())))
|
||||
|
||||
(define (compute-related-tags tag index)
|
||||
(let ((hash (assq-ref index 'tags))
|
||||
(master (assq-ref index 'master)))
|
||||
(let ((hash (assq-ref index 'tags)))
|
||||
(if hash
|
||||
(let ((accum (make-hash-table)))
|
||||
(for-each
|
||||
|
|
@ -87,7 +85,7 @@
|
|||
(lambda (other-tag)
|
||||
(if (not (equal? other-tag tag))
|
||||
(hash-push! accum other-tag key)))
|
||||
(post-tags (post-from-key master key))))
|
||||
(post-tags (post-from-key index key))))
|
||||
(or (hash-ref hash tag) '()))
|
||||
(dsu-sort
|
||||
(hash-fold
|
||||
|
|
@ -99,4 +97,4 @@
|
|||
'())))
|
||||
|
||||
(define (reindex-tags old-index index)
|
||||
(compute-tags (filter post-published? (assq-ref index 'posts))))
|
||||
(compute-tags (latest-posts index #:limit -1)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue