(define-module (ldp resource unsafe save)
  #:use-module (ldp resource)
  #:use-module (ldp path)
  #:use-module (ldp resource xml)
  #:use-module (ice-9 ftw)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 binary-ports)
  #:use-module (web uri))

(define (clean-directories path kept)
  ;; Remove everything in path except kept
  (define (enter-aux? x list)
    (cond ((null? list)
	   #t)
	  ((string=? x (car list))
	   #f)
	  (else (enter-aux? x (cdr list)))))
  (define (enter? name stat result)
    (enter-aux? name kept))
  (define (leaf name stat result)
    (delete-file name)
    result)
  (define (down name stat result)
    result)
  (define (up name stat result)
    (unless (string=? name path)
      (rmdir name))
    result)
  (define (skip name stat result) #f)
  (define (error name stat errno result)
    (unless (string=? name path)
      (catch #t
	(lambda ()
	  (delete-file name))
	(lambda err #t))
      (catch #t
	(lambda ()
	  (rmdir name))
	(lambda err #t)))
    result)
  (file-system-fold enter? leaf down up skip error #t path))

(define (fix-directories resource)
  (let ((dirname (path->filename (resource-path resource))))
    (map
     (lambda (path)
       (catch #t
	 (lambda ()
	   ;; It may already exist, of course
	   (mkdir (path->filename path)))
	 (lambda err #t)))
     (or (resource-contained resource) '()))
    (clean-directories
     dirname
     (cons (string-append dirname "/representation")
	   (map path->filename
		(or (resource-contained resource) '()))))))

(define-public (save-manifest resource)
  (let* ((dirname (path->filename (resource-path resource)))
	 (filename (string-append dirname "/representation/manifest.xml"))
	 (temp-filename (string-append filename "~")))
    (catch #t
      (lambda ()
	(mkdir (string-append dirname "/representation")))
      (lambda err #t))
    (call-with-output-file temp-filename
      (lambda (port)
	(resource->xml resource port)))
    (rename-file temp-filename filename)
    (fix-directories resource)))

(define-public (save resource content)
  (let* ((dirname (path->filename (resource-path resource)))
	 (reprname (string-append dirname "/representation"))
	 (temp-reprname (string-append dirname "/representation~")))
    (catch #t
      (lambda ()
	(mkdir temp-reprname))
      (lambda err #t))
    (call-with-output-file (string-append temp-reprname "/manifest.xml")
      (lambda (port)
	(resource->xml resource port)))
    (call-with-output-file (string-append temp-reprname "/content")
      (lambda (port)
	(put-bytevector port
			(if (string? content)
			    (string->utf8 content)
			    content)))
      #:binary #t)
    (rename-file temp-reprname reprname)
    (fix-directories resource)))