(define-module (ldp precondition)
  #:use-module (ldp etag)
  #:use-module (web request)
  #:use-module (oop goops))

(define-class <precondition> ()
  (if-match #:init-keyword #:if-match #:getter precondition-if-match)
  (if-none-match #:init-keyword #:if-match #:getter precondition-if-none-match))

(define (the-precondition x)
  (unless (is-a? x <precondition>)
    (scm-error 'wrong-type-arg
	       "the-precondition"
	       "Expected a precondition."
	       '()
	       (list x)))
  x)

(define (the-string x)
  (unless (string? x)
    (scm-error 'wrong-type-arg
	       "the-string"
	       "Expected a string."
	       '()
	       (list x)))
  x)

(define-public (make-precondition if-match if-none-match)
  (unless if-match
    (set! if-match '("*")))
  (unless if-none-match
    (set! if-none-match '()))
  (set! if-match (map the-string if-match))
  (set! if-none-match (map the-string if-none-match))
  (make <precondition>
    #:if-match if-match
    #:if-none-match if-none-match))

(define-public (request->precondition request)
  (make-precondition
   (request-if-match request)
   (request-if-none-match request)))

(define-public (precondition-valid? x etag)
  (define (check-matching list)
    (and (not (null? list))
	 (or (string=? etag (car list))
	     (string=? (car list) "*")
	     (check-matching (cdr list)))))
  (define (check-non-matching list)
    (or (null? list)
	(and (not (string=? etag (car list)))
	     (check-non-matching (cdr list)))))
  (and (check-matching (precondition-if-match x))
       (check-non-matching (precondition-if-none-match x))))