diff --git a/bench/MainCriterion.hs b/bench/MainCriterion.hs --- a/bench/MainCriterion.hs +++ b/bench/MainCriterion.hs @@ -9,70 +9,66 @@ -- The `bills.102.rdf` XML file is needed to run this benchmark suite -- --- $ wget https://www.govtrack.us/data/rdf/bills.102.rdf.gz --- $ gzip -d bills.102.rdf.gz - -parseTurtle :: RDF rdf => String -> rdf -parseTurtle s = - let (Right rdf) = parseString (TurtleParser Nothing Nothing) (T.pack s) - in rdf +-- $ wget https://www.govtrack.us/data/rdf/bills.099.actions.rdf.gz +-- $ gzip -d bills.099.actions.rdf.gz -queryGr :: RDF rdf => (Maybe Node,Maybe Node,Maybe Node,rdf) -> [Triple] +parseXmlRDF :: Rdf a => String -> RDF a +parseXmlRDF s = + let (Right rdf) = parseString (XmlParser Nothing Nothing) (T.pack s) + in rdf + +queryGr :: Rdf a => (Maybe Node,Maybe Node,Maybe Node,RDF a) -> [Triple] queryGr (maybeS,maybeP,maybeO,rdf) = query rdf maybeS maybeP maybeO -selectGr :: RDF rdf => (NodeSelector,NodeSelector,NodeSelector,rdf) -> [Triple] +selectGr :: Rdf a => (NodeSelector,NodeSelector,NodeSelector,RDF a) -> [Triple] selectGr (selectorS,selectorP,selectorO,rdf) = select rdf selectorS selectorP selectorO main :: IO () main = defaultMain [ - env (readFile "bills.102.ttl") $ \ ~(ttl_countries) -> - bgroup "parse" [ - bench "HashMapS" $ - nf (parseTurtle :: String -> HashMapS) ttl_countries - , bench "HashMapSP" $ - nf (parseTurtle :: String -> HashMapSP) ttl_countries - , bench "MapSP" $ - nf (parseTurtle :: String -> MapSP) ttl_countries - , bench "TriplesList" $ - nf (parseTurtle :: String -> TriplesList) ttl_countries - , bench "ListPatriciaTree" $ - nf (parseTurtle :: String -> TriplesPatriciaTree) ttl_countries - ] + -- env (readFile "bills.102.rdf") $ \ ~(ttl_countries) -> + -- bgroup "parse" [ + -- bench "HashS" $ + -- nf (parseXmlRDF :: String -> RDF HashS) ttl_countries + -- , bench "HashSP" $ + -- nf (parseXmlRDF :: String -> RDF HashSP) ttl_countries + -- , bench "SP" $ + -- nf (parseXmlRDF :: String -> RDF SP) ttl_countries + -- , bench "TList" $ + -- nf (parseXmlRDF :: String -> RDF TList) ttl_countries + -- , bench "TPatriciaTree" $ + -- nf (parseXmlRDF :: String -> RDF TPatriciaTree) ttl_countries + -- ] - , - env (do ttl_countries <- readFile "bills.102.ttl" - let (Right rdf1) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries) - let (Right rdf2) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries) - let (Right rdf3) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries) - let (Right rdf4) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries) - let (Right rdf5) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries) - return (rdf1 :: TriplesPatriciaTree,rdf2 :: TriplesList,rdf3 :: HashMapS,rdf4 :: MapSP,rdf5::HashMapSP) ) - $ \ ~(triplesPatriciaTree,triplesList,hashMapS,mapSP,hashMapSP) -> + -- , + env (do ttl_countries <- readFile "bills.099.actions.rdf" + let (Right rdf1) = parseString (XmlParser Nothing Nothing) (T.pack ttl_countries) + let (Right rdf2) = parseString (XmlParser Nothing Nothing) (T.pack ttl_countries) + let (Right rdf3) = parseString (XmlParser Nothing Nothing) (T.pack ttl_countries) + let (Right rdf4) = parseString (XmlParser Nothing Nothing) (T.pack ttl_countries) + return (rdf1 :: RDF TList,rdf2 :: RDF HashS,rdf3 :: RDF SP,rdf4::RDF HashSP) ) + $ \ ~(triplesList,hashMapS,mapSP,hashMapSP) -> bgroup "query" - (queryBench "TriplesList" triplesList - ++ queryBench "HashMapS" hashMapS - ++ queryBench "MapSP" mapSP - ++ queryBench "HashMapSP" hashMapSP - ++ queryBench "TriplesPatriciaTree" triplesPatriciaTree) + (queryBench "TList" triplesList + ++ queryBench "HashS" hashMapS + ++ queryBench "SP" mapSP + ++ queryBench "HashSP" hashMapSP) , - env (do ttl_countries <- readFile "bills.102.ttl" - let (Right rdf1) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries) - let (Right rdf2) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries) - let (Right rdf3) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries) - let (Right rdf4) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries) - let (Right rdf5) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries) - return (rdf1 :: TriplesPatriciaTree,rdf2 :: TriplesList,rdf3 :: HashMapS,rdf4 :: MapSP,rdf5 :: HashMapSP) ) - $ \ ~(triplesPatriciaTree,triplesList,hashMapS,mapSP,hashMapSP) -> + env (do ttl_countries <- readFile "bills.099.actions.rdf" + let (Right rdf1) = parseString (XmlParser Nothing Nothing) (T.pack ttl_countries) + let (Right rdf2) = parseString (XmlParser Nothing Nothing) (T.pack ttl_countries) + let (Right rdf3) = parseString (XmlParser Nothing Nothing) (T.pack ttl_countries) + let (Right rdf4) = parseString (XmlParser Nothing Nothing) (T.pack ttl_countries) + return (rdf1 :: RDF TList,rdf2 :: RDF HashS,rdf3 :: RDF SP,rdf4 :: RDF HashSP) ) + $ \ ~(triplesList,hashMapS,mapSP,hashMapSP) -> bgroup "select" - (selectBench "TriplesList" triplesList - ++ selectBench "HashMapS" hashMapS - ++ selectBench "MapSP" mapSP - ++ selectBench "HashMapSP" hashMapSP - ++ selectBench "TriplesPatriciaTree" triplesPatriciaTree) + (selectBench "TList" triplesList + ++ selectBench "HashS" hashMapS + ++ selectBench "SP" mapSP + ++ selectBench "HashSP" hashMapSP) ] -selectBench :: forall rdf. RDF rdf => String -> rdf -> [Benchmark] +selectBench :: Rdf a => String -> RDF a -> [Benchmark] selectBench label gr = [ bench (label ++ " SPO") $ nf selectGr (subjSelect,predSelect,objSelect,gr) , bench (label ++ " SP") $ nf selectGr (subjSelect,predSelect,selectNothing,gr) @@ -90,12 +86,12 @@ selectNothing = Nothing subjQuery, predQuery, objQuery, queryNothing :: Maybe Node -subjQuery = Just (UNode "http://www.rdfabout.com/rdf/usgov/congress/102/bills/h5694") -predQuery = Just (UNode "bill:congress") -objQuery = Just (LNode (PlainL (T.pack "102"))) +subjQuery = Just (UNode "http://www.rdfabout.com/rdf/usgov/congress/99/bills/h4") +predQuery = Just (UNode "bill:hadAction") +objQuery = Just (BNodeGen 1) queryNothing = Nothing -queryBench :: forall rdf. RDF rdf => String -> rdf -> [Benchmark] +queryBench :: Rdf a => String -> RDF a -> [Benchmark] queryBench label gr = [ bench (label ++ " SPO") $ nf queryGr (subjQuery,predQuery,objQuery,gr) , bench (label ++ " SP") $ nf queryGr (subjQuery,predQuery,queryNothing,gr) diff --git a/examples/ESWC.hs b/examples/ESWC.hs new file mode 100644 --- /dev/null +++ b/examples/ESWC.hs @@ -0,0 +1,35 @@ + +module Main where + +import Data.RDF +import qualified Data.Text as T + +eswcCommitteeURI, heldByProp :: T.Text +eswcCommitteeURI = "http://data.semanticweb.org/conference/eswc/2015/program-committee-member" +heldByProp = "swc:heldBy" + +-- | returns a list of full names of people who served as +-- members on the ESWC 2015 conference programme committee. +eswcCommitteeMembers :: RDF TList -> [T.Text] +eswcCommitteeMembers graph = + let triples = query graph (Just (unode eswcCommitteeURI)) (Just (unode heldByProp)) Nothing + memberURIs = map objectOf triples + in map + (\memberURI -> + let (LNode (PlainL (firstName::T.Text))) = + objectOf $ head $ query graph (Just memberURI) (Just (unode "foaf:firstName")) Nothing + (LNode (PlainL lastName)) = + objectOf $ head $ query graph (Just memberURI) (Just (unode "foaf:lastName")) Nothing + in (T.append firstName (T.append (T.pack " ") lastName))) + memberURIs + +main :: IO () +main = do + result <- parseURL + (XmlParser Nothing Nothing) + "http://data.semanticweb.org/dumps/conferences/eswc-2015-complete.rdf" + case result of + Left err -> error "Unable to parse RDF content from that URL" + Right rdfGraph -> do + let eswcMemberNames = eswcCommitteeMembers rdfGraph + mapM_ (putStrLn . T.unpack) eswcMemberNames diff --git a/rdf4h.cabal b/rdf4h.cabal --- a/rdf4h.cabal +++ b/rdf4h.cabal @@ -1,5 +1,5 @@ name: rdf4h -version: 2.0.0 +version: 3.0.0 synopsis: A library for RDF processing in Haskell description: 'RDF for Haskell' is a library for working with RDF in Haskell. @@ -19,9 +19,10 @@ build-type: Simple category: RDF stability: Experimental -tested-with: GHC==7.6.3, GHC==7.8.3, GHC==7.10.2 +tested-with: GHC==7.10.2, GHC==8.0.2 extra-tmp-files: test extra-source-files: examples/ParseURLs.hs + , examples/ESWC.hs flag network-uri description: Get Network.URI from the network-uri package @@ -35,8 +36,9 @@ , Data.RDF.Graph.HashMapS , Data.RDF.Graph.HashMapSP , Data.RDF.Graph.MapSP - , Data.RDF.Graph.TriplesPatriciaTree - , Data.RDF.Graph.TriplesList + -- this is very slow + -- , Data.RDF.Graph.TPatriciaTree + , Data.RDF.Graph.TList , Text.RDF.RDF4H.TurtleParser , Text.RDF.RDF4H.TurtleSerializer , Text.RDF.RDF4H.NTriplesParser @@ -47,7 +49,9 @@ , directory , containers , parsec >= 3 - , fgl >= 5.5.2.0 + -- was needed for the patricia tree RDF implementation, + -- which was too slow. + -- , fgl >= 5.5.2.0 , HTTP >= 4000.0.0 , hxt >= 9.3.1.2 , text >= 1.2.1.0 @@ -94,11 +98,11 @@ type: exitcode-stdio-1.0 main-is: Test.hs other-modules: Data.RDF.GraphTestUtils - Data.RDF.Graph.HashMapS_Test - Data.RDF.Graph.HashMapSP_Test - Data.RDF.Graph.MapSP_Test - Data.RDF.Graph.TriplesPatriciaTree_Test - Data.RDF.Graph.TriplesList_Test + Data.RDF.Graph.HashS_Test + Data.RDF.Graph.HashSP_Test + Data.RDF.Graph.SP_Test + -- Data.RDF.Graph.TriplesPatriciaTree_Test + Data.RDF.Graph.TList_Test Text.RDF.RDF4H.TurtleParser_ConformanceTest Text.RDF.RDF4H.XmlParser_Test W3C.Manifest diff --git a/src/Data/RDF.hs b/src/Data/RDF.hs --- a/src/Data/RDF.hs +++ b/src/Data/RDF.hs @@ -3,7 +3,7 @@ module Data.RDF ( - RDF(..), + Rdf(..), RdfSerializer(..), RdfParser(..), @@ -12,11 +12,10 @@ module Data.RDF.Query, -- * RDF type class instances - module Data.RDF.Graph.TriplesList, + module Data.RDF.Graph.TList, module Data.RDF.Graph.HashMapS, module Data.RDF.Graph.HashMapSP, module Data.RDF.Graph.MapSP, - module Data.RDF.Graph.TriplesPatriciaTree, -- * RDF parsers and serializers module Text.RDF.RDF4H.NTriplesSerializer, @@ -28,11 +27,10 @@ where import Data.RDF.Namespace -import Data.RDF.Graph.TriplesList +import Data.RDF.Graph.TList import Data.RDF.Graph.HashMapS import Data.RDF.Graph.HashMapSP import Data.RDF.Graph.MapSP -import Data.RDF.Graph.TriplesPatriciaTree import Text.RDF.RDF4H.NTriplesSerializer import Text.RDF.RDF4H.TurtleSerializer import Text.RDF.RDF4H.NTriplesParser diff --git a/src/Data/RDF/Graph/HashMapS.hs b/src/Data/RDF/Graph/HashMapS.hs --- a/src/Data/RDF/Graph/HashMapS.hs +++ b/src/Data/RDF/Graph/HashMapS.hs @@ -1,8 +1,15 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE EmptyDataDecls #-} + -- |A graph implementation mapping hashed S to a mapping of -- hashed P to hashed O, backed by 'Data.HashMap'. -module Data.RDF.Graph.HashMapS (HashMapS) where +module Data.RDF.Graph.HashMapS (HashS) where import Prelude hiding (pred) import Control.DeepSeq (NFData) @@ -16,6 +23,8 @@ import Data.HashSet(HashSet) import qualified Data.HashSet as Set import Data.List +import GHC.Generics +import Data.Binary (Binary) -- |A map-based graph implementation. -- @@ -64,10 +73,18 @@ -- * 'select' : O(n) -- -- * 'query' : O(log n) -newtype HashMapS = HashMapS (TMaps, Maybe BaseUrl, PrefixMappings) - deriving (NFData) +-- newtype HashS = HashS (TMaps, Maybe BaseUrl, PrefixMappings) +-- deriving (NFData) -instance RDF HashMapS where +data HashS deriving (Generic) + +instance Binary HashS +instance NFData HashS + +data instance RDF HashS = HashS (TMaps, Maybe BaseUrl, PrefixMappings) + deriving (NFData,Generic) + +instance Rdf HashS where baseUrl = baseUrl' prefixMappings = prefixMappings' addPrefixMappings = addPrefixMappings' @@ -77,10 +94,23 @@ uniqTriplesOf = uniqTriplesOf' select = select' query = query' + showGraph = showGraph' -instance Show HashMapS where - show gr = concatMap (\t -> show t ++ "\n") (triplesOf gr) +-- instance Show (HashS) where +-- show (HashS ((spoMap, _), _, _)) = +-- let ts = concatMap (uncurry tripsSubj) subjPredMaps +-- where subjPredMaps = HashMap.toList spoMap +-- in concatMap (\t -> show t ++ "\n") ts +showGraph' :: RDF HashS -> [Char] +showGraph' ((HashS ((spoMap, _), _, _))) = + let ts = concatMap (uncurry tripsSubj) subjPredMaps + where subjPredMaps = HashMap.toList spoMap + in concatMap (\t -> show t ++ "\n") ts + +-- instance Show (RDF HashS) where +-- show gr = concatMap (\t -> show t ++ "\n") (triplesOf gr) + -- some convenience type alias for readability -- An adjacency map for a subject, mapping from a predicate node to @@ -93,22 +123,22 @@ type TMaps = (TMap, TMap) -baseUrl' :: HashMapS -> Maybe BaseUrl -baseUrl' (HashMapS (_, baseURL, _)) = baseURL +baseUrl' :: RDF HashS -> Maybe BaseUrl +baseUrl' (HashS (_, baseURL, _)) = baseURL -prefixMappings' :: HashMapS -> PrefixMappings -prefixMappings' (HashMapS (_, _, pms)) = pms +prefixMappings' :: RDF HashS -> PrefixMappings +prefixMappings' (HashS (_, _, pms)) = pms -addPrefixMappings' :: HashMapS -> PrefixMappings -> Bool -> HashMapS -addPrefixMappings' (HashMapS (ts, baseURL, pms)) pms' replace = +addPrefixMappings' :: RDF HashS -> PrefixMappings -> Bool -> RDF HashS +addPrefixMappings' (HashS (ts, baseURL, pms)) pms' replace = let merge = if replace then flip mergePrefixMappings else mergePrefixMappings - in HashMapS (ts, baseURL, merge pms pms') + in HashS (ts, baseURL, merge pms pms') -empty' :: HashMapS -empty' = HashMapS ((HashMap.empty, HashMap.empty), Nothing, PrefixMappings Map.empty) +empty' :: RDF HashS +empty' = HashS ((HashMap.empty, HashMap.empty), Nothing, PrefixMappings Map.empty) -mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> HashMapS -mkRdf' ts baseURL pms = HashMapS (mergeTs (HashMap.empty, HashMap.empty) ts, baseURL, pms) +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF HashS +mkRdf' ts baseURL pms = HashS (mergeTs (HashMap.empty, HashMap.empty) ts, baseURL, pms) mergeTs :: TMaps -> [Triple] -> TMaps mergeTs = foldl' mergeT @@ -137,12 +167,12 @@ get = HashMap.lookupDefault Set.empty -- 3 following functions support triplesOf -triplesOf' :: HashMapS -> Triples -triplesOf' (HashMapS ((spoMap, _), _, _)) = concatMap (uncurry tripsSubj) subjPredMaps +triplesOf' :: RDF HashS -> Triples +triplesOf' (HashS ((spoMap, _), _, _)) = concatMap (uncurry tripsSubj) subjPredMaps where subjPredMaps = HashMap.toList spoMap -- naive implementation for now -uniqTriplesOf' :: HashMapS -> Triples +uniqTriplesOf' :: RDF HashS -> Triples uniqTriplesOf' = nub . expandTriples tripsSubj :: Subject -> AdjacencyMap -> Triples @@ -153,8 +183,8 @@ tripsForSubjPred s p adjs = map (Triple s p) (Set.toList adjs) -- supports select -select' :: HashMapS -> NodeSelector -> NodeSelector -> NodeSelector -> Triples -select' (HashMapS ((spoMap,_),_,_)) subjFn predFn objFn = +select' :: RDF HashS -> NodeSelector -> NodeSelector -> NodeSelector -> Triples +select' (HashS ((spoMap,_),_,_)) subjFn predFn objFn = map (\(s,p,o) -> Triple s p o) $ Set.toList $ sel1 subjFn predFn objFn spoMap sel1 :: NodeSelector -> NodeSelector -> NodeSelector -> TMap -> HashSet (Node, Node, Node) @@ -182,8 +212,8 @@ sel3 Nothing (p, os) = Set.map (\o -> (p, o)) os -- support query -query' :: HashMapS -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples -query' (HashMapS (m,_ , _)) subj pred obj = map f $ Set.toList $ q1 subj pred obj m +query' :: RDF HashS -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples +query' (HashS (m,_ , _)) subj pred obj = map f $ Set.toList $ q1 subj pred obj m where f (s, p, o) = Triple s p o q1 :: Maybe Node -> Maybe Node -> Maybe Node -> TMaps -> HashSet (Node, Node, Node) diff --git a/src/Data/RDF/Graph/HashMapSP.hs b/src/Data/RDF/Graph/HashMapSP.hs --- a/src/Data/RDF/Graph/HashMapSP.hs +++ b/src/Data/RDF/Graph/HashMapSP.hs @@ -1,7 +1,14 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE EmptyDataDecls #-} + -- |A graph implementation mapping (S,P) pairs to O, backed by 'Data.Map'. -module Data.RDF.Graph.HashMapSP (HashMapSP) where +module Data.RDF.Graph.HashMapSP (HashSP) where import Prelude hiding (pred) import Control.DeepSeq (NFData) @@ -12,13 +19,20 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map import Data.List +import GHC.Generics +import Data.Binary (Binary) +data HashSP deriving (Generic) + +instance Binary HashSP +instance NFData HashSP + -- |A map-based graph implementation. -newtype HashMapSP = HashMapSP (SPMap, Maybe BaseUrl, PrefixMappings) - deriving (NFData) +data instance RDF HashSP = HashSP (SPMap, Maybe BaseUrl, PrefixMappings) + deriving (NFData,Generic) -instance RDF HashMapSP where +instance Rdf HashSP where baseUrl = baseUrl' prefixMappings = prefixMappings' addPrefixMappings = addPrefixMappings' @@ -28,131 +42,142 @@ uniqTriplesOf = uniqTriplesOf' select = select' query = query' + showGraph = showGraph' -instance Show HashMapSP where - show gr = concatMap (\t -> show t ++ "\n") (triplesOf gr) +-- instance Show (HashSP) where +-- show (HashSP (tsMap,_,_)) = +-- let ts = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . HashMap.toList) tsMap +-- in concatMap (\t -> show t ++ "\n") ts +showGraph' :: RDF HashSP -> [Char] +showGraph' (HashSP (tsMap,_,_)) = + let ts = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . HashMap.toList) tsMap + in concatMap (\t -> show t ++ "\n") ts + +-- instance Show (HashSP) where +-- show gr = concatMap (\t -> show t ++ "\n") (triplesOf gr) + type SPMap = HashMap (Subject,Predicate) [Object] -baseUrl' :: HashMapSP -> Maybe BaseUrl -baseUrl' (HashMapSP (_, baseURL, _)) = baseURL +baseUrl' :: RDF HashSP -> Maybe BaseUrl +baseUrl' (HashSP (_, baseURL, _)) = baseURL -prefixMappings' :: HashMapSP -> PrefixMappings -prefixMappings' (HashMapSP (_, _, pms)) = pms +prefixMappings' :: RDF HashSP -> PrefixMappings +prefixMappings' (HashSP (_, _, pms)) = pms -addPrefixMappings' :: HashMapSP -> PrefixMappings -> Bool -> HashMapSP -addPrefixMappings' (HashMapSP (tsMap, baseURL, pms)) pms' replace = +addPrefixMappings' :: RDF HashSP -> PrefixMappings -> Bool -> RDF HashSP +addPrefixMappings' (HashSP (tsMap, baseURL, pms)) pms' replace = let merge = if replace then flip mergePrefixMappings else mergePrefixMappings - in HashMapSP (tsMap, baseURL, merge pms pms') + in HashSP (tsMap, baseURL, merge pms pms') -empty' :: HashMapSP -empty' = HashMapSP (HashMap.empty, Nothing, PrefixMappings Map.empty) +empty' :: RDF HashSP +empty' = HashSP (HashMap.empty, Nothing, PrefixMappings Map.empty) -mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> HashMapSP -mkRdf' triples baseURL pms = HashMapSP (tsMap, baseURL, pms) +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF HashSP +mkRdf' triples baseURL pms = HashSP (tsMap, baseURL, pms) where tsMap = sortAndGroup triples sortAndGroup xs = HashMap.fromListWith (++) [((s,p), [o]) | Triple s p o <- xs] -triplesOf' :: HashMapSP -> Triples -triplesOf' (HashMapSP (tsMap,_,_)) = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . HashMap.toList) tsMap +triplesOf' :: RDF HashSP -> Triples +triplesOf' (HashSP (tsMap,_,_)) = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . HashMap.toList) tsMap -uniqTriplesOf' :: HashMapSP -> Triples +uniqTriplesOf' :: RDF HashSP -> Triples uniqTriplesOf' = nub . expandTriples -select' :: HashMapSP -> NodeSelector -> NodeSelector -> NodeSelector -> Triples +select' :: RDF HashSP -> NodeSelector -> NodeSelector -> NodeSelector -> Triples select' gr Nothing Nothing Nothing = triplesOf' gr -select' (HashMapSP (tsMap,_,_)) Nothing (Just pSelector) Nothing = +select' (HashSP (tsMap,_,_)) Nothing (Just pSelector) Nothing = HashMap.foldrWithKey findTripleWithP [] tsMap where findTripleWithP (s,p) oList ts = if pSelector p then map (Triple s p) oList ++ ts else ts -select' (HashMapSP (tsMap,_,_)) Nothing Nothing (Just oSelector) = +select' (HashSP (tsMap,_,_)) Nothing Nothing (Just oSelector) = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = map (Triple s p) (filter oSelector oList) ++ ts -select' (HashMapSP (tsMap,_,_)) Nothing (Just pSelector) (Just oSelector) = +select' (HashSP (tsMap,_,_)) Nothing (Just pSelector) (Just oSelector) = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = if pSelector p then map (Triple s p) (filter oSelector oList) ++ ts else ts -select' (HashMapSP (tsMap,_,_)) (Just sSelector) Nothing Nothing = +select' (HashSP (tsMap,_,_)) (Just sSelector) Nothing Nothing = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = if sSelector s then map (Triple s p) oList ++ ts else ts -select' (HashMapSP (tsMap,_,_)) (Just sSelector) (Just pSelector) Nothing = +select' (HashSP (tsMap,_,_)) (Just sSelector) (Just pSelector) Nothing = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = if sSelector s && pSelector p then map (Triple s p) oList ++ ts else ts -select' (HashMapSP (tsMap,_,_)) (Just sSelector) Nothing (Just oSelector) = +select' (HashSP (tsMap,_,_)) (Just sSelector) Nothing (Just oSelector) = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = if sSelector s then map (Triple s p) (filter oSelector oList) ++ ts else ts -select' (HashMapSP (tsMap,_,_)) (Just sSelector) (Just pSelector) (Just oSelector) = +select' (HashSP (tsMap,_,_)) (Just sSelector) (Just pSelector) (Just oSelector) = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = if sSelector s && pSelector p then map (Triple s p) (filter oSelector oList) ++ ts else ts -query' :: HashMapSP -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples +query' :: RDF HashSP -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples query' gr Nothing Nothing Nothing = triplesOf' gr -query' (HashMapSP (tsMap,_,_)) Nothing (Just p) Nothing = +query' (HashSP (tsMap,_,_)) Nothing (Just p) Nothing = HashMap.foldrWithKey findTripleWithP [] tsMap where findTripleWithP (s,p') oList ts = if p == p' then map (Triple s p) oList ++ ts else ts -query' (HashMapSP (tsMap,_,_)) Nothing Nothing (Just o) = +query' (HashSP (tsMap,_,_)) Nothing Nothing (Just o) = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = map (Triple s p) (filter (== o) oList) ++ ts -query' (HashMapSP (tsMap,_,_)) Nothing (Just p) (Just o) = +query' (HashSP (tsMap,_,_)) Nothing (Just p) (Just o) = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p') oList ts = if p == p' then map (Triple s p) (filter (== o) oList) ++ ts else ts -query' (HashMapSP (tsMap,_,_)) (Just s) Nothing Nothing = +query' (HashSP (tsMap,_,_)) (Just s) Nothing Nothing = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s',p) oList ts = if s == s' then map (Triple s p) oList ++ ts else ts --- optimal pattern for this HashMapSP instance -query' (HashMapSP (tsMap,_,_)) (Just s) (Just p) Nothing = +-- optimal pattern for this RDF HashSP instance +query' (HashSP (tsMap,_,_)) (Just s) (Just p) Nothing = (map (Triple s p) . HashMap.lookupDefault [] (s,p)) tsMap -query' (HashMapSP (tsMap,_,_)) (Just s) Nothing (Just o) = +query' (HashSP (tsMap,_,_)) (Just s) Nothing (Just o) = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s',p) oList ts = if s == s' then map (Triple s p) (filter (== o) oList) ++ ts else ts -query' (HashMapSP (tsMap,_,_)) (Just s) (Just p) (Just o) = +query' (HashSP (tsMap,_,_)) (Just s) (Just p) (Just o) = HashMap.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s',p') oList ts = if s == s' && p == p' diff --git a/src/Data/RDF/Graph/MapSP.hs b/src/Data/RDF/Graph/MapSP.hs --- a/src/Data/RDF/Graph/MapSP.hs +++ b/src/Data/RDF/Graph/MapSP.hs @@ -1,7 +1,16 @@ -{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE EmptyDataDecls #-} + + -- |A graph implementation mapping (S,P) pairs to O, backed by 'Data.Map'. -module Data.RDF.Graph.MapSP (MapSP) where +module Data.RDF.Graph.MapSP (SP) where import Prelude hiding (pred) import Control.DeepSeq (NFData) @@ -11,6 +20,8 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.List +import GHC.Generics +import Data.Binary (Binary) -- |A map-based graph implementation. -- @@ -40,10 +51,14 @@ -- value:[http:\/\/example.com\/o3]; -- @ -newtype MapSP = MapSP (SPMap, Maybe BaseUrl, PrefixMappings) - deriving (NFData) +data SP deriving (Generic) +instance Binary SP +instance NFData SP -instance RDF MapSP where +data instance RDF SP = SP (SPMap, Maybe BaseUrl, PrefixMappings) + deriving (Generic,NFData) + +instance Rdf SP where baseUrl = baseUrl' prefixMappings = prefixMappings' addPrefixMappings = addPrefixMappings' @@ -53,131 +68,139 @@ uniqTriplesOf = uniqTriplesOf' select = select' query = query' + showGraph = showGraph' -instance Show MapSP where - show gr = concatMap (\t -> show t ++ "\n") (triplesOf gr) +-- instance Show SP where +-- show (SP (tsMap,_,_)) = +-- let ts = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . Map.toList) tsMap +-- in concatMap (\t -> show t ++ "\n") ts +showGraph' :: RDF SP -> String +showGraph' (SP (tsMap,_,_)) = + let ts = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . Map.toList) tsMap + in concatMap (\t -> show t ++ "\n") ts + type SPMap = Map (Subject,Predicate) [Object] -baseUrl' :: MapSP -> Maybe BaseUrl -baseUrl' (MapSP (_, baseURL, _)) = baseURL +baseUrl' :: RDF SP -> Maybe BaseUrl +baseUrl' (SP (_, baseURL, _)) = baseURL -prefixMappings' :: MapSP -> PrefixMappings -prefixMappings' (MapSP (_, _, pms)) = pms +prefixMappings' :: RDF SP -> PrefixMappings +prefixMappings' (SP (_, _, pms)) = pms -addPrefixMappings' :: MapSP -> PrefixMappings -> Bool -> MapSP -addPrefixMappings' (MapSP (tsMap, baseURL, pms)) pms' replace = +addPrefixMappings' :: RDF SP -> PrefixMappings -> Bool -> RDF SP +addPrefixMappings' (SP (tsMap, baseURL, pms)) pms' replace = let merge = if replace then flip mergePrefixMappings else mergePrefixMappings - in MapSP (tsMap, baseURL, merge pms pms') + in SP (tsMap, baseURL, merge pms pms') -empty' :: MapSP -empty' = MapSP (Map.empty, Nothing, PrefixMappings Map.empty) +empty' :: RDF SP +empty' = SP (Map.empty, Nothing, PrefixMappings Map.empty) -mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> MapSP -mkRdf' triples baseURL pms = MapSP (tsMap, baseURL, pms) +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF SP +mkRdf' triples baseURL pms = SP (tsMap, baseURL, pms) where tsMap = sortAndGroup triples sortAndGroup xs = Map.fromListWith (++) [((s,p), [o]) | Triple s p o <- xs] -triplesOf' :: MapSP -> Triples -triplesOf' (MapSP (tsMap,_,_)) = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . Map.toList) tsMap +triplesOf' :: RDF SP -> Triples +triplesOf' (SP (tsMap,_,_)) = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . Map.toList) tsMap -uniqTriplesOf' :: MapSP -> Triples +uniqTriplesOf' :: RDF SP -> Triples uniqTriplesOf' = nub . expandTriples -select' :: MapSP -> NodeSelector -> NodeSelector -> NodeSelector -> Triples +select' :: RDF SP -> NodeSelector -> NodeSelector -> NodeSelector -> Triples select' gr Nothing Nothing Nothing = triplesOf' gr -select' (MapSP (tsMap,_,_)) Nothing (Just pSelector) Nothing = +select' (SP (tsMap,_,_)) Nothing (Just pSelector) Nothing = Map.foldrWithKey findTripleWithP [] tsMap where findTripleWithP (s,p) oList ts = if pSelector p then map (Triple s p) oList ++ ts else ts -select' (MapSP (tsMap,_,_)) Nothing Nothing (Just oSelector) = +select' (SP (tsMap,_,_)) Nothing Nothing (Just oSelector) = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = map (Triple s p) (filter oSelector oList) ++ ts -select' (MapSP (tsMap,_,_)) Nothing (Just pSelector) (Just oSelector) = +select' (SP (tsMap,_,_)) Nothing (Just pSelector) (Just oSelector) = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = if pSelector p then map (Triple s p) (filter oSelector oList) ++ ts else ts -select' (MapSP (tsMap,_,_)) (Just sSelector) Nothing Nothing = +select' (SP (tsMap,_,_)) (Just sSelector) Nothing Nothing = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = if sSelector s then map (Triple s p) oList ++ ts else ts -select' (MapSP (tsMap,_,_)) (Just sSelector) (Just pSelector) Nothing = +select' (SP (tsMap,_,_)) (Just sSelector) (Just pSelector) Nothing = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = if sSelector s && pSelector p then map (Triple s p) oList ++ ts else ts -select' (MapSP (tsMap,_,_)) (Just sSelector) Nothing (Just oSelector) = +select' (SP (tsMap,_,_)) (Just sSelector) Nothing (Just oSelector) = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = if sSelector s then map (Triple s p) (filter oSelector oList) ++ ts else ts -select' (MapSP (tsMap,_,_)) (Just sSelector) (Just pSelector) (Just oSelector) = +select' (SP (tsMap,_,_)) (Just sSelector) (Just pSelector) (Just oSelector) = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = if sSelector s && pSelector p then map (Triple s p) (filter oSelector oList) ++ ts else ts -query' :: MapSP -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples +query' :: RDF SP -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples query' gr Nothing Nothing Nothing = triplesOf' gr -query' (MapSP (tsMap,_,_)) Nothing (Just p) Nothing = +query' (SP (tsMap,_,_)) Nothing (Just p) Nothing = Map.foldrWithKey findTripleWithP [] tsMap where findTripleWithP (s,p') oList ts = if p == p' then map (Triple s p) oList ++ ts else ts -query' (MapSP (tsMap,_,_)) Nothing Nothing (Just o) = +query' (SP (tsMap,_,_)) Nothing Nothing (Just o) = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p) oList ts = map (Triple s p) (filter (== o) oList) ++ ts -query' (MapSP (tsMap,_,_)) Nothing (Just p) (Just o) = +query' (SP (tsMap,_,_)) Nothing (Just p) (Just o) = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s,p') oList ts = if p == p' then map (Triple s p) (filter (== o) oList) ++ ts else ts -query' (MapSP (tsMap,_,_)) (Just s) Nothing Nothing = +query' (SP (tsMap,_,_)) (Just s) Nothing Nothing = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s',p) oList ts = if s == s' then map (Triple s p) oList ++ ts else ts --- optimal pattern for this MapSP instance -query' (MapSP (tsMap,_,_)) (Just s) (Just p) Nothing = +-- optimal pattern for this SP instance +query' (SP (tsMap,_,_)) (Just s) (Just p) Nothing = (map (Triple s p) . Map.findWithDefault [] (s,p)) tsMap -query' (MapSP (tsMap,_,_)) (Just s) Nothing (Just o) = +query' (SP (tsMap,_,_)) (Just s) Nothing (Just o) = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s',p) oList ts = if s == s' then map (Triple s p) (filter (== o) oList) ++ ts else ts -query' (MapSP (tsMap,_,_)) (Just s) (Just p) (Just o) = +query' (SP (tsMap,_,_)) (Just s) (Just p) (Just o) = Map.foldrWithKey findTripleWithS [] tsMap where findTripleWithS (s',p') oList ts = if s == s' && p == p' diff --git a/src/Data/RDF/Graph/TList.hs b/src/Data/RDF/Graph/TList.hs new file mode 100644 --- /dev/null +++ b/src/Data/RDF/Graph/TList.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE EmptyDataDecls #-} + + +-- |"TriplesGraph" contains a list-backed graph implementation suitable +-- for smallish graphs or for temporary graphs that will not be queried. +-- It maintains the triples in the order that they are given in, and is +-- especially useful for holding N-Triples, where it is often desirable +-- to preserve the order of the triples when they were originally parsed. +-- Duplicate triples are not filtered. If you might have duplicate triples, +-- use @MGraph@ instead, which is also more efficient. However, the query +-- functions of this graph (select, query) remove duplicates from their +-- result triples (but triplesOf does not) since it is usually cheap +-- to do so. +module Data.RDF.Graph.TList (TList) where + +import Prelude hiding (pred) +import Control.DeepSeq (NFData) +import Data.Binary +import qualified Data.Map as Map +import Data.RDF.Namespace +import Data.RDF.Query +import Data.RDF.Types (RDF,Rdf(..),Triple,Node,Subject,Predicate,Object,NodeSelector,Triples,BaseUrl) +import Data.List (nub) +import GHC.Generics + +-- |A simple implementation of the 'RDF' type class that represents +-- the graph internally as a list of triples. +-- +-- Note that this type of RDF is fine for interactive +-- experimentation and querying of smallish (<10,000 triples) graphs, +-- but there are better options for larger graphs or graphs that you +-- will do many queries against (e.g., @MGraph@ is faster for queries). +-- +-- The time complexity of the functions (where n == num_triples) are: +-- +-- * 'empty' : O(1) +-- +-- * 'mkRdf' : O(n) +-- +-- * 'triplesOf': O(1) +-- +-- * 'select' : O(n) +-- +-- * 'query' : O(n) +-- newtype TList = TList (Triples, Maybe BaseUrl, PrefixMappings) +-- deriving (Generic,NFData) + +data TList deriving (Generic) + +-- data TList = TListC (Triples, Maybe BaseUrl, PrefixMappings) +-- deriving (Generic,NFData) + +instance Binary TList +instance NFData TList + +-- instance Show TList where +-- show ((TListC (a,b,c,d))) = "" + +data instance RDF TList = TListC (Triples, Maybe BaseUrl, PrefixMappings) + deriving (Generic,NFData) + +-- data instance RDF TList + +instance Rdf TList where + -- data RDF TList = RDF TList + baseUrl = baseUrl' + prefixMappings = prefixMappings' + addPrefixMappings = addPrefixMappings' + empty = empty' + mkRdf = mkRdf' + triplesOf = triplesOf' + uniqTriplesOf = uniqTriplesOf' + select = select' + query = query' + showGraph = showGraph' + +-- instance Show TList where +-- show ((TListC (ts, _, _))) = concatMap (\t -> show t ++ "\n") ts + +showGraph' :: RDF TList -> [Char] +showGraph' ((TListC (ts, _, _))) = concatMap (\t -> show t ++ "\n") ts + +prefixMappings' :: RDF TList -> PrefixMappings +prefixMappings' (TListC(_, _, pms)) = pms + +addPrefixMappings' :: RDF TList -> PrefixMappings -> Bool -> RDF TList +addPrefixMappings' (TListC(ts, baseURL, pms)) pms' replace = + let merge = if replace then flip mergePrefixMappings else mergePrefixMappings + in TListC(ts, baseURL, merge pms pms') + +baseUrl' :: RDF TList -> Maybe BaseUrl +baseUrl' (TListC(_, baseURL, _)) = baseURL + +empty' :: RDF TList +empty' = TListC([], Nothing, PrefixMappings Map.empty) + +-- We no longer remove duplicates here, as it is very time consuming and is often not +-- necessary (raptor does not seem to remove dupes either). Instead, we remove dupes +-- from the results of the select' and query' functions, since it is cheap to do +-- there in most cases, but not when triplesOf' is called. +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF TList +mkRdf' ts baseURL pms = TListC(ts, baseURL, pms) + +triplesOf' :: RDF TList -> Triples +triplesOf' ((TListC(ts, _, _))) = ts + +uniqTriplesOf' :: RDF TList -> Triples +uniqTriplesOf' = nub . expandTriples + +select' :: RDF TList -> NodeSelector -> NodeSelector -> NodeSelector -> Triples +select' g s p o = filter (matchSelect s p o) $ triplesOf g + +query' :: RDF TList -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples +query' g s p o = filter (matchPattern s p o) $ triplesOf g + +matchSelect :: NodeSelector -> NodeSelector -> NodeSelector -> Triple -> Bool +matchSelect s p o t = + match s (subjectOf t) && match p (predicateOf t) && match o (objectOf t) + where + match Nothing _ = True + match (Just fn) n = fn n + +matchPattern :: Maybe Subject -> Maybe Predicate -> Maybe Object -> Triple -> Bool +matchPattern subj pred obj t = smatch t && pmatch t && omatch t + where + smatch trp = matchNode subj (subjectOf trp) + pmatch trp = matchNode pred (predicateOf trp) + omatch trp = matchNode obj (objectOf trp) + +matchNode :: Maybe Node -> Node -> Bool +matchNode Nothing _ = True +matchNode (Just n1) n2 = n1 == n2 diff --git a/src/Data/RDF/Graph/TriplesList.hs b/src/Data/RDF/Graph/TriplesList.hs deleted file mode 100644 --- a/src/Data/RDF/Graph/TriplesList.hs +++ /dev/null @@ -1,112 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving , DeriveGeneric #-} - --- |"TriplesGraph" contains a list-backed graph implementation suitable --- for smallish graphs or for temporary graphs that will not be queried. --- It maintains the triples in the order that they are given in, and is --- especially useful for holding N-Triples, where it is often desirable --- to preserve the order of the triples when they were originally parsed. --- Duplicate triples are not filtered. If you might have duplicate triples, --- use @MGraph@ instead, which is also more efficient. However, the query --- functions of this graph (select, query) remove duplicates from their --- result triples (but triplesOf does not) since it is usually cheap --- to do so. -module Data.RDF.Graph.TriplesList (TriplesList) where - -import Prelude hiding (pred) -import Control.DeepSeq (NFData) -import Data.Binary -import qualified Data.Map as Map -import Data.RDF.Namespace -import Data.RDF.Query -import Data.RDF.Types -import Data.List (nub) -import GHC.Generics - --- |A simple implementation of the 'RDF' type class that represents --- the graph internally as a list of triples. --- --- Note that this type of RDF is fine for interactive --- experimentation and querying of smallish (<10,000 triples) graphs, --- but there are better options for larger graphs or graphs that you --- will do many queries against (e.g., @MGraph@ is faster for queries). --- --- The time complexity of the functions (where n == num_triples) are: --- --- * 'empty' : O(1) --- --- * 'mkRdf' : O(n) --- --- * 'triplesOf': O(1) --- --- * 'select' : O(n) --- --- * 'query' : O(n) -newtype TriplesList = TriplesList (Triples, Maybe BaseUrl, PrefixMappings) - deriving (Generic,NFData) - -instance Binary TriplesList - -instance RDF TriplesList where - baseUrl = baseUrl' - prefixMappings = prefixMappings' - addPrefixMappings = addPrefixMappings' - empty = empty' - mkRdf = mkRdf' - triplesOf = triplesOf' - uniqTriplesOf = uniqTriplesOf' - select = select' - query = query' - -instance Show TriplesList where - show gr = concatMap (\t -> show t ++ "\n") (triplesOf gr) - -prefixMappings' :: TriplesList -> PrefixMappings -prefixMappings' (TriplesList (_, _, pms)) = pms - -addPrefixMappings' :: TriplesList -> PrefixMappings -> Bool -> TriplesList -addPrefixMappings' (TriplesList (ts, baseURL, pms)) pms' replace = - let merge = if replace then flip mergePrefixMappings else mergePrefixMappings - in TriplesList (ts, baseURL, merge pms pms') - -baseUrl' :: TriplesList -> Maybe BaseUrl -baseUrl' (TriplesList (_, baseURL, _)) = baseURL - -empty' :: TriplesList -empty' = TriplesList ([], Nothing, PrefixMappings Map.empty) - --- We no longer remove duplicates here, as it is very time consuming and is often not --- necessary (raptor does not seem to remove dupes either). Instead, we remove dupes --- from the results of the select' and query' functions, since it is cheap to do --- there in most cases, but not when triplesOf' is called. -mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesList -mkRdf' ts baseURL pms = TriplesList (ts, baseURL, pms) - -triplesOf' :: TriplesList -> Triples -triplesOf' (TriplesList (ts, _, _)) = ts - -uniqTriplesOf' :: TriplesList -> Triples -uniqTriplesOf' = nub . expandTriples - -select' :: TriplesList -> NodeSelector -> NodeSelector -> NodeSelector -> Triples -select' g s p o = filter (matchSelect s p o) $ triplesOf g - -query' :: TriplesList -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples -query' g s p o = filter (matchPattern s p o) $ triplesOf g - -matchSelect :: NodeSelector -> NodeSelector -> NodeSelector -> Triple -> Bool -matchSelect s p o t = - match s (subjectOf t) && match p (predicateOf t) && match o (objectOf t) - where - match Nothing _ = True - match (Just fn) n = fn n - -matchPattern :: Maybe Subject -> Maybe Predicate -> Maybe Object -> Triple -> Bool -matchPattern subj pred obj t = smatch t && pmatch t && omatch t - where - smatch trp = matchNode subj (subjectOf trp) - pmatch trp = matchNode pred (predicateOf trp) - omatch trp = matchNode obj (objectOf trp) - -matchNode :: Maybe Node -> Node -> Bool -matchNode Nothing _ = True -matchNode (Just n1) n2 = n1 == n2 diff --git a/src/Data/RDF/Graph/TriplesPatriciaTree.hs b/src/Data/RDF/Graph/TriplesPatriciaTree.hs deleted file mode 100644 --- a/src/Data/RDF/Graph/TriplesPatriciaTree.hs +++ /dev/null @@ -1,276 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, BangPatterns #-} - -module Data.RDF.Graph.TriplesPatriciaTree (TriplesPatriciaTree) where - -import Data.RDF.Namespace -import Data.RDF.Query -import Data.RDF.Types - -import Control.DeepSeq (NFData) -import qualified Data.Graph.Inductive.Graph as G -import qualified Data.Graph.Inductive.PatriciaTree as PT -import qualified Data.Graph.Inductive.Query.DFS as DFS -import qualified Data.IntMap as IntMap -import Data.List -import qualified Data.Map as Map -import Data.Maybe - -newtype TriplesPatriciaTree = TriplesPatriciaTree (PT.Gr Node Node,IntMap.IntMap Node, Maybe BaseUrl, PrefixMappings) - deriving (Show,NFData) - -instance RDF TriplesPatriciaTree where - baseUrl = baseUrl' - prefixMappings = prefixMappings' - addPrefixMappings = addPrefixMappings' - empty = empty' - mkRdf = mkRdf' - triplesOf = triplesOf' - uniqTriplesOf = uniqTriplesOf' - select = select' - query = query' - -empty' :: TriplesPatriciaTree -empty' = TriplesPatriciaTree (G.empty,IntMap.empty, Nothing, PrefixMappings Map.empty) - -prefixMappings' :: TriplesPatriciaTree -> PrefixMappings -prefixMappings' (TriplesPatriciaTree (_,_,_,pms')) = pms' - -addPrefixMappings' :: TriplesPatriciaTree -> PrefixMappings -> Bool -> TriplesPatriciaTree -addPrefixMappings' (TriplesPatriciaTree (g, idxLookup, baseURL, pms)) pms' replace = - let merge = if replace then flip mergePrefixMappings else mergePrefixMappings - in TriplesPatriciaTree (g, idxLookup, baseURL, merge pms pms') - -baseUrl' :: TriplesPatriciaTree -> Maybe BaseUrl -baseUrl' (TriplesPatriciaTree _) = Nothing - -data AutoIncrMap = AutoIncrMap - { theMap :: Map.Map Node (Int,Node) - , idxPtr :: !Int } - -{- -init -> [] -insert www -> [0,www] -insert ttt -> [1,ttt] -insert ttt -> [1,ttt] --} -insertIncr :: Node -> AutoIncrMap -> (Int,AutoIncrMap) -insertIncr !node mp = - let x = Map.lookup node (theMap mp) - in if isJust x - then - let (i,_) = fromJust x - in (i,mp) - else - let curIdx = idxPtr mp - mp' = mp { idxPtr = curIdx + 1 - , theMap = Map.insert node (idxPtr mp, node) (theMap mp) } - in (curIdx, mp') - -mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesPatriciaTree -mkRdf' ts base' pms' = - -- step 1: subjects and objects assigned node ID (an Int) - let (mp,ledges) = foldl' f ((AutoIncrMap Map.empty 0),[]) ts - - -- step 2: for all triples, create arc with - -- - predicate node the arc label - -- - subject the source node ID - -- - object the target node ID - f (mp',edges) (Triple s p o) = - let (sIdx,mp'') = insertIncr s mp' - (oIdx,mp''') = insertIncr o mp'' - edge = (sIdx,oIdx,p) - in (mp''',edge : edges) - - lnodes = Map.elems (theMap mp) - intIdx = IntMap.fromList lnodes - ptGraph = G.mkGraph lnodes ledges - - in TriplesPatriciaTree (ptGraph ,intIdx, base', pms') - -triplesOf' :: TriplesPatriciaTree -> Triples -triplesOf' (TriplesPatriciaTree (g,idxLookup,_,_)) = - map (\(sIdx,oIdx,p) -> - let [s,o] = map (\idx -> fromJust $ IntMap.lookup idx idxLookup) [sIdx,oIdx] - in Triple s p o) (G.labEdges g) - -uniqTriplesOf' :: TriplesPatriciaTree -> Triples -uniqTriplesOf' ptG@(TriplesPatriciaTree (g,idxLookup,_,_)) = - nub $ map (\(sIdx,oIdx,p) -> - let [s,o] = map (\idx -> fromJust $ IntMap.lookup idx idxLookup) [sIdx,oIdx] - in expandTriple (prefixMappings ptG) (Triple s p o)) (G.labEdges g) - -mkTriples :: IntMap.IntMap Node -> Node -> [(Node, IntMap.Key)] -> [(Node, IntMap.Key)] -> [Triple] -mkTriples idxLookup thisNode adjsIn adjsOut = - let ts1 = map (\(predNode,subjIdx) -> - let s = fromJust (IntMap.lookup subjIdx idxLookup) - in Triple s predNode thisNode - ) adjsIn - - ts2 = map (\(predNode,objIdx) -> - let o = fromJust (IntMap.lookup objIdx idxLookup) - in Triple thisNode predNode o - ) adjsOut - in ts1 ++ ts2 - -select' :: TriplesPatriciaTree -> NodeSelector -> NodeSelector -> NodeSelector -> Triples -select' (TriplesPatriciaTree (g,idxLookup,_,_)) maybeSubjSel maybePredSel maybeObjSel = - - let cfun ( adjsIn , _nodeIdx , thisNode , adjsOut ) - | isNothing maybeSubjSel && isNothing maybePredSel && isNothing maybeObjSel = - mkTriples idxLookup thisNode adjsIn adjsOut - - | isJust maybeSubjSel && isNothing maybePredSel && isNothing maybeObjSel = - let adjsIn' = filter (\(_p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup))) adjsIn - ts1 = mkTriples idxLookup thisNode adjsIn' [] - ts2 = if fromJust maybeSubjSel thisNode - then mkTriples idxLookup thisNode [] adjsOut - else [] - in ts1 ++ ts2 - | isNothing maybeSubjSel && isJust maybePredSel && isNothing maybeObjSel = - let adjsIn' = filter (\(p,_idxSubj) -> fromJust maybePredSel p ) adjsIn - adjsOut' = filter (\(p,_idxObj) -> fromJust maybePredSel p ) adjsOut - ts1 = if not (null adjsIn') - then mkTriples idxLookup thisNode adjsIn' [] - else [] - ts2 = if not (null adjsOut') - then mkTriples idxLookup thisNode [] adjsOut' - else [] - in ts1 ++ ts2 - - | isNothing maybeSubjSel && isNothing maybePredSel && isJust maybeObjSel = - let adjsOut' = filter (\(_p,idxObj) -> fromJust maybeObjSel (fromJust (IntMap.lookup idxObj idxLookup)) ) adjsOut - ts1 = mkTriples idxLookup thisNode [] adjsOut' - ts2 = if fromJust maybeObjSel thisNode - then mkTriples idxLookup thisNode adjsIn [] - else [] - in ts1 ++ ts2 - - | isJust maybeSubjSel && isJust maybePredSel && isNothing maybeObjSel = - let adjsIn' = filter (\(p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup)) - && fromJust maybePredSel p ) adjsIn - adjsOut' = filter (\(p,_idxObj) -> fromJust maybePredSel p ) adjsOut - ts1 = mkTriples idxLookup thisNode adjsIn' [] - ts2 = if fromJust maybeSubjSel thisNode - then mkTriples idxLookup thisNode [] adjsOut' - else [] - in ts1 ++ ts2 - - | isJust maybeSubjSel && isNothing maybePredSel && isJust maybeObjSel = - let adjsIn' = filter (\(_p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup)) ) adjsIn - adjsOut' = filter (\(_p,idxObj) -> fromJust maybeObjSel (fromJust (IntMap.lookup idxObj idxLookup)) ) adjsOut - ts1 = if fromJust maybeObjSel thisNode - then mkTriples idxLookup thisNode adjsIn' [] - else [] - ts2 = if fromJust maybeSubjSel thisNode - then mkTriples idxLookup thisNode [] adjsOut' - else [] - in ts1 ++ ts2 - - | isNothing maybeSubjSel && isJust maybePredSel && isJust maybeObjSel = - let adjsIn' = filter (\(p,_idxSubj) -> fromJust maybePredSel p ) adjsIn - adjsOut' = filter (\(p,idxObj) -> fromJust maybeObjSel (fromJust (IntMap.lookup idxObj idxLookup)) - && fromJust maybePredSel p ) adjsOut - ts1 = if fromJust maybeObjSel thisNode - then mkTriples idxLookup thisNode adjsIn' [] - else [] - ts2 = mkTriples idxLookup thisNode [] adjsOut' - in ts1 ++ ts2 - - | isJust maybeSubjSel && isJust maybePredSel && isJust maybeObjSel = - let adjsIn' = filter (\(p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup)) - && fromJust maybePredSel p ) adjsIn - adjsOut' = filter (\(p,idxObj) -> fromJust maybeObjSel (fromJust (IntMap.lookup idxObj idxLookup)) - && fromJust maybePredSel p ) adjsOut - ts1 = if fromJust maybeObjSel thisNode - then mkTriples idxLookup thisNode adjsIn' [] - else [] - ts2 = if fromJust maybeSubjSel thisNode - then mkTriples idxLookup thisNode [] adjsOut' - else [] - in ts1 ++ ts2 - - cfun ( _ , _ , _ , _) = undefined -- not sure why this pattern is needed to exhaust cfun arg patterns - - in concat $ DFS.dfsWith' cfun g - -query' :: TriplesPatriciaTree -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples -query' (TriplesPatriciaTree (g,idxLookup,_,_)) maybeSubj maybePred maybeObj = - - let cfun ( adjsIn , _nodeIdx , thisNode , adjsOut ) - | isNothing maybeSubj && isNothing maybePred && isNothing maybeObj = - mkTriples idxLookup thisNode adjsIn adjsOut - - | isJust maybeSubj && isNothing maybePred && isNothing maybeObj = - let adjsIn' = filter (\(_p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj ) adjsIn - ts1 = mkTriples idxLookup thisNode adjsIn' [] - ts2 = if thisNode == fromJust maybeSubj - then mkTriples idxLookup thisNode [] adjsOut - else [] - in ts1 ++ ts2 - - | isNothing maybeSubj && isJust maybePred && isNothing maybeObj = - let adjsIn' = filter (\(p,_idxSubj) -> p == fromJust maybePred ) adjsIn - adjsOut' = filter (\(p,_idxObj) -> p == fromJust maybePred ) adjsOut - ts1 = if not (null adjsIn') - then mkTriples idxLookup thisNode adjsIn' [] - else [] - ts2 = if not (null adjsOut') - then mkTriples idxLookup thisNode [] adjsOut' - else [] - in ts1 ++ ts2 - - | isNothing maybeSubj && isNothing maybePred && isJust maybeObj = - let adjsOut' = filter (\(_p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj ) adjsOut - ts1 = mkTriples idxLookup thisNode [] adjsOut' - ts2 = if thisNode == fromJust maybeObj - then mkTriples idxLookup thisNode adjsIn [] - else [] - in ts1 ++ ts2 - - | isJust maybeSubj && isJust maybePred && isNothing maybeObj = - let adjsIn' = filter (\(p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj - && p == fromJust maybePred ) adjsIn - adjsOut' = filter (\(p,_idxObj) -> p == fromJust maybePred ) adjsOut - ts1 = mkTriples idxLookup thisNode adjsIn' [] - ts2 = if thisNode == fromJust maybeSubj - then mkTriples idxLookup thisNode [] adjsOut' - else [] - in ts1 ++ ts2 - - | isJust maybeSubj && isNothing maybePred && isJust maybeObj = - let adjsIn' = filter (\(_p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj ) adjsIn - adjsOut' = filter (\(_p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj ) adjsOut - ts1 = if thisNode == fromJust maybeObj - then mkTriples idxLookup thisNode adjsIn' [] - else [] - ts2 = if thisNode == fromJust maybeSubj - then mkTriples idxLookup thisNode [] adjsOut' - else [] - in ts1 ++ ts2 - - | isNothing maybeSubj && isJust maybePred && isJust maybeObj = - let adjsIn' = filter (\(p,_idxSubj) -> p == fromJust maybePred ) adjsIn - adjsOut' = filter (\(p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj - && p == fromJust maybePred ) adjsOut - ts1 = if thisNode == fromJust maybeObj - then mkTriples idxLookup thisNode adjsIn' [] - else [] - ts2 = mkTriples idxLookup thisNode [] adjsOut' - in ts1 ++ ts2 - - | isJust maybeSubj && isJust maybePred && isJust maybeObj = - let adjsIn' = filter (\(p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj - && p == fromJust maybePred ) adjsIn - adjsOut' = filter (\(p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj - && p == fromJust maybePred ) adjsOut - ts1 = if thisNode == fromJust maybeObj - then mkTriples idxLookup thisNode adjsIn' [] - else [] - ts2 = if thisNode == fromJust maybeSubj - then mkTriples idxLookup thisNode [] adjsOut' - else [] - in ts1 ++ ts2 - - cfun ( _ , _ , _ , _ ) = undefined -- not sure why this pattern is needed to exhaust cfun arg patterns - - in concat $ DFS.dfsWith' cfun g diff --git a/src/Data/RDF/Query.hs b/src/Data/RDF/Query.hs --- a/src/Data/RDF/Query.hs +++ b/src/Data/RDF/Query.hs @@ -43,7 +43,7 @@ objectOf (Triple _ _ o) = o -- |Answer if rdf contains node. -rdfContainsNode :: forall rdf. (RDF rdf) => rdf -> Node -> Bool +rdfContainsNode :: (Rdf a) => RDF a -> Node -> Bool rdfContainsNode rdf node = let ts = triplesOf rdf xs = map (tripleContainsNode node) ts @@ -72,22 +72,22 @@ equalObjects (Triple _ _ o1) (Triple _ _ o2) = o1 == o2 -- |Determines whether the 'RDF' contains zero triples. -isEmpty :: RDF rdf => rdf -> Bool +isEmpty :: Rdf a => RDF a -> Bool isEmpty rdf = let ts = triplesOf rdf in null ts -- |Lists of all subjects of triples with the given predicate. -subjectsWithPredicate :: RDF rdf => rdf -> Predicate -> [Subject] +subjectsWithPredicate :: Rdf a => RDF a -> Predicate -> [Subject] subjectsWithPredicate rdf pred = map subjectOf $ query rdf Nothing (Just pred) Nothing -- |Lists of all objects of triples with the given predicate. -objectsOfPredicate :: RDF rdf => rdf -> Predicate -> [Object] +objectsOfPredicate :: Rdf a => RDF a -> Predicate -> [Object] objectsOfPredicate rdf pred = map objectOf $ query rdf Nothing (Just pred) Nothing -- |Convert a parse result into an RDF if it was successful -- and error and terminate if not. -fromEither :: RDF rdf => Either ParseFailure rdf -> rdf +fromEither :: Rdf a => Either ParseFailure (RDF a) -> RDF a fromEither res = case res of (Left err) -> error (show err) @@ -98,7 +98,7 @@ -- |This determines if two RDF representations are equal regardless of blank -- node names, triple order and prefixes. In math terms, this is the \simeq -- latex operator, or ~= -isIsomorphic :: forall rdf1 rdf2. (RDF rdf1, RDF rdf2) => rdf1 -> rdf2 -> Bool +isIsomorphic :: (Rdf a, Rdf b) => RDF a -> RDF b -> Bool isIsomorphic g1 g2 = and $ zipWith compareTripleUnlessBlank (normalize g1) (normalize g2) where compareNodeUnlessBlank :: Node -> Node -> Bool @@ -116,19 +116,19 @@ compareNodeUnlessBlank p1 p2 && compareNodeUnlessBlank o1 o2 - normalize :: forall rdf. (RDF rdf) => rdf -> Triples + normalize :: (Rdf a) => RDF a -> Triples normalize = sort . nub . expandTriples -- | Compares the structure of two graphs and returns 'True' if -- their graph structures are identical. This does not consider the nature of -- each node in the graph, i.e. the URI text of 'UNode' nodes, the generated -- index of a blank node, or the values in literal nodes. -isGraphIsomorphic :: forall rdf1 rdf2. (RDF rdf1, RDF rdf2) => rdf1 -> rdf2 -> Bool +isGraphIsomorphic :: (Rdf a, Rdf b) => RDF a -> RDF b -> Bool isGraphIsomorphic g1 g2 = Automorphism.isIsomorphic g1' g2' where g1' = rdfGraphToDataGraph g1 g2' = rdfGraphToDataGraph g2 - rdfGraphToDataGraph :: RDF rdf3 => rdf3 -> Graph + rdfGraphToDataGraph :: Rdf c => RDF c -> Graph rdfGraphToDataGraph g = dataGraph where triples = expandTriples g @@ -140,7 +140,7 @@ -- |Expand the triples in a graph with the prefix map and base URL for that -- graph. -expandTriples :: (RDF rdf) => rdf -> Triples +expandTriples :: (Rdf a) => RDF a -> Triples expandTriples rdf = expandTriples' [] (baseUrl rdf) (prefixMappings rdf) (triplesOf rdf) expandTriples' :: Triples -> Maybe BaseUrl -> PrefixMappings -> Triples -> Triples 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 @@ -1,4 +1,9 @@ -{-# LANGUAGE DeriveGeneric, OverloadedStrings, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Data.RDF.Types ( @@ -17,9 +22,12 @@ -- * Miscellaneous resolveQName, absolutizeUrl, isAbsoluteUri, mkAbsoluteUrl,escapeRDFSyntax,fileSchemeToFilePath, - -- * RDF Type - RDF(baseUrl,prefixMappings,addPrefixMappings,empty,mkRdf,triplesOf,uniqTriplesOf,select,query), + -- * RDF data family + RDF, + -- * Rdf type class + Rdf(baseUrl,prefixMappings,addPrefixMappings,empty,mkRdf,triplesOf,uniqTriplesOf,select,query,showGraph), + -- * Parsing RDF RdfParser(parseString,parseFile,parseURL), @@ -315,6 +323,9 @@ class View a b where view :: a -> b +-- |RDF data family +data family RDF a + -- |An RDF value is a set of (unique) RDF triples, together with the -- operations defined upon them. -- @@ -323,37 +334,40 @@ -- -- For more information about the concept of an RDF graph, see -- the following: . -class RDF rdf where +class (Generic rdfImpl, NFData rdfImpl) => Rdf rdfImpl where + -- -- |RDF type family + -- data RDF rdfImpl + -- |Return the base URL of this RDF, if any. - baseUrl :: rdf -> Maybe BaseUrl + baseUrl :: RDF rdfImpl -> Maybe BaseUrl -- |Return the prefix mappings defined for this RDF, if any. - prefixMappings :: rdf -> PrefixMappings + prefixMappings :: RDF rdfImpl -> PrefixMappings -- |Return an RDF with the specified prefix mappings merged with -- the existing mappings. If the Bool arg is True, then a new mapping -- for an existing prefix will replace the old mapping; otherwise, -- the new mapping is ignored. - addPrefixMappings :: rdf -> PrefixMappings -> Bool -> rdf + addPrefixMappings :: RDF rdfImpl -> PrefixMappings -> Bool -> RDF rdfImpl -- |Return an empty RDF. - empty :: rdf + empty :: RDF rdfImpl -- |Return a RDF containing all the given triples. Handling of duplicates -- in the input depend on the particular RDF implementation. - mkRdf :: Triples -> Maybe BaseUrl -> PrefixMappings -> rdf + mkRdf :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdfImpl -- |Return all triples in the RDF, as a list. -- -- Note that this function returns a list of triples in the RDF as they -- were added, without removing duplicates and without expanding namespaces. - triplesOf :: rdf -> Triples + triplesOf :: RDF rdfImpl -> Triples -- |Return unique triples in the RDF, as a list. -- -- This function performs namespace expansion and removal of duplicates. - uniqTriplesOf :: rdf -> Triples + uniqTriplesOf :: RDF rdfImpl -> Triples -- |Select the triples in the RDF that match the given selectors. -- @@ -375,7 +389,7 @@ -- -- Note: this function may be very slow; see the documentation for the -- particular RDF implementation for more information. - select :: rdf -> NodeSelector -> NodeSelector -> NodeSelector -> Triples + select :: RDF rdfImpl -> NodeSelector -> NodeSelector -> NodeSelector -> Triples -- |Return the triples in the RDF that match the given pattern, where -- the pattern (3 Maybe Node parameters) is interpreted as a triple pattern. @@ -388,8 +402,14 @@ -- For example, @ query rdf (Just n1) Nothing (Just n2) @ would return all -- and only the triples that have @n1@ as subject and @n2@ as object, -- regardless of the predicate of the triple. - query :: rdf -> Maybe Node -> Maybe Node -> Maybe Node -> Triples + query :: RDF rdfImpl -> Maybe Node -> Maybe Node -> Maybe Node -> Triples + -- |pretty prints the RDF graph + showGraph :: RDF rdfImpl -> String + +instance (Rdf a) => Show (RDF a) where + show a = showGraph a + -- |An RdfParser is a parser that knows how to parse 1 format of RDF and -- can parse an RDF document of that type from a string, a file, or a URL. -- Required configuration options will vary from instance to instance. @@ -397,35 +417,34 @@ -- |Parse RDF from the given text, yielding a failure with error message or -- the resultant RDF. - parseString :: forall rdf. (RDF rdf) => p -> T.Text -> Either ParseFailure rdf + parseString :: (Rdf a) => p -> T.Text -> Either ParseFailure (RDF a) -- |Parse RDF from the local file with the given path, yielding a failure with error -- message or the resultant RDF in the IO monad. - parseFile :: forall rdf. (RDF rdf) => p -> String -> IO (Either ParseFailure rdf) + parseFile :: (Rdf a) => p -> String -> IO (Either ParseFailure (RDF a)) -- |Parse RDF from the remote file with the given HTTP URL (https is not supported), -- yielding a failure with error message or the resultant graph in the IO monad. - parseURL :: forall rdf. (RDF rdf) => p -> String -> IO (Either ParseFailure rdf) - + parseURL :: (Rdf a) => p -> String -> IO (Either ParseFailure (RDF a)) -- |An RdfSerializer is a serializer of RDF to some particular output format, such as -- NTriples or Turtle. class RdfSerializer s where -- |Write the RDF to a file handle using whatever configuration is specified by -- the first argument. - hWriteRdf :: forall rdf. (RDF rdf) => s -> Handle -> rdf -> IO () + hWriteRdf :: (Rdf a) => s -> Handle -> RDF a -> IO () -- |Write the RDF to stdout; equivalent to @'hWriteRdf' stdout@. - writeRdf :: forall rdf. (RDF rdf) => s -> rdf -> IO () + writeRdf :: (Rdf a) => s -> RDF a -> IO () -- |Write to the file handle whatever header information is required based on -- the output format. For example, if serializing to Turtle, this method would -- write the necessary \@prefix declarations and possibly a \@baseUrl declaration, -- whereas for NTriples, there is no header section at all, so this would be a no-op. - hWriteH :: forall rdf. (RDF rdf) => s -> Handle -> rdf -> IO () + hWriteH :: (Rdf a) => s -> Handle -> RDF a -> IO () -- |Write header information to stdout; equivalent to @'hWriteRdf' stdout@. - writeH :: forall rdf. (RDF rdf) => s -> rdf -> IO () + writeH :: (Rdf a) => s -> RDF a -> IO () -- |Write some triples to a file handle using whatever configuration is specified -- by the first argument. diff --git a/src/Rdf4hParseMain.hs b/src/Rdf4hParseMain.hs --- a/src/Rdf4hParseMain.hs +++ b/src/Rdf4hParseMain.hs @@ -6,7 +6,7 @@ module Main where import Data.RDF.Types -import Data.RDF.Graph.TriplesList +import Data.RDF.Graph.TList import Text.RDF.RDF4H.NTriplesParser import Text.RDF.RDF4H.NTriplesSerializer import Text.RDF.RDF4H.TurtleParser @@ -65,26 +65,26 @@ ("turtle", True) -> parseURL (TurtleParser mInputUri docUri) inputUri >>= - \ (res :: Either ParseFailure TriplesList) -> + \ (res :: Either ParseFailure (RDF TList)) -> write outputFormat docUri emptyPms res ("turtle", False) -> (if inputUri /= "-" then parseFile (TurtleParser mInputUri docUri) inputUri else liftM (parseString (TurtleParser mInputUri docUri)) TIO.getContents) >>= - \ (res :: Either ParseFailure TriplesList) -> + \ (res :: Either ParseFailure (RDF TList)) -> write outputFormat docUri emptyPms res ("ntriples", True) -> parseURL NTriplesParser inputUri >>= - \ (res :: Either ParseFailure TriplesList) -> + \ (res :: Either ParseFailure (RDF TList)) -> write outputFormat Nothing emptyPms res ("ntriples", False) -> (if inputUri /= "-" then parseFile NTriplesParser inputUri else liftM (parseString NTriplesParser) TIO.getContents) >>= - \ (res :: Either ParseFailure TriplesList) -> + \ (res :: Either ParseFailure (RDF TList)) -> write outputFormat Nothing emptyPms res (str, _) -> putStrLn ("Invalid format: " ++ str) >> exitFailure -write :: forall rdf. (RDF rdf) => String -> Maybe T.Text -> PrefixMappings -> Either ParseFailure rdf -> IO () +write :: (Rdf a) => String -> Maybe T.Text -> PrefixMappings -> Either ParseFailure (RDF a) -> IO () write format docUri pms res = case res of (Left (ParseFailure msg)) -> putStrLn msg >> exitWith (ExitFailure 1) diff --git a/src/Text/RDF/RDF4H/Interact.hs b/src/Text/RDF/RDF4H/Interact.hs --- a/src/Text/RDF/RDF4H/Interact.hs +++ b/src/Text/RDF/RDF4H/Interact.hs @@ -17,7 +17,7 @@ import qualified Data.Text as T import Data.RDF.Types hiding (baseUrl) -import Data.RDF.Graph.TriplesList() +import Data.RDF.Graph.TList() import Data.RDF.Graph.HashMapS() import Text.RDF.RDF4H.NTriplesParser @@ -30,17 +30,17 @@ -- (used to resolve <> in the document). -- -- This function calls 'error' with an error message if unable to load the file. -loadTurtleFile :: forall rdf. (RDF rdf) => Maybe String -> Maybe String -> String -> IO rdf +loadTurtleFile :: (Rdf a) => Maybe String -> Maybe String -> String -> IO (RDF a) loadTurtleFile baseUrl docUri = _load parseFile (mkTurtleParser baseUrl docUri) -- |Load a Turtle file from a URL just like 'loadTurtleFile' does from the local -- filesystem. See that function for explanation of args, etc. -loadTurtleURL :: forall rdf. (RDF rdf) => Maybe String -> Maybe String -> String -> IO rdf +loadTurtleURL :: (Rdf a) => Maybe String -> Maybe String -> String -> IO (RDF a) loadTurtleURL baseUrl docUri = _load parseURL (mkTurtleParser baseUrl docUri) -- |Parse a Turtle document from the given 'T.Text' using the given @baseUrl@ and -- @docUri@, which have the same semantics as in the loadTurtle* functions. -parseTurtleString :: forall rdf. (RDF rdf) => Maybe String -> Maybe String -> T.Text -> rdf +parseTurtleString :: (Rdf a) => Maybe String -> Maybe String -> T.Text -> RDF a parseTurtleString baseUrl docUri = _parse parseString (mkTurtleParser baseUrl docUri) mkTurtleParser :: Maybe String -> Maybe String -> TurtleParser @@ -49,17 +49,17 @@ -- |Load an NTriples file from the filesystem. -- -- This function calls 'error' with an error message if unable to load the file. -loadNTriplesFile :: forall rdf. (RDF rdf) => String -> IO rdf +loadNTriplesFile :: (Rdf a) => String -> IO (RDF a) loadNTriplesFile = _load parseFile NTriplesParser -- |Load an NTriples file from a URL just like 'loadNTriplesFile' does from the local -- filesystem. See that function for more info. -loadNTriplesURL :: forall rdf. (RDF rdf) => String -> IO rdf +loadNTriplesURL :: (Rdf a) => String -> IO (RDF a) loadNTriplesURL = _load parseURL NTriplesParser -- |Parse an NTriples document from the given 'T.Text', as 'loadNTriplesFile' does -- from a file. -parseNTriplesString :: forall rdf. (RDF rdf) => T.Text -> rdf +parseNTriplesString :: (Rdf a) => T.Text -> RDF a parseNTriplesString = _parse parseString NTriplesParser @@ -70,19 +70,19 @@ -- Load an RDF using the given parseFunc, parser, and the location (filesystem path -- or HTTP URL), calling error with the 'ParseFailure' message if unable to load -- or parse for any reason. -_load :: forall p rdf. (RdfParser p, RDF rdf) => - (p -> String -> IO (Either ParseFailure rdf)) -> - p -> String -> IO rdf +_load :: (RdfParser p, Rdf a) => + (p -> String -> IO (Either ParseFailure (RDF a))) -> + p -> String -> IO (RDF a) _load parseFunc parser location = parseFunc parser location >>= _handle -- Use the given parseFunc and parser to parse the given 'T.Text', calling error -- with the 'ParseFailure' message if unable to load or parse for any reason. -_parse :: forall p rdf. (RdfParser p, RDF rdf) => - (p -> T.Text -> Either ParseFailure rdf) -> - p -> T.Text -> rdf +_parse :: (RdfParser p, Rdf a) => + (p -> T.Text -> Either ParseFailure (RDF a)) -> + p -> T.Text -> RDF a _parse parseFunc parser rdfBs = either (error . show) id $ parseFunc parser rdfBs -- Handle the result of an IO parse by returning the graph if parse was successful -- and calling 'error' with the 'ParseFailure' error message if unsuccessful. -_handle :: forall rdf. (RDF rdf) => Either ParseFailure rdf -> IO rdf +_handle :: (Rdf a) => Either ParseFailure (RDF a) -> IO (RDF a) _handle = either (error . show) return diff --git a/src/Text/RDF/RDF4H/NTriplesParser.hs b/src/Text/RDF/RDF4H/NTriplesParser.hs --- a/src/Text/RDF/RDF4H/NTriplesParser.hs +++ b/src/Text/RDF/RDF4H/NTriplesParser.hs @@ -256,19 +256,19 @@ nt_tab :: GenParser () Char nt_tab = char '\t' -parseString' :: forall rdf. (RDF rdf) => T.Text -> Either ParseFailure rdf +parseString' :: (Rdf a) => T.Text -> Either ParseFailure (RDF a) parseString' bs = handleParse mkRdf (runParser nt_ntripleDoc () "" bs) -parseURL' :: forall rdf. (RDF rdf) => String -> IO (Either ParseFailure rdf) +parseURL' :: (Rdf a) => String -> IO (Either ParseFailure (RDF a)) parseURL' = _parseURL parseString' -parseFile' :: forall rdf. (RDF rdf) => String -> IO (Either ParseFailure rdf) +parseFile' :: (Rdf a) => String -> IO (Either ParseFailure (RDF a)) parseFile' path = liftM (handleParse mkRdf . runParser nt_ntripleDoc () path) (TIO.readFile path) -handleParse :: forall rdf. (RDF rdf) => (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> +handleParse :: {-forall rdf. (RDF rdf) => -} (Triples -> Maybe BaseUrl -> PrefixMappings -> (RDF a)) -> Either ParseError [Maybe Triple] -> - Either ParseFailure rdf + Either ParseFailure (RDF a) handleParse _mkRdf result -- | T.length rem /= 0 = (Left $ ParseFailure $ "Invalid Document. Unparseable end of document: " ++ T.unpack rem) | otherwise = diff --git a/src/Text/RDF/RDF4H/NTriplesSerializer.hs b/src/Text/RDF/RDF4H/NTriplesSerializer.hs --- a/src/Text/RDF/RDF4H/NTriplesSerializer.hs +++ b/src/Text/RDF/RDF4H/NTriplesSerializer.hs @@ -26,7 +26,7 @@ hWriteN _ = _writeNode writeN _ = _writeNode stdout -_writeRdf :: RDF rdf => Handle -> rdf -> IO () +_writeRdf :: Rdf a => Handle -> RDF a -> IO () _writeRdf h = _writeTriples h . expandTriples _writeTriples :: Handle -> Triples -> IO () diff --git a/src/Text/RDF/RDF4H/ParserUtils.hs b/src/Text/RDF/RDF4H/ParserUtils.hs --- a/src/Text/RDF/RDF4H/ParserUtils.hs +++ b/src/Text/RDF/RDF4H/ParserUtils.hs @@ -15,7 +15,7 @@ -- | A convenience function for terminating a parse with a parse failure, using -- the given error message as the message for the failure. -errResult :: RDF rdf => String -> Either ParseFailure rdf +errResult :: {- RDF rdf => -} String -> Either ParseFailure (RDF rdfImpl) errResult msg = Left (ParseFailure msg) -- | Keep the (Just t) triples (eliminating the Nothing comments), and unbox the @@ -25,7 +25,7 @@ filter (/= Nothing) -- | Parse contents at URL into an 'RDF'. -_parseURL :: RDF rdf => (T.Text -> Either ParseFailure rdf) -> String -> IO (Either ParseFailure rdf) +_parseURL :: {- Rdf rdf => -} (T.Text -> Either ParseFailure (RDF rdfImpl)) -> String -> IO (Either ParseFailure (RDF rdfImpl)) _parseURL parseFunc url = maybe (return (Left (ParseFailure $ "Unable to parse URL: " ++ url))) diff --git a/src/Text/RDF/RDF4H/TurtleParser.hs b/src/Text/RDF/RDF4H/TurtleParser.hs --- a/src/Text/RDF/RDF4H/TurtleParser.hs +++ b/src/Text/RDF/RDF4H/TurtleParser.hs @@ -714,11 +714,11 @@ -- base URI against which the relative URI is resolved. -- -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples. -parseURL' :: forall rdf. (RDF rdf) => +parseURL' :: (Rdf a) => Maybe BaseUrl -- ^ The optional base URI of the document. -> Maybe T.Text -- ^ The document URI (i.e., the URI of the document itself); if Nothing, use location URI. -> String -- ^ The location URI from which to retrieve the Turtle document. - -> IO (Either ParseFailure rdf) + -> IO (Either ParseFailure (RDF a)) -- ^ The parse result, which is either a @ParseFailure@ or the RDF -- corresponding to the Turtle document. parseURL' bUrl docUrl = _parseURL (parseString' bUrl docUrl) @@ -728,7 +728,7 @@ -- than a location URI. -- -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples. -parseFile' :: forall rdf. (RDF rdf) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure rdf) +parseFile' :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure (RDF a)) parseFile' bUrl docUrl fpath = do TIO.readFile fpath >>= \bs' -> return $ handleResult bUrl (runParser t_turtleDoc initialState (maybe "" T.unpack docUrl) bs') where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], [], False, Seq.empty) @@ -736,11 +736,11 @@ -- |Parse the given string as a Turtle document. The arguments and return type have the same semantics -- as , except that the last @String@ argument corresponds to the Turtle document itself as -- a string rather than a location URI. -parseString' :: forall rdf. (RDF rdf) => Maybe BaseUrl -> Maybe T.Text -> T.Text -> Either ParseFailure rdf +parseString' :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> T.Text -> Either ParseFailure (RDF a) parseString' bUrl docUrl ttlStr = handleResult bUrl (runParser t_turtleDoc initialState "" ttlStr) where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], [], False, Seq.empty) -handleResult :: RDF rdf => Maybe BaseUrl -> Either ParseError (Seq Triple, PrefixMappings) -> Either ParseFailure rdf +handleResult :: Rdf a => Maybe BaseUrl -> Either ParseError (Seq Triple, PrefixMappings) -> Either ParseFailure (RDF a) handleResult bUrl result = case result of (Left err) -> Left (ParseFailure $ show err) diff --git a/src/Text/RDF/RDF4H/TurtleSerializer.hs b/src/Text/RDF/RDF4H/TurtleSerializer.hs --- a/src/Text/RDF/RDF4H/TurtleSerializer.hs +++ b/src/Text/RDF/RDF4H/TurtleSerializer.hs @@ -40,7 +40,7 @@ -- configurable somehow, so that if the user really doesn't want any extra -- prefix declarations added, that is possible. -_writeRdf :: RDF rdf => Handle -> Maybe T.Text -> rdf -> IO () +_writeRdf :: Rdf a => Handle -> Maybe T.Text -> RDF a -> IO () _writeRdf h mdUrl rdf = writeHeader h bUrl pms' >> writeTriples h mdUrl pms' ts >> hPutChar h '\n' where diff --git a/src/Text/RDF/RDF4H/XmlParser.hs b/src/Text/RDF/RDF4H/XmlParser.hs --- a/src/Text/RDF/RDF4H/XmlParser.hs +++ b/src/Text/RDF/RDF4H/XmlParser.hs @@ -15,7 +15,7 @@ import Data.Maybe import Data.Typeable import Text.RDF.RDF4H.ParserUtils -import Data.RDF.Types (RDF,RdfParser(..),Node(BNodeGen),BaseUrl(..),Triple(..),Triples,Subject,Predicate,Object,PrefixMappings(..),ParseFailure(ParseFailure),mkRdf,lnode,plainL,plainLL,typedL,unode,bnode,unodeValidate) +import Data.RDF.Types (Rdf,RDF,RdfParser(..),Node(BNodeGen),BaseUrl(..),Triple(..),Triples,Subject,Predicate,Object,PrefixMappings(..),ParseFailure(ParseFailure),mkRdf,lnode,plainL,plainLL,typedL,unode,bnode,unodeValidate) import qualified Data.Text as T (Text,pack,unpack) import qualified Data.Text.IO as TIO import Text.XML.HXT.Core (ArrowXml,ArrowIf,XmlTree,IfThen((:->)),(>.),(>>.),first,neg,(<+>),expandURI,getName,getAttrValue,getAttrValue0,getAttrl,hasAttrValue,hasAttr,constA,choiceA,getChildren,ifA,arr2A,second,hasName,isElem,isWhiteSpace,xshow,listA,isA,isText,getText,this,unlistA,orElse,sattr,mkelem,xreadDoc,runSLA) @@ -51,7 +51,7 @@ -- than a location URI. -- -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples. -parseFile' :: forall rdf. (RDF rdf) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure rdf) +parseFile' :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure (RDF a)) parseFile' bUrl dUrl fpath = TIO.readFile fpath >>= return . parseXmlRDF bUrl dUrl @@ -72,22 +72,22 @@ -- base URI against which the relative URI is resolved. --p -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples. -parseURL' :: forall rdf. (RDF rdf) => +parseURL' :: (Rdf a) => Maybe BaseUrl -- ^ The optional base URI of the document. -> Maybe T.Text -- ^ The document URI (i.e., the URI of the document itself); if Nothing, use location URI. -> String -- ^ The location URI from which to retrieve the XML document. - -> IO (Either ParseFailure rdf) + -> IO (Either ParseFailure (RDF a)) -- ^ The parse result, which is either a @ParseFailure@ or the RDF -- corresponding to the XML document. parseURL' bUrl docUrl = _parseURL (parseXmlRDF bUrl docUrl) -- |Parse a xml T.Text to an RDF representation -parseXmlRDF :: forall rdf. (RDF rdf) +parseXmlRDF :: (Rdf a) => Maybe BaseUrl -- ^ The base URL for the RDF if required -> Maybe T.Text -- ^ DocUrl: The request URL for the RDF if available -> T.Text -- ^ The contents to parse - -> Either ParseFailure rdf -- ^ The RDF representation of the triples or ParseFailure + -> Either ParseFailure (RDF a) -- ^ The RDF representation of the triples or ParseFailure parseXmlRDF bUrl dUrl xmlStr = case runParseArrow of (_,r:_) -> Right r _ -> Left (ParseFailure "XML parsing failed") @@ -108,7 +108,7 @@ mkBase Nothing = [] -- |Arrow that translates HXT XmlTree to an RDF representation -getRDF :: forall rdf a. (RDF rdf, ArrowXml a, ArrowState GParseState a) => a XmlTree rdf +getRDF :: forall rdf a. (Rdf rdf, ArrowXml a, ArrowState GParseState a) => a XmlTree (RDF rdf) getRDF = proc xml -> do -- rdf <- hasName "rdf:RDF" `orElse` hasName "RDF" <<< isElem <<< getChildren -< xml rdf <- isElem <<< getChildren -< xml diff --git a/testsuite/tests/Data/RDF/Graph/HashMapSP_Test.hs b/testsuite/tests/Data/RDF/Graph/HashMapSP_Test.hs deleted file mode 100644 --- a/testsuite/tests/Data/RDF/Graph/HashMapSP_Test.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Data.RDF.Graph.HashMapSP_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where - -import Data.RDF.Types -import Data.RDF.Graph.HashMapSP (HashMapSP) -import Data.RDF.GraphTestUtils -import qualified Data.Map as Map -import Control.Monad - -import Test.QuickCheck - -instance Arbitrary HashMapSP where - arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) - -empty' :: HashMapSP -empty' = empty - -mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> HashMapSP -mkRdf' = mkRdf - -triplesOf' :: HashMapSP -> Triples -triplesOf' = triplesOf - -uniqTriplesOf' :: HashMapSP -> Triples -uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/Graph/HashMapS_Test.hs b/testsuite/tests/Data/RDF/Graph/HashMapS_Test.hs deleted file mode 100644 --- a/testsuite/tests/Data/RDF/Graph/HashMapS_Test.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Data.RDF.Graph.HashMapS_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where - -import Data.RDF.Types -import Data.RDF.Graph.HashMapS (HashMapS) -import Data.RDF.GraphTestUtils -import qualified Data.Map as Map -import Control.Monad - -import Test.QuickCheck - -instance Arbitrary HashMapS where - arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) - --coarbitrary = undefined - -empty' :: HashMapS -empty' = empty - -mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> HashMapS -mkRdf' = mkRdf - -triplesOf' :: HashMapS -> Triples -triplesOf' = triplesOf - -uniqTriplesOf' :: HashMapS -> Triples -uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/Graph/HashSP_Test.hs b/testsuite/tests/Data/RDF/Graph/HashSP_Test.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/Data/RDF/Graph/HashSP_Test.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE FlexibleInstances #-} + +module Data.RDF.Graph.HashSP_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where + +import Data.RDF.Types +import Data.RDF.Graph.HashMapSP (HashSP) +import Data.RDF.GraphTestUtils +import qualified Data.Map as Map +import Control.Monad + +import Test.QuickCheck + +instance Arbitrary HashSP + +instance Arbitrary (RDF HashSP) where + arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) + +empty' :: RDF HashSP +empty' = empty + +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF HashSP +mkRdf' = mkRdf + +triplesOf' :: RDF HashSP -> Triples +triplesOf' = triplesOf + +uniqTriplesOf' :: RDF HashSP -> Triples +uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/Graph/HashS_Test.hs b/testsuite/tests/Data/RDF/Graph/HashS_Test.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/Data/RDF/Graph/HashS_Test.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE FlexibleInstances #-} + +module Data.RDF.Graph.HashS_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where + +import Data.RDF.Types +import Data.RDF.Graph.HashMapS (HashS) +import Data.RDF.GraphTestUtils +import qualified Data.Map as Map +import Control.Monad + +import Test.QuickCheck + +instance Arbitrary HashS + +instance Arbitrary (RDF HashS) where + arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) + --coarbitrary = undefined + +empty' :: RDF HashS +empty' = empty + +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF HashS +mkRdf' = mkRdf + +triplesOf' :: RDF HashS -> Triples +triplesOf' = triplesOf + +uniqTriplesOf' :: RDF HashS -> Triples +uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/Graph/MapSP_Test.hs b/testsuite/tests/Data/RDF/Graph/MapSP_Test.hs deleted file mode 100644 --- a/testsuite/tests/Data/RDF/Graph/MapSP_Test.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Data.RDF.Graph.MapSP_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where - -import Data.RDF.Types -import Data.RDF.Graph.MapSP (MapSP) -import Data.RDF.GraphTestUtils -import qualified Data.Map as Map -import Control.Monad - -import Test.QuickCheck - -instance Arbitrary MapSP where - arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) - --coarbitrary = undefined - -empty' :: MapSP -empty' = empty - -mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> MapSP -mkRdf' = mkRdf - -triplesOf' :: MapSP -> Triples -triplesOf' = triplesOf - -uniqTriplesOf' :: MapSP -> Triples -uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/Graph/SP_Test.hs b/testsuite/tests/Data/RDF/Graph/SP_Test.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/Data/RDF/Graph/SP_Test.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE FlexibleInstances #-} + +module Data.RDF.Graph.SP_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where + +import Data.RDF.Types +import Data.RDF.Graph.MapSP (SP) +import Data.RDF.GraphTestUtils +import qualified Data.Map as Map +import Control.Monad + +import Test.QuickCheck + +instance Arbitrary SP + +instance Arbitrary (RDF SP) where + arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) + --coarbitrary = undefined + +empty' :: RDF SP +empty' = empty + +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF SP +mkRdf' = mkRdf + +triplesOf' :: RDF SP -> Triples +triplesOf' = triplesOf + +uniqTriplesOf' :: RDF SP -> Triples +uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/Graph/TList_Test.hs b/testsuite/tests/Data/RDF/Graph/TList_Test.hs new file mode 100644 --- /dev/null +++ b/testsuite/tests/Data/RDF/Graph/TList_Test.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE FlexibleInstances #-} + +module Data.RDF.Graph.TList_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.Graph.TList +import Data.RDF.Types +import Test.QuickCheck.Arbitrary + +instance Arbitrary TList + +instance Arbitrary (RDF TList) where + arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) + --coarbitrary = undefined + +empty' :: RDF TList +empty' = empty + +mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF TList +mkRdf' = mkRdf + +triplesOf' :: RDF TList -> Triples +triplesOf' = triplesOf + +uniqTriplesOf' :: RDF TList -> Triples +uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/Graph/TriplesList_Test.hs b/testsuite/tests/Data/RDF/Graph/TriplesList_Test.hs deleted file mode 100644 --- a/testsuite/tests/Data/RDF/Graph/TriplesList_Test.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Data.RDF.Graph.TriplesList_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.Graph.TriplesList -import Data.RDF.Types -import Test.QuickCheck.Arbitrary - -instance Arbitrary TriplesList where - arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) - --coarbitrary = undefined - -empty' :: TriplesList -empty' = empty - -mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesList -mkRdf' = mkRdf - -triplesOf' :: TriplesList -> Triples -triplesOf' = triplesOf - -uniqTriplesOf' :: TriplesList -> Triples -uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/Graph/TriplesPatriciaTree_Test.hs b/testsuite/tests/Data/RDF/Graph/TriplesPatriciaTree_Test.hs deleted file mode 100644 --- a/testsuite/tests/Data/RDF/Graph/TriplesPatriciaTree_Test.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Data.RDF.Graph.TriplesPatriciaTree_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where - -import Data.RDF.Types -import Data.RDF.Graph.TriplesPatriciaTree (TriplesPatriciaTree) -import Data.RDF.GraphTestUtils -import qualified Data.Map as Map -import Control.Monad - -import Test.QuickCheck - -instance Arbitrary TriplesPatriciaTree where - arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty) - --coarbitrary = undefined - -empty' :: TriplesPatriciaTree -empty' = empty - -mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesPatriciaTree -mkRdf' = mkRdf - -triplesOf' :: TriplesPatriciaTree -> Triples -triplesOf' = triplesOf - -uniqTriplesOf' :: TriplesPatriciaTree -> Triples -uniqTriplesOf' = uniqTriplesOf diff --git a/testsuite/tests/Data/RDF/GraphTestUtils.hs b/testsuite/tests/Data/RDF/GraphTestUtils.hs --- a/testsuite/tests/Data/RDF/GraphTestUtils.hs +++ b/testsuite/tests/Data/RDF/GraphTestUtils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + module Data.RDF.GraphTestUtils where import Data.RDF.Types @@ -10,6 +12,7 @@ import qualified Data.Set as Set import qualified Data.Map as Map import Control.Monad +import GHC.Generics () import System.Directory (removeFile) import System.IO.Unsafe(unsafePerformIO) import System.IO @@ -22,8 +25,10 @@ -- 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) -> TestTree +instance Arbitrary (RDF a) + +graphTests :: (Arbitrary rdf, Rdf rdf) + => TestName -> (RDF rdf -> Triples) -> (RDF rdf -> Triples) -> RDF rdf -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -> TestTree graphTests testGroupName _triplesOf _uniqTriplesOf _empty _mkRdf = testGroup testGroupName [ testProperty "empty" (p_empty _triplesOf _empty) @@ -67,17 +72,17 @@ -- 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool p_mkRdf_no_dupes _uniqtriplesOf _mkRdf ts bUrl pms = null ts || (sort result == uordered ts) where @@ -89,14 +94,14 @@ -- 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 :: Rdf rdf => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property p_query_matched_spo _triplesOf rdf = classify (null ts) "trivial" $ forAll (tripleFromGen _triplesOf rdf) f @@ -113,7 +118,7 @@ -- 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 :: RDF 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 @@ -125,7 +130,7 @@ -} -- 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Triple -> Property p_query_unmatched_spo _triplesOf rdf t = classify (t `elem` ts) "ignored" $ notElem t ts ==> [] == queryT rdf t @@ -135,43 +140,43 @@ -- 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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) +mk_query_match_fn :: Rdf rdf => (Triple -> Triple -> Bool) -> (Triple -> (Maybe Node, Maybe Node, Maybe Node)) - -> (rdf -> Triples) -> rdf -> Property + -> (RDF rdf -> Triples) -> RDF rdf -> Property mk_query_match_fn tripleCompareFn mkPatternFn _triplesOf rdf = forAll (tripleFromGen _triplesOf rdf) f where @@ -187,7 +192,7 @@ all (tripleCompareFn t) results && all (not . tripleCompareFn t) notResults -p_select_match_none :: RDF rdf => (rdf -> Triples) -> rdf -> Bool +p_select_match_none :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Bool p_select_match_none _triplesOf_not_used rdf = sort ts1 == sort ts2 where ts1 = select rdf Nothing Nothing Nothing @@ -197,14 +202,14 @@ -- https://github.com/cordawyn/rdf4h/commit/9dd4729908db8d2f80088706592adac81a0f3016 ts2 = triplesOf rdf -p_select_match_s :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_select_match_s :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property p_select_match_p = p_select_match_fn same mkPattern where @@ -216,35 +221,35 @@ lastChar _ = error "GraphTestUtils.p_select_match_p.lastChar" -p_select_match_o :: RDF rdf => (rdf -> Triples) -> rdf -> Property +p_select_match_o :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property p_select_match_spo = p_select_match_fn same mkPattern where @@ -257,9 +262,9 @@ 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) +p_select_match_fn :: Rdf rdf => (Triple -> Triple -> Bool) -> (Triple -> (NodeSelector, NodeSelector, NodeSelector)) - -> (rdf -> Triples) -> rdf -> Property + -> (RDF rdf -> Triples) -> RDF rdf -> Property p_select_match_fn tripleCompareFn mkPatternFn _triplesOf rdf = forAll (tripleFromGen _triplesOf rdf) f where @@ -275,7 +280,7 @@ all (tripleCompareFn t) results && all (not . tripleCompareFn t) notResults -mkRdfWithDupe :: RDF rdf => (rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> rdf -> Triple -> rdf +mkRdfWithDupe :: Rdf rdf => (RDF rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -> RDF rdf -> Triple -> RDF rdf mkRdfWithDupe _triplesOf _mkRdf rdf t = _mkRdf ts (baseUrl rdf) (prefixMappings rdf) where ts = t : _triplesOf rdf @@ -284,10 +289,10 @@ -- 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 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 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 @@ -317,14 +322,14 @@ uordered :: Triples -> Triples uordered = sort . nub -tripleFromGen :: RDF rdf => (rdf -> Triples) -> rdf -> Gen (Maybe Triple) +tripleFromGen :: Rdf rdf => (RDF rdf -> Triples) -> RDF 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 rdf => RDF rdf -> Triple -> Triples queryT rdf t = query rdf (Just $ subjectOf t) (Just $ predicateOf t) (Just $ objectOf t) languages :: [T.Text] @@ -394,7 +399,7 @@ -- Reported by Daniel Bergey: -- https://github.com/robstewart57/rdf4h/issues/4 -p_reverseRdfTest :: RDF rdf => (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> Property +p_reverseRdfTest :: Rdf a => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF a) -> Property p_reverseRdfTest _mkRdf = monadicIO $ do fileContents <- Test.QuickCheck.Monadic.run $ do (pathFile,hFile) <- openTempFile "." "tmp." diff --git a/testsuite/tests/Test.hs b/testsuite/tests/Test.hs --- a/testsuite/tests/Test.hs +++ b/testsuite/tests/Test.hs @@ -2,11 +2,12 @@ import Test.Tasty (defaultMain,testGroup) -import qualified Data.RDF.Graph.TriplesList_Test as TriplesList -import qualified Data.RDF.Graph.HashMapS_Test as HashMapS -import qualified Data.RDF.Graph.HashMapSP_Test as HashMapSP -import qualified Data.RDF.Graph.MapSP_Test as MapSP -import qualified Data.RDF.Graph.TriplesPatriciaTree_Test as TriplesPatriciaTree +import qualified Data.RDF.Graph.TList_Test as TList +import qualified Data.RDF.Graph.HashS_Test as HashS +import qualified Data.RDF.Graph.HashSP_Test as HashSP +import qualified Data.RDF.Graph.SP_Test as SP +-- very slow implementation, disabled for now. +-- import qualified Data.RDF.Graph.TriplesPatriciaTree_Test as TriplesPatriciaTree import Data.RDF.Types import qualified Text.RDF.RDF4H.XmlParser_Test as XmlParser import qualified Text.RDF.RDF4H.TurtleParser_ConformanceTest as TurtleParser @@ -54,35 +55,35 @@ defaultMain (testGroup "rdf4h tests" [ -- RDF graph API tests - graphTests "TriplesList" - TriplesList.triplesOf' - TriplesList.uniqTriplesOf' - TriplesList.empty' - TriplesList.mkRdf' + graphTests "TList" + TList.triplesOf' + TList.uniqTriplesOf' + TList.empty' + TList.mkRdf' - , graphTests "HashMapS" - HashMapS.triplesOf' - HashMapS.uniqTriplesOf' - HashMapS.empty' - HashMapS.mkRdf' + , graphTests "HashS" + HashS.triplesOf' + HashS.uniqTriplesOf' + HashS.empty' + HashS.mkRdf' - , graphTests "HashMapSP" - HashMapSP.triplesOf' - HashMapSP.uniqTriplesOf' - HashMapSP.empty' - HashMapSP.mkRdf' + , graphTests "HashSP" + HashSP.triplesOf' + HashSP.uniqTriplesOf' + HashSP.empty' + HashSP.mkRdf' - , graphTests "MapSP" - MapSP.triplesOf' - MapSP.uniqTriplesOf' - MapSP.empty' - MapSP.mkRdf' + , graphTests "SP" + SP.triplesOf' + SP.uniqTriplesOf' + SP.empty' + SP.mkRdf' - , graphTests "TriplesPatriciaTree" - TriplesPatriciaTree.triplesOf' - TriplesPatriciaTree.uniqTriplesOf' - TriplesPatriciaTree.empty' - TriplesPatriciaTree.mkRdf' + -- , graphTests "TriplesPatriciaTree" + -- TriplesPatriciaTree.triplesOf' + -- TriplesPatriciaTree.uniqTriplesOf' + -- TriplesPatriciaTree.empty' + -- TriplesPatriciaTree.mkRdf' -- rdf4h unit tests , TurtleParser.tests diff --git a/testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs b/testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs --- a/testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs +++ b/testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs @@ -8,7 +8,7 @@ import Control.Monad (liftM) import Data.RDF.GraphTestUtils import Data.RDF.Query -import Data.RDF.Graph.TriplesList +import Data.RDF.Graph.TList import Data.RDF.Types import qualified Data.Text as T import qualified Data.Text.IO as TIO @@ -59,8 +59,8 @@ inGr = loadInputGraph1 dir fname in doGoodConformanceTest expGr inGr $ printf "test using file \"%s\"" fname -doGoodConformanceTest :: IO (Either ParseFailure TriplesList) -> - IO (Either ParseFailure TriplesList) -> +doGoodConformanceTest :: IO (Either ParseFailure (RDF TList)) -> + IO (Either ParseFailure (RDF TList)) -> String -> TestTree doGoodConformanceTest expGr inGr testname = let t1 = assertLoadSuccess (printf "expected (%s): " testname) expGr @@ -75,7 +75,7 @@ -- 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 :: Rdf a => Either ParseFailure (RDF a) -> Either ParseFailure (RDF a) -> Maybe String equivalent (Left _) _ = Nothing equivalent _ (Left _) = Nothing equivalent (Right gr1) (Right gr2) = test $! zip gr1ts gr2ts @@ -101,17 +101,17 @@ -- 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 TriplesList) +loadInputGraph :: String -> Int -> IO (Either ParseFailure (RDF TList)) 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 TriplesList) +loadInputGraph1 :: String -> String -> IO (Either ParseFailure (RDF TList)) loadInputGraph1 dir fname = TIO.readFile (printf "%s/%s.ttl" dir fname :: String) >>= return . parseString (TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname)) >>= return . handleLoad -handleLoad :: Either ParseFailure TriplesList -> Either ParseFailure TriplesList +handleLoad :: Either ParseFailure (RDF TList) -> Either ParseFailure (RDF TList) handleLoad res = case res of l@(Left _) -> l @@ -126,13 +126,13 @@ normalizeN (BNodeGen i) = BNode (T.pack $ "_:genid" ++ show i) normalizeN n = n -loadExpectedGraph :: String -> Int -> IO (Either ParseFailure TriplesList) +loadExpectedGraph :: String -> Int -> IO (Either ParseFailure (RDF TList)) loadExpectedGraph name n = loadExpectedGraph1 (fpath name n "out") -loadExpectedGraph1 :: String -> IO (Either ParseFailure TriplesList) +loadExpectedGraph1 :: String -> IO (Either ParseFailure (RDF TList)) loadExpectedGraph1 fname = liftM (parseString (TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname))) (TIO.readFile fname) -assertLoadSuccess, assertLoadFailure :: String -> IO (Either ParseFailure TriplesList) -> TU.Assertion +assertLoadSuccess, assertLoadFailure :: String -> IO (Either ParseFailure (RDF TList)) -> TU.Assertion assertLoadSuccess idStr exprGr = do g <- exprGr case g of @@ -145,7 +145,7 @@ Left _ -> return () Right _ -> TU.assertFailure $ "Bad test " ++ idStr ++ " loaded successfully." -assertEquivalent :: RDF rdf => String -> IO (Either ParseFailure rdf) -> IO (Either ParseFailure rdf) -> TU.Assertion +assertEquivalent :: Rdf a => String -> IO (Either ParseFailure (RDF a)) -> IO (Either ParseFailure (RDF a)) -> TU.Assertion assertEquivalent testname r1 r2 = do gr1 <- r1 gr2 <- r2 diff --git a/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs b/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs --- a/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs +++ b/testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs @@ -9,7 +9,7 @@ -- Import common libraries to facilitate tests import qualified Data.Map as Map import Data.RDF.Query -import Data.RDF.Graph.TriplesList (TriplesList) +import Data.RDF.Graph.TList (TList) import Data.RDF.Types import qualified Data.Text as T (Text, unlines) import Text.RDF.RDF4H.XmlParser @@ -42,13 +42,13 @@ mkTextNode :: T.Text -> Node mkTextNode = lnode . plainL -testParse :: T.Text -> TriplesList -> Assertion +testParse :: T.Text -> RDF TList -> Assertion testParse exRDF ex = case parsed of Right result -> assertBool ("expected: " ++ show ex ++ "but got: " ++ show result) - (isIsomorphic (result :: TriplesList) (ex :: TriplesList)) + (isIsomorphic (result :: RDF TList) (ex :: RDF TList)) Left (ParseFailure err) -> assertFailure err where parsed = parseString (XmlParser Nothing Nothing) exRDF diff --git a/testsuite/tests/W3C/Manifest.hs b/testsuite/tests/W3C/Manifest.hs --- a/testsuite/tests/W3C/Manifest.hs +++ b/testsuite/tests/W3C/Manifest.hs @@ -5,7 +5,7 @@ TestEntry(..) ) where -import Data.RDF.Graph.TriplesList +import Data.RDF.Graph.TList import Data.RDF.Query import Data.RDF.Types import Data.RDF.Namespace @@ -126,7 +126,7 @@ parseFile testParser (T.unpack manifestPath) >>= return . rdfToManifest . fromEither where testParser = TurtleParser (Just $ BaseUrl baseIRI) Nothing -rdfToManifest :: TriplesList -> Manifest +rdfToManifest :: RDF TList -> 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) @@ -137,10 +137,10 @@ 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 :: TriplesList -> Node -> TestEntry +rdfToTestEntry :: RDF TList -> Node -> TestEntry rdfToTestEntry rdf teSubject = triplesToTestEntry rdf $ query rdf (Just teSubject) Nothing Nothing -triplesToTestEntry :: TriplesList -> Triples -> TestEntry +triplesToTestEntry :: RDF TList -> Triples -> TestEntry triplesToTestEntry rdf ts = case objectByPredicate rdfType ts of (UNode "http://www.w3.org/ns/rdftest#TestTurtleEval") -> mkTestTurtleEval ts @@ -188,7 +188,7 @@ action = objectByPredicate mfAction ts } -mkPositiveEntailmentTest :: Triples -> TriplesList -> TestEntry +mkPositiveEntailmentTest :: Triples -> RDF TList -> TestEntry mkPositiveEntailmentTest ts rdf = PositiveEntailmentTest { name = lnodeText $ objectByPredicate mfName ts, comment = lnodeText $ objectByPredicate rdfsComment ts, @@ -206,7 +206,7 @@ uDT = rdfCollectionToList rdf uDTCollectionHead uDTCollectionHead = objectByPredicate mfUnrecognizedDatatypes ts -mkNegativeEntailmentTest :: Triples -> TriplesList -> TestEntry +mkNegativeEntailmentTest :: Triples -> RDF TList -> TestEntry mkNegativeEntailmentTest ts rdf = NegativeEntailmentTest { name = lnodeText $ objectByPredicate mfName ts, comment = lnodeText $ objectByPredicate rdfsComment ts, @@ -266,10 +266,10 @@ objectByPredicate :: Predicate -> Triples -> Object objectByPredicate p = objectOf . fromJust . L.find (\t -> predicateOf t == p) -manifestSubjectNodes :: TriplesList -> [Subject] +manifestSubjectNodes :: RDF TList -> [Subject] manifestSubjectNodes rdf = subjectNodes rdf [mfManifest] -subjectNodes :: TriplesList -> [Object] -> [Subject] +subjectNodes :: RDF TList -> [Object] -> [Subject] subjectNodes rdf = (map subjectOf) . concatMap queryType where queryType n = query rdf Nothing (Just rdfType) (Just n) @@ -294,15 +294,15 @@ -- | 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 :: TriplesList -> Node -> [Node] +rdfCollectionToList :: RDF TList -> 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 :: TriplesList -> Triple -> [Node] +tripleToList :: RDF TList -> 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 :: TriplesList -> Node -> Triples +nextCollectionTriples :: RDF TList -> 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 --- a/testsuite/tests/W3C/NTripleTest.hs +++ b/testsuite/tests/W3C/NTripleTest.hs @@ -10,7 +10,7 @@ import Data.RDF.Types import Text.RDF.RDF4H.NTriplesParser -import Data.RDF.Graph.TriplesList +import Data.RDF.Graph.TList tests :: Manifest -> TestTree tests = runManifestTests mfEntryToTest @@ -23,11 +23,11 @@ mfEntryToTest :: TestEntry -> TestTree mfEntryToTest (TestNTriplesPositiveSyntax nm _ _ act') = let act = (UNode . fromJust . fileSchemeToFilePath) act' - rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList) + rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList)) in TU.testCase (T.unpack nm) $ assertIsParsed rdf mfEntryToTest (TestNTriplesNegativeSyntax nm _ _ act') = let act = (UNode . fromJust . fileSchemeToFilePath) act' - rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList) + rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList)) in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x diff --git a/testsuite/tests/W3C/RdfXmlTest.hs b/testsuite/tests/W3C/RdfXmlTest.hs --- a/testsuite/tests/W3C/RdfXmlTest.hs +++ b/testsuite/tests/W3C/RdfXmlTest.hs @@ -12,7 +12,7 @@ import Data.RDF.Query import Text.RDF.RDF4H.XmlParser import Text.RDF.RDF4H.NTriplesParser -import Data.RDF.Graph.TriplesList +import Data.RDF.Graph.TList tests :: Manifest -> TestTree tests = runManifestTests mfEntryToTest @@ -26,12 +26,12 @@ mfEntryToTest (TestXMLEval nm _ _ act' res') = let act = (UNode . fromJust . fileSchemeToFilePath) act' res = (UNode . fromJust . fileSchemeToFilePath) res' - parsedRDF = parseFile testParser (nodeURI act) >>= return . fromEither :: IO TriplesList - expectedRDF = parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO TriplesList + parsedRDF = parseFile testParser (nodeURI act) >>= return . fromEither :: IO (RDF TList) + expectedRDF = parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO (RDF TList) in TU.testCase (T.unpack nm) $ assertIsIsomorphic parsedRDF expectedRDF mfEntryToTest (TestXMLNegativeSyntax nm _ _ act') = let act = (UNode . fromJust . fileSchemeToFilePath) act' - rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList) + rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList)) in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x diff --git a/testsuite/tests/W3C/TurtleTest.hs b/testsuite/tests/W3C/TurtleTest.hs --- a/testsuite/tests/W3C/TurtleTest.hs +++ b/testsuite/tests/W3C/TurtleTest.hs @@ -13,7 +13,7 @@ import Data.RDF.Query import Text.RDF.RDF4H.TurtleParser import Text.RDF.RDF4H.NTriplesParser -import Data.RDF.Graph.TriplesList +import Data.RDF.Graph.TList tests :: Manifest -> TestTree tests = runManifestTests mfEntryToTest @@ -22,20 +22,20 @@ mfEntryToTest (TestTurtleEval nm _ _ act' res') = let act = (UNode . fromJust . fileSchemeToFilePath) act' res = (UNode . fromJust . fileSchemeToFilePath) res' - parsedRDF = parseFile testParser (nodeURI act) >>= return . fromEither :: IO TriplesList - expectedRDF = parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO TriplesList + parsedRDF = parseFile testParser (nodeURI act) >>= return . fromEither :: IO (RDF TList) + expectedRDF = parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO (RDF TList) in TU.testCase (T.unpack nm) $ assertIsIsomorphic parsedRDF expectedRDF mfEntryToTest (TestTurtleNegativeEval nm _ _ act') = let act = (UNode . fromJust . fileSchemeToFilePath) act' - rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList) + rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList)) in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf mfEntryToTest (TestTurtlePositiveSyntax nm _ _ act') = let act = (UNode . fromJust . fileSchemeToFilePath) act' - rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList) + rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList)) in TU.testCase (T.unpack nm) $ assertIsParsed rdf mfEntryToTest (TestTurtleNegativeSyntax nm _ _ act') = let act = (UNode . fromJust . fileSchemeToFilePath) act' - rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList) + rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList)) in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x diff --git a/testsuite/tests/W3C/W3CAssertions.hs b/testsuite/tests/W3C/W3CAssertions.hs --- a/testsuite/tests/W3C/W3CAssertions.hs +++ b/testsuite/tests/W3C/W3CAssertions.hs @@ -10,9 +10,7 @@ runManifestTests mfEntryToTest manifest = testGroup (T.unpack $ description manifest) $ map mfEntryToTest $ entries manifest -assertIsIsomorphic :: forall rdf1 rdf2. - (Show rdf1, Show rdf2, RDF rdf1, RDF rdf2) => - IO rdf1 -> IO rdf2 -> IO () +assertIsIsomorphic :: IO (RDF TList) -> IO (RDF TList) -> IO () assertIsIsomorphic r1 r2 = do gr1 <- r1 gr2 <- r2 @@ -35,12 +33,12 @@ -- mf:action parsed RDF with the expected mf:result structure. else isGraphIsomorphic g1 g2 -assertIsParsed :: (Show rdf, RDF rdf) => IO (Either ParseFailure rdf) -> TU.Assertion +assertIsParsed :: IO (Either ParseFailure (RDF TList)) -> TU.Assertion assertIsParsed r1 = do gr1 <- r1 TU.assertBool ("unable to parse, reason:\n" ++ show gr1) (isParsed gr1) -assertIsNotParsed :: (Show rdf, RDF rdf) => IO (Either ParseFailure rdf) -> TU.Assertion +assertIsNotParsed :: IO (Either ParseFailure (RDF TList)) -> TU.Assertion assertIsNotParsed r1 = do gr1 <- r1 TU.assertBool ("parsed unexpectantly:\n" ++ show gr1) (not (isParsed gr1))