#lang scheme
(require "../annotation.ss"
"../base.ss"
"era-struct.ss")
(define master-hash
(make-hasheq))
(define (annotations-ref era)
(hash-ref master-hash era
(lambda ()
(define hash (make-hasheq))
(hash-set! master-hash era hash)
hash)))
(define (era-annotation-ref era annote)
(hash-ref (annotations-ref era)
annote
(cut (annotation-default annote) era)))
(define (era-annotation-set? era annote)
(with-handlers ([exn? (lambda _ #f)])
(hash-ref (annotations-ref era) annote)
#t))
(define (era-annotation-set! era annote value)
(define hash
(annotations-ref era))
(hash-set! hash annote ((annotation-combinator annote)
era (era-annotation-ref era annote) value)))
(define-annotation ann:pretty-name
(lambda (era)
(symbol->string
(cond [(entity? era) (entity-name era)]
[(relationship? era) (relationship-name era)]
[(attribute? era) (attribute-name era)])))
(lambda (era old new)
new))
(provide/contract
[ann:pretty-name annotation?]
[rename era-annotation-ref entity-annotation (-> entity? annotation? any)]
[rename era-annotation-ref attribute-annotation (-> attribute? annotation? any)]
[rename era-annotation-set? entity-has-annotation? (-> entity? annotation? boolean?)]
[rename era-annotation-set? attribute-has-annotation? (-> attribute? annotation? boolean?)]
[rename era-annotation-set! set-entity-annotation! (-> entity? annotation? any/c void?)]
[rename era-annotation-set! set-attribute-annotation! (-> attribute? annotation? any/c void?)])