|
@ -8,21 +8,45 @@ |
|
|
(couchdb-connect |
|
|
(couchdb-connect |
|
|
#:host "localhost" |
|
|
#:host "localhost" |
|
|
#:port 5984 |
|
|
#:port 5984 |
|
|
#:user "wes" |
|
|
#:user "admin" |
|
|
#:password "password") |
|
|
#:password "password") |
|
|
database-name)) |
|
|
database-name)) |
|
|
|
|
|
|
|
|
|
|
|
(define number->symbol (compose string->symbol number->string)) |
|
|
|
|
|
|
|
|
(define conn (database-connection "blipcache")) |
|
|
(define conn (database-connection "blipcache")) |
|
|
|
|
|
|
|
|
(define (cached? id) |
|
|
(define (cached? id) |
|
|
(with-handlers ([exn:couchdb:not-found? |
|
|
(with-handlers ([exn:couchdb:not-found? |
|
|
(lambda (_) |
|
|
(lambda (_) |
|
|
#f)]) |
|
|
#f)]) |
|
|
|
|
|
;(hash-ref (couchdb-get conn id) 'content) |
|
|
(couchdb-get conn id))) |
|
|
(couchdb-get conn id))) |
|
|
|
|
|
|
|
|
|
|
|
(define (user-cached? username page-num) |
|
|
|
|
|
((compose |
|
|
|
|
|
(λ (object) |
|
|
|
|
|
(match object |
|
|
|
|
|
[#f #f] |
|
|
|
|
|
[(? (λ (obj) (not (hash-has-key? obj (number->symbol page-num))))) 'update] |
|
|
|
|
|
[_ (hash-ref object (number->symbol page-num))])) |
|
|
|
|
|
cached?) username)) |
|
|
|
|
|
|
|
|
|
|
|
(define category-cached? |
|
|
|
|
|
(compose |
|
|
|
|
|
(λ (obj) |
|
|
|
|
|
(match obj |
|
|
|
|
|
[#f #f] |
|
|
|
|
|
[_ (hash-ref obj 'content)])) |
|
|
|
|
|
cached?)) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; type is the type of data to cache |
|
|
;; type is the type of data to cache |
|
|
;; info is the actual name of the data to be cached |
|
|
;; info is the actual name of the data to be cached |
|
|
;; get-data is the proc that gets the data from the database |
|
|
;; get-data is the proc that gets the data from the database |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (cache info type get-data) |
|
|
(define (cache info type get-data) |
|
|
(match type |
|
|
(match type |
|
|
['user |
|
|
['user |
|
@ -34,11 +58,19 @@ |
|
|
(couchdb-put conn message) |
|
|
(couchdb-put conn message) |
|
|
data)])) |
|
|
data)])) |
|
|
|
|
|
|
|
|
|
|
|
(define (cache-user message username page-num get-data) |
|
|
|
|
|
(let ([data (get-data)]) |
|
|
|
|
|
(hash-set! message '_id username) |
|
|
|
|
|
(hash-set! message (number->symbol page-num) data) |
|
|
|
|
|
(hash-set! message 'last_updated (current-inexact-milliseconds)) |
|
|
|
|
|
(couchdb-put conn message) |
|
|
|
|
|
data)) |
|
|
|
|
|
|
|
|
;; Checks if a document needs updating |
|
|
;; Checks if a document needs updating |
|
|
;; Info -> String |
|
|
;; Info -> String |
|
|
;; Data -> Hash |
|
|
;; Data -> Hash |
|
|
;; Updater -> (Hash -> Hash) |
|
|
;; Updater -> (Hash -> Hash) |
|
|
(define (update? info data updater) |
|
|
(define (update? key data updater) |
|
|
(let* ([last-time (hash-ref data 'last_updated)] |
|
|
(let* ([last-time (hash-ref data 'last_updated)] |
|
|
[revision-id (hash-ref data '_rev)] |
|
|
[revision-id (hash-ref data '_rev)] |
|
|
[current-time (current-inexact-milliseconds)] |
|
|
[current-time (current-inexact-milliseconds)] |
|
@ -47,21 +79,35 @@ |
|
|
[#t (λ () |
|
|
[#t (λ () |
|
|
(let ([message (hasheq '_rev revision-id |
|
|
(let ([message (hasheq '_rev revision-id |
|
|
'last_updated current-time |
|
|
'last_updated current-time |
|
|
'content new-data |
|
|
key new-data |
|
|
'_id (hash-ref data '_id))]) |
|
|
'_id (hash-ref data '_id))]) |
|
|
(couchdb-put conn message)))] |
|
|
(couchdb-put conn message) |
|
|
|
|
|
data))] |
|
|
[_ #f]))) |
|
|
[_ #f]))) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;((update? "foobar" (couchdb-get conn "foobar") (λ (h) (string-append "watwat" "foobarbaz")))) |
|
|
;((update? "foobar" (couchdb-get conn "foobar") (λ (h) (string-append "watwat" "foobarbaz")))) |
|
|
|
|
|
|
|
|
|
|
|
(struct user-cache-params (username pagenum)) |
|
|
|
|
|
|
|
|
|
|
|
(define (immuthsh->muthsh hsh) |
|
|
|
|
|
(make-hash (hash-map hsh (λ (a b) (cons a b))))) |
|
|
|
|
|
|
|
|
;; |
|
|
;; |
|
|
(define (check-cache info type get-data) |
|
|
(define (check-cache info type get-data updater) |
|
|
(match (cached? info) |
|
|
(match type |
|
|
[#f (cache info type get-data)] |
|
|
['user (let* [(username (user-cache-params-username info)) |
|
|
[result |
|
|
(pagenum (user-cache-params-pagenum info))] |
|
|
(match (update? info (couchdb-get conn info)) |
|
|
(match (user-cached? username pagenum) |
|
|
[#f result] |
|
|
['update (let ([message (immuthsh->muthsh (couchdb-get conn username))]) |
|
|
[updated (updated)])])) |
|
|
(cache-user message username pagenum get-data))] |
|
|
|
|
|
[#f (cache-user (make-hash) username pagenum get-data)] |
|
|
(provide check-cache) |
|
|
[result result]))])) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;(define (check-user-cache username page-number get-data) |
|
|
|
|
|
; (match ( |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(provide check-cache user-cache-params) |