(library (sph storage dg intern)
  (export
    dg-compound-intern-data?
    dg-ensure-compound-interns
    dg-intern-data?
    dg-tree-compound-intern-data->id
    dg-tree-ensure-compound-interns
    dg-tree-ensure-true-interns
    dg-tree-intern-data->id
    dg-tree-intern-id->data
    valid-intern-string?)
  (import
    (rnrs bytevectors)
    (sph)
    (sph conditional)
    (sph list)
    (sph storage dg)
    (sph string)
    (sph tree))

  (define (dg-intern-ensure-one txn data) (dg-intern-ensure txn (list data)))

  (define (dg-compound-intern-data? a)
    "sph-dg accepts any scheme datum as data, but this is not checked here"
    (or (bytevector? a) (string? a)))

  (define (dg-intern-data? a)
    "sph-dg accepts any scheme datum as data, but this is not checked here"
    (or (integer? a) (bytevector? a) (string? a)))

  (define (dg-ensure-compound-interns txn a)
    (replace-at-once dg-compound-intern-data? (l a (apply dg-intern-ensure txn a)) a))

  (define (dg-tree-ensure-compound-interns txn a)
    "list -> list
     ensures intern-elements for strings and bytevectors in the list tree but not for integers and replaces the values with their integer identifiers"
    (tree-replace-at-once dg-compound-intern-data? (l a (apply dg-intern-ensure txn a)) a))

  (define (dg-tree-ensure-true-interns txn a) "list -> list"
    (tree-replace-at-once identity (l a (apply dg-intern-ensure txn a)) a))

  (define (dg-tree-intern-id->data a retrieve)
    "list symbol -> list
     replace all integers in tree with the data of intern-elements"
    (let (id (tree-filter-flat integer? a))
      (if (null? id) a (tree-replace-by-list a integer? (dg-intern-id->data id retrieve)))))

  (define* (dg-tree-intern-data->id txn a #:optional before-replace (replace? dg-intern-data?))
    "dg-txn list [procedure:{list:all-matches list:all-translations -> list:all-translations}] -> false/list
     replace all interns in list and sub-lists with their corresponding node id or return false
     if any intern could not be translated.
     before-replace is an optional procedure that maps flat lists of all matches and translations to all-translations
     before making replacements"
    (let (interns (tree-filter-flat replace? a))
      (if (null? interns) a
        (if-pass (dg-intern-data->id txn interns #t)
          (if before-replace
            (l (id)
              (let (id (before-replace interns id)) (if id (tree-replace-by-list a replace? id) id)))
            (l (id) (tree-replace-by-list a replace? id)))))))

  (define* (dg-tree-compound-intern-data->id txn a #:optional before-replace)
    "dg-txn list procedure -> list/boolean
     like dg-tree-intern-data->id but only translates the compound intern data source types
     (string bytevector) and not integers"
    (dg-tree-intern-data->id txn a before-replace dg-compound-intern-data?))

  (define (valid-intern-string? a)
    "string -> boolean
     accepts only lowercase strings that use not more space than dg-size-octets-data-max"
    (and (string? a) (< (string-octet-length a) dg-size-octets-data-max) (string-lowercase? a))))