TurtleParser_ConformanceTest.hs

{-# LANGUAGE OverloadedStrings #-}

module Text.RDF.RDF4H.TurtleParser_ConformanceTest
  ( tests,
  )
where

-- Testing imports

-- Import common libraries to facilitate tests

import Control.Applicative ((<|>))
import Data.RDF.Graph.TList
import Data.RDF.Query
import Data.RDF.Types
import Data.String (fromString)
import Data.Text (Text)
import Test.Tasty
import Test.Tasty.HUnit as TU
import Text.Printf
import Text.RDF.RDF4H.TurtleParser

-- tests :: TestTree
-- tests = testGroup "TurtleParser" allCTests

-- A list of other tests to run, each entry of which is (directory, fname_without_ext).
otherTestFiles :: [(String, String)]
otherTestFiles =
  [ ("data/ttl", "example1"),
    ("data/ttl", "example2"),
    ("data/ttl", "example3"),
    ("data/ttl", "example5"),
    ("data/ttl", "example6"),
    ("data/ttl", "example7"),
    ("data/ttl", "example8"),
    ("data/ttl", "example9"),
    ("data/ttl", "example10"),
    ("data/ttl", "example11"),
    ("data/ttl", "example12"),
    ("data/ttl", "fawlty1")
  ]

-- The Base URI to be used for all conformance tests:
testBaseUri :: Text
testBaseUri = "http://www.w3.org/2001/sw/DataAccess/df1/tests/"

mtestBaseUri :: Maybe BaseUrl
mtestBaseUri = Just . BaseUrl $ testBaseUri

tests :: [TestTree]
tests =
  baseUrlTests
    : fmap (uncurry checkGoodOtherTest) otherTestFiles

baseUrlTests :: TestTree
baseUrlTests =
  let t1 = assertBaseUrlSuccess (parseFile (TurtleParser Nothing Nothing) "data/ttl/example13.ttl") "http://example.org" "baseUrl-test1"
   in testGroup "baseUrl-tests" $
        fmap (uncurry testCase) [("baseUrl-test1", t1)]

assertBaseUrlSuccess :: IO (Either ParseFailure (RDF TList)) -> Text -> String -> TU.Assertion
assertBaseUrlSuccess exprGr expectedBUrl testLabel = do
  g <- exprGr
  case g of
    Left (ParseFailure err) -> TU.assertFailure err
    Right g' ->
      case baseUrl g' of
        Just (BaseUrl bUrl) ->
          if bUrl == expectedBUrl
            then return ()
            else TU.assertFailure $ "wrong base URL: " <> testLabel
        Nothing -> TU.assertFailure $ "no base URL: " <> testLabel

checkGoodOtherTest :: String -> String -> TestTree
checkGoodOtherTest dir fname =
  let expGr = loadExpectedGraph1 (printf "%s/%s.out" dir fname :: String)
      inGr = loadInputGraph1 dir fname
   in doGoodConformanceTest expGr inGr $ printf "turtle-%s" fname

doGoodConformanceTest ::
  IO (Either ParseFailure (RDF TList)) ->
  IO (Either ParseFailure (RDF TList)) ->
  String ->
  TestTree
doGoodConformanceTest expGr inGr testname =
  let t1 = assertLoadSuccess (printf "expected (%s): " testname) expGr
      t2 = assertLoadSuccess (printf "   input (%s): " testname) inGr
      t3 = assertEquivalent testname expGr inGr
   in testGroup (printf "conformance-%s" testname) $ fmap (uncurry testCase) [("loading-expected-graph-data", t1), ("loading-input-graph-data", t2), ("comparing-graphs", t3)]

-- Determines if graphs are equivalent, returning Nothing if so or else a diagnostic message.
-- First graph is expected graph, second graph is actual.
equivalent :: (Rdf a) => Either ParseFailure (RDF a) -> Either ParseFailure (RDF a) -> Maybe String
equivalent (Left e) _ = Just $ "Parse failure of the expected graph: " <> show e
equivalent _ (Left e) = Just $ "Parse failure of the input graph: " <> show e
equivalent (Right gr1) (Right gr2) = checkSize <|> (test $! zip gr1ts gr2ts)
  where
    gr1ts = uordered $ triplesOf gr1
    gr2ts = uordered $ triplesOf gr2
    length1 = length gr1ts
    length2 = length gr2ts
    checkSize = if (length1 == length2) then Nothing else (Just $ "Size different. Expected: " <> (show length1) <> ", got: " <> (show length2))
    test [] = Nothing
    test ((t1, t2) : ts) = maybe (test ts) pure (compareTriple t1 t2)
    compareTriple t1@(Triple s1 p1 o1) t2@(Triple s2 p2 o2) =
      if equalNodes s1 s2 && equalNodes p1 p2 && equalNodes o1 o2
        then Nothing
        else Just ("Expected:\n  " <> show t1 <> "\nFound:\n  " <> show t2 <> "\n")
    -- I'm not sure it's right to compare blank nodes with generated
    -- blank nodes. This is because parsing an already generated blank
    -- node is parsed as a blank node. Moreover, a parser is free to
    -- generate the blank node how ever they wish. E.g. parsing [] could be:
    --
    -- _:genid1
    --
    -- or
    --
    -- _:Bb71dd4e4b81c097db8d7f79078bbc7c0
    --
    -- which just so happens to be what Apache Jena just created when
    -- [] was parsed.
    equalNodes (BNode _) (BNodeGen _) = True
    equalNodes (BNodeGen _) (BNode _) = True
    equalNodes (BNodeGen _) (BNodeGen _) = True
    equalNodes (BNode _) (BNode _) = True
    equalNodes n1 n2 = n1 == n2

loadInputGraph1 :: String -> String -> IO (Either ParseFailure (RDF TList))
loadInputGraph1 dir fname = parseFile parserConfig path
  where
    path = printf "%s/%s.ttl" dir fname :: String
    parserConfig = TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname)

loadExpectedGraph1 :: String -> IO (Either ParseFailure (RDF TList))
loadExpectedGraph1 fname =
  parseFile (TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname)) fname

assertLoadSuccess :: String -> IO (Either ParseFailure (RDF TList)) -> TU.Assertion
assertLoadSuccess idStr exprGr = do
  g <- exprGr
  case g of
    Left (ParseFailure err) -> TU.assertFailure $ idStr <> err
    Right _ -> return ()

assertEquivalent :: (Rdf a) => String -> IO (Either ParseFailure (RDF a)) -> IO (Either ParseFailure (RDF a)) -> TU.Assertion
assertEquivalent testname r1 r2 = do
  gr1 <- r1
  gr2 <- r2
  case equivalent gr1 gr2 of
    Nothing -> return ()
    (Just msg) -> fail $ "Graph " <> testname <> " not equivalent to expected:\n" <> msg

mkDocUrl1 :: Text -> String -> Maybe Text
mkDocUrl1 baseDocUrl fname = Just . fromString $ printf "%s%s.ttl" baseDocUrl fname