(define-test-module (test module sph-cms)
  (import
    (sph-cms)
    (sph-cms other one)
    (sph filesystem) (sph hashtable) (sph io) (sph list) (sph number) (sph other) (sph process) (sph string) (sph vector) (sph)
    (sph record)
    (sph storage dg file)
    (sph storage dg)
    (ice-9 match)
    (sph web app start)
    (sph web app)
    (sph web app http)
    (sph-cms other lang itml)
    (test helper sph-cms))

  (define data-itml-simple
    (string-append "a\n" (string-multiply " " 2) "\\short-description: test-description"))

  (define-as data list-qq
    ; c-class c-string type-name
    (content 1 "test-1" "plaintext") (content 2 (unquote data-itml-simple) "itml")
    (tag-relation "tag-1" 1) (tag-relation "tag-2" 1 2))

  (define (test-robots-txt get-res . a)
    (get-res "/robots.txt"
      (l (res res-string)
        (assert-and (assert-equal 200 (swa-http-response-status res))
          (assert-true (string? res-string))))))

  (define (test-c-browse-recent-atom get-res . a)
    (get-res "/c/browse/recent/atom"
      (l (res res-string)
        (assert-and (assert-equal 200 (swa-http-response-status res))
          (assert-true (and (string? res-string) (string-contains res-string "tag-1")))))))

  (define (test-c-browse-all get-res . a)
    (get-res "/c/browse/link"
      (l (res res-string)
        (assert-and (assert-equal 200 (swa-http-response-status res))
          (assert-true (and (string? res-string) (string-contains res-string "tag-1")))))))

  (define (test-c-browse-some-one get-res . a)
    "browse with a tag that has only one target, redirecting to the target"
    (get-res "/c/browse/link/tag-1"
      (l (res res-string)
        (assert-and (assert-equal 303 (swa-http-response-status res))
          (assert-true
            (let (h (swa-http-response-headers res))
              (and (not (null? h)) (string-prefix? "location:/c/" (first h)))))
          (assert-true (string? res-string))))))

  (define (test-c-browse-some-multiple get-res . a)
    "browse with a tag that has multiple targets, listing targets"
    (assert-and
      (get-res "/c/browse/link/tag-2"
        (l (res res-string)
          (assert-and "link" (assert-equal 200 (swa-http-response-status res))
            (assert-true
              (and (string? res-string) (string-contains res-string "tag-2")
                (string-contains res-string "span class=\"id\""))))))
      (get-res "/c/browse/link-titled/tag-2"
        (l (res res-string)
          (assert-and "link-titled" (assert-equal 200 (swa-http-response-status res))
            (assert-true (and (string? res-string) (string-contains res-string "tag-2"))))))
      (get-res "/c/browse/link-data/tag-2"
        (l (res res-string)
          (assert-and "link-data" (assert-equal 200 (swa-http-response-status res))
            (assert-true
              (and (string? res-string) (string-contains res-string "tag-2")
                (string-contains res-string "c/data"))))))
      (get-res "/c/browse/include/tag-2"
        (l (res res-string)
          (assert-and "text" (assert-equal 200 (swa-http-response-status res))
            (assert-true
              (and (string? res-string) (string-contains res-string "tag-2")
                (string-contains res-string "included"))))))))

  (define (test-path-list->path-find-path . a)
    (dg-txn-call-read
      (l (txn)
        (assert-true
          (match (path-list->path-find-path txn (list "tag-1" "tag-2"))
            ((((quote and) (? integer?) (? integer?)) (quote *)) #t) (else #f))))))

  (define (test-start-page get-res . a)
    (get-res "/"
      (l (res res-string)
        (assert-and (assert-equal 200 (swa-http-response-status res))
          (assert-true
            (and (string? res-string)
              (string-contains-some? res-string (list "start" "bottom" "section"))))))))

  (define (swa-env-start-content-id swa-env) (ht-ref-q (swa-env-config swa-env) start-content-id))

  (define (test-c-data get-res swa-env . a)
    (get-res (string-append "/c/data/" (dg-file-name (swa-env-start-content-id swa-env)))
      (l (res res-string)
        (assert-and (assert-equal 200 (swa-http-response-status res))
          (assert-true (string-contains res-string "content-type:text/plain"))
          (assert-true (string-contains res-string "x-accel-redirect:"))))))

  (define (test-c-html get-res swa-env . a)
    (get-res (string-append "/c/html/" (dg-file-name (swa-env-start-content-id swa-env)))
      (l (res res-string)
        (assert-and (assert-equal 200 (swa-http-response-status res))
          (assert-true (string-contains res-string "content-type:text/html"))
          (assert-true (string-contains res-string "<section><h1>"))))))

  (define (test-c-copy-by-tag get-res swa-env . a)
    (assert-and
      (get-res (string-append "/c/copy/tag-1")
        (l (res res-string)
          (assert-and (assert-equal 200 (swa-http-response-status res))
            (assert-true (string-contains res-string "x-accel-redirect")))))
      (get-res (string-append "/c/copy/tag-1/tag-2")
        (l (res res-string) (assert-equal 422 (swa-http-response-status res))))))

  (define-procedure-tests tests c-browse-some-one
    c-browse-some-multiple c-browse-all
    c-browse-recent-atom robots-txt start-page c-data c-html c-copy-by-tag path-list->path-find-path)

  (l (settings) (delete-test-directory (ht-ref-q default-config dg-root))
    (swa-test-http-start (dirname (getcwd)) (sph-cms)
      default-config swa-app
      settings
      (l (settings swa-env) (set! data (insert-test-data data))
        (ht-set-q! (swa-env-config swa-env) start-content-id (vector-ref (ht-ref data 2) 0))
        (test-execute-procedures settings tests) (list)))))