Fix test suite for Turtle

src/Text/RDF/RDF4H/TurtleParser.hs

@@ -8,6 +8,7 @@
 module Text.RDF.RDF4H.TurtleParser
   ( TurtleParser(TurtleParser)
   , TurtleParserCustom(TurtleParserCustom)
+  , parseTurtleDebug
   ) where
 
 import Prelude hiding (readFile)
@@ -16,9 +17,11 @@ import Data.Char (toLower, toUpper, isDigit, isHexDigit)
 import qualified Data.Map as Map
 import Data.Map (Map)
 import Data.Maybe
+import Data.Either
 import Data.Semigroup ((<>))
 import Data.RDF.Types
 import Data.RDF.IRI
+import Data.RDF.Graph.TList
 import Text.RDF.RDF4H.ParserUtils
 import Text.RDF.RDF4H.NTriplesParser
 import Text.Parsec (runParser, ParseError)
@@ -30,7 +33,7 @@ import Control.Monad
 import Text.Parser.Char
 import Text.Parser.Combinators
 import Text.Parser.LookAhead
-import Control.Applicative
+import Control.Applicative hiding (empty)
 import Control.Monad.State.Class
 import Control.Monad.State.Strict
 
@@ -74,6 +77,9 @@ type ParseState =
   , Seq Triple       -- the triples encountered while parsing; always added to on the right side
   , Map String Integer ) -- map blank node names to generated id.
 
+parseTurtleDebug :: String -> IO (RDF TList)
+parseTurtleDebug f = fromRight empty <$> parseFile (TurtleParserCustom (Just . BaseUrl $ "http://base-url.com/") (Just "http://doc-url.com/") Attoparsec) f
+
 -- grammar rule: [1] turtleDoc
 t_turtleDoc :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m (Seq Triple, PrefixMappings)
 t_turtleDoc =
@@ -639,7 +645,7 @@ parseURLAttoparsec bUrl docUrl = parseFromURL (parseStringAttoparsec bUrl docUrl
 ---------------------------------
 
 initialState :: Maybe BaseUrl -> Maybe T.Text -> ParseState
-initialState bUrl docUrl = (bUrl, docUrl, 1, PrefixMappings mempty, Nothing, Nothing, mempty, mempty)
+initialState bUrl docUrl = (BaseUrl <$> docUrl <|> bUrl, docUrl, 1, PrefixMappings mempty, Nothing, Nothing, mempty, mempty)
 
 
 handleResult :: Rdf a => Maybe BaseUrl -> Either ParseError (Seq Triple, PrefixMappings) -> Either ParseFailure (RDF a)

src/Text/RDF/RDF4H/XmlParser.hs

@@ -11,7 +11,7 @@
 
 module Text.RDF.RDF4H.XmlParser
   ( XmlParser(..)
-  , parseDebug -- [FIXME]
+  , parseXmlDebug -- [FIXME]
   ) where
 
 import Text.RDF.RDF4H.ParserUtils hiding (Parser)
@@ -97,8 +97,8 @@ parseXmlRDF bUrl dUrl = parseRdf . parseXml
     parseRdf' ns = join $ evalState (runExceptT (runParserT rdfParser ns)) initState
     initState = ParseState bUrl' mempty mempty empty mempty empty 0 0
 
-parseDebug :: String -> IO (RDF TList)
-parseDebug f = fromRight RDF.empty <$> parseFile (XmlParser (Just . BaseUrl $ "http://base-url.com/") (Just "http://doc-url.com/")) f
+parseXmlDebug :: String -> IO (RDF TList)
+parseXmlDebug f = fromRight RDF.empty <$> parseFile (XmlParser (Just . BaseUrl $ "http://base-url.com/") (Just "http://doc-url.com/")) f
 
 rdfParser :: Rdf a => Parser (RDF a)
 rdfParser = do

testsuite/tests/Test.hs

@@ -25,13 +25,13 @@ suiteFilesDirXml = "rdf-tests/rdf-xml/"
 suiteFilesDirNTriples = "rdf-tests/ntriples/"
 
 mfPathTurtle,mfPathXml,mfPathNTriples :: T.Text
-mfPathTurtle = T.concat [suiteFilesDirTurtle, "manifest.ttl"]
-mfPathXml = T.concat [suiteFilesDirXml, "manifest.ttl"]
-mfPathNTriples = T.concat [suiteFilesDirNTriples, "manifest.ttl"]
+mfPathTurtle = mconcat [suiteFilesDirTurtle, "manifest.ttl"]
+mfPathXml = mconcat [suiteFilesDirXml, "manifest.ttl"]
+mfPathNTriples = mconcat [suiteFilesDirNTriples, "manifest.ttl"]
 
 mfBaseURITurtle,mfBaseURIXml,mfBaseURINTriples :: BaseUrl
-mfBaseURITurtle   = BaseUrl "http://www.w3.org/2013/TurtleTests/"
-mfBaseURIXml      = BaseUrl "http://www.w3.org/2013/RDFXMLTests/"
+mfBaseURITurtle   = W3CTurtleTest.mfBaseURITurtle
+mfBaseURIXml      = W3CRdfXmlTest.mfBaseURIXml
 mfBaseURINTriples = BaseUrl "http://www.w3.org/2013/N-TriplesTests/"
 
 main :: IO ()
@@ -41,8 +41,7 @@ main = do
   dir <- getCurrentDirectory
   let fileSchemeUri suitesDir =
         fromJust . filePathToUri $ (dir </> T.unpack suitesDir)
-  turtleManifest <-
-    loadManifest mfPathTurtle (fileSchemeUri suiteFilesDirTurtle)
+  turtleManifest <- loadManifest mfPathTurtle (unBaseUrl mfBaseURITurtle)
   xmlManifest <- loadManifest mfPathXml (unBaseUrl mfBaseURIXml)
   nTriplesManifest <-
     loadManifest mfPathNTriples (fileSchemeUri suiteFilesDirNTriples)
@@ -100,10 +99,10 @@ main = do
        "parser-w3c-tests-turtle"
        [ testGroup
          "parser-w3c-tests-turtle-parsec"
-         [W3CTurtleTest.testsParsec turtleManifest]
+         [W3CTurtleTest.testsParsec (dir </> T.unpack suiteFilesDirTurtle) turtleManifest]
        , testGroup
          "parser-w3c-tests-turtle-attoparsec"
-         [W3CTurtleTest.testsAttoparsec turtleManifest]
+         [W3CTurtleTest.testsAttoparsec (dir </> T.unpack suiteFilesDirTurtle) turtleManifest]
        ]
        ,
        testGroup

testsuite/tests/W3C/TurtleTest.hs

@@ -3,6 +3,7 @@
 module W3C.TurtleTest
   ( testsParsec
   , testsAttoparsec
+  , mfBaseURITurtle
   ) where
 
 import Test.Tasty
@@ -22,41 +23,47 @@ import Text.RDF.RDF4H.NTriplesParser
 import Text.RDF.RDF4H.ParserUtils
 import Data.RDF.Graph.TList
 
-testsParsec :: Manifest -> TestTree
-testsParsec = runManifestTests (mfEntryToTest testParserParsec)
+testsParsec :: String -> Manifest -> TestTree
+testsParsec = runManifestTests . (`mfEntryToTest` testParserParsec)
 
-testsAttoparsec :: Manifest -> TestTree
-testsAttoparsec = runManifestTests (mfEntryToTest testParserAttoparsec)
+testsAttoparsec :: String -> Manifest -> TestTree
+testsAttoparsec = runManifestTests . (`mfEntryToTest` testParserAttoparsec)
 
-mfEntryToTest :: TurtleParserCustom -> TestEntry -> TestTree
-mfEntryToTest parser (TestTurtleEval nm _ _ act' res') =
-  let act = (UNode . fromJust . fileSchemeToFilePath) act'
-      res = (UNode . fromJust . fileSchemeToFilePath) res'
-      parsedRDF   = (fromEither <$> parseFile parser (nodeURI act)) :: IO (RDF TList)
-      expectedRDF = (fromEither <$> parseFile NTriplesParser (nodeURI res)) :: IO (RDF TList)
+mfEntryToTest :: String -> (String -> TurtleParserCustom) -> TestEntry -> TestTree
+mfEntryToTest dir parser (TestTurtleEval nm _ _ act res) =
+  let pathExpected = getFilePath dir res
+      pathAction = getFilePath dir act
+      parsedRDF   = (fromEither <$> parseFile (parser (nodeURI act)) pathAction) :: IO (RDF TList)
+      expectedRDF = (fromEither <$> parseFile NTriplesParser pathExpected) :: IO (RDF TList)
   in TU.testCase (T.unpack nm) $ assertIsIsomorphic parsedRDF expectedRDF
-mfEntryToTest parser (TestTurtleNegativeEval nm _ _ act') =
-  let act = (UNode . fromJust . fileSchemeToFilePath) act'
-      rdf = parseFile parser (nodeURI act) :: IO (Either ParseFailure (RDF TList))
+mfEntryToTest dir parser (TestTurtleNegativeEval nm _ _ act) =
+  let pathAction = getFilePath dir act
+      rdf = parseFile (parser (nodeURI act)) pathAction :: IO (Either ParseFailure (RDF TList))
   in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf
-mfEntryToTest parser (TestTurtlePositiveSyntax nm _ _ act') =
-  let act = (UNode . fromJust . fileSchemeToFilePath) act'
-      rdf = parseFile parser (nodeURI act) :: IO (Either ParseFailure (RDF TList))
+mfEntryToTest dir parser (TestTurtlePositiveSyntax nm _ _ act) =
+  let pathAction = getFilePath dir act
+      rdf = parseFile (parser (nodeURI act)) pathAction :: IO (Either ParseFailure (RDF TList))
   in TU.testCase (T.unpack nm) $ assertIsParsed rdf
-mfEntryToTest parser (TestTurtleNegativeSyntax nm _ _ act') =
-  let act = (UNode . fromJust . fileSchemeToFilePath) act'
-      rdf = parseFile parser (nodeURI act) :: IO (Either ParseFailure (RDF TList))
+mfEntryToTest dir parser (TestTurtleNegativeSyntax nm _ _ act) =
+  let pathAction = getFilePath dir act
+      rdf = parseFile (parser (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
+mfEntryToTest _ _ x = error $ "unknown TestEntry pattern in mfEntryToTest: " <> show x
 
+-- [NOTE] Was previously: http://www.w3.org/2013/TurtleTests/
 mfBaseURITurtle :: BaseUrl
-mfBaseURITurtle   = BaseUrl "http://www.w3.org/2013/TurtleTests/"
+mfBaseURITurtle = BaseUrl "http://w3c.github.io/rdf-tests/turtle/"
 
 -- testParser :: TurtleParser
 -- testParser = TurtleParser (Just mfBaseURITurtle) Nothing
 
-testParserParsec :: TurtleParserCustom
-testParserParsec = TurtleParserCustom (Just mfBaseURITurtle) Nothing Parsec
+testParserParsec :: String -> TurtleParserCustom
+testParserParsec dUrl = TurtleParserCustom (Just mfBaseURITurtle) (Just . T.pack $ dUrl) Parsec
 
-testParserAttoparsec :: TurtleParserCustom
-testParserAttoparsec = TurtleParserCustom (Just mfBaseURITurtle) Nothing Attoparsec
+testParserAttoparsec :: String -> TurtleParserCustom
+testParserAttoparsec dUrl = TurtleParserCustom (Just mfBaseURITurtle) (Just . T.pack $ dUrl) Attoparsec
+
+getFilePath :: String -> Node -> String
+getFilePath dir (UNode iri) = fixFilePath' iri
+  where fixFilePath' = (dir <>) . T.unpack . fromJust . T.stripPrefix (unBaseUrl mfBaseURITurtle)
+getFilePath _ _ = error "Unexpected node"