era/annotation.ss
#lang scheme

(require "../annotation.ss"
         "../base.ss"
         "era-struct.ss")

; Type definitions used below:
;     era : (U entity relationship attribute)

; Master annotation table ------------------------

; (hasheqof era (hasheqof annotation any))
(define master-hash
  (make-hasheq))

; era -> (hashof annotation any)
(define (annotations-ref era)
  (hash-ref master-hash era
            (lambda ()
              (define hash (make-hasheq))
              (hash-set! master-hash era hash)
              hash)))

; Public accessors and mutators ------------------

; era annotation -> any
(define (era-annotation-ref era annote)
  (hash-ref (annotations-ref era) 
            annote
            (cut (annotation-default annote) era)))

; era annotation -> boolean
(define (era-annotation-set? era annote)
  (with-handlers ([exn? (lambda _ #f)])
    (hash-ref (annotations-ref era) annote)
    #t))

; era annotation any -> void
(define (era-annotation-set! era annote value)
  ; (hashof annotation any)
  (define hash 
    (annotations-ref era))
  (hash-set! hash annote ((annotation-combinator annote)
                          era (era-annotation-ref era annote) value)))

; Predefined annotations -------------------------

; (annotation (U string #f))
(define-annotation ann:pretty-name 
  ; era -> string
  (lambda (era) 
    (symbol->string
     (cond [(entity? era) (entity-name era)]
           #;[(relationship? era) (relationship-name era)]
           [(attribute? era) (attribute-name era)])))
  ; era string string -> string
  (lambda (era old new)
    new))

; Provide statements -----------------------------

(provide/contract
 [ann:pretty-name                                         annotation?]
 [rename era-annotation-ref entity-annotation             (-> entity? annotation? any)]
 ;[rename era-annotation-ref relationship-annotation       (-> relationship? 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? relationship-has-annotation? (-> relationship? 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-relationship-annotation! (-> relationship? annotation? any/c void?)]
 [rename era-annotation-set! set-attribute-annotation!    (-> attribute? annotation? any/c void?)])