(library (sph storage dg dictionary)
  (export
    dg-dictionary
    dg-dictionary->alist
    dg-dictionary->hashtable
    dg-dictionary-add
    dg-dictionary-add-from-alist
    dg-dictionary-add-one
    dg-dictionary-delete
    dg-dictionary-from-alist
    dg-dictionary-from-hashtable
    dg-dictionary-keys
    dg-dictionary-ref
    dg-dictionary-ref-one
    dg-dictionary-remove
    dg-dictionary-update
    dg-dictionary-update-one
    dg-dictionary-value->key
    dg-dictionary-values
    sph-storage-dg-dictionary-description)
  (import
    (sph)
    (sph alist)
    (sph hashtable)
    (sph list)
    (sph storage dg)
    (sph storage dg one))

  (define sph-storage-dg-dictionary-description
    "create dictionary data structures where node ids are keys and values
     data model
       r: dictionary-id key value")

  (define (dg-dictionary-add txn ids keys values)
    "dg-txn (integer ...) (integer ...) (integer ...) ->
     adds new keys or values.
     ids/keys/values are produced so that each dictionary will have all keys and each key will have all values"
    (dg-relation-ensure txn ids values keys))

  (define (dg-dictionary-add-one txn id key value) "dg-txn integer integer integer ->"
    (dg-dictionary-add txn (list id) (list key) (list value)))

  (define (dg-dictionary-remove txn ids keys)
    (let (old-values (dg-relation-select-read txn ids null keys (q right)))
      (dg-relation-delete txn ids null keys) (dg-delete-disconnected txn old-values)))

  (define (dg-dictionary-update txn ids keys values)
    "dg-txn (integer ...) (integer ...) (integer ...) ->" (dg-dictionary-remove txn ids keys)
    (dg-dictionary-add txn ids keys values))

  (define (dg-dictionary-update-one txn id key . values) "dg-txn integer integer integer ... ->"
    (dg-dictionary-update txn (list id) (list key) values))

  (define (dg-dictionary-value->key txn ids values) "dg-txn list list -> list"
    (dg-relation-select-read txn ids values null (q label)))

  (define (dg-dictionary-add-from-alist txn ids a)
    "dg-txn (integer ...):dictionary-ids ((integer:key . integer:value) ...):alist ->"
    (each (l (a) (dg-relation-ensure txn ids (tail a) (first a))) a))

  (define (dg-dictionary-from-alist txn a)
    "dg-txn alist -> integer:ids
     supports m:m relations, example-input: ((1 . 2) (3 4 5) ((6 7) . 8))"
    (dg-dictionary-add-from-alist txn (dg-id-create txn) a))

  (define (dg-dictionary txn . assoc)
    "dg-txn key value/key ...-> integer:dictionary-id
     create a dictionary from alternatingly given keys and values"
    (dg-dictionary-from-alist txn (list->alist assoc)))

  (define (dg-dictionary-delete txn . ids)
    "dg-txn integer ... ->
     deletes dictionary associations and disconnected key/values"
    (let (relations (dg-relation-select-read txn ids null null)) (dg-delete txn ids)
      (dg-delete-disconnected txn
        (append (map dg-relation-record-label relations) (map dg-relation-record-right relations)))))

  (define (dg-dictionary-keys txn . ids) "dg-txn integer ... -> (integer ...)"
    (dg-relation-select-read txn ids null null (q label)))

  (define (dg-dictionary-values txn . ids) "dg-txn integer ... -> (integer ...)"
    (dg-relation-select-read txn ids null null (q right)))

  (define (dg-dictionary->alist txn . ids) "dg-txn integer -> alist"
    (map (l (a) (pair (dg-relation-record-label a) (dg-relation-record-right a)))
      (dg-relation-select-read txn ids)))

  (define (dg-dictionary-read->hashtable txn . ids) "dg-txn integer -> rnrs-hashtable"
    (let* ((relations (dg-relation-select-read txn ids)) (r (ht-make-eqv (length relations))))
      (each (l (a) (ht-set! r (dg-relation-record-label a) (dg-relation-record-right a))) relations)
      r))

  (define* (dg-dictionary-ref txn ids keys #:optional (values (list)))
    "dg-txn (integer ...) (integer ...) [(integer ...)] -> (integer ...)"
    (dg-relation-select-read txn ids values keys (q right)))

  (define* (dg-dictionary-ref-one txn id key #:optional value)
    "dg-txn (integer ...) (integer ...) [(integer ...)] -> false/integer
     giving value is like checking if the value exists in the dictionary"
    (first-or-false
      (dg-relation-select-read txn (list id) (if value (list value) null) (list key) (q right))))

  (define (dg-dictionary-from-hashtable txn a)
    "dg-txn rnrs-hashtable -> integer:id
     hashtable key: integer:node-identifier
     hashtable value: integer:node-identifier/(integer:node-identifier)"
    (apply-values
      (l (keys values)
        (let ((ids (dg-id-create txn)) (count (vector-length keys)))
          (let loop ((index 0))
            (if (< index count)
              (begin
                (dg-dictionary-add txn ids
                  (any->list (vector-ref keys index)) (any->list (vector-ref values index)))
                (loop (+ 1 index)))
              (first ids)))))
      (ht-entries a))))