{-# LANGUAGE OverloadedStrings #-} module W3C.RdfXmlTest ( tests , mfBaseURIXml ) where import Data.Semigroup ((<>)) import Data.Maybe (fromJust) import Test.Tasty import qualified Test.Tasty.HUnit as TU import qualified Data.Text as T import W3C.Manifest import W3C.W3CAssertions import Data.RDF.Types import Data.RDF.Query import Text.RDF.RDF4H.XmlParser import Text.RDF.RDF4H.NTriplesParser import Data.RDF.Graph.TList tests :: String -> Manifest -> TestTree tests = runManifestTests . mfEntryToTest -- Functions to map manifest test entries to unit tests. -- They are defined here to avoid cluttering W3C.Manifest -- with functions that may not be needed to those who -- just want to parse Manifest files. -- TODO: They should probably be moved to W3C.Manifest after all. mfEntryToTest :: String -> TestEntry -> TestTree mfEntryToTest dir (TestXMLEval nm _ _ act res) = let pathExpected = getFilePath dir res pathAction = getFilePath dir act parsedRDF = (fromEither <$> parseFile (testParser (nodeURI act)) pathAction) :: IO (RDF TList) expectedRDF = (fromEither <$> parseFile NTriplesParser pathExpected) :: IO (RDF TList) in TU.testCase (T.unpack nm) $ assertIsIsomorphic parsedRDF expectedRDF mfEntryToTest dir (TestXMLNegativeSyntax nm _ _ act) = let pathAction = getFilePath dir act rdf = parseFile (testParser (nodeURI act)) pathAction :: IO (Either ParseFailure (RDF TList)) in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf mfEntryToTest _ x = error $ "unknown TestEntry pattern in mfEntryToTest: " <> show x getFilePath :: String -> Node -> String getFilePath dir (UNode iri) = fixFilePath' iri where fixFilePath' = (dir <>) . T.unpack . fromJust . T.stripPrefix (unBaseUrl mfBaseURIXml) getFilePath _ _ = error "Unexpected node" mfBaseURIXml :: BaseUrl mfBaseURIXml = BaseUrl "http://www.w3.org/2013/RDFXMLTests/" testParser :: String -> XmlParser testParser dUri = XmlParser (Just mfBaseURIXml) (Just . T.pack $ dUri)