diff --git a/rdf4h.cabal b/rdf4h.cabal --- a/rdf4h.cabal +++ b/rdf4h.cabal @@ -1,5 +1,5 @@ name: rdf4h -version: 1.3.4 +version: 1.3.5 synopsis: A library for RDF processing in Haskell description: 'RDF for Haskell' is a library for working with RDF in Haskell. @@ -96,6 +96,15 @@ test-suite test-rdf4h type: exitcode-stdio-1.0 main-is: Test.hs + other-modules: Data.RDF.GraphTestUtils + Data.RDF.MGraph_Test + Data.RDF.PatriciaTreeGraph_Test + Text.RDF.RDF4H.TurtleParser_ConformanceTest + Text.RDF.RDF4H.XmlParser_Test + Data.RDF.TriplesGraph_Test + W3C.Manifest + W3C.NTripleTest + W3C.RdfXmlTest ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-name-shadowing -funbox-strict-fields extensions: RankNTypes MultiParamTypeClasses Arrows FlexibleContexts OverloadedStrings build-depends: base >= 4 && < 6 diff --git a/src/Data/RDF/Types.hs b/src/Data/RDF/Types.hs --- a/src/Data/RDF/Types.hs +++ b/src/Data/RDF/Types.hs @@ -144,6 +144,10 @@ -- For background on 'unodeValidate', see: -- http://stackoverflow.com/questions/33250184/unescaping-unicode-literals-found-in-haskell-strings +-- +-- Escaped literals are defined in the Turtle spec, and is +-- inherited by the NTriples and XML specification. +-- http://www.w3.org/TR/turtle/#sec-escapes -- |Validate a URI and return it in a @Just UNode@ if it is -- valid, otherwise @Nothing@ is returned. Performs the following: @@ -161,19 +165,6 @@ unicodeEscParser = do ss <- many ( try (do { _ <- char '\\' - ; _ <- char 'u' - ; pos1 <- digit - ; pos2 <- digit - ; pos3 <- digit - ; pos4 <- digit - ; pos5 <- digit - ; pos6 <- digit - ; pos7 <- digit - ; pos8 <- digit - ; let str = ['\\','x',pos1,pos2,pos3,pos4,pos5,pos6,pos7,pos8] - ; return (read ("\"" ++ str ++ "\"") :: String)}) - <|> - try (do { _ <- char '\\' ; _ <- char 'U' ; pos1 <- digit ; pos2 <- digit @@ -188,15 +179,6 @@ <|> try (do { _ <- char '\\' ; _ <- char 'u' - ; pos1 <- digit - ; pos2 <- digit - ; pos3 <- digit - ; pos4 <- digit - ; let str = ['\\','x',pos1,pos2,pos3,pos4] - ; return (read ("\"" ++ str ++ "\"") :: String)}) - <|> - try (do { _ <- char '\\' - ; _ <- char 'U' ; pos1 <- digit ; pos2 <- digit ; pos3 <- digit diff --git a/testsuite/tests/Data/RDF/GraphTestUtils.hs b/testsuite/tests/Data/RDF/GraphTestUtils.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/Data/RDF/GraphTestUtils.hs @@ -0,0 +1,418 @@ +module Data.RDF.GraphTestUtils where + +import Control.Applicative ((<$>)) +import Data.ByteString (pack) +import qualified Data.ByteString.Char8 as C +import Data.Knob +import Data.RDF.Types +import Data.RDF.Query +import Data.RDF.Namespace +import Text.RDF.RDF4H.NTriplesSerializer +import qualified Data.Text as T +import Test.QuickCheck +import Data.List +import qualified Data.Set as Set +import qualified Data.Map as Map +import Control.Monad +import System.IO.Unsafe(unsafePerformIO) +import System.IO + +import Test.Framework (Test,TestName,testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck.Monadic (assert, monadicIO,run) + +---------------------------------------------------- +-- property based quick check test cases -- +---------------------------------------------------- + +graphTests :: forall rdf. (Arbitrary rdf, RDF rdf, Show rdf) + => TestName -> (rdf -> Triples) -> (rdf -> Triples) -> rdf -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> [Test] +graphTests testGroupName _triplesOf _uniqTriplesOf _empty _mkRdf = [ testGroup testGroupName + [ + testProperty "empty" (p_empty _triplesOf _empty) + , testProperty "mkRdf_triplesOf" (p_mkRdf_triplesOf _triplesOf _mkRdf) + , testProperty "mkRdf_no_dupes" (p_mkRdf_no_dupes _uniqTriplesOf _mkRdf) + , testProperty "query_match_none" (p_query_match_none _mkRdf) + , testProperty "query_matched_spo" (p_query_matched_spo _triplesOf) + -- see comment above p_query_matched_spo_no_dupes for why this is disabled + -- , testProperty "query_matched_spo_no_dupes" (p_query_matched_spo_no_dupes _triplesOf _mkRdf) + , testProperty "query_unmatched_spo" (p_query_unmatched_spo _triplesOf) + , testProperty "query_match_s" (p_query_match_s _triplesOf) + , testProperty "query_match_p" (p_query_match_p _triplesOf) + , testProperty "query_match_o" (p_query_match_o _triplesOf) + , testProperty "query_match_sp" (p_query_match_sp _triplesOf) + , testProperty "query_match_so" (p_query_match_so _triplesOf) + , testProperty "query_match_po" (p_query_match_po _triplesOf) + , testProperty "select_match_none" (p_select_match_none _triplesOf) + , testProperty "select_match_s" (p_select_match_s _triplesOf) + , testProperty "select_match_p" (p_select_match_p _triplesOf) + , testProperty "select_match_o" (p_select_match_o _triplesOf) + , testProperty "select_match_sp" (p_select_match_sp _triplesOf) + , testProperty "select_match_so" (p_select_match_so _triplesOf) + , testProperty "select_match_po" (p_select_match_po _triplesOf) + , testProperty "select_match_spo" (p_select_match_spo _triplesOf) + , testProperty "reversed RDF handle write" (p_reverseRdfTest _mkRdf) + ] + ] + + +instance Arbitrary BaseUrl where + arbitrary = oneof $ map (return . BaseUrl . T.pack) ["http://example.com/a", "http://asdf.org/b"] + --coarbitrary = undefined + +instance Arbitrary PrefixMappings where + arbitrary = oneof [return $ PrefixMappings Map.empty, return $ PrefixMappings $ + Map.fromAscList [(T.pack "eg1", T.pack "http://example.com/1"), + (T.pack "eg2", T.pack "http://example.com/2")]] + --coarbitrary = undefined + +-- Test stubs, which just require the appropriate RDF impl function +-- passed in to determine the implementation to be tested. + +-- empty RDF should have no triples +p_empty :: RDF rdf => (rdf -> Triples) -> rdf -> Bool +p_empty _triplesOf _empty = _triplesOf _empty == [] + +-- triplesOf any RDF should return unique triples used to create it +p_mkRdf_triplesOf :: RDF rdf => (rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool +p_mkRdf_triplesOf _triplesOf _mkRdf ts bUrl pms = + uordered (_triplesOf (_mkRdf ts bUrl pms)) == uordered ts + +-- duplicate input triples should not be returned when +-- uniqTriplesof is used +p_mkRdf_no_dupes :: RDF rdf => (rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool +p_mkRdf_no_dupes _uniqtriplesOf _mkRdf ts bUrl pms = + null ts || (sort result == uordered ts) + where + tsWithDupe = head ts : ts + result = _uniqtriplesOf $ _mkRdf tsWithDupe bUrl pms + +-- Note: in TriplesGraph and PatriciaTreeGraph `query` expands triples +-- but `ts` here is not necessarily expanded. What is the correct +-- property this test should check? +-- +-- query with all 3 wildcards should yield all triples in RDF +p_query_match_none :: RDF rdf => (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool +p_query_match_none _mkRdf ts bUrl pms = uordered ts == uordered result + where + result = query (_mkRdf ts bUrl pms) Nothing Nothing Nothing + +-- query with no wildcard and a triple in the RDF should yield +-- a singleton list with just the triple. +p_query_matched_spo :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_query_matched_spo _triplesOf rdf = + classify (null ts) "trivial" $ + forAll (tripleFromGen _triplesOf rdf) f + where + ts = _triplesOf rdf + f t = case t of + Nothing -> True + (Just t') -> [t'] == queryT rdf t' + +{- disabled: +-- removing duplicates from `query` (and `select`) is deprecated, see +-- https://github.com/cordawyn/rdf4h/commit/9dd4729908db8d2f80088706592adac81a0f3016 +-- +-- query as in p_query_matched_spo after duplicating a triple in the +-- RDF, so that we can verify that the results just have 1, even +-- if the RDF itself doesn't ensure that there are no dupes internally. +p_query_matched_spo_no_dupes :: RDF rdf => (rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> rdf -> Property +p_query_matched_spo_no_dupes _triplesOf _mkRdf rdf = + classify (null ts) "trivial" $ + forAll (tripleFromGen _triplesOf rdf) f + where + ts = _triplesOf rdf + f t = case t of + Nothing -> True + Just t' -> [t'] == queryT (mkRdfWithDupe _triplesOf _mkRdf rdf t') t' +-} + +-- query with no wildcard and a triple no in the RDF should yield [] +p_query_unmatched_spo :: RDF rdf => (rdf -> Triples) -> rdf -> Triple -> Property +p_query_unmatched_spo _triplesOf rdf t = + classify (t `elem` ts) "ignored" $ + notElem t ts ==> [] == queryT rdf t + where + ts = _triplesOf rdf + +-- query with fixed subject and wildcards for pred and obj should yield +-- a list with all triples having subject, and RDF minus result triples +-- should yield all triple with unequal subjects. +p_query_match_s :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_query_match_s = mk_query_match_fn sameSubj f + where f t = (Just (subjectOf t), Nothing, Nothing) + +-- query w/ fixed predicate and wildcards for subj and obj should yield +-- a list with all triples having predicate, and RDFgraph minus result triples +-- should yield all triple with unequal predicates. +p_query_match_p :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_query_match_p = mk_query_match_fn samePred f + where f t = (Nothing, Just (predicateOf t), Nothing) + +-- likewise for fixed subject and predicate with object wildcard +p_query_match_o :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_query_match_o = mk_query_match_fn sameObj f + where f t = (Nothing, Nothing, Just (objectOf t)) + +-- verify likewise for fixed subject and predicate with wildcard object +p_query_match_sp :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_query_match_sp = mk_query_match_fn same f + where same t1 t2 = sameSubj t1 t2 && samePred t1 t2 + f t = (Just $ subjectOf t, Just $ predicateOf t, Nothing) + +-- fixed subject and object with wildcard predicate +p_query_match_so :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_query_match_so = mk_query_match_fn same f + where same t1 t2 = sameSubj t1 t2 && sameObj t1 t2 + f t = (Just $ subjectOf t, Nothing, Just $ objectOf t) + +-- fixed predicate and object with wildcard subject +p_query_match_po :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_query_match_po = mk_query_match_fn same f + where same t1 t2 = samePred t1 t2 && sameObj t1 t2 + f t = (Nothing, Just $ predicateOf t, Just $ objectOf t) + +mk_query_match_fn :: RDF rdf => (Triple -> Triple -> Bool) + -> (Triple -> (Maybe Node, Maybe Node, Maybe Node)) + -> (rdf -> Triples) -> rdf -> Property +mk_query_match_fn tripleCompareFn mkPatternFn _triplesOf rdf = + forAll (tripleFromGen _triplesOf rdf) f + where + f :: Maybe Triple -> Bool + f Nothing = True + f (Just t) = + let + all_ts = _triplesOf rdf + all_ts_sorted = uordered all_ts + results = uordered $ queryC rdf (mkPatternFn t) + notResults = ldiff all_ts_sorted results + in + all (tripleCompareFn t) results && + all (not . tripleCompareFn t) notResults + +p_select_match_none :: RDF rdf => (rdf -> Triples) -> rdf -> Bool +p_select_match_none _triplesOf_not_used rdf = sort ts1 == sort ts2 + where + ts1 = select rdf Nothing Nothing Nothing + -- ts2 = (nub . triplesOf) rdf + + -- may have duplicates, see comments in + -- https://github.com/cordawyn/rdf4h/commit/9dd4729908db8d2f80088706592adac81a0f3016 + ts2 = triplesOf rdf + +p_select_match_s :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_select_match_s = + p_select_match_fn same mkPattern + where + same = equivNode (==) subjectOf + mkPattern t = (Just (\n -> n == subjectOf t), Nothing, Nothing) + +p_select_match_p :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_select_match_p = + p_select_match_fn same mkPattern + where + same = equivNode equiv predicateOf + equiv (UNode u1) (UNode u2) = T.last u1 == T.last u2 + equiv _ _ = error "GraphTestUtils.p_select_match_p.equiv" + mkPattern t = (Nothing, Just (\n -> lastChar n == lastChar (predicateOf t)) , Nothing) + lastChar (UNode uri) = T.last uri + lastChar _ = error "GraphTestUtils.p_select_match_p.lastChar" + + +p_select_match_o :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_select_match_o = + p_select_match_fn same mkPattern + where + same = equivNode (/=) objectOf + mkPattern t = (Nothing, Nothing, Just (\n -> n /= objectOf t)) + +p_select_match_sp :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_select_match_sp = + p_select_match_fn same mkPattern + where + same t1 t2 = subjectOf t1 == subjectOf t2 && predicateOf t1 /= predicateOf t2 + mkPattern t = (Just (\n -> n == subjectOf t), Just (\n -> n /= predicateOf t), Nothing) + +p_select_match_so :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_select_match_so = + p_select_match_fn same mkPattern + where + same t1 t2 = subjectOf t1 /= subjectOf t2 && objectOf t1 == objectOf t2 + mkPattern t = (Just (\n -> n /= subjectOf t), Nothing, Just (\n -> n == objectOf t)) + +p_select_match_po :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_select_match_po = + p_select_match_fn same mkPattern + where + same t1 t2 = predicateOf t1 == predicateOf t2 && objectOf t1 == objectOf t2 + mkPattern t = (Nothing, Just (\n -> n == predicateOf t), Just (\n -> n == objectOf t)) + +p_select_match_spo :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_select_match_spo = + p_select_match_fn same mkPattern + where + same t1 t2 = subjectOf t1 == subjectOf t2 && predicateOf t1 == predicateOf t2 && + objectOf t1 /= objectOf t2 + mkPattern t = (Just (\n -> n == subjectOf t), + Just (\n -> n == predicateOf t), + Just (\n -> n /= objectOf t)) + +equivNode :: (Node -> Node -> Bool) -> (Triple -> Node) -> Triple -> Triple -> Bool +equivNode eqFn exFn t1 t2 = exFn t1 `eqFn` exFn t2 + +p_select_match_fn :: RDF rdf => (Triple -> Triple -> Bool) + -> (Triple -> (NodeSelector, NodeSelector, NodeSelector)) + -> (rdf -> Triples) -> rdf -> Property +p_select_match_fn tripleCompareFn mkPatternFn _triplesOf rdf = + forAll (tripleFromGen _triplesOf rdf) f + where + f :: Maybe Triple -> Bool + f Nothing = True + f (Just t) = + let + all_ts = triplesOf rdf + all_ts_sorted = uordered all_ts + results = uordered $ selectC rdf (mkPatternFn t) + notResults = ldiff all_ts_sorted results + in + all (tripleCompareFn t) results && + all (not . tripleCompareFn t) notResults + +mkRdfWithDupe :: RDF rdf => (rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> rdf -> Triple -> rdf +mkRdfWithDupe _triplesOf _mkRdf rdf t = _mkRdf ts (baseUrl rdf) (prefixMappings rdf) + where ts = t : _triplesOf rdf + + +-- Utility functions and test data ... -- + +-- a curried version of query that delegates to the actual query after unpacking +-- curried maybe node pattern. +queryC :: RDF rdf => rdf -> (Maybe Node, Maybe Node, Maybe Node) -> Triples +queryC rdf (s, p, o) = query rdf s p o + +selectC :: RDF rdf => rdf -> (NodeSelector, NodeSelector, NodeSelector) -> Triples +selectC rdf (s, p, o) = select rdf s p o + +uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d +uncurry3 fn (x, y, z) = fn x y z + +curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d +curry3 fn x y z = fn (x, y, z) + +debug :: String -> Triples -> Bool +debug msg ts = + unsafePerformIO $ + putStrLn msg >> mapM print ts >> return True + +ldiff :: Triples -> Triples -> Triples +ldiff l1 l2 = Set.toList $(Set.fromList l1) `Set.difference` Set.fromList l2 + +sameSubj :: Triple -> Triple -> Bool +sameSubj t1 t2 = subjectOf t1 == subjectOf t2 + +samePred :: Triple -> Triple -> Bool +samePred t1 t2 = predicateOf t1 == predicateOf t2 + +sameObj :: Triple -> Triple -> Bool +sameObj t1 t2 = objectOf t1 == objectOf t2 + +-- Convert a list of triples into a sorted list of unique triples. +uordered :: Triples -> Triples +uordered = sort . nub + +tripleFromGen :: RDF rdf => (rdf -> Triples) -> rdf -> Gen (Maybe Triple) +tripleFromGen _triplesOf rdf = + if null ts + then return Nothing + else oneof $ map (return . Just) ts + where ts = _triplesOf rdf + +queryT :: RDF rdf => rdf -> Triple -> Triples +queryT rdf t = query rdf (Just $ subjectOf t) (Just $ predicateOf t) (Just $ objectOf t) + +languages :: [T.Text] +languages = [T.pack "fr", T.pack "en"] + +datatypes :: [T.Text] +datatypes = map (mkUri xsd . T.pack) ["string", "int", "token"] + +uris :: [T.Text] +uris = map (mkUri ex) [T.pack n `T.append` T.pack (show (i::Int)) | n <- ["foo", "bar", "quz", "zak"], i <- [0..9]] + +plainliterals :: [LValue] +plainliterals = [plainLL lit lang | lit <- litvalues, lang <- languages] + +typedliterals :: [LValue] +typedliterals = [typedL lit dtype | lit <- litvalues, dtype <- datatypes] + +litvalues :: [T.Text] +litvalues = map T.pack ["hello", "world", "peace", "earth", "", "haskell"] + +unodes :: [Node] +unodes = map UNode uris + +bnodes :: [ Node] +bnodes = map (BNode . \i -> T.pack ":_genid" `T.append` T.pack (show (i::Int))) [1..5] + +lnodes :: [Node] +lnodes = [LNode lit | lit <- plainliterals ++ typedliterals] + +test_triples :: [Triple] +test_triples = [triple s p o | s <- unodes ++ bnodes, p <- unodes, o <- unodes ++ bnodes ++ lnodes] + +maxN :: Int +maxN = min 100 (length test_triples - 1) + +instance Arbitrary Triple where + arbitrary = liftM3 triple arbitraryS arbitraryP arbitraryO + --coarbitrary = undefined + +instance Arbitrary Node where + arbitrary = oneof $ map return unodes + --coarbitrary = undefined + +arbitraryTNum :: Gen Int +arbitraryTNum = choose (0, maxN - 1) + +arbitraryTs :: Gen Triples +arbitraryTs = do + n <- sized (\_ -> choose (0, maxN)) + sequence [arbitrary | _ <- [1..n]] + +arbitraryT :: Gen Triple +arbitraryT = elements test_triples + +arbitraryN :: Gen Int +arbitraryN = choose (0, maxN - 1) + +arbitraryS, arbitraryP, arbitraryO :: Gen Node +arbitraryS = oneof $ map return $ unodes ++ bnodes +arbitraryP = oneof $ map return unodes +arbitraryO = oneof $ map return $ unodes ++ bnodes ++ lnodes + +---------------------------------------------------- +-- Unit test cases -- +---------------------------------------------------- + +-- Reported by Daniel Bergey: +-- https://github.com/robstewart57/rdf4h/issues/4 + +p_reverseRdfTest :: RDF rdf => (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> Property +p_reverseRdfTest _mkRdf = monadicIO $ do + fileContents <- run $ do + knob <- newKnob (pack []) + h <- newFileHandle knob "test.rdf" WriteMode + hWriteRdf NTriplesSerializer h rdfGraph + hClose h + C.unpack <$> Data.Knob.getContents knob + let expected = " \"literal string\" .\n" + assert $ expected == fileContents + + where + rdfGraph = _mkRdf ts (Just $ BaseUrl "file://") (ns_mappings []) + + ts :: [Triple] + ts = [Triple + (unode "file:///this/is/not/a/palindrome") + (unode "file:///this/is/not/a/palindrome") + (LNode . PlainL . T.pack $ "literal string")] diff --git a/testsuite/tests/Data/RDF/MGraph_Test.hs b/testsuite/tests/Data/RDF/MGraph_Test.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/Data/RDF/MGraph_Test.hs @@ -0,0 +1,25 @@ +module Data.RDF.MGraph_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where + +import Data.RDF.Types +import Data.RDF.MGraph (MGraph) +import Data.RDF.GraphTestUtils +import qualified Data.Map as Map +import Control.Monad + +import Test.QuickCheck + +instance Arbitrary MGraph where + arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) + --coarbitrary = undefined + +empty' :: MGraph +empty' = empty + +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> MGraph +mkRdf' = mkRdf + +triplesOf' :: MGraph -> Triples +triplesOf' = triplesOf + +uniqTriplesOf' :: MGraph -> Triples +uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/PatriciaTreeGraph_Test.hs b/testsuite/tests/Data/RDF/PatriciaTreeGraph_Test.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/Data/RDF/PatriciaTreeGraph_Test.hs @@ -0,0 +1,25 @@ +module Data.RDF.PatriciaTreeGraph_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where + +import Data.RDF.Types +import Data.RDF.PatriciaTreeGraph (PatriciaTreeGraph) +import Data.RDF.GraphTestUtils +import qualified Data.Map as Map +import Control.Monad + +import Test.QuickCheck + +instance Arbitrary PatriciaTreeGraph where + arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) + --coarbitrary = undefined + +empty' :: PatriciaTreeGraph +empty' = empty + +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> PatriciaTreeGraph +mkRdf' = mkRdf + +triplesOf' :: PatriciaTreeGraph -> Triples +triplesOf' = triplesOf + +uniqTriplesOf' :: PatriciaTreeGraph -> Triples +uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/TriplesGraph_Test.hs b/testsuite/tests/Data/RDF/TriplesGraph_Test.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/Data/RDF/TriplesGraph_Test.hs @@ -0,0 +1,25 @@ +module Data.RDF.TriplesGraph_Test (empty',triplesOf',uniqTriplesOf',mkRdf') where + +import Control.Monad +import qualified Data.Map as Map +import Data.RDF.GraphTestUtils +import Data.RDF.Namespace +import Data.RDF.TriplesGraph +import Data.RDF.Types +import Test.QuickCheck.Arbitrary + +instance Arbitrary TriplesGraph where + arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) + --coarbitrary = undefined + +empty' :: TriplesGraph +empty' = empty + +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesGraph +mkRdf' = mkRdf + +triplesOf' :: TriplesGraph -> Triples +triplesOf' = triplesOf + +uniqTriplesOf' :: TriplesGraph -> Triples +uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs b/testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs @@ -0,0 +1,155 @@ +module Text.RDF.RDF4H.TurtleParser_ConformanceTest where + +-- Testing imports +import Test.Framework.Providers.API +import Test.Framework.Providers.HUnit +import qualified Test.HUnit as TU + +-- Import common libraries to facilitate tests +import Control.Monad (liftM) +import Data.RDF.GraphTestUtils +import Data.RDF.Query +import Data.RDF.TriplesGraph +import Data.RDF.Types +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import Text.Printf +import Text.RDF.RDF4H.TurtleParser + +tests :: [Test] +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"), -- rdf4h URIs support RFC3986, not unicode IRIs in RFC3987 + ("data/ttl", "example8"), + ("data/ttl", "fawlty1") + ] + +-- The Base URI to be used for all conformance tests: +testBaseUri :: String +testBaseUri = "http://www.w3.org/2001/sw/DataAccess/df1/tests/" + +mtestBaseUri :: Maybe BaseUrl +mtestBaseUri = Just $ BaseUrl $ T.pack testBaseUri + +fpath :: String -> Int -> String -> String +fpath name i ext = printf "data/ttl/conformance/%s-%02d.%s" name i ext :: String + +allCTests :: [Test] +allCTests = ts1 ++ ts2 ++ ts3 + where + ts1 = map (buildTest . checkGoodConformanceTest) [0..30] + ts2 = map (buildTest . checkBadConformanceTest) [0..14] + ts3 = map (buildTest . uncurry checkGoodOtherTest) otherTestFiles + +checkGoodConformanceTest :: Int -> IO Test +checkGoodConformanceTest i = + do + expGr <- loadExpectedGraph "test" i + inGr <- loadInputGraph "test" i + doGoodConformanceTest expGr inGr (printf "test %d" i :: String) + +checkGoodOtherTest :: String -> String -> IO Test +checkGoodOtherTest dir fname = + do + expGr <- loadExpectedGraph1 (printf "%s/%s.out" dir fname :: String) + inGr <- loadInputGraph1 dir fname + doGoodConformanceTest expGr inGr $ printf "test using file \"%s\"" fname + +doGoodConformanceTest :: Either ParseFailure TriplesGraph -> + Either ParseFailure TriplesGraph -> + String -> IO Test +doGoodConformanceTest expGr inGr testname = do + let t1 = assertLoadSuccess (printf "expected (%s): " testname) expGr + t2 = assertLoadSuccess (printf " input (%s): " testname) inGr + t3 = assertEquivalent testname expGr inGr + return $ testGroup (printf "Conformance %s" testname) $ map (uncurry testCase) [("Loading expected graph data", t1), ("Loading input graph data", t2), ("Comparing graphs", t3)] + +checkBadConformanceTest :: Int -> IO Test +checkBadConformanceTest i = do + let t = loadInputGraph "bad" i >>= assertLoadFailure (show i) + return $ testCase (printf "Loading test %d (negative)" i) t + +-- 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 rdf => Either ParseFailure rdf -> Either ParseFailure rdf -> Maybe String +equivalent (Left _) _ = Nothing +equivalent _ (Left _) = Nothing +equivalent (Right gr1) (Right gr2) = test $! zip gr1ts gr2ts + where + gr1ts = uordered $ triplesOf gr1 + gr2ts = uordered $ triplesOf gr2 + test [] = Nothing + test ((t1,t2):ts) = + case compareTriple t1 t2 of + Nothing -> test ts + err -> err + compareTriple t1 t2 = + if equalNodes s1 s2 && equalNodes p1 p2 && equalNodes o1 o2 + then Nothing + else Just ("Expected:\n " ++ show t1 ++ "\nFound:\n " ++ show t2 ++ "\n") + where + (s1, p1, o1) = f t1 + (s2, p2, o2) = f t2 + f t = (subjectOf t, predicateOf t, objectOf t) + -- equalNodes (BNode fs1) (BNodeGen i) = T.reverse fs1 == T.pack ("_:genid" ++ show i) + equalNodes (BNode fs1) (BNodeGen i) = fs1 == T.pack ("_:genid" ++ show i) + equalNodes n1 n2 = n1 == n2 + +-- Returns a graph for a good ttl test that is intended to pass, and normalizes +-- triples into a format so that they can be compared with the expected output triples. +loadInputGraph :: String -> Int -> IO (Either ParseFailure TriplesGraph) +loadInputGraph name n = + TIO.readFile (fpath name n "ttl") >>= + return . parseString (TurtleParser mtestBaseUri (mkDocUrl testBaseUri name n)) >>= return . handleLoad + +loadInputGraph1 :: String -> String -> IO (Either ParseFailure TriplesGraph) +loadInputGraph1 dir fname = + TIO.readFile (printf "%s/%s.ttl" dir fname :: String) >>= + return . parseString (TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname)) >>= return . handleLoad + +handleLoad :: Either ParseFailure TriplesGraph -> Either ParseFailure TriplesGraph +handleLoad res = + case res of + l@(Left _) -> l + (Right gr) -> Right $ mkRdf (map normalize (triplesOf gr)) (baseUrl gr) (prefixMappings gr) + +normalize :: Triple -> Triple +normalize t = let s' = normalizeN $ subjectOf t + p' = normalizeN $ predicateOf t + o' = normalizeN $ objectOf t + in triple s' p' o' +normalizeN :: Node -> Node +normalizeN (BNodeGen i) = BNode (T.pack $ "_:genid" ++ show i) +normalizeN n = n + +loadExpectedGraph :: String -> Int -> IO (Either ParseFailure TriplesGraph) +loadExpectedGraph name n = loadExpectedGraph1 (fpath name n "out") +loadExpectedGraph1 :: String -> IO (Either ParseFailure TriplesGraph) +loadExpectedGraph1 fname = + liftM (parseString (TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname))) (TIO.readFile fname) + +assertLoadSuccess, assertLoadFailure :: String -> Either ParseFailure TriplesGraph -> TU.Assertion +assertLoadSuccess idStr (Left (ParseFailure err)) = TU.assertFailure $ idStr ++ err +assertLoadSuccess _ (Right _) = return () +assertLoadFailure _ (Left _) = return () +assertLoadFailure idStr _ = TU.assertFailure $ "Bad test " ++ idStr ++ " loaded successfully." + +assertEquivalent :: RDF rdf => String -> Either ParseFailure rdf -> Either ParseFailure rdf -> TU.Assertion +assertEquivalent testname r1 r2 = + case equiv of + Nothing -> TU.assert True + (Just msg) -> fail $ "Graph " ++ testname ++ " not equivalent to expected:\n" ++ msg + where equiv = equivalent r1 r2 + +mkDocUrl :: String -> String -> Int -> Maybe T.Text +mkDocUrl baseDocUrl fname testNum = Just $ T.pack $ printf "%s%s-%02d.ttl" baseDocUrl fname testNum + +mkDocUrl1 :: String -> String -> Maybe T.Text +mkDocUrl1 baseDocUrl fname = Just $ T.pack $ printf "%s%s.ttl" baseDocUrl fname diff --git a/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs b/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs @@ -0,0 +1,690 @@ +module Text.RDF.RDF4H.XmlParser_Test where + +-- todo: QuickCheck tests + +-- Testing imports +import Test.Framework (Test,testGroup) +import Test.Framework.Providers.HUnit +import Test.HUnit (Assertion,assertBool,assertFailure) + +-- Import common libraries to facilitate tests +import qualified Data.Map as Map +import Data.RDF.Query +import Data.RDF.TriplesGraph (TriplesGraph) +import Data.RDF.Types +import qualified Data.Text as T (Text, unlines) +import Text.RDF.RDF4H.XmlParser + +tests :: [Test] +tests = [ testGroup "XmlParser:parseXmlRDF" [ testCase "simpleStriping1" test_simpleStriping1 + , testCase "simpleStriping2" test_simpleStriping2 + , testCase "simpleSingleton1" test_simpleSingleton1 + , testCase "simpleSingleton2" test_simpleSingleton2 + , testCase "example07" test_parseXmlRDF_example07 + , testCase "example08" test_parseXmlRDF_example08 + , testCase "example09" test_parseXmlRDF_example09 + , testCase "example10" test_parseXmlRDF_example10 + , testCase "example11" test_parseXmlRDF_example11 + , testCase "example12" test_parseXmlRDF_example12 + , testCase "example13" test_parseXmlRDF_example13 + , testCase "example14" test_parseXmlRDF_example14 + , testCase "example15" test_parseXmlRDF_example15 + , testCase "example16" test_parseXmlRDF_example16 + , testCase "example17" test_parseXmlRDF_example17 + , testCase "example18" test_parseXmlRDF_example18 + , testCase "example19" test_parseXmlRDF_example19 + , testCase "example20" test_parseXmlRDF_example20 + , testCase "vCardPersonal" test_parseXmlRDF_vCardPersonal + , testCase "NML" test_parseXmlRDF_NML + , testCase "NML2" test_parseXmlRDF_NML2 + , testCase "NML3" test_parseXmlRDF_NML3 + ] + ] + + +mkTextNode :: T.Text -> Node +mkTextNode = lnode . plainL + +testParse :: T.Text -> TriplesGraph -> Assertion +testParse exRDF ex = + case parsed of + Right result -> + assertBool + ("expected: " ++ show ex ++ "but got: " ++ show result) + (isIsomorphic (result :: TriplesGraph) (ex :: TriplesGraph)) + Left (ParseFailure err) -> + assertFailure err + where parsed = parseString (XmlParser Nothing Nothing) exRDF + +test_simpleStriping1 :: Assertion +test_simpleStriping1 = testParse + "\ + \\ + \RDF/XML Syntax Specification (Revised)\ + \\ + \" + ( mkRdf [ Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (mkTextNode "RDF/XML Syntax Specification (Revised)") ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +test_simpleStriping2 :: Assertion +test_simpleStriping2 = testParse + "\ + \\ + \RDF/XML Syntax Specification (Revised)\ + \\ + \\ + \Der Baum\ + \\ + \" + ( mkRdf [ Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (mkTextNode "RDF/XML Syntax Specification (Revised)") + , Triple (unode "http://example.org/buecher/baum") + (unode "dc:title") + (mkTextNode "Der Baum") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +test_simpleSingleton1 :: Assertion +test_simpleSingleton1 = testParse + "\ + \\ + \" + ( mkRdf [ Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (mkTextNode "RDF/XML Syntax Specification (Revised)") ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +test_simpleSingleton2 :: Assertion +test_simpleSingleton2 = testParse + "\ + \\ + \" + ( mkRdf [ Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (mkTextNode "RDF/XML Syntax Specification (Revised)") + , Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:subject") + (mkTextNode "RDF") ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * Document Element and XML Declaration +test_parseXmlRDF_example07 :: Assertion +test_parseXmlRDF_example07 = testParse + "\ + \\ + \\ + \\ + \\ + \\ + \\ + \\ + \" + ( mkRdf [ Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (mkTextNode "RDF/XML Syntax Specification (Revised)") + , Triple (BNodeGen 1) (unode "ex:fullName") (mkTextNode "Dave Beckett") + , Triple (BNodeGen 1) (unode "ex:homePage") (unode "http://purl.org/net/dajobe/") + , Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") (unode "ex:editor") (BNodeGen 1) + ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * Languages: xml:lang +test_parseXmlRDF_example08 :: Assertion +test_parseXmlRDF_example08 = testParse + "\ + \\ + \RDF/XML Syntax Specification (Revised)\ + \RDF/XML Syntax Specification (Revised)\ + \RDF/XML Syntax Specification (Revised)\ + \\ + \\ + \Der Baum\ + \Das Buch ist außergewöhnlich\ + \The Tree\ + \\ + \" + ( mkRdf [ Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (mkTextNode "RDF/XML Syntax Specification (Revised)") + , Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (lnode (plainLL ("RDF/XML Syntax Specification (Revised)") ("en"))) + , Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (lnode (plainLL ("RDF/XML Syntax Specification (Revised)") ("en-US"))) + , Triple (unode "http://example.org/buecher/baum") + (unode "dc:title") + (lnode (plainLL ("Der Baum") ("de"))) + , Triple (unode "http://example.org/buecher/baum") + (unode "dc:description") + (lnode (plainLL ("Das Buch ist außergewöhnlich") ("de"))) + , Triple (unode "http://example.org/buecher/baum") + (unode "dc:title") + (lnode (plainLL ("The Tree") ("en"))) + ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * XML Literals: rdf:parseType="Literal" +test_parseXmlRDF_example09 :: Assertion +test_parseXmlRDF_example09 = testParse + "\ + \\ + \\ + \\ + \\ + \\ + \\ + \" + ( mkRdf [ Triple (unode "http://example.org/item01") + (unode "ex:prop") + (lnode (typedL ("\ + \\ + \\ + \") + ("http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral"))) + ] + Nothing + ( PrefixMappings (Map.fromList [ ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * Typed Literals: rdf:datatype +test_parseXmlRDF_example10 :: Assertion +test_parseXmlRDF_example10 = testParse + "\ + \\ + \123\ + \\ + \" + ( mkRdf [ Triple (unode "http://example.org/item01") + (unode "ex:size") + (lnode (typedL ("123") + ("http://www.w3.org/2001/XMLSchema#int"))) + ] + Nothing + ( PrefixMappings (Map.fromList [ ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * Identifying Blank Nodes: rdf:nodeID +test_parseXmlRDF_example11 :: Assertion +test_parseXmlRDF_example11 = testParse + "\ + \\ + \\ + \\ + \\ + \\ + \\ + \" + ( mkRdf [ Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (mkTextNode "RDF/XML Syntax Specification (Revised)") + , Triple (mkBNode "abc") (unode "ex:fullName") (mkTextNode "Dave Beckett") + , Triple (mkBNode "abc") (unode "ex:homePage") (unode "http://purl.org/net/dajobe/") + , Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "ex:editor") + (mkBNode "abc") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + where mkBNode = BNode + +-- * Omitting Blank Nodes: rdf:parseType="Resource" +test_parseXmlRDF_example12 :: Assertion +test_parseXmlRDF_example12 = testParse + "\ + \\ + \\ + \Dave Beckett\ + \\ + \\ + \\ + \" + ( mkRdf [ Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (mkTextNode "RDF/XML Syntax Specification (Revised)") + , Triple (BNodeGen 1) (unode "ex:fullName") (mkTextNode "Dave Beckett") + , Triple (BNodeGen 1) (unode "ex:homePage") (unode "http://purl.org/net/dajobe/") + , Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "ex:editor") + (BNodeGen 1) + ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * Omitting Nodes: Property Attributes on an empty Property Element +test_parseXmlRDF_example13 :: Assertion +test_parseXmlRDF_example13 = testParse + "\ + \\ + \\ + \\ + \" + ( mkRdf [ Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "dc:title") + (mkTextNode "RDF/XML Syntax Specification (Revised)") + , Triple (BNodeGen 1) + (unode "ex:fullName") + (mkTextNode "Dave Beckett") + , Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar") + (unode "ex:editor") + (BNodeGen 1) + ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * Typed Node Elements +test_parseXmlRDF_example14 :: Assertion +test_parseXmlRDF_example14 = testParse + "\ + \\ + \\ + \A marvelous thing\ + \\ + \" + ( mkRdf [ Triple (unode "http://example.org/thing") + (unode "rdf:type") + (unode "http://example.org/stuff/1.0/Document") + , Triple (unode "http://example.org/thing") + (unode "dc:title") + (mkTextNode "A marvelous thing") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +test_parseXmlRDF_example15 :: Assertion +test_parseXmlRDF_example15 = testParse + "\ + \\ + \A marvelous thing\ + \\ + \" + ( mkRdf [ Triple (unode "http://example.org/thing") + (unode "rdf:type") + (unode "ex:Document") + , Triple (unode "http://example.org/thing") + (unode "dc:title") + (mkTextNode "A marvelous thing") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("dc", "http://purl.org/dc/elements/1.1/") + , ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * Abbreviating URIs: rdf:ID and xml:base +test_parseXmlRDF_example16 :: Assertion +test_parseXmlRDF_example16 = testParse + "\ + \\ + \\ + \\ + \" + ( mkRdf [ Triple (unode "http://example.org/here/#snack") (unode "ex:prop") (unode "http://example.org/here/fruit/apple") ] + Nothing + ( PrefixMappings (Map.fromList [ ("base", "http://example.org/here/") + , ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * Container Membership Property Elements: rdf:li and rdf:_n +test_parseXmlRDF_example17 :: Assertion +test_parseXmlRDF_example17 = testParse + "\ + \\ + \\ + \\ + \\ + \\ + \" + ( mkRdf [ Triple (unode "http://example.org/favourite-fruit") + (unode "rdf:type") + (unode "rdf:Seq") + , Triple (unode "http://example.org/favourite-fruit") + (unode "rdf:_1") + (unode "http://example.org/banana") + , Triple (unode "http://example.org/favourite-fruit") + (unode "rdf:_2") + (unode "http://example.org/apple") + , Triple (unode "http://example.org/favourite-fruit") + (unode "rdf:_3") + (unode "http://example.org/pear") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +test_parseXmlRDF_example18 :: Assertion +test_parseXmlRDF_example18 = testParse + "\ + \\ + \\ + \\ + \\ + \\ + \" + ( mkRdf [ Triple (unode "http://example.org/favourite-fruit") + (unode "rdf:type") + (unode "rdf:Seq") + , Triple (unode "http://example.org/favourite-fruit") + (unode "rdf:_1") + (unode "http://example.org/banana") + , Triple (unode "http://example.org/favourite-fruit") + (unode "rdf:_2") + (unode "http://example.org/apple") + , Triple (unode "http://example.org/favourite-fruit") + (unode "rdf:_3") + (unode "http://example.org/pear") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * Collections: rdf:parseType="Collection" +test_parseXmlRDF_example19 :: Assertion +test_parseXmlRDF_example19 = testParse + "\ + \\ + \\ + \\ + \\ + \\ + \\ + \\ + \" + ( mkRdf [ Triple (unode "http://example.org/basket") (unode "ex:hasFruit") (BNodeGen 1) + , Triple (BNodeGen 1) + (unode "rdf:first") + (unode "http://example.org/banana") + , Triple (BNodeGen 1) + (unode "rdf:rest") + (BNodeGen 2) + , Triple (BNodeGen 2) + (unode "rdf:first") + (unode "http://example.org/apple") + , Triple (BNodeGen 2) + (unode "rdf:rest") + (BNodeGen 3) + , Triple (BNodeGen 3) + (unode "rdf:first") + (unode "http://example.org/pear") + , Triple (BNodeGen 3) + (unode "rdf:rest") + (unode "rdf:nil") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +-- * Reifying Statements: rdf:ID +test_parseXmlRDF_example20 :: Assertion +test_parseXmlRDF_example20 = testParse + "\ + \\ + \blah\ + \\ + \" + ( mkRdf [ Triple (unode "http://example.org/") + (unode "ex:prop") + (mkTextNode "blah") + , Triple (unode "http://example.org/triples/#triple1") + (unode "rdf:type") + (unode "rdf:Statement") + , Triple (unode "http://example.org/triples/#triple1") + (unode "rdf:subject") + (unode "http://example.org/") + , Triple (unode "http://example.org/triples/#triple1") + (unode "rdf:predicate") + (unode "ex:prop") + , Triple (unode "http://example.org/triples/#triple1") + (unode "rdf:object") + (mkTextNode "blah") + ] + ( Just (BaseUrl ("http://example.org/here/")) ) + ( PrefixMappings (Map.fromList [ ("ex", "http://example.org/stuff/1.0/") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +test_parseXmlRDF_vCardPersonal :: Assertion +test_parseXmlRDF_vCardPersonal = testParse + "\ + \\ + \Corky Crystal\ + \Corks\ + \\ + \\ + \+61 7 5555 5555\ + \\ + \\ + \\ + \\ + \\ + \\ + \\ + \111 Lake Drive\ + \WonderCity\ + \5555\ + \Australia\ + \\ + \\ + \\ + \\ + \" + ( mkRdf [ Triple (unode "http://example.com/me/corky") + (unode "rdf:type") + (unode "v:VCard") + , Triple (unode "http://example.com/me/corky") + (unode "v:fn") + (mkTextNode "Corky Crystal") + , Triple (unode "http://example.com/me/corky") + (unode "v:nickname") + (mkTextNode "Corks") + , Triple (unode "http://example.com/me/corky") + (unode "v:tel") + (BNodeGen 1) + , Triple (BNodeGen 1) + (unode "rdf:value") + (mkTextNode "+61 7 5555 5555") + , Triple (BNodeGen 1) + (unode "rdf:type") + (unode "http://www.w3.org/2006/vcard/ns#Home") + , Triple (BNodeGen 1) + (unode "rdf:type") + (unode "http://www.w3.org/2006/vcard/ns#Voice") + , Triple (unode "http://example.com/me/corky") + (unode "v:email") + (unode "mailto:corky@example.com") + , Triple (unode "http://example.com/me/corky") + (unode "v:adr") + (BNodeGen 2) + , Triple (BNodeGen 2) + (unode "v:street-address") + (mkTextNode "111 Lake Drive") + , Triple (BNodeGen 2) + (unode "v:locality") + (mkTextNode "WonderCity") + , Triple (BNodeGen 2) + (unode "v:postal-code") + (mkTextNode "5555") + , Triple (BNodeGen 2) + (unode "v:country-name") + (mkTextNode "Australia") + , Triple (BNodeGen 2) + (unode "rdf:type") + (unode "http://www.w3.org/2006/vcard/ns#Home") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("v", "http://www.w3.org/2006/vcard/ns#") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +test_parseXmlRDF_NML :: Assertion +test_parseXmlRDF_NML = testParse + (T.unlines + ["" + ,"" + ," " + ," " + ," " + ," " + ," " + ," " + ," " + ,"" + ]) + ( mkRdf [ Triple (unode "urn:ogf:network:example.org:2014:foo") + (unode "rdf:type") + (unode "nml:Node") + , Triple (unode "urn:ogf:network:example.org:2014:foo") + (unode "nml:hasInboundPort") + (unode "urn:ogf:network:example.org:2014:foo:A1:in") + , Triple (unode "urn:ogf:network:example.org:2014:foo:A1:in") + (unode "rdf:type") + (unode "nml:Port") + , Triple (unode "urn:ogf:network:example.org:2014:foo:A1:in") + (unode "nml:isSink") + (unode "urn:ogf:network:example.org:2014:link:1") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("nml", "http://schemas.ogf.org/nml/2013/05/base#") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +test_parseXmlRDF_NML2 :: Assertion +test_parseXmlRDF_NML2 = testParse + (T.unlines + ["" + ,"" + ," " + ," " + ," " + ," " + ," " + ," " + ,"" + ]) + ( mkRdf [ Triple (unode "urn:ogf:network:example.org:2014:foo") + (unode "rdf:type") + (unode "nml:Node") + , Triple (unode "urn:ogf:network:example.org:2014:foo") + (unode "nml:hasInboundPort") + (unode "urn:ogf:network:example.org:2014:foo:A1:in") + , Triple (unode "urn:ogf:network:example.org:2014:foo:A1:in") + (unode "rdf:type") + (unode "nml:Port") + , Triple (unode "urn:ogf:network:example.org:2014:foo:A1:in") + (unode "nml:isSink") + (unode "urn:ogf:network:example.org:2014:link:1") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("nml", "http://schemas.ogf.org/nml/2013/05/base#") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) + +test_parseXmlRDF_NML3 :: Assertion +test_parseXmlRDF_NML3 = testParse + "\ + \\ + \ \ + \ \ + \ \ + \ \ + \ \ + \ \ + \" + ( mkRdf [ Triple (unode "urn:ogf:network:example.org:2014:foo") + (unode "rdf:type") + (unode "nml:Node") + , Triple (unode "urn:ogf:network:example.org:2014:foo") + (unode "nml:hasInboundPort") + (unode "urn:ogf:network:example.org:2014:foo:A1:in") + , Triple (unode "urn:ogf:network:example.org:2014:foo:A1:in") + (unode "rdf:type") + (unode "nml:Port") + , Triple (unode "urn:ogf:network:example.org:2014:foo:A1:in") + (unode "nml:isSink") + (unode "urn:ogf:network:example.org:2014:link:1") + ] + Nothing + ( PrefixMappings (Map.fromList [ ("nml", "http://schemas.ogf.org/nml/2013/05/base#") + , ("rdf", "http://www.w3.org/1999/02/22-rdf-syntax-ns#") ]) ) + ) diff --git a/testsuite/tests/W3C/Manifest.hs b/testsuite/tests/W3C/Manifest.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/W3C/Manifest.hs @@ -0,0 +1,304 @@ +module W3C.Manifest ( + loadManifest, + + Manifest(..), + TestEntry(..) +) where + +import Data.RDF.TriplesGraph +import Data.RDF.Query +import Data.RDF.Types +import Data.RDF.Namespace +import Safe +import Text.RDF.RDF4H.TurtleParser + +import qualified Data.Text as T +import qualified Data.List as L (find) +import Data.Maybe (fromJust) + +-- | 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 = unode $ mkUri rdf "type" +rdfsComment = unode $ mkUri rdfs "comment" +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 = do + parseFile testParser (T.unpack manifestPath) >>= return . rdfToManifest . fromEither + where testParser = TurtleParser (Just $ BaseUrl baseIRI) Nothing + +rdfToManifest :: TriplesGraph -> 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 rdfsComment) Nothing + ++ query rdf (Just manifestNode) (Just mfName) Nothing +-- descNode = query rdf (Just manifestNode) (Just mfName) Nothing + tpls = map (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 :: TriplesGraph -> Node -> TestEntry +rdfToTestEntry rdf teSubject = triplesToTestEntry rdf $ query rdf (Just teSubject) Nothing Nothing + +triplesToTestEntry :: TriplesGraph -> 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 -> TriplesGraph -> 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 -> TriplesGraph -> 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 = TestNTriplesPositiveSyntax { + 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 :: TriplesGraph -> [Subject] +manifestSubjectNodes rdf = subjectNodes rdf [mfManifest] + +subjectNodes :: TriplesGraph -> [Object] -> [Subject] +subjectNodes rdf = (map 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: +-- | +-- | +-- | +-- | +-- | +-- | ... it extracts a list of nodes [i1, i2]. +-- | First argument (`rdf`) is the RDF graph; +-- | second argument (`tip`) is the "collection head" ( in the example above), +-- | (all triples with and pairs). +-- TODO: Looks useful. Move it to RDF4H lib? +rdfCollectionToList :: TriplesGraph -> 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 :: TriplesGraph -> 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 :: TriplesGraph -> Node -> Triples +nextCollectionTriples rdf tip@(BNodeGen _) = query rdf (Just tip) Nothing Nothing +nextCollectionTriples _ _ = error "Invalid collection format" diff --git a/testsuite/tests/W3C/NTripleTest.hs b/testsuite/tests/W3C/NTripleTest.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/W3C/NTripleTest.hs @@ -0,0 +1,58 @@ +module W3C.NTripleTest where + +import Data.Maybe (fromJust) +import Test.Framework.Providers.API +import Test.Framework.Providers.HUnit +import qualified Test.HUnit as TU +import qualified Data.Text as T +import System.Directory + +import W3C.Manifest + +import Data.RDF.Types +import Text.RDF.RDF4H.NTriplesParser +import Data.RDF.TriplesGraph + +suiteFilesDir = "data/w3c/n3/" + +mfPath = T.concat [suiteFilesDir, "manifest.ttl"] +mfBaseURI = BaseUrl "http://www.w3.org/2013/N-TriplesTests/" + +tests :: [Test] +tests = [ buildTest allNTripleTests ] + +allNTripleTests :: IO Test +allNTripleTests = do + dir <- getCurrentDirectory + let fileSchemeURI = T.pack ("file://" ++ dir ++ "/" ++ T.unpack suiteFilesDir) + m <- loadManifest mfPath fileSchemeURI + return $ testGroup (T.unpack $ description m) $ map (buildTest . mfEntryToTest) $ entries m + +-- 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 :: TestEntry -> IO Test +mfEntryToTest (TestNTriplesPositiveSyntax nm _ _ act') = do + let act = (UNode . fromJust . fileSchemeToFilePath) act' + rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph) + return $ testCase (T.unpack nm) $ TU.assert $ isParsed rdf +mfEntryToTest (TestNTriplesNegativeSyntax nm _ _ act') = do + let act = (UNode . fromJust . fileSchemeToFilePath) act' + rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph) + return $ testCase (T.unpack nm) $ TU.assert $ isNotParsed rdf +mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x + +isParsed :: Either a b -> Bool +isParsed (Left _) = False +isParsed (Right _) = True + +isNotParsed :: Either a b -> Bool +isNotParsed = not . isParsed + +nodeURI :: Node -> String +nodeURI = \(UNode u) -> T.unpack u + +testParser :: NTriplesParser +testParser = NTriplesParser diff --git a/testsuite/tests/W3C/RdfXmlTest.hs b/testsuite/tests/W3C/RdfXmlTest.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/W3C/RdfXmlTest.hs @@ -0,0 +1,62 @@ +module W3C.RdfXmlTest where + +import Data.Maybe (fromJust) +import Test.Framework.Providers.API +import Test.Framework.Providers.HUnit +import qualified Test.HUnit as TU +import qualified Data.Text as T +import System.Directory + +import W3C.Manifest + +import Data.RDF.Types +import Data.RDF.Query +import Text.RDF.RDF4H.XmlParser +import Text.RDF.RDF4H.NTriplesParser +import Data.RDF.TriplesGraph + +suiteFilesDir = "data/w3c/rdf-xml/" + +mfPath = T.concat [suiteFilesDir, "manifest.ttl"] +mfBaseURI = BaseUrl "http://www.w3.org/2013/RDFXMLTests/" + +tests :: [Test] +tests = [ buildTest allRdfXmlTests ] + +allRdfXmlTests :: IO Test +allRdfXmlTests = do + dir <- getCurrentDirectory + let fileSchemeURI = T.pack ("file://" ++ dir ++ "/" ++ T.unpack suiteFilesDir) + m <- loadManifest mfPath fileSchemeURI + return $ testGroup (T.unpack $ description m) $ map (buildTest . mfEntryToTest) $ entries m + +-- 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 :: TestEntry -> IO Test +mfEntryToTest (TestXMLEval nm _ _ act' res') = do + let act = (UNode . fromJust . fileSchemeToFilePath) act' + let res = (UNode . fromJust . fileSchemeToFilePath) res' + parsedRDF <- parseFile testParser (nodeURI act) >>= return . fromEither :: IO TriplesGraph + expectedRDF <- parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO TriplesGraph + return $ testCase (T.unpack nm) $ TU.assert $ isIsomorphic parsedRDF expectedRDF +mfEntryToTest (TestXMLNegativeSyntax nm _ _ act') = do + let act = (UNode . fromJust . fileSchemeToFilePath) act' + rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph) + return $ testCase (T.unpack nm) $ TU.assert $ isNotParsed rdf +mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x + +isParsed :: Either a b -> Bool +isParsed (Left _) = False +isParsed (Right _) = True + +isNotParsed :: Either a b -> Bool +isNotParsed = not . isParsed + +nodeURI :: Node -> String +nodeURI = \(UNode u) -> T.unpack u + +testParser :: XmlParser +testParser = XmlParser (Just mfBaseURI) Nothing