;;;; 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)))