(use ugarit-backend)
(use matchable)

(define (backend-log name logfile include-bulk-data? be)
  (let ((logport (open-output-file logfile)))
    (set-buffering-mode! logport #:none)
    (fprintf logport "(use ugarit-backend)\n")
    (fprintf logport "(use test)\n")
    (fprintf logport "(let ((storage (import-storage ~S)))\n" name)
    (make-storage
     (storage-max-block-size be)
     (storage-writable? be)
     (storage-unlinkable? be)
     (lambda (key data type)               ; put!
       (begin
         (fprintf logport "  (test (void) ((storage-put! storage) ~S '~S '~S))\n"
                  key (if include-bulk-data? data '...) type)
         ((storage-put! be) key data type)))

     (lambda ()                            ; flush!
       (begin
         (fprintf logport "  (test (void) ((storage-flush! storage)))\n")
         ((storage-flush! be))))

     (lambda (key)                         ; exists?
       (let ((result ((storage-exists? be) key)))
         (begin
           (fprintf logport "  (test ~S ((storage-exists? storage) ~S))\n"
                    result key)
           result)))
     (lambda (key)                         ; get
       (let ((result ((storage-get be) key)))
         (begin
           (if include-bulk-data?
               (fprintf logport "  (test '~S ((storage-get storage) ~S))\n"
                        result key)
               (fprintf logport "  ((storage-get storage) ~S)\n"
                        key))
           result)))
     (lambda (key)                         ; link!
       (begin
         (fprintf logport "  (test (void) ((storage-link! storage) ~S))\n" key)
         ((storage-link! be) key)))
     (lambda (key)                         ; unlink!
       (let ((result ((storage-unlink! be) key)))
         (begin
           (if include-bulk-data?
               (fprintf logport "  (test '~S ((storage-unlink! storage) ~S))\n"
                        result key)
               (fprintf logport "  ((storage-unlink! storage) ~S)\n"
                        key))
           result)))
     (lambda (tag key)                     ; set-tag!
       (begin
         (fprintf logport "  (test (void) ((storage-set-tag! storage) ~S ~S))\n" tag key)
         ((storage-set-tag! be) tag key)))
     (lambda (tag)                         ; tag
       (let ((result ((storage-tag be) tag)))
         (begin
           (fprintf logport "  (test ~S ((storage-tag storage) ~S))\n"
                    result tag)
           result)))
     (lambda ()                            ; all-tags
       (let ((result ((storage-all-tags be))))
         (begin
           (fprintf logport "  (test ~S ((storage-all-tags storage)))\n"
                    result)
           result)))
     (lambda (tag)                         ; remove-tag!
       (begin
         (fprintf logport "  (test (void) ((storage-remove-tag! storage) ~S))\n" tag)
         ((storage-remove-tag! be) tag)))
     (lambda (tag)                         ; lock-tag!
       (let ((result ((storage-lock-tag! be) tag)))
         (begin
           (fprintf logport "  (test ~S ((storage-lock-tag! storage) ~S))\n"
                    result tag)
           result)))
     (lambda (tag)                         ; tag-locked?
       (let ((result ((storage-tag-locked? be) tag)))
         (begin
           (fprintf logport "  (test ~S ((storage-tag-locked? storage) ~S))\n"
                    result tag)
           result)))
     (lambda (tag)                         ; unlock-tag!
       (begin
         (fprintf logport "  (test (void) ((storage-unlock-tag! storage) ~S))\n" tag)
         ((storage-unlock-tag! be) tag)))
     (lambda (command)                     ; admin!
       (let ((result ((storage-admin! be) command)))
         (begin
           (fprintf logport "  (test ~S ((storage-admin! storage) ~S))\n"
                    result command)
           result)))
     (lambda ()                            ; close!
       (begin
         (fprintf logport "  (test (void) ((storage-close! storage))))\n")
         ((storage-close! be)))))))

(define backend
  (match (command-line-arguments)
         ((logpath backend)
          (lambda () (backend-log backend logpath #f (import-storage backend))))
         (("-v" logpath backend)
          (lambda () (backend-log backend logpath #t (import-storage backend))))

         (else
          (export-storage-error! "Invalid arguments to backend-log")
          (printf "USAGE:\nbackend-log <path-to-log-file> \"<backend command line>\"\n")
          #f)))

(if backend
    (export-storage! backend))