diff --git a/cacher.rkt b/cacher.rkt index 61d8b94..42f90af 100644 --- a/cacher.rkt +++ b/cacher.rkt @@ -8,21 +8,45 @@ (couchdb-connect #:host "localhost" #:port 5984 - #:user "wes" + #:user "admin" #:password "password") database-name)) +(define number->symbol (compose string->symbol number->string)) + (define conn (database-connection "blipcache")) (define (cached? id) (with-handlers ([exn:couchdb:not-found? (lambda (_) #f)]) + ;(hash-ref (couchdb-get conn id) 'content) (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 ;; info is the actual name of the data to be cached ;; get-data is the proc that gets the data from the database + + + (define (cache info type get-data) (match type ['user @@ -34,11 +58,19 @@ (couchdb-put conn message) 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 ;; Info -> String ;; Data -> Hash ;; Updater -> (Hash -> Hash) -(define (update? info data updater) +(define (update? key data updater) (let* ([last-time (hash-ref data 'last_updated)] [revision-id (hash-ref data '_rev)] [current-time (current-inexact-milliseconds)] @@ -47,21 +79,35 @@ [#t (λ () (let ([message (hasheq '_rev revision-id 'last_updated current-time - 'content new-data + key new-data '_id (hash-ref data '_id))]) - (couchdb-put conn message)))] + (couchdb-put conn message) + data))] [_ #f]))) ;((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) - (match (cached? info) - [#f (cache info type get-data)] - [result - (match (update? info (couchdb-get conn info)) - [#f result] - [updated (updated)])])) +(define (check-cache info type get-data updater) + (match type + ['user (let* [(username (user-cache-params-username info)) + (pagenum (user-cache-params-pagenum info))] + (match (user-cached? username pagenum) + ['update (let ([message (immuthsh->muthsh (couchdb-get conn username))]) + (cache-user message username pagenum get-data))] + [#f (cache-user (make-hash) username pagenum get-data)] + [result result]))])) + -(provide check-cache) \ No newline at end of file +;(define (check-user-cache username page-number get-data) +; (match ( + + + +(provide check-cache user-cache-params) \ No newline at end of file diff --git a/playlist_server.rkt b/playlist_server.rkt index dd8ff06..33a7716 100644 --- a/playlist_server.rkt +++ b/playlist_server.rkt @@ -45,7 +45,11 @@ (string->xexpr (let [(username (path/param-path (car (url-path (request-uri req))))) (page-n (hash-ref (list->hash (url-query (request-uri req))) 'p))] - (retrieve-videos username (string->number page-n)))))) + (check-cache (user-cache-params username + (string->number page-n)) + 'user + (λ () (retrieve-videos username (string->number page-n))) + identity))))) ;; Adds a new resource to the lazyplay queue (define (add-name req)