rdf4h-5.2.0: testsuite/tests/W3C/Manifest.hs

{-# LANGUAGE OverloadedStrings #-}

module W3C.Manifest
  ( loadManifest,
    Manifest (..),
    TestEntry (..),
  )
where

import qualified Data.List as L (find)
import Data.Maybe (fromJust)
import Data.RDF.Graph.TList
import Data.RDF.Namespace (mkUri, rdfs)
import qualified Data.RDF.Namespace as NS
import Data.RDF.Query
import Data.RDF.Types
import qualified Data.Text as T
import Safe
import Text.RDF.RDF4H.TurtleParser

-- | Manifest data as represented in W3C test files.
data Manifest = Manifest
  { description :: T.Text,
    entries :: [TestEntry]
  }

-- TODO: Fields `name` and `action` are mandatory for all tests,
-- `result` is mandatory for positive *Eval tests,
-- the rest are optional, so we should use "Maybe" for them.
data TestEntry
  = TestTurtleEval
      { name :: T.Text,
        comment :: T.Text,
        approval :: Node,
        action :: Node,
        result :: Node
      }
  | TestTurtleNegativeEval
      { name :: T.Text,
        comment :: T.Text,
        approval :: Node,
        action :: Node
      }
  | TestTurtlePositiveSyntax
      { name :: T.Text,
        comment :: T.Text,
        approval :: Node,
        action :: Node
      }
  | TestTurtleNegativeSyntax
      { name :: T.Text,
        comment :: T.Text,
        approval :: Node,
        action :: Node
      }
  | PositiveEntailmentTest
      { name :: T.Text,
        comment :: T.Text,
        approval :: Node,
        action :: Node,
        result :: Node,
        entailmentRegime :: T.Text,
        recognizedDatatypes :: [Node],
        unrecognizedDatatypes :: [Node]
      }
  | NegativeEntailmentTest
      { name :: T.Text,
        comment :: T.Text,
        approval :: Node,
        action :: Node,
        result :: Node,
        entailmentRegime :: T.Text,
        recognizedDatatypes :: [Node],
        unrecognizedDatatypes :: [Node]
      }
  | TestXMLEval
      { name :: T.Text,
        comment :: T.Text,
        approval :: Node,
        action :: Node,
        result :: Node
      }
  | TestXMLNegativeSyntax
      { name :: T.Text,
        comment :: T.Text,
        approval :: Node,
        action :: Node
      }
  | TestNTriplesPositiveSyntax
      { name :: T.Text,
        comment :: T.Text,
        approval :: Node,
        action :: Node
      }
  | TestNTriplesNegativeSyntax
      { name :: T.Text,
        comment :: T.Text,
        approval :: Node,
        action :: Node
      }
  deriving (Show)

-- TODO: Perhaps these should be pulled from the manifest graph
rdfType,
  rdfsComment,
  rdfsLabel,
  rdftApproval,
  rdfsApproval,
  mfName,
  mfManifest,
  mfAction,
  mfResult,
  mfEntries,
  mfEntailmentRegime,
  mfRecognizedDatatypes,
  mfUnrecognizedDatatypes ::
    Node
rdfType = unode $ mkUri NS.rdf "type"
rdfsComment = unode $ mkUri rdfs "comment"
rdfsLabel = unode $ mkUri rdfs "label"
-- rdftTestTurtleEval = unode "http://www.w3.org/ns/rdftest#TestTurtleEval"
-- rdftTestTurtleNegativeEval = unode "http://www.w3.org/ns/rdftest#TestTurtleNegativeEval"
rdftApproval = unode "http://www.w3.org/ns/rdftest#approval"
rdfsApproval = unode $ mkUri rdfs "approval" -- FIXME: incorrect namespace "rdfs:approval" in rdf-mt/manifest.ttl, must be "rdft:approval"
mfName = unode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#name"
mfManifest = unode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#Manifest"
mfAction = unode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#action"
mfResult = unode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#result"
mfEntries = unode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#entries"
mfEntailmentRegime = unode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#entailmentRegime"
mfRecognizedDatatypes = unode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#recognizedDatatypes"
mfUnrecognizedDatatypes = unode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#unrecognizedDatatypes"

-- | Load the manifest from the given file;
-- apply the given namespace as the base IRI of the manifest.
loadManifest :: T.Text -> T.Text -> IO Manifest
loadManifest manifestPath baseIRI =
  (rdfToManifest . fromEither) <$> parseFile testParser (T.unpack manifestPath)
  where
    testParser = TurtleParser (Just $ BaseUrl baseIRI) Nothing

rdfToManifest :: RDF TList -> Manifest
rdfToManifest rdf = Manifest desc tpls
  where
    desc = lnodeText $ objectOf $ headDef (error ("query empty: subject mf:node & predicate mf:name in:\n\n" <> show (triplesOf rdf))) descNode
    -- FIXME: Inconsistent use of nodes for describing the manifest (W3C bug)
    descNode =
      query rdf (Just manifestNode) (Just rdfsLabel) Nothing
        <> query rdf (Just manifestNode) (Just mfName) Nothing
    --        descNode = query rdf (Just manifestNode) (Just mfName) Nothing
    tpls = (rdfToTestEntry rdf) <$> rdfCollectionToList rdf collectionHead
    collectionHead = objectOf $ headDef (error "query: mf:node & mf:entries") $ query rdf (Just manifestNode) (Just mfEntries) Nothing
    manifestNode = headDef (error "manifestSubjectNodes yielding empty list") $ manifestSubjectNodes rdf

rdfToTestEntry :: RDF TList -> Node -> TestEntry
rdfToTestEntry rdf teSubject = triplesToTestEntry rdf $ query rdf (Just teSubject) Nothing Nothing

triplesToTestEntry :: RDF TList -> Triples -> TestEntry
triplesToTestEntry rdf ts =
  case objectByPredicate rdfType ts of
    (UNode "http://www.w3.org/ns/rdftest#TestTurtleEval") -> mkTestTurtleEval ts
    (UNode "http://www.w3.org/ns/rdftest#TestTurtleNegativeEval") -> mkTestTurtleNegativeEval ts
    (UNode "http://www.w3.org/ns/rdftest#TestTurtlePositiveSyntax") -> mkTestTurtlePositiveSyntax ts
    (UNode "http://www.w3.org/ns/rdftest#TestTurtleNegativeSyntax") -> mkTestTurtleNegativeSyntax ts
    (UNode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#PositiveEntailmentTest") -> mkPositiveEntailmentTest ts rdf
    (UNode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#NegativeEntailmentTest") -> mkNegativeEntailmentTest ts rdf
    (UNode "http://www.w3.org/ns/rdftest#TestXMLEval") -> mkTestXMLEval ts
    (UNode "http://www.w3.org/ns/rdftest#TestXMLNegativeSyntax") -> mkTestXMLNegativeSyntax ts
    (UNode "http://www.w3.org/ns/rdftest#TestNTriplesPositiveSyntax") -> mkTestNTriplesPositiveSyntax ts
    (UNode "http://www.w3.org/ns/rdftest#TestNTriplesNegativeSyntax") -> mkTestNTriplesNegativeSyntax ts
    n -> error ("Unknown test case: " <> show n)

mkTestTurtleEval :: Triples -> TestEntry
mkTestTurtleEval ts =
  TestTurtleEval
    { name = lnodeText $ objectByPredicate mfName ts,
      comment = lnodeText $ objectByPredicate rdfsComment ts,
      approval = objectByPredicate rdftApproval ts,
      action = objectByPredicate mfAction ts,
      result = objectByPredicate mfResult ts
    }

mkTestTurtleNegativeEval :: Triples -> TestEntry
mkTestTurtleNegativeEval ts =
  TestTurtleNegativeEval
    { name = lnodeText $ objectByPredicate mfName ts,
      comment = lnodeText $ objectByPredicate rdfsComment ts,
      approval = objectByPredicate rdftApproval ts,
      action = objectByPredicate mfAction ts
    }

mkTestTurtlePositiveSyntax :: Triples -> TestEntry
mkTestTurtlePositiveSyntax ts =
  TestTurtlePositiveSyntax
    { name = lnodeText $ objectByPredicate mfName ts,
      comment = lnodeText $ objectByPredicate rdfsComment ts,
      approval = objectByPredicate rdftApproval ts,
      action = objectByPredicate mfAction ts
    }

mkTestTurtleNegativeSyntax :: Triples -> TestEntry
mkTestTurtleNegativeSyntax ts =
  TestTurtleNegativeSyntax
    { name = lnodeText $ objectByPredicate mfName ts,
      comment = lnodeText $ objectByPredicate rdfsComment ts,
      approval = objectByPredicate rdftApproval ts,
      action = objectByPredicate mfAction ts
    }

mkPositiveEntailmentTest :: Triples -> RDF TList -> TestEntry
mkPositiveEntailmentTest ts rdf =
  PositiveEntailmentTest
    { name = lnodeText $ objectByPredicate mfName ts,
      comment = lnodeText $ objectByPredicate rdfsComment ts,
      -- FIXME: incorrect namespace "rdfs:approval" in rdf-mt/manifest.ttl
      -- approval = objectByPredicate rdftApproval ts,
      approval = objectByPredicate rdfsApproval ts,
      action = objectByPredicate mfAction ts,
      result = objectByPredicate mfResult ts,
      entailmentRegime = lnodeText $ objectByPredicate mfEntailmentRegime ts,
      recognizedDatatypes = rDT,
      unrecognizedDatatypes = uDT
    }
  where
    rDT = rdfCollectionToList rdf rDTCollectionHead
    rDTCollectionHead = objectByPredicate mfRecognizedDatatypes ts
    uDT = rdfCollectionToList rdf uDTCollectionHead
    uDTCollectionHead = objectByPredicate mfUnrecognizedDatatypes ts

mkNegativeEntailmentTest :: Triples -> RDF TList -> TestEntry
mkNegativeEntailmentTest ts rdf =
  NegativeEntailmentTest
    { name = lnodeText $ objectByPredicate mfName ts,
      comment = lnodeText $ objectByPredicate rdfsComment ts,
      -- FIXME: incorrect namespace "rdfs:approval" in rdf-mt/manifest.ttl
      -- approval = objectByPredicate rdftApproval ts,
      approval = objectByPredicate rdfsApproval ts,
      action = objectByPredicate mfAction ts,
      result = objectByPredicate mfResult ts,
      entailmentRegime = lnodeText $ objectByPredicate mfEntailmentRegime ts,
      recognizedDatatypes = rDT,
      unrecognizedDatatypes = uDT
    }
  where
    rDT = rdfCollectionToList rdf rDTCollectionHead
    rDTCollectionHead = objectByPredicate mfRecognizedDatatypes ts
    uDT = rdfCollectionToList rdf uDTCollectionHead
    uDTCollectionHead = objectByPredicate mfUnrecognizedDatatypes ts

mkTestXMLEval :: Triples -> TestEntry
mkTestXMLEval ts =
  TestXMLEval
    { name = lnodeText $ objectByPredicate mfName ts,
      comment = lnodeText $ objectByPredicate rdfsComment ts,
      -- FIXME: incorrect namespace "rdfs:approval" in rdf-mt/manifest.ttl
      -- approval = objectByPredicate rdftApproval ts,
      approval = objectByPredicate rdfsApproval ts,
      action = objectByPredicate mfAction ts,
      result = objectByPredicate mfResult ts
    }

mkTestXMLNegativeSyntax :: Triples -> TestEntry
mkTestXMLNegativeSyntax ts =
  TestXMLNegativeSyntax
    { name = lnodeText $ objectByPredicate mfName ts,
      comment = lnodeText $ objectByPredicate rdfsComment ts,
      -- FIXME: incorrect namespace "rdfs:approval" in rdf-mt/manifest.ttl
      -- approval = objectByPredicate rdftApproval ts
      approval = objectByPredicate rdfsApproval ts,
      action = objectByPredicate mfAction ts
    }

mkTestNTriplesPositiveSyntax :: Triples -> TestEntry
mkTestNTriplesPositiveSyntax ts =
  TestNTriplesPositiveSyntax
    { name = lnodeText $ objectByPredicate mfName ts,
      comment = lnodeText $ objectByPredicate rdfsComment ts,
      approval = objectByPredicate rdftApproval ts,
      action = objectByPredicate mfAction ts
    }

mkTestNTriplesNegativeSyntax :: Triples -> TestEntry
mkTestNTriplesNegativeSyntax ts =
  TestNTriplesNegativeSyntax
    { name = lnodeText $ objectByPredicate mfName ts,
      comment = lnodeText $ objectByPredicate rdfsComment ts,
      approval = objectByPredicate rdftApproval ts,
      action = objectByPredicate mfAction ts
    }

-- Filter the triples by given predicate and return the object of the first found triple.
-- Raises an exception on errors.
objectByPredicate :: Predicate -> Triples -> Object
objectByPredicate p = objectOf . fromJust . L.find (\t -> predicateOf t == p)

manifestSubjectNodes :: RDF TList -> [Subject]
manifestSubjectNodes rdf = subjectNodes rdf [mfManifest]

subjectNodes :: RDF TList -> [Object] -> [Subject]
subjectNodes rdf = (fmap subjectOf) . concatMap queryType
  where
    queryType n = query rdf Nothing (Just rdfType) (Just n)

-- | Text of the literal node.
-- Note that it doesn't perform type conversion for TypedL.
-- TODO: Looks useful. Move it to RDF4H lib?
lnodeText :: Node -> T.Text
lnodeText (LNode (PlainL t)) = t
lnodeText (LNode (PlainLL t _)) = t
lnodeText (LNode (TypedL t _)) = t
lnodeText _ = error "Not a literal node"

-- | Convert an RDF collection to a List of its objects.
-- | Given a list of RDF triples as shown:
-- |   <x> <collection> <c1>
-- |   <c1> <rdf:first> <i1>
-- |   <c1> <rdf:rest> <c2>
-- |   <c2> <rdf:first> <i2>
-- |   <c2> <rdf:rest> <rdf:nil>
-- | ... it extracts a list of nodes [i1, i2].
-- | First argument (`rdf`) is the RDF graph;
-- | second argument (`tip`) is the "collection head" (<c1> in the example above),
-- | (all triples with <rdf:first> and <rdf:rest> pairs).
-- TODO: Looks useful. Move it to RDF4H lib?
rdfCollectionToList :: RDF TList -> Node -> [Node]
rdfCollectionToList _ (UNode ("http://www.w3.org/1999/02/22-rdf-syntax-ns#nil")) = []
rdfCollectionToList rdf tip = concatMap (tripleToList rdf) $ nextCollectionTriples rdf tip

tripleToList :: RDF TList -> Triple -> [Node]
tripleToList _ (Triple _ (UNode ("http://www.w3.org/1999/02/22-rdf-syntax-ns#first")) n@(UNode _)) = [n]
tripleToList rdf (Triple _ (UNode ("http://www.w3.org/1999/02/22-rdf-syntax-ns#rest")) tip) = rdfCollectionToList rdf tip
tripleToList _ _ = error "Invalid collection format"

nextCollectionTriples :: RDF TList -> Node -> Triples
nextCollectionTriples rdf tip@(BNodeGen _) = query rdf (Just tip) Nothing Nothing
nextCollectionTriples _ _ = error "Invalid collection format"