(define-module (ldp resource)
  #:use-module (ldp path)
  #:use-module (ldp etag)
  #:use-module (oop goops)
  #:use-module (web uri))

;; If contained is #f, then this is not a container. Otherwise, this
;; is a container, possibly empty (null)
(define-class <resource> ()
  (path #:init-keyword #:path #:getter resource-path)
  (etag #:init-keyword #:etag #:getter resource-etag)
  (content-type #:init-keyword #:content-type #:getter resource-content-type)
  (contained #:init-keyword #:contained #:getter resource-contained))

(export resource-path
	resource-etag
	resource-content-type
	resource-contained)

(define (the-symbol x)
  (unless (symbol? x)
    (scm-error 'wrong-type-arg
	       "the-symbol"
	       "Expected a symbol, got ~s."
	       (list x)
	       (list x)))
  x)

(define-public (make-resource path etag content-type contained)
  (unless (or (not contained)
	      (eq? content-type 'text/turtle))
    (throw 'containers-should-be-rdf))
  (make <resource>
    #:path (the-path path)
    #:etag (the-etag etag)
    #:content-type (the-symbol content-type)
    #:contained (and contained
		     (map the-path contained))))

(define-public (resource? x)
  (is-a? x <resource>))

(define-public (container? x)
  (and (resource? x)
       (resource-contained x)))

(define-public (the-resource x)
  (unless (resource? x)
    (scm-error 'wrong-type-arg
	       "the-non-container"
	       "Expected a resource from (ldp resource)."
	       '()
	       (list x)))
  x)

(define-public (the-container x)
  (unless (container? x)
    (scm-error 'wrong-type-arg
	       "the-container"
	       "Expected a container from (ldp resource)."
	       '()
	       (list x)))
  x)

(define-method (has-child? (container <resource>) (child <path>))
  (define (check list)
    (and (not (null? list))
	 (or (path-equal? (car list) child)
	     (check (cdr list)))))
  (check (resource-contained container)))

(export has-child?)

(define-public (add-child container child)
  (set! container (the-container container))
  (set! child (the-path child))
  (if (has-child? container child)
      (throw 'child-already-exists)
      (make-resource (resource-path container)
		     (generate-etag)
		     (resource-content-type container)
		     (cons child (resource-contained container)))))

(define-public (remove-child container child)
  (set! container (the-container container))
  (set! child (the-path child))
  (define (check found kept list)
    (if (null? list)
	(if found
	    (reverse kept)
	    (throw 'child-does-not-exist))
	(if (path-equal? (car list) child)
	    (check #t kept (cdr list))
	    (check found (cons (car list) kept) (cdr list)))))
  (make-resource (resource-path container)
		 (generate-etag)
		 (resource-content-type container)
		 (check #f '() (resource-contained container))))

(define-public (update-children container added removed)
  (set! container (the-container container))
  (set! added (map the-path added))
  (set! removed (map the-path removed))
  (cond
   ((and (null? added) (null? removed))
    container)
   ((null? added)
    (update-children (remove-child container (car removed))
		     '() (cdr removed)))
   (else
    (update-children (add-child container (car added))
		     (cdr added) removed))))