#lang racket/base
(require racket/class
"../atom.rkt")
(provide (all-defined-out))
(define atom-resource<%>
(interface ()
get-atom get-feed-atom get-atom-sxml get-id
get-title
internal-get-atom update-atom-cache! ))
(define atom-feed-resource<%>
(interface (atom-resource<%>)
list-children
find-children-by-title
find-child-by-title
find-child-by-id
make-child
intern
eject!
reset!))
(define atom-resource/child<%>
(interface ()
valid?
check-valid
invalidate!
update!
))
(define atom-resource-mixin
(mixin () (atom-resource<%>)
(init-field [(atom* atom) #f])
(super-new)
(define/public (get-atom #:reload? [reload? #f]
#:who [who 'atom-resource:get-atom])
(cache! reload? #:need-feed? #f #:who who)
atom*)
(define/public (get-feed-atom #:reload? [reload? #f]
#:who [who 'atom-resource:get-feed])
(cache! reload? #:need-feed? #t #:who who)
atom*)
(define/public (get-atom-sxml #:reload? [reload? #f]
#:who [who 'atom-resource:get-atom-sxml])
(send (get-atom #:reload? reload? #:who who) get-sxml))
(define/public (get-id #:who [who 'atom-resource:get-id])
(send (get-atom #:who who) get-id))
(define/public (get-title #:who [who 'atom-resource:get-title])
(send (get-atom #:who who) get-title))
(define/private (cache! reload? #:need-feed? need-feed? #:who who)
(when (or reload? (not atom*)
(and need-feed? (not (send atom* is-feed?))))
(update-atom-cache! (atom (internal-get-atom #:who who)))
(void)))
(define/public (internal-get-atom #:who who)
(error who "not implemented"))
(define/public (update-atom-cache! new-atom)
(set! atom* new-atom))
))
(define atom-feed-resource-mixin
(mixin (atom-resource<%>) (atom-feed-resource<%>)
(field [table (make-hash)]) (inherit get-atom
get-feed-atom)
(super-new)
(define/public (make-child atom)
(error 'atom-feed-resource-mixin:make-child "not implemented"))
(define/public (intern atom)
(let* ([key (send atom get-id)]
[v (hash-ref! table key #f)])
(cond [v (begin (send v update! atom) v)]
[else (let ([v (make-child atom)])
(hash-set! table key v)
v)])))
(define/public (eject! key)
(let ([child (hash-ref table key #f)])
(when child
(send child invalidate!)
(hash-remove! table key))))
(define/override (update-atom-cache! a)
(super update-atom-cache! a)
(when (send a is-feed?) (reset! (for/hash ([child (in-list (send a get-entries))])
(values (send a get-id) a)))))
(define/public (reset! key=>atom-hash)
(let ([delenda
(for/list ([key (in-hash-keys table)]
#:when (not (hash-has-key? key=>atom-hash key)))
key)])
(for ([key (in-list delenda)])
(eject! key)))
(for ([(key atom) (in-hash key=>atom-hash)])
(intern atom)))
(define/public (list-children #:reload? [reload? #f]
#:who [who 'atom-feed-resource:list-children])
(let* ([feed (get-feed-atom #:reload? reload? #:who who)])
(for/list ([child (in-list (send feed get-entries))])
(intern child))))
(define/public (find-children-by-title title
#:reload? [reload? #f]
#:who [who 'atom-feed-resource:find-children-by-title])
(for/list ([child (in-list (list-children #:reload? reload? #:who who))]
#:when (equal? (send (send child get-atom) get-title) title))
child))
(define/public (find-child-by-title title
#:reload? [reload? #f]
#:who [who 'atom-feed-resource:find-child-by-title])
(for/first ([child (in-list (find-children-by-title title #:reload? reload? #:who who))])
child))
(define/public (find-child-by-id id
#:reload? [reload? #f]
#:who [who 'atom-feed-resource:find-child-by-id])
(for/first ([child (in-list (list-children #:reload? reload? #:who who))]
#:when (equal? id (send child get-id)))
child))
))
(define atom-resource/child-mixin
(mixin (atom-resource<%>) (atom-resource/child<%>)
(init-field parent)
(define is-valid? #t)
(inherit get-atom)
(super-new)
(define/public (valid?) is-valid?)
(define/public (check-valid who)
(unless (valid?) (error who "no longer valid")))
(define/public (invalidate!)
(when is-valid?
(set! is-valid? #f)
(send parent eject! (send (get-atom) get-id))))
(define/public (update! new-aux) (void))
))
(define atom-resource% (atom-resource-mixin object%))
(define atom-feed-resource% (atom-feed-resource-mixin atom-resource%))
(define atom-resource/child% (atom-resource/child-mixin atom-resource%))
(define atom-resource/parent+child%
(class (atom-resource/child-mixin atom-feed-resource%)
(super-new)
(inherit reset!)
(define/override (invalidate!)
(super invalidate!)
(reset! #hash()))))