rdf4h-1.3.6: testsuite/tests/Data/RDF/GraphTestUtils.hs
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","http://asdf.org/c"]
--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"),
(T.pack "eg3", T.pack "http://example.com/3")]]
--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 = "<file:///this/is/not/a/palindrome> <file:///this/is/not/a/palindrome> \"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")]