(library (sph storage dg file)
  (export
    dg-file->string
    dg-file-all
    dg-file-all-missing
    dg-file-create
    dg-file-delete
    dg-file-from-data
    dg-file-from-filesystem
    dg-file-identify
    dg-file-init
    dg-file-intern-file
    dg-file-move
    dg-file-name
    dg-file-name->id
    dg-file-open
    dg-file-path
    dg-file-root
    dg-file-stat
    dg-file-unlink
    dg-file-update
    dg-file-update-from-filesystem
    dg-file?
    sph-storage-dg-file-description)
  (import
    (guile)
    (rnrs bytevectors)
    (rnrs io ports)
    (rnrs sorting)
    (sph)
    (sph filesystem)
    (sph storage dg)
    (sph storage dg one)
    (only (rnrs base) set!)
    (only (sph io) file->string port-copy-all)
    (only (sph list) first-or-false)
    (only (sph two) copy-file!?))

  (define sph-storage-dg-file-description
    "for managing externs whose ids correspond to files in the filesystem
     data model
       r: \"file\" \"file\" type-extern-node-id
       file-path: {dg-root}/files/base32-encoded-id")

  (define dg-file-intern-file)

  (define (dg-file-init)
    (if (not (list? dg-file-intern-file))
      (dg-txn-call-write
        (l (txn) (set! dg-file-intern-file (dg-intern-ensure txn (list "file")))
          (ensure-directory-structure (string-append (dg-root) "/files"))))))

  (define (dg-file-root) (string-append (dg-root) "/files/"))
  (define (dg-file-path id) (string-append (dg-root) "/files/" (number->string id 32)))
  (define (dg-file-name id) (number->string id 32))
  (define (dg-file-name->id a) (string->number a 32))

(define (dg-file->string id)
    "integer -> string
     read and return all file content as a string"
    (file->string (dg-file-path id)))

  (define (dg-file-open id mode) "integer string:mode -> port" (open-file (dg-file-path id) mode))

  (define (dg-file-update id data)
    "integer bytevector/string -> false/unspecified
     sets the content of a file to data"
    (call-with-output-file (dg-file-path id)
      (l (file)
        (and-let*
          ((write (if (bytevector? data) put-bytevector (if (string? data) put-string #f))))
          (write file data)))))

  (define (dg-file-update-from-filesystem id a) "integer string -> boolean"
    (and (false-if-exception (eqv? (q regular) (stat:type (stat a))))
      (copy-file a (dg-file-path id))))

  (define (dg-file-from-filesystem txn a) "dg-txn string -> integer:id"
    (let (id (first (dg-file-create txn)))
      (call-with-input-file a
        (l (in) (call-with-output-file (dg-file-path id) (l (out) (port-copy-all in out)))))
      id))

  (define (dg-file-from-data txn a)
    (let (id (first (dg-file-create txn))) (dg-file-update id a) id))

  (define (dg-file-stat id) "integer -> guile-stat" (stat (dg-file-path id)))

  (define* (dg-file-create txn #:optional (count 1)) "dg-txn [integer] -> (integer ...)"
    (let (ids (dg-extern-create txn count))
      (dg-relation-ensure txn dg-file-intern-file ids dg-file-intern-file) ids))

  (define (dg-file-unlink txn ids)
    "dg-txn ids ->
     make ids not be considered files anymore. nodes and filesystem data is kept"
    (dg-relation-delete txn dg-file-intern-file ids dg-file-intern-file))

  (define (dg-file-delete txn ids)
    "dg-txn integer ... -> boolean
     unlink and delete in dg and in the filesystem data"
    (dg-delete txn ids)
    (any not (map (l (a) (false-if-exception (delete-file (dg-file-path a)))) ids)))

(define (dg-file-identify txn ids)
    "dg-txn (integer ...) -> (integer ...)
     filter existing file ids.
     result ids in reverse order"
    (dg-relation-select-read txn dg-file-intern-file ids dg-file-intern-file (q right)))

(define (dg-file? txn . ids) "dg-txn integer -> boolean"
    (equal? (length ids) (length (dg-file-identify txn ids))))

  (define (dg-file-move txn id-source id-dest)
    "dg-txn integer integer -> boolean
     overwrite destination and delete source"
    (and (not (= id-source id-dest)) (dg-file? txn id-source id-dest)
      (begin (rename-file (dg-file-path id-source) (dg-file-path id-dest))
        (dg-delete txn (list id-source)) #t)))

(define (dg-file-all txn) "dg-txn -> dg-selection"
  (dg-relation-select txn dg-file-intern-file #f dg-file-intern-file (q right)))

  (define (dg-file-all-missing txn)
    "dg-txn -> (integer ...)
     return a list all file ids without that have no corresponding file"
    (let*
      ( (selection (dg-file-all txn))
        (read (nullary (dg-relation-read selection dg-default-read-count))))
      (let loop ((ids (read)))
        (if (null? ids) ids
          (let (missing (filter (compose not file-exists? dg-file-path) ids))
            (if (null? missing) (loop (read)) (append missing (loop (read))))))))))