;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; 

(define-module (test-modules online)
  #:use-module (ice-9 match)
  #:use-module (ice-9 binary-ports)
  #:use-module (nquads tordf)
  #:use-module ((rdf entailment rdf) #:prefix rdf:)
  #:use-module ((rdf entailment rdfs) #:prefix rdfs:)
  #:use-module ((rdf entailment simple) #:prefix simple:)
  #:use-module (rdf rdf)
  #:use-module ((rdf xsd) #:prefix xsd:)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-64)
  #:use-module (test-modules test-case)
  #:use-module (turtle tordf)
  #:use-module (web client)
  #:use-module (web response)
  #:export (run-test-suite))


(define (run-test test)
  (define (entailment-test action-doc action regime vocabulary expected-doc)
    "Run an entailment test."
    (let ((result (turtle->rdf action-doc action))
          (entails? (match regime
                      ("simple" simple:entails?)
                      ("RDF"
                       (lambda (g e)
                         (rdf:entails? g e vocabulary)))
                      ("RDFS"
                       (lambda (g e)
                         (rdfs:entails? g e vocabulary)))
                      (_ (throw 'unknown-regime regime))))
          (consistent-graph?
            (match regime
              ("simple" simple:consistent-graph?)
              ("RDF" (lambda (g)
                       (rdf:consistent-graph? g vocabulary)))
              ("RDFS" (lambda (g)
                        (rdfs:consistent-graph? g vocabulary))))))
      (if expected-doc
          (entails? result expected-doc)
          (not (consistent-graph? result)))))

  (match test
    (($ test-case type name regime recognized unrecognized action result)
     (let ((action-doc (get-test-doc action))
           (vocabulary (make-rdf-vocabulary
                         (cons* xsd:string rdf:langString recognized)
                         xsd:order xsd:compatible?))
           (expected-doc (if result
                             (turtle->rdf (get-test-doc result) result)
                             #f)))
       (match type
         ("TestTurtlePositiveSyntax"
          (test-assert name (turtle->rdf action-doc action)))
         ("TestTurtleNegativeSyntax"
          (test-error name #t (turtle->rdf action-doc action)))
         ("TestTurtleNegativeEval"
          (test-error name #t (turtle->rdf action-doc action)))
         ("TestTurtleEval"
          (test-assert name (rdf-isomorphic? (turtle->rdf action-doc action)
                                             expected-doc)))
         ("TestNQuadsPositiveSyntax"
          (test-assert name (nquads->rdf action-doc)))
         ("TestNQuadsNegativeSyntax"
          (test-error name #t (nquads->rdf action-doc)))
         ("PositiveEntailmentTest"
          (test-assert name (entailment-test action-doc action regime vocabulary
                                             expected-doc)))
         ("NegativeEntailmentTest"
          (test-assert name
                       (not (entailment-test action-doc action regime vocabulary
                                             expected-doc))))
         (_ (throw 'unrecognized-type type)))))))

(define (get-test-doc url)
  "Get a test suite object from the manifest at @var{url}."

  (define cache-filename
    (string-append "test-files/" (substring url
                                            (string-length "http://www.w3.org/2013/"))))

  (if (file-exists? cache-filename)
      (let ((bv (call-with-input-file cache-filename get-bytevector-all)))
        (if (eof-object? bv)
            ""
            (utf8->string bv)))
      (call-with-values
        (lambda ()
          (http-get url))
        (lambda (hdr body)
          (if (equal? (response-code hdr) 200)
              (if (string? body)
                  body
                  (utf8->string body))
              (throw 'error-fetching-test-manifest (response-code hdr)))))))

(define (run-test-suite manifest expected-failures name)
  (test-begin name)
  (let ((plan (rdf->test-plan
                 (turtle->rdf (get-test-doc manifest) manifest)
                 manifest)))
    (for-each run-test plan)
    (test-end name)))