Turtle quickcheck -- DO NOT MERGE!

rdf4h.cabal

@@ -105,6 +105,7 @@ test-suite test-rdf4h
   other-modules: Data.RDF.PropertyTests
                  Data.RDF.GraphImplTests
                  Data.RDF.IRITests
+                 Text.RDF.RDF4H.QuickCheck
                  Text.RDF.RDF4H.TurtleSerializerTest
                  Text.RDF.RDF4H.TurtleParser_ConformanceTest
                  Text.RDF.RDF4H.XmlParser_Test

testsuite/tests/Data/RDF/PropertyTests.hs

@@ -5,24 +5,22 @@
 
 module Data.RDF.PropertyTests (graphTests) where
 
-import qualified Data.Text.IO as T
-import Data.RDF hiding (empty)
-import Data.RDF.Namespace hiding (rdf)
-import qualified Data.Text as T
-import Test.QuickCheck
-import Data.List
-import Data.Semigroup ((<>))
+import           Control.Exception (bracket)
+import           Data.List
+import           Data.RDF hiding (empty)
+import           Data.RDF.Namespace hiding (rdf)
+import           Data.Semigroup ((<>))
 import qualified Data.Set as Set
-import qualified Data.Map as Map
-import Control.Monad
-import Control.Exception (bracket)
-import GHC.Generics ()
-import System.Directory (removeFile)
-import System.IO
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import           GHC.Generics ()
+import           System.Directory (removeFile)
+import           System.IO
+import           Text.RDF.RDF4H.QuickCheck
 
-import Test.Tasty
-import Test.Tasty.QuickCheck
-import Test.QuickCheck.Monadic (assert, monadicIO,run)
+import           Test.Tasty
+import           Test.Tasty.QuickCheck
+import           Test.QuickCheck.Monadic (assert, monadicIO,run)
 
 ----------------------------------------------------
 --  property based quick check test cases         --
@@ -80,50 +78,39 @@ graphTests testGroupName empty _mkRdf =
         (p_add_then_remove_triples empty)
     ]
 
-newtype SingletonGraph rdf = SingletonGraph
-  { rdfGraph :: (RDF rdf)
-  }
-
-instance (Rdf rdf) =>
-         Arbitrary (SingletonGraph rdf) where
-  arbitrary = do
-    pref <- arbitraryPrefixMappings
-    baseU' <- arbitraryBaseUrl
-    baseU <- oneof [return (Just baseU'), return Nothing]
-    t <- liftM3 triple arbitraryS arbitraryP arbitraryO
-    return SingletonGraph {rdfGraph = (mkRdf [t] baseU pref)}
-
-instance (Rdf rdf) =>
-         Show (SingletonGraph rdf) where
-  show singletonGraph = showGraph (rdfGraph singletonGraph)
-
-instance Arbitrary BaseUrl where
-  arbitrary = arbitraryBaseUrl
-
-instance Arbitrary PrefixMappings where
-  arbitrary = arbitraryPrefixMappings
-
-arbitraryBaseUrl :: Gen BaseUrl
-arbitraryBaseUrl =
-  oneof $
-  fmap
-    (return . BaseUrl . T.pack)
-    ["http://example.org/", "http://example.com/a", "http://asdf.org/b", "http://asdf.org/c"]
-
-arbitraryPrefixMappings :: Gen PrefixMappings
-arbitraryPrefixMappings =
-  oneof
-    [ return $ PrefixMappings Map.empty
-    , return $
-      PrefixMappings $
-      Map.fromAscList
-        [ (T.pack "ex", T.pack "ex:")
-        , (T.pack "eg1", T.pack "http://example.org/1")
-        , (T.pack "eg2", T.pack "http://example.org/2")
-        , (T.pack "eg3", T.pack "http://example.org/3")
-        ]
-    ]
+----------------------------------------------------
+--  Unit test cases                               --
+----------------------------------------------------
 
+-- Reported by Daniel Bergey:
+--   https://github.com/robstewart57/rdf4h/issues/4
+
+p_reverseRdfTest
+  :: Rdf a
+  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF a) -> Property
+p_reverseRdfTest _mkRdf =
+  monadicIO $ do
+    fileContents <- Test.QuickCheck.Monadic.run $ bracket
+      (openTempFile "." "tmp")
+      (\(path, h) -> hClose h >> removeFile path)
+      (\(_, h) -> do
+        hSetEncoding h utf8
+        hWriteRdf NTriplesSerializer h rdf
+        hSeek h AbsoluteSeek 0
+        T.hGetContents h)
+    assert $ expected == fileContents
+  where
+    rdf = _mkRdf ts (Just $ BaseUrl "file://") (ns_mappings mempty)
+    ts :: [Triple]
+    ts =
+      [ Triple
+          (unode "file:///this/is/not/a/palindrome")
+          (unode "file:///this/is/not/a/palindrome")
+          (LNode . PlainL $ "literal string")
+      ]
+    expected = "<file:///this/is/not/a/palindrome> \
+               \<file:///this/is/not/a/palindrome> \
+               \\"literal string\" .\n"
 
 -- Test stubs, which just require the appropriate RDF impl function
 -- passed in to determine the implementation to be tested.
@@ -556,98 +543,3 @@ queryT
   => 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 = fmap (mkUri xsd . T.pack) ["string", "int", "token"]
-
-uris :: [T.Text]
-uris =  [mkUri ex (n <> T.pack (show (i :: Int)))
-        | n <- ["foo", "bar", "quz", "zak"], i <- [0 .. 2]]
-     <> ["ex:" <> n <> T.pack (show (i::Int))
-        | n <- ["s", "p", "o"], i <- [1..3]]
-
-plainliterals :: [LValue]
-plainliterals = [plainLL lit lang | lit <- litvalues, lang <- languages]
-
-typedliterals :: [LValue]
-typedliterals = [typedL lit dtype | lit <- litvalues, dtype <- datatypes]
-
-litvalues :: [T.Text]
-litvalues = fmap T.pack ["hello", "world", "peace", "earth", "", "haskell"]
-
-unodes :: [Node]
-unodes = fmap UNode uris
-
-bnodes :: [ Node]
-bnodes = fmap (BNode . \i -> T.pack ":_genid" <> T.pack (show (i::Int))) [1..5]
-
-lnodes :: [Node]
-lnodes = [LNode lit | lit <- plainliterals <> typedliterals]
-
--- maximum number of triples
-maxN :: Int
-maxN = 10
-
-instance (Rdf rdf) => Arbitrary (RDF rdf) where
-  arbitrary = do
-    prefix <- arbitraryPrefixMappings
-    baseU' <- arbitraryBaseUrl
-    baseU <- oneof [return (Just baseU'), return Nothing]
-    ts <- arbitraryTs
-    return $ mkRdf ts baseU prefix
-
-instance Arbitrary Triple where
-  arbitrary = do
-    s <- arbitraryS
-    p <- arbitraryP
-    triple s p <$> arbitraryO
-
-instance Arbitrary Node where
-  arbitrary = oneof $ fmap return unodes
-
-arbitraryTs :: Gen Triples
-arbitraryTs = do
-  n <- sized (\_ -> choose (0, maxN))
-  sequence [arbitrary | _ <- [1 .. n]]
-
-arbitraryS, arbitraryP, arbitraryO :: Gen Node
-arbitraryS = oneof $ fmap return $ unodes <> bnodes
-arbitraryP = oneof $ fmap return unodes
-arbitraryO = oneof $ fmap return $ unodes <> bnodes <> lnodes
-
-----------------------------------------------------
---  Unit test cases                               --
-----------------------------------------------------
-
--- Reported by Daniel Bergey:
---   https://github.com/robstewart57/rdf4h/issues/4
-
-p_reverseRdfTest
-  :: Rdf a
-  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF a) -> Property
-p_reverseRdfTest _mkRdf =
-  monadicIO $ do
-    fileContents <- Test.QuickCheck.Monadic.run $ bracket
-      (openTempFile "." "tmp")
-      (\(path, h) -> hClose h >> removeFile path)
-      (\(_, h) -> do
-        hSetEncoding h utf8
-        hWriteRdf NTriplesSerializer h rdf
-        hSeek h AbsoluteSeek 0
-        T.hGetContents h)
-    assert $ expected == fileContents
-  where
-    rdf = _mkRdf ts (Just $ BaseUrl "file://") (ns_mappings mempty)
-    ts :: [Triple]
-    ts =
-      [ Triple
-          (unode "file:///this/is/not/a/palindrome")
-          (unode "file:///this/is/not/a/palindrome")
-          (LNode . PlainL $ "literal string")
-      ]
-    expected = "<file:///this/is/not/a/palindrome> \
-               \<file:///this/is/not/a/palindrome> \
-               \\"literal string\" .\n"

testsuite/tests/Text/RDF/RDF4H/QuickCheck.hs

@@ -0,0 +1,115 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Text.RDF.RDF4H.QuickCheck where
+
+import           Control.Monad
+import qualified Data.Map as Map
+import           Data.RDF hiding (empty)
+import qualified Data.Text as T
+import           Test.QuickCheck
+
+newtype SingletonGraph rdf = SingletonGraph
+  { rdfGraph :: (RDF rdf)
+  }
+
+instance (Rdf rdf) =>
+         Arbitrary (SingletonGraph rdf) where
+  arbitrary = do
+    pref <- arbitraryPrefixMappings
+    baseU' <- arbitraryBaseUrl
+    baseU <- oneof [return (Just baseU'), return Nothing]
+    t <- liftM3 triple arbitraryS arbitraryP arbitraryO
+    return SingletonGraph {rdfGraph = (mkRdf [t] baseU pref)}
+
+instance (Rdf rdf) =>
+         Show (SingletonGraph rdf) where
+  show singletonGraph = showGraph (rdfGraph singletonGraph)
+
+instance Arbitrary BaseUrl where
+  arbitrary = arbitraryBaseUrl
+
+instance Arbitrary PrefixMappings where
+  arbitrary = arbitraryPrefixMappings
+
+arbitraryBaseUrl :: Gen BaseUrl
+arbitraryBaseUrl =
+  oneof $
+  fmap
+    (return . BaseUrl . T.pack)
+    ["http://example.org/", "http://example.com/a", "http://asdf.org/b", "http://asdf.org/c"]
+
+arbitraryPrefixMappings :: Gen PrefixMappings
+arbitraryPrefixMappings =
+  oneof
+    [ return $ PrefixMappings Map.empty
+    , return $
+      PrefixMappings $
+      Map.fromAscList
+        [ (T.pack "ex", T.pack "ex:")
+        , (T.pack "eg1", T.pack "http://example.org/1")
+        , (T.pack "eg2", T.pack "http://example.org/2")
+        , (T.pack "eg3", T.pack "http://example.org/3")
+        ]
+    ]
+
+languages :: [T.Text]
+languages = [T.pack "fr", T.pack "en"]
+
+datatypes :: [T.Text]
+datatypes = fmap (mkUri xsd . T.pack) ["string", "int", "token"]
+
+uris :: T.Text -> [T.Text]
+uris type' =
+  [mkUri ex (type' <> "/" <> n <> T.pack (show (i :: Int))) | n <- ["foo", "bar", "quz", "zak"], i <- [0 .. 2]]
+
+plainliterals :: [LValue]
+plainliterals = [plainLL lit lang | lit <- litvalues, lang <- languages]
+
+typedliterals :: [LValue]
+typedliterals = [typedL lit dtype | lit <- litvalues, dtype <- datatypes]
+
+litvalues :: [T.Text]
+litvalues = fmap T.pack ["hello", "world", "peace", "earth", "", "haskell"]
+
+unodes :: T.Text -> [Node]
+unodes type' = fmap UNode (uris type')
+
+bnodes :: T.Text -> [Node]
+bnodes type' = [BNode (":_" <> type' <>  "-genid" <> T.pack (show (i::Int))) | i <- [1..5]]
+
+lnodes :: [Node]
+lnodes = [LNode lit | lit <- plainliterals <> typedliterals]
+
+-- maximum number of triples
+maxN :: Int
+maxN = 10
+
+instance (Rdf rdf) => Arbitrary (RDF rdf) where
+  arbitrary = do
+    prefix <- arbitraryPrefixMappings
+    baseU' <- arbitraryBaseUrl
+    baseU <- oneof [return (Just baseU'), return Nothing]
+    ts <- arbitraryTs
+    return $ mkRdf ts baseU prefix
+
+instance Arbitrary Triple where
+  arbitrary = do
+    s <- arbitraryS
+    p <- arbitraryP
+    triple s p <$> arbitraryO
+
+instance Arbitrary Node where
+  arbitrary = do
+    type' <- elements ["sub", "pred", "obj"]
+    --let typeText = T.pack type'
+    oneof $ fmap return (unodes type')
+
+arbitraryTs :: Gen Triples
+arbitraryTs = do
+  n <- sized (\_ -> choose (0, maxN))
+  sequence [arbitrary | _ <- [1 .. n]]
+
+arbitraryS, arbitraryP, arbitraryO :: Gen Node
+arbitraryS = oneof $ fmap return $ (unodes "sub") <> (bnodes "sub")
+arbitraryP = oneof $ fmap return (unodes "pred")
+arbitraryO = oneof $ fmap return $ (unodes "obj") <> (bnodes "obj") <> lnodes