rdf4h 3.0.0 → 3.0.1

raw patch · 22 files changed

+864/−902 lines, 22 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• bench/MainCriterion.hs +68/−45
• rdf4h.cabal +7/−7
• src/Data/RDF.hs +6/−6
• src/Data/RDF/Graph/AdjHashMap.hs +317/−0
• src/Data/RDF/Graph/HashMapS.hs +0/−233
• src/Data/RDF/Graph/HashMapSP.hs +0/−185
• src/Data/RDF/Graph/MapSP.hs +0/−208
• src/Data/RDF/Graph/TList.hs +15/−2
• src/Data/RDF/Query.hs +5/−1
• src/Data/RDF/Types.hs +10/−2
• src/Rdf4hParseMain.hs +20/−7
• src/Text/RDF/RDF4H/Interact.hs +1/−1
• src/Text/RDF/RDF4H/TurtleParser.hs +71/−53
• src/Text/RDF/RDF4H/XmlParser.hs +109/−12
• testsuite/tests/Data/RDF/Graph/AdjHashMap_Test.hs +33/−0
• testsuite/tests/Data/RDF/Graph/HashSP_Test.hs +0/−28
• testsuite/tests/Data/RDF/Graph/HashS_Test.hs +0/−29
• testsuite/tests/Data/RDF/Graph/SP_Test.hs +0/−29
• testsuite/tests/Data/RDF/Graph/TList_Test.hs +7/−3
• testsuite/tests/Data/RDF/GraphTestUtils.hs +172/−32
• testsuite/tests/Test.hs +22/−18
• testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs +1/−1

@@ -3,6 +3,7 @@ module Main where  import Criterion+import Criterion.Types import Criterion.Main import Data.RDF import qualified Data.Text as T@@ -12,11 +13,24 @@ -- $ wget https://www.govtrack.us/data/rdf/bills.099.actions.rdf.gz -- $ gzip -d bills.099.actions.rdf.gz -parseXmlRDF :: Rdf a => String -> RDF a+parseXmlRDF :: Rdf a => T.Text -> RDF a parseXmlRDF s =-  let (Right rdf) = parseString (XmlParser Nothing Nothing) (T.pack s)+  let (Right rdf) = parseString (XmlParser Nothing Nothing) s   in rdf-  +{-# INLINE parseXmlRDF #-}++parseNtRDF :: Rdf a => T.Text -> RDF a+parseNtRDF s =+  let (Right rdf) = parseString NTriplesParser s+  in rdf+{-# INLINE parseNtRDF #-}++parseTtlRDF :: Rdf a => T.Text -> RDF a+parseTtlRDF s =+  let (Right rdf) = parseString (TurtleParser Nothing Nothing) s+  in rdf+{-# INLINE parseTtlRDF #-}+ queryGr :: Rdf a => (Maybe Node,Maybe Node,Maybe Node,RDF a) -> [Triple] queryGr (maybeS,maybeP,maybeO,rdf) = query rdf maybeS maybeP maybeO @@ -24,49 +38,58 @@ selectGr (selectorS,selectorP,selectorO,rdf) = select rdf selectorS selectorP selectorO  main :: IO ()-main = defaultMain [-   -- 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.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 "TList" triplesList-     ++ queryBench "HashS" hashMapS-     ++ queryBench "SP" mapSP-     ++ queryBench "HashSP" hashMapSP)+main =+  defaultMainWith+    (defaultConfig {resamples = 100})+    [ env+      -- fawltyContent <- T.pack <$> readFile "data/ttl/fawlty1.ttl"+        (do rdfContent <- T.pack <$> readFile "bills.099.actions.rdf"+            let (Right rdf1) =+                  parseString (XmlParser Nothing Nothing) rdfContent+            let (Right rdf2) =+                  parseString (XmlParser Nothing Nothing) rdfContent+            -- let (Right rdf3) =+            --       parseString (XmlParser Nothing Nothing) rdfContent+            -- let (Right rdf4) =+            --       parseString (XmlParser Nothing Nothing) rdfContent+            return+              ( rdf1 :: RDF TList+              , rdf2 :: RDF AdjHashMap+              )) $ \ ~(triplesList, adjMap) ->+        bgroup+          "rdf4h"+          --  bgroup+          --     "parsers"+          --     [ bench "AdjHashMap" $+          --       nf (parseTtlRDF :: T.Text -> RDF AdjHashMap) fawlty_towers+          --     , bench "HashSP" $+          --       nf (parseTtlRDF :: T.Text -> RDF HashSP) fawlty_towers+          --     , bench "SP" $ nf (parseTtlRDF :: T.Text -> RDF SP) fawlty_towers+          --     , bench "TList" $+          --       nf (parseTtlRDF :: T.Text -> RDF TList) fawlty_towers+          --     ]+          -- ,+          [ bgroup+              "query"+              (queryBench "TList" triplesList +++               queryBench "AdjHashMap" adjMap+               -- queryBench "SP" mapSP ++ queryBench "HashSP" hashMapSP+              )+          , bgroup+              "select"+              (selectBench "TList" triplesList +++               selectBench "AdjHashMap" adjMap+               -- selectBench "SP" mapSP ++ selectBench "HashSP" hashMapSP+              )+          , bgroup+            "count_triples"+            [ bench "TList" (nf (length . triplesOf) triplesList)+            , bench "AdjHashMap" (nf (length . triplesOf) adjMap)+            ]+          ]+    ] -   ,-   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 "TList" triplesList-     ++ selectBench "HashS" hashMapS-     ++ selectBench "SP" mapSP-     ++ selectBench "HashSP" hashMapSP)- ]+          selectBench :: Rdf a => String -> RDF a -> [Benchmark] selectBench label gr =

@@ -1,5 +1,5 @@ name:            rdf4h-version:         3.0.0+version:         3.0.1 synopsis:        A library for RDF processing in Haskell description:   'RDF for Haskell' is a library for working with RDF in Haskell.@@ -33,9 +33,9 @@                  , Data.RDF.Namespace                  , Data.RDF.Types                  , Data.RDF.Query-                 , Data.RDF.Graph.HashMapS-                 , Data.RDF.Graph.HashMapSP-                 , Data.RDF.Graph.MapSP+                 , Data.RDF.Graph.AdjHashMap+                 -- , Data.RDF.Graph.HashMapSP+                 -- , Data.RDF.Graph.MapSP                  -- this is very slow                  -- , Data.RDF.Graph.TPatriciaTree                  , Data.RDF.Graph.TList@@ -98,9 +98,9 @@   type:          exitcode-stdio-1.0   main-is:       Test.hs   other-modules: Data.RDF.GraphTestUtils-                 Data.RDF.Graph.HashS_Test-                 Data.RDF.Graph.HashSP_Test-                 Data.RDF.Graph.SP_Test+                 Data.RDF.Graph.AdjHashMap_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

@@ -13,9 +13,9 @@    -- * RDF type class instances   module Data.RDF.Graph.TList,-  module Data.RDF.Graph.HashMapS,-  module Data.RDF.Graph.HashMapSP,-  module Data.RDF.Graph.MapSP,+  module Data.RDF.Graph.AdjHashMap,+  -- module Data.RDF.Graph.HashMapSP,+  -- module Data.RDF.Graph.MapSP,    -- * RDF parsers and serializers   module Text.RDF.RDF4H.NTriplesSerializer,@@ -28,9 +28,9 @@  import Data.RDF.Namespace import Data.RDF.Graph.TList-import Data.RDF.Graph.HashMapS-import Data.RDF.Graph.HashMapSP-import Data.RDF.Graph.MapSP+import Data.RDF.Graph.AdjHashMap+-- import Data.RDF.Graph.HashMapSP+-- import Data.RDF.Graph.MapSP import Text.RDF.RDF4H.NTriplesSerializer import Text.RDF.RDF4H.TurtleSerializer import Text.RDF.RDF4H.NTriplesParser

@@ -0,0 +1,317 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |A graph implementation mapping hashed S to a mapping of+--  hashed P to hashed O, backed by 'Data.HashMap'.++module Data.RDF.Graph.AdjHashMap (AdjHashMap) where++import Prelude hiding (pred)+import Control.DeepSeq (NFData)+import Data.RDF.Types+import Data.RDF.Query+import Data.RDF.Namespace+import qualified Data.Map as Map+import Data.Hashable()+import Data.HashMap.Strict(HashMap)+import qualified Data.HashMap.Strict as HashMap+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.+--+-- This instance of 'RDF' is an adjacency map with each subject+-- mapping to a mapping from a predicate node to to the adjacent nodes+-- via that predicate.+--+-- Given the following triples graph::+--+-- @+--   (http:\/\/example.com\/s1,http:\/\/example.com\/p1,http:\/\/example.com\/o1)+--   (http:\/\/example.com\/s1,http:\/\/example.com\/p1,http:\/\/example.com\/o2)+--   (http:\/\/example.com\/s1,http:\/\/example.com\/p2,http:\/\/example.com\/o1)+--   (http:\/\/example.com\/s2,http:\/\/example.com\/p3,http:\/\/example.com\/o3)+-- @+--+-- where+--+-- > hash "http://example.com/s1" = 1600134414+-- > hash "http://example.com/s2" = 1600134413+-- > hash "http://example.com/p1" = 1616912099+-- > hash "http://example.com/p2" = 1616912096+-- > hash "http://example.com/p3" = 1616912097+-- > hash "http://example.com/o1" = 1935686794+-- > hash "http://example.com/o2" = 1935686793+-- > hash "http://example.com/o3" = 1935686792+--+-- the in-memory hashmap representation of the triples graph is:+--+-- @+-- key:1600134414, value:(key:1616912099, value:[1935686794    -- (..\/s1,..\/p1,..\/o1)+--                                              ,1935686793];  -- (..\/s1,..\/p1,..\/o2)+--                        key:1616912096, value:[1935686794]); -- (..\/s1,..\/p2,..\/o1)+-- key:1600134413, value:(key:1616912097, value:[1935686792])  -- (..\/s1,..\/p3,..\/o3)+-- @+--+-- Worst-case time complexity of the graph functions, with respect+-- to the number of triples, are:+--+--  * 'empty'    : O(1)+--+--  * 'mkRdf'  : O(n)+--+--  * 'triplesOf': O(n)+--+--  * 'select'   : O(n)+--+--  * 'query'    : O(log n)+-- newtype HashS = HashS (TMaps, Maybe BaseUrl, PrefixMappings)+--                  deriving (NFData)++data AdjHashMap deriving (Generic)++instance Binary AdjHashMap+instance NFData AdjHashMap++data instance RDF AdjHashMap = AdjHashMap (TMaps, Maybe BaseUrl, PrefixMappings)+                 deriving (NFData,Generic)++instance Rdf AdjHashMap where+  baseUrl           = baseUrl'+  prefixMappings    = prefixMappings'+  addPrefixMappings = addPrefixMappings'+  empty             = empty'+  mkRdf             = mkRdf'+  triplesOf         = triplesOf'+  uniqTriplesOf     = uniqTriplesOf'+  select            = select'+  query             = query'+  showGraph         = showGraph'+  addTriple         = addTriple'+  removeTriple      = removeTriple'++-- instance Show (AdjHashMap) where+--   show (AdjHashMap ((spoMap, _), _, _)) =+--     let ts = concatMap (uncurry tripsSubj) subjPredMaps+--           where subjPredMaps = HashMap.toList spoMap+--     in concatMap (\t -> show t ++ "\n") ts++showGraph' :: RDF AdjHashMap -> [Char]+showGraph' ((AdjHashMap ((spoMap, _), _, _))) =+    let ts = concatMap (uncurry tripsSubj) subjPredMaps+          where subjPredMaps = HashMap.toList spoMap+    in concatMap (\t -> show t ++ "\n") ts++-- instance Show (RDF AdjHashMap) 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+-- to the adjacent nodes via that predicate.+type AdjacencyMap = HashMap Predicate (HashSet Node)++type Adjacencies = HashSet Node++type TMap   = HashMap Node AdjacencyMap+type TMaps  = (TMap, TMap)+++baseUrl' :: RDF AdjHashMap -> Maybe BaseUrl+baseUrl' (AdjHashMap (_, baseURL, _)) = baseURL++prefixMappings' :: RDF AdjHashMap -> PrefixMappings+prefixMappings' (AdjHashMap (_, _, pms)) = pms++addPrefixMappings' :: RDF AdjHashMap -> PrefixMappings -> Bool -> RDF AdjHashMap+addPrefixMappings' (AdjHashMap (ts, baseURL, pms)) pms' replace = +  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings+  in  AdjHashMap (ts, baseURL, merge pms pms')++empty' :: RDF AdjHashMap+empty' = AdjHashMap ((HashMap.empty, HashMap.empty), Nothing, PrefixMappings Map.empty)++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF AdjHashMap+mkRdf' ts baseURL pms = AdjHashMap (mergeTs (HashMap.empty, HashMap.empty) ts, baseURL, pms)++addTriple' :: RDF AdjHashMap -> Triple -> RDF AdjHashMap+addTriple' (AdjHashMap (tmaps, baseURL, pms)) t =+  let newTMaps = mergeTs tmaps [t]+  in AdjHashMap (newTMaps, baseURL, pms)++removeTriple' :: RDF AdjHashMap -> Triple -> RDF AdjHashMap+removeTriple' (AdjHashMap ((spoMap, opsMap), baseURL, pms)) (Triple s p o) =+  (AdjHashMap (new_tmaps, baseURL, pms))+  where+    new_tmaps = (newSpoMap, newOpsMap)+    newSpoMap =+      case HashMap.lookup s spoMap of+        Nothing -> spoMap+        Just poAdjMap ->+          case HashMap.lookup p poAdjMap of+            Nothing -> spoMap+            Just oHashSet ->+              if not (Set.member o oHashSet)+                then spoMap+                else let newPoAdjMap =+                           HashMap.adjust+                             (\oHashSet' -> Set.delete o oHashSet')+                             p+                             poAdjMap+                     in HashMap.adjust (\_poAdjMap' -> newPoAdjMap) s spoMap+    newOpsMap =+      case HashMap.lookup o opsMap of+        Nothing -> opsMap+        Just poAdjMap ->+          case HashMap.lookup p poAdjMap of+            Nothing -> opsMap+            Just sHashSet ->+              if not (Set.member s sHashSet)+                then opsMap+                else let newPoAdjMap =+                           HashMap.adjust+                             (\sHashSet' -> Set.delete s sHashSet')+                             p+                             poAdjMap+                     in HashMap.adjust (\_poAdjMap' -> newPoAdjMap) o opsMap      ++mergeTs :: TMaps -> [Triple] -> TMaps+mergeTs = foldl' mergeT+  where+    mergeT :: TMaps -> Triple -> TMaps+    mergeT m t = mergeT' m (subjectOf t) (predicateOf t) (objectOf t)++mergeT' :: TMaps -> Subject -> Predicate -> Object -> TMaps+mergeT' (spo, ops) s p o = (mergeT'' spo s p o, mergeT'' ops o p s)++mergeT'' :: TMap -> Subject -> Predicate -> Object -> TMap+mergeT'' m s p o =+  if s `HashMap.member` m then+    (if p `HashMap.member` adjs then HashMap.insert s addPredObj m+       else HashMap.insert s addNewPredObjMap m)+    else HashMap.insert s newPredMap m+  where+    adjs = HashMap.lookupDefault HashMap.empty s m+    newPredMap :: HashMap Predicate (HashSet Object)+    newPredMap = HashMap.singleton p (Set.singleton o)+    addNewPredObjMap :: HashMap Predicate (HashSet Object)+    addNewPredObjMap = HashMap.insert p (Set.singleton o) adjs+    addPredObj :: HashMap Predicate (HashSet Object)+    addPredObj = HashMap.insert p (Set.insert o (get p adjs)) adjs+    --get :: (Ord k, Hashable k) => k -> HashMap k v -> v+    get = HashMap.lookupDefault Set.empty++-- 3 following functions support triplesOf+triplesOf' :: RDF AdjHashMap -> Triples+triplesOf' (AdjHashMap ((spoMap, _), _, _)) = concatMap (uncurry tripsSubj) subjPredMaps+  where subjPredMaps = HashMap.toList spoMap++-- naive implementation for now+uniqTriplesOf' :: RDF AdjHashMap -> Triples+uniqTriplesOf' = nub . expandTriples++tripsSubj :: Subject -> AdjacencyMap -> Triples+tripsSubj s adjMap = concatMap (uncurry (tfsp s)) (HashMap.toList adjMap)+  where tfsp = tripsForSubjPred++tripsForSubjPred :: Subject -> Predicate -> Adjacencies -> Triples+tripsForSubjPred s p adjs = map (Triple s p) (Set.toList adjs)++-- supports select+select' :: RDF AdjHashMap -> NodeSelector -> NodeSelector -> NodeSelector -> Triples+select' (AdjHashMap ((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)+sel1 (Just subjFn) p o spoMap =+  Set.unions $ map (sel2 p o) $ filter (\(x,_) -> subjFn x) $ HashMap.toList spoMap+sel1 Nothing p o spoMap = Set.unions $ map (sel2 p o) $ HashMap.toList spoMap++sel2 :: NodeSelector -> NodeSelector -> (Node, HashMap Node (HashSet Node)) -> HashSet (Node, Node, Node)+sel2 (Just predFn) mobjFn (s, ps) =+  Set.map (\(p,o) -> (s,p,o)) $+  foldl' Set.union Set.empty $+  map (sel3 mobjFn) poMapS :: HashSet (Node, Node, Node)+  where+    poMapS :: [(Node, HashSet Node)]+    poMapS = filter (\(k,_) -> predFn k) $ HashMap.toList ps+sel2 Nothing mobjFn (s, ps) =+  Set.map (\(p,o) -> (s,p,o)) $+  foldl' Set.union Set.empty $+  map (sel3 mobjFn) poMaps+  where+    poMaps = HashMap.toList ps++sel3 :: NodeSelector -> (Node, HashSet Node) -> HashSet (Node, Node)+sel3 (Just objFn) (p, os) = Set.map (\o -> (p, o)) $ Set.filter objFn os+sel3 Nothing      (p, os) = Set.map (\o -> (p, o)) os++-- support query+query' :: RDF AdjHashMap -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples+query' (AdjHashMap (m,_ , _)) subj pred obj = map (\(s, p, o) -> Triple s p o) $ Set.toList (q1 subj pred obj m)++q1 :: Maybe Node -> Maybe Node -> Maybe Node -> TMaps -> HashSet (Node, Node, Node)+q1 (Just s) p o        (spoMap, _     ) = q2 p o (s, HashMap.lookupDefault HashMap.empty s spoMap)+q1 s        p (Just o) (_     , opsMap) = Set.map (\(o',p',s') -> (s',p',o')) $ q2 p s (o, HashMap.lookupDefault HashMap.empty o opsMap)+q1 Nothing (Just p) Nothing (spoMap,_) =+  let (filtered::HashMap Node (HashMap Node (HashSet Node)))+        = HashMap.filter (\poAdjMap -> HashMap.member p poAdjMap) spoMap+      subjXS = HashMap.toList filtered :: [(Node,AdjacencyMap)]+      ys = concatMap (\(s,poMap) ->+                        let objs = map snd (HashMap.toList poMap :: [(Predicate,HashSet Node)])+                        in concatMap (\objHash -> map (\o -> (s,p,o)) (Set.toList objHash)) objs+                     ) subjXS+  in Set.fromList ys+{-+      (xs::[(Subject,Predicate,Object)]) = HashMap.foldlWithKey' f [] filtered+      f triples s poAdjMap =+        let objs = HashMap.elems poAdjMap+        in triples ++ concatMap (\oSet -> map (\o -> (s,p,o)) (Set.toList oSet)) objs+  in Set.fromList xs+-}++q1 Nothing  p o        (spoMap, _     ) =+  let hashSets = map (q2 p o) (HashMap.toList spoMap) :: [HashSet (Node,Node,Node)]+  in Set.unions hashSets++-- | takes a @Maybe Predicate@ and a @Maybe Object@, a subject and+-- predicate map tuple, and returns a (s,p,o) hash set.+q2+  :: Maybe Node+  -> Maybe Node+  -> (Node, HashMap Node (HashSet Node))+  -> HashSet (Node, Node, Node)+q2 (Just p) o (s, pmap) =+  let objAdjHashMapetMaybe = HashMap.lookup p pmap :: Maybe (HashSet Node) -- lookup object hash set+  in case objAdjHashMapetMaybe of+       Nothing -> Set.empty+       Just objAdjHashMapet ->+         let poAdjHashMapet = q3 o (p,objAdjHashMapet)+         in Set.map (\(p', o') -> (s, p', o')) poAdjHashMapet+q2 Nothing o (s, pmap) =+  Set.map (\(x, y) -> (s, x, y)) $ Set.unions $ map (q3 o) opmaps+  where+    opmaps :: [(Node, HashSet Node)]+    opmaps = HashMap.toList pmap++-- | looks up an object in an object hash set. If it exists, then this+-- function returns a hashset with a set with single (p,o) tuple+-- element. If the @Maybe Object@ value is @Empty@, then create a hash+-- set of (p,o) tuples for every object in the object hash set.+q3 :: Maybe Node -- ^ object+   -> (Node, HashSet Node) -- ^ predicate and object hash set tuple+   -> HashSet (Node, Node) -- ^ hash set of (p,o) tuples+q3 (Just o) (p, os) =+  if o `Set.member` os -- if the queried object is in the object set+    then Set.singleton (p, o) -- return a set with a single (p,o) tuple element +    else Set.empty -- otherwise return an empty set+q3 Nothing (p, os) = Set.map (\o -> (p, o)) os

@@ -1,233 +0,0 @@-{-# 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 (HashS) where--import Prelude hiding (pred)-import Control.DeepSeq (NFData)-import Data.RDF.Types-import Data.RDF.Query-import Data.RDF.Namespace-import qualified Data.Map as Map-import Data.Hashable()-import Data.HashMap.Strict(HashMap)-import qualified Data.HashMap.Strict as HashMap-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.------ This instance of 'RDF' is an adjacency map with each subject--- mapping to a mapping from a predicate node to to the adjacent nodes--- via that predicate.------ Given the following triples graph::------ @---   (http:\/\/example.com\/s1,http:\/\/example.com\/p1,http:\/\/example.com\/o1)---   (http:\/\/example.com\/s1,http:\/\/example.com\/p1,http:\/\/example.com\/o2)---   (http:\/\/example.com\/s1,http:\/\/example.com\/p2,http:\/\/example.com\/o1)---   (http:\/\/example.com\/s2,http:\/\/example.com\/p3,http:\/\/example.com\/o3)--- @------ where------ > hash "http://example.com/s1" = 1600134414--- > hash "http://example.com/s2" = 1600134413--- > hash "http://example.com/p1" = 1616912099--- > hash "http://example.com/p2" = 1616912096--- > hash "http://example.com/p3" = 1616912097--- > hash "http://example.com/o1" = 1935686794--- > hash "http://example.com/o2" = 1935686793--- > hash "http://example.com/o3" = 1935686792------ the in-memory hashmap representation of the triples graph is:------ @--- key:1600134414, value:(key:1616912099, value:[1935686794    -- (..\/s1,..\/p1,..\/o1)---                                              ,1935686793];  -- (..\/s1,..\/p1,..\/o2)---                        key:1616912096, value:[1935686794]); -- (..\/s1,..\/p2,..\/o1)--- key:1600134413, value:(key:1616912097, value:[1935686792])  -- (..\/s1,..\/p3,..\/o3)--- @------ Worst-case time complexity of the graph functions, with respect--- to the number of triples, are:------  * 'empty'    : O(1)------  * 'mkRdf'  : O(n)------  * 'triplesOf': O(n)------  * 'select'   : O(n)------  * 'query'    : O(log n)--- newtype HashS = HashS (TMaps, Maybe BaseUrl, PrefixMappings)---                  deriving (NFData)--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'-  empty             = empty'-  mkRdf             = mkRdf'-  triplesOf         = triplesOf'-  uniqTriplesOf     = uniqTriplesOf'-  select            = select'-  query             = query'-  showGraph         = showGraph'---- 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--- to the adjacent nodes via that predicate.-type AdjacencyMap = HashMap Predicate (HashSet Node)--type Adjacencies = HashSet Node--type TMap   = HashMap Node AdjacencyMap-type TMaps  = (TMap, TMap)---baseUrl' :: RDF HashS -> Maybe BaseUrl-baseUrl' (HashS (_, baseURL, _)) = baseURL--prefixMappings' :: RDF HashS -> PrefixMappings-prefixMappings' (HashS (_, _, pms)) = pms--addPrefixMappings' :: RDF HashS -> PrefixMappings -> Bool -> RDF HashS-addPrefixMappings' (HashS (ts, baseURL, pms)) pms' replace = -  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings-  in  HashS (ts, baseURL, merge pms pms')--empty' :: RDF HashS-empty' = HashS ((HashMap.empty, HashMap.empty), Nothing, PrefixMappings Map.empty)--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-  where-    mergeT :: TMaps -> Triple -> TMaps-    mergeT m t = mergeT' m (subjectOf t) (predicateOf t) (objectOf t)--mergeT' :: TMaps -> Subject -> Predicate -> Object -> TMaps-mergeT' (spo, ops) s p o = (mergeT'' spo s p o, mergeT'' ops o p s)--mergeT'' :: TMap -> Subject -> Predicate -> Object -> TMap-mergeT'' m s p o =-  if s `HashMap.member` m then-    (if p `HashMap.member` adjs then HashMap.insert s addPredObj m-       else HashMap.insert s addNewPredObjMap m)-    else HashMap.insert s newPredMap m-  where-    adjs = HashMap.lookupDefault HashMap.empty s m-    newPredMap :: HashMap Predicate (HashSet Object)-    newPredMap = HashMap.singleton p (Set.singleton o)-    addNewPredObjMap :: HashMap Predicate (HashSet Object)-    addNewPredObjMap = HashMap.insert p (Set.singleton o) adjs-    addPredObj :: HashMap Predicate (HashSet Object)-    addPredObj = HashMap.insert p (Set.insert o (get p adjs)) adjs-    --get :: (Ord k, Hashable k) => k -> HashMap k v -> v-    get = HashMap.lookupDefault Set.empty---- 3 following functions support triplesOf-triplesOf' :: RDF HashS -> Triples-triplesOf' (HashS ((spoMap, _), _, _)) = concatMap (uncurry tripsSubj) subjPredMaps-  where subjPredMaps = HashMap.toList spoMap---- naive implementation for now-uniqTriplesOf' :: RDF HashS -> Triples-uniqTriplesOf' = nub . expandTriples--tripsSubj :: Subject -> AdjacencyMap -> Triples-tripsSubj s adjMap = concatMap (uncurry (tfsp s)) (HashMap.toList adjMap)-  where tfsp = tripsForSubjPred--tripsForSubjPred :: Subject -> Predicate -> Adjacencies -> Triples-tripsForSubjPred s p adjs = map (Triple s p) (Set.toList adjs)---- supports select-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)-sel1 (Just subjFn) p o spoMap =-  Set.unions $ map (sel2 p o) $ filter (\(x,_) -> subjFn x) $ HashMap.toList spoMap-sel1 Nothing p o spoMap = Set.unions $ map (sel2 p o) $ HashMap.toList spoMap--sel2 :: NodeSelector -> NodeSelector -> (Node, HashMap Node (HashSet Node)) -> HashSet (Node, Node, Node)-sel2 (Just predFn) mobjFn (s, ps) =-  Set.map (\(p,o) -> (s,p,o)) $-  foldl' Set.union Set.empty $-  map (sel3 mobjFn) poMapS :: HashSet (Node, Node, Node)-  where-    poMapS :: [(Node, HashSet Node)]-    poMapS = filter (\(k,_) -> predFn k) $ HashMap.toList ps-sel2 Nothing mobjFn (s, ps) =-  Set.map (\(p,o) -> (s,p,o)) $-  foldl' Set.union Set.empty $-  map (sel3 mobjFn) poMaps-  where-    poMaps = HashMap.toList ps--sel3 :: NodeSelector -> (Node, HashSet Node) -> HashSet (Node, Node)-sel3 (Just objFn) (p, os) = Set.map (\o -> (p, o)) $ Set.filter objFn os-sel3 Nothing      (p, os) = Set.map (\o -> (p, o)) os---- support query-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)-q1 (Just s) p o        (spoMap, _     ) = q2 p o (s, HashMap.lookupDefault HashMap.empty s spoMap)-q1 s        p (Just o) (_     , opsMap) = Set.map (\(o',p',s') -> (s',p',o')) $ q2 p s (o, HashMap.lookupDefault HashMap.empty o opsMap)-q1 Nothing  p o        (spoMap, _     ) = Set.unions $ map (q2 p o) $ HashMap.toList spoMap--q2 :: Maybe Node -> Maybe Node -> (Node, HashMap Node (HashSet Node)) -> HashSet (Node, Node, Node)-q2 (Just p) o (s, pmap) =-  maybe Set.empty (Set.map (\ (p', o') -> (s, p', o')) . q3 o . (p,)) $ HashMap.lookup p pmap-q2 Nothing o (s, pmap) = Set.map (\(x,y) -> (s,x,y)) $ Set.unions $ map (q3 o) opmaps-  where opmaps ::[(Node, HashSet Node)]-        opmaps = HashMap.toList pmap--q3 :: Maybe Node -> (Node, HashSet Node) -> HashSet (Node, Node)-q3 (Just o) (p, os) = if o `Set.member` os then Set.singleton (p, o) else Set.empty-q3 Nothing  (p, os) = Set.map (\o -> (p, o)) os

@@ -1,185 +0,0 @@-{-# 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 (HashSP) where--import Prelude hiding (pred)-import Control.DeepSeq (NFData)-import Data.RDF.Types-import Data.RDF.Query-import Data.RDF.Namespace-import Data.HashMap.Strict (HashMap)-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.--data instance RDF HashSP = HashSP (SPMap, Maybe BaseUrl, PrefixMappings)-                 deriving (NFData,Generic)--instance Rdf HashSP where-  baseUrl           = baseUrl'-  prefixMappings    = prefixMappings'-  addPrefixMappings = addPrefixMappings'-  empty             = empty'-  mkRdf             = mkRdf'-  triplesOf         = triplesOf'-  uniqTriplesOf     = uniqTriplesOf'-  select            = select'-  query             = query'-  showGraph         = showGraph'---- 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' :: RDF HashSP -> Maybe BaseUrl-baseUrl' (HashSP (_, baseURL, _)) = baseURL--prefixMappings' :: RDF HashSP -> PrefixMappings-prefixMappings' (HashSP (_, _, pms)) = pms--addPrefixMappings' :: RDF HashSP -> PrefixMappings -> Bool -> RDF HashSP-addPrefixMappings' (HashSP (tsMap, baseURL, pms)) pms' replace =-  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings-  in  HashSP (tsMap, baseURL, merge pms pms')--empty' :: RDF HashSP-empty' = HashSP (HashMap.empty, Nothing, PrefixMappings Map.empty)--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' :: RDF HashSP -> Triples-triplesOf' (HashSP (tsMap,_,_)) = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . HashMap.toList) tsMap--uniqTriplesOf' :: RDF HashSP -> Triples-uniqTriplesOf' = nub . expandTriples--select' :: RDF HashSP -> NodeSelector -> NodeSelector -> NodeSelector -> Triples-select' gr Nothing Nothing Nothing =-    triplesOf' gr--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' (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' (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' (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' (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' (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' (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' :: RDF HashSP -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples-query' gr Nothing  Nothing  Nothing  =-    triplesOf' gr--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' (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' (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' (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 RDF HashSP instance-query' (HashSP (tsMap,_,_))    (Just s) (Just p) Nothing =-    (map (Triple s p) . HashMap.lookupDefault [] (s,p)) tsMap--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' (HashSP (tsMap,_,_))    (Just s) (Just p) (Just o) =-    HashMap.foldrWithKey findTripleWithS [] tsMap-    where-      findTripleWithS (s',p') oList ts = if s == s' && p == p'-                                        then map (Triple s p) (filter (== o) oList) ++ ts-                                        else ts

@@ -1,208 +0,0 @@-{-# 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 (SP) where--import Prelude hiding (pred)-import Control.DeepSeq (NFData)-import Data.RDF.Types-import Data.RDF.Query-import Data.RDF.Namespace-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.------ This instance of 'RDF' is an adjacency map with each subject--- mapping to a mapping from a predicate node to to the adjacent nodes--- via that predicate.------ Given the following triples graph::------ @---   (http:\/\/example.com\/s1,http:\/\/example.com\/p1,http:\/\/example.com\/o1)---   (http:\/\/example.com\/s1,http:\/\/example.com\/p1,http:\/\/example.com\/o2)---   (http:\/\/example.com\/s1,http:\/\/example.com\/p2,http:\/\/example.com\/o1)---   (http:\/\/example.com\/s2,http:\/\/example.com\/p3,http:\/\/example.com\/o3)--- @------ the in-memory map representation of the triples graph is:------ @--- key:(http:\/\/example.com\/s1,http:\/\/example.com\/p1),--- value:[http:\/\/example.com\/o1,http:\/\/example.com\/o2];------ key:(http:\/\/example.com\/s1,http:\/\/example.com\/p2),--- value:[http:\/\/example.com\/o1];------ key:(http:\/\/example.com\/s2,http:\/\/example.com\/p3),--- value:[http:\/\/example.com\/o3];--- @--data SP deriving (Generic)-instance Binary SP-instance NFData SP--data instance RDF SP = SP (SPMap, Maybe BaseUrl, PrefixMappings)-                     deriving (Generic,NFData)--instance Rdf SP where-  baseUrl           = baseUrl'-  prefixMappings    = prefixMappings'-  addPrefixMappings = addPrefixMappings'-  empty             = empty'-  mkRdf             = mkRdf'-  triplesOf         = triplesOf'-  uniqTriplesOf     = uniqTriplesOf'-  select            = select'-  query             = query'-  showGraph         = showGraph'---- 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' :: RDF SP -> Maybe BaseUrl-baseUrl' (SP (_, baseURL, _)) = baseURL--prefixMappings' :: RDF SP -> PrefixMappings-prefixMappings' (SP (_, _, pms)) = pms--addPrefixMappings' :: RDF SP -> PrefixMappings -> Bool -> RDF SP-addPrefixMappings' (SP (tsMap, baseURL, pms)) pms' replace =-  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings-  in  SP (tsMap, baseURL, merge pms pms')--empty' :: RDF SP-empty' = SP (Map.empty, Nothing, PrefixMappings Map.empty)--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' :: RDF SP -> Triples-triplesOf' (SP (tsMap,_,_)) = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . Map.toList) tsMap--uniqTriplesOf' :: RDF SP -> Triples-uniqTriplesOf' = nub . expandTriples--select' :: RDF SP -> NodeSelector -> NodeSelector -> NodeSelector -> Triples-select' gr Nothing Nothing Nothing =-    triplesOf' gr--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' (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' (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' (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' (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' (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' (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' :: RDF SP -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples-query' gr Nothing  Nothing  Nothing  =-    triplesOf' gr--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' (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' (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' (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 SP instance-query' (SP (tsMap,_,_))    (Just s) (Just p) Nothing =-    (map (Triple s p) . Map.findWithDefault [] (s,p)) tsMap--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' (SP (tsMap,_,_))    (Just s) (Just p) (Just o) =-    Map.foldrWithKey findTripleWithS [] tsMap-    where-      findTripleWithS (s',p') oList ts = if s == s' && p == p'-                                        then map (Triple s p) (filter (== o) oList) ++ ts-                                        else ts

@@ -74,6 +74,8 @@   addPrefixMappings = addPrefixMappings'   empty             = empty'   mkRdf             = mkRdf'+  addTriple         = addTriple'+  removeTriple      = removeTriple'   triplesOf         = triplesOf'   uniqTriplesOf     = uniqTriplesOf'   select            = select'@@ -84,7 +86,8 @@ --  show ((TListC (ts, _, _))) = concatMap (\t -> show t ++ "\n") ts  showGraph' :: RDF TList -> [Char]-showGraph' ((TListC (ts, _, _))) = concatMap (\t -> show t ++ "\n") ts+-- showGraph' ((TListC (ts, _, _))) = concatMap (\t -> show t ++ "\n") ts+showGraph' gr = concatMap (\t -> show t ++ "\n") (expandTriples gr)  prefixMappings' :: RDF TList -> PrefixMappings prefixMappings' (TListC(_, _, pms)) = pms@@ -105,7 +108,17 @@ -- 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)+mkRdf' ts baseURL pms = TListC (ts, baseURL, pms)++addTriple' :: RDF TList -> Triple -> RDF TList+addTriple' (TListC (ts, bURL, preMapping)) t = TListC (t:ts,bURL,preMapping)++-- | yes, broken for now. use property tests to fix.+removeTriple' :: RDF TList -> Triple -> RDF TList+removeTriple' (TListC (ts, bURL, preMapping)) t =+  TListC (newTs,bURL,preMapping)+  where+    newTs = filter (/= t) ts  triplesOf' :: RDF TList -> Triples triplesOf' ((TListC(ts, _, _))) = ts

@@ -4,7 +4,7 @@   equalSubjects, equalPredicates, equalObjects,   subjectOf, predicateOf, objectOf, isEmpty,   rdfContainsNode, tripleContainsNode,-  subjectsWithPredicate, objectsOfPredicate,+  subjectsWithPredicate, objectsOfPredicate, uordered,    -- * RDF graph functions   isIsomorphic, isGraphIsomorphic, expandTriples, fromEither,@@ -92,6 +92,10 @@   case res of     (Left err) -> error (show err)     (Right rdf) -> rdf++-- |Convert a list of triples into a sorted list of unique triples.+uordered :: Triples -> Triples+uordered  =  sort . nub  -- graphFromEdges :: Ord key => [(node, key, [key])] -> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex) 

@@ -26,7 +26,7 @@   RDF,    -- * Rdf type class-  Rdf(baseUrl,prefixMappings,addPrefixMappings,empty,mkRdf,triplesOf,uniqTriplesOf,select,query,showGraph),+  Rdf(baseUrl,prefixMappings,addPrefixMappings,empty,mkRdf,addTriple,removeTriple,triplesOf,uniqTriplesOf,select,query,showGraph),    -- * Parsing RDF   RdfParser(parseString,parseFile,parseURL),@@ -358,6 +358,12 @@   -- in the input depend on the particular RDF implementation.   mkRdf :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdfImpl +  -- |Adds a triple to an RDF graph.+  addTriple :: RDF rdfImpl -> Triple -> RDF rdfImpl++  -- |Removes all occurrences of a triple in an RDF graph.+  removeTriple :: RDF rdfImpl -> Triple -> 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@@ -747,5 +753,7 @@ fileSchemeToFilePath (UNode fileScheme) =     if T.pack "file://" `T.isPrefixOf` fileScheme     then fmap (T.pack . Network.uriPath) (Network.parseURI (T.unpack fileScheme))-    else Nothing+    else if T.pack "http://" `T.isPrefixOf` fileScheme+         then fmap (T.pack . Network.uriPath) (Network.parseURI (T.unpack fileScheme))+         else Nothing fileSchemeToFilePath _ = Nothing

@@ -5,12 +5,13 @@  module Main where -import Data.RDF.Types-import Data.RDF.Graph.TList-import Text.RDF.RDF4H.NTriplesParser-import Text.RDF.RDF4H.NTriplesSerializer-import Text.RDF.RDF4H.TurtleParser-import Text.RDF.RDF4H.TurtleSerializer+import Data.RDF+-- import Data.RDF.Types+-- import Data.RDF.Graph.TList+-- import Text.RDF.RDF4H.NTriplesParser+-- import Text.RDF.RDF4H.NTriplesSerializer+-- import Text.RDF.RDF4H.TurtleParser+-- import Text.RDF.RDF4H.TurtleSerializer  import qualified Data.Text as T import qualified Data.Text.IO as TIO@@ -82,6 +83,17 @@                                   >>=                                   \ (res :: Either ParseFailure (RDF TList)) ->                                     write outputFormat Nothing emptyPms res+         ("xml", True) -> parseURL (XmlParser mInputUri docUri)+                          inputUri+                          >>=+                          \ (res :: Either ParseFailure (RDF TList)) ->+                            write outputFormat docUri emptyPms res+         ("xml", False) -> (if inputUri /= "-" then+                                   parseFile (XmlParser mInputUri docUri) inputUri else+                                   liftM (parseString (XmlParser mInputUri docUri)) TIO.getContents)+                                  >>=+                                  \ (res :: Either ParseFailure (RDF TList)) ->+                                    write outputFormat docUri emptyPms res          (str, _) -> putStrLn ("Invalid format: " ++ str) >> exitFailure  write :: (Rdf a) => String -> Maybe T.Text -> PrefixMappings -> Either ParseFailure (RDF a) -> IO ()@@ -167,7 +179,8 @@  , Option "d"  ["debug"]                         (NoArg Debug)   "Print debug info (like INPUT-BASE-URI used, etc.)"  , Option "i"  ["input"]        (ReqArg InputFormat  "FORMAT") $ "Set input format/parser to one of:\n" ++                                                                    "  turtle      Turtle (default)\n" ++-                                                                   "  ntriples    N-Triples"+                                                                   "  ntriples    N-Triples\n" +++                                                                   "  xml         RDF/XML"  , Option "I"  ["input-base-uri"]  (ReqArg InputBaseUri "URI") $ "Set the input/parser base URI. '-' for none.\n" ++                                                                    "  Default is INPUT-BASE-URI argument value.\n\n" 

@@ -18,7 +18,7 @@  import Data.RDF.Types hiding (baseUrl) import Data.RDF.Graph.TList()-import Data.RDF.Graph.HashMapS()+import Data.RDF.Graph.AdjHashMap()  import Text.RDF.RDF4H.NTriplesParser import Text.RDF.RDF4H.TurtleParser

@@ -8,13 +8,14 @@ where  import Data.Char (isLetter,isAlphaNum,toLower,toUpper)+import qualified Data.Map as Map+import Data.Map (Map) import Data.Maybe import Data.RDF.Types import Data.RDF.Namespace import Text.RDF.RDF4H.ParserUtils import Text.Parsec import Text.Parsec.Text-import qualified Data.Map as Map import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Sequence(Seq, (|>))@@ -51,12 +52,13 @@    [Bool],           -- a stack of values to indicate that we're processing a (possibly nested) collection; top True indicates just started (on first element)    [Bool],           -- when in a collection, is it a subject collection or not    Bool,           -- when in a blank node property list, is it a subject collection or not-   Seq Triple)       -- the triples encountered while parsing; always added to on the right side+   Seq Triple,       -- the triples encountered while parsing; always added to on the right side+   Map String Int)  -- grammar rule: [1] turtleDoc t_turtleDoc :: GenParser ParseState (Seq Triple, PrefixMappings) t_turtleDoc =-  many t_statement >> (eof <?> "eof") >> getState >>= \(_, _, _, pms, _, _, _, _, _, ts) -> return (ts, pms)+  many t_statement >> (eof <?> "eof") >> getState >>= \(_, _, _, pms, _, _, _, _, _, ts,_) -> return (ts, pms)  -- grammar rule: [2] statement t_statement :: GenParser ParseState ()@@ -110,7 +112,7 @@      uriFrag <- t_iriref      void (many t_ws <?> "prefixID-whitespace")      void (char '.' <?> "end-of-prefixID-period")-     (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _, _, _) <- getState+     (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _, _, _, _) <- getState      updatePMs $ Just (PrefixMappings $ Map.insert pre (absolutizeUrl bUrl dUrl uriFrag) pms)      return () @@ -121,7 +123,7 @@      pre <- (many1 t_ws <?> "whitespace-after-@prefix") >> option T.empty t_pn_prefix      void (char ':' >> (many1 t_ws <?> "whitespace-after-@prefix-colon"))      uriFrag <- t_iriref-     (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _, _, _) <- getState+     (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _, _, _, _) <- getState      updatePMs $ Just (PrefixMappings $ Map.insert pre (absolutizeUrl bUrl dUrl uriFrag) pms)      return () @@ -160,7 +162,7 @@ t_pname_ns =do   pre <- option T.empty (try t_pn_prefix)   void (char ':')-  (bUrl, _, _, pms, _, _, _, _, _, _) <- getState+  (bUrl, _, _, pms, _, _, _, _, _, _, _) <- getState   case resolveQName bUrl pre pms of     Just n  -> return n     Nothing -> unexpected ("Cannot resolve QName prefix: " ++ T.unpack pre)@@ -226,18 +228,27 @@ -- [137s] BlankNode ::= BLANK_NODE_LABEL | ANON t_blankNode :: GenParser ParseState Node t_blankNode = do-  (try t_blank_node_label <|> t_anon)-  i <- nextIdCounter-  let node = BNodeGen i+  genID <- (try t_blank_node_label <|> (t_anon >> return ""))+  mp <- currGenIdLookup+  node <-+    case Map.lookup genID mp of+      Nothing -> do+        i <- nextIdCounter+        let node = BNodeGen i+        addGenIdLookup genID i+        return node+      Just i ->+        return $ BNodeGen i   return node  -- TODO replicate the recursion technique from [168s] for ((..)* something)? -- [141s] BLANK_NODE_LABEL ::= '_:' (PN_CHARS_U | [0-9]) ((PN_CHARS | '.')* PN_CHARS)?-t_blank_node_label :: GenParser ParseState ()+t_blank_node_label :: GenParser ParseState [Char] t_blank_node_label = do   void (string "_:")-  void (t_pn_chars_u <|> oneOf ['0'..'9'])-  optional $ try $ do+  firstChar <- (t_pn_chars_u <|> oneOf ['0'..'9'])+--  optional $ try $ do+  try $ do     ss <- option "" $ do             xs <- many (t_pn_chars <|> char '.')             if null xs@@ -245,7 +256,7 @@             else if last xs == '.'                  then unexpected "'.' at the end of a blank node label"                  else return xs-    return ss+    return (firstChar : ss)  -- [162s] ANON ::= '[' WS* ']' t_anon :: GenParser ParseState ()@@ -547,37 +558,44 @@ newBaseUrl Nothing               url = BaseUrl url newBaseUrl (Just (BaseUrl bUrl)) url = BaseUrl $! mkAbsoluteUrl bUrl url +currGenIdLookup :: GenParser ParseState (Map String Int)+currGenIdLookup = getState >>= \(_, _, _, _, _, _, _, _, _, _,genMap) -> return genMap++addGenIdLookup :: String -> Int -> GenParser ParseState ()+addGenIdLookup genId counter = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->+                  setState (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, Map.insert genId counter genMap)+ currBaseUrl :: GenParser ParseState (Maybe BaseUrl)-currBaseUrl = getState >>= \(bUrl, _, _, _, _, _, _, _, _, _) -> return bUrl+currBaseUrl = getState >>= \(bUrl, _, _, _, _, _, _, _, _, _,_) -> return bUrl  currDocUrl :: GenParser ParseState (Maybe T.Text)-currDocUrl = getState >>= \(_, dUrl, _, _, _, _, _, _, _, _) -> return dUrl+currDocUrl = getState >>= \(_, dUrl, _, _, _, _, _, _, _, _,_) -> return dUrl  pushSubj :: Subject -> GenParser ParseState ()-pushSubj s = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts) ->-                  setState (bUrl, dUrl, i, pms, s:ss, ps, cs, subjC, subjBNodeList, ts)+pushSubj s = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->+                  setState (bUrl, dUrl, i, pms, s:ss, ps, cs, subjC, subjBNodeList, ts, genMap)  popSubj :: GenParser ParseState Subject-popSubj = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts) ->-                setState (bUrl, dUrl, i, pms, tail ss, ps, cs, subjC, subjBNodeList, ts) >>+popSubj = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->+                setState (bUrl, dUrl, i, pms, tail ss, ps, cs, subjC, subjBNodeList, ts, genMap) >>                   when (null ss) (error "Cannot pop subject off empty stack.") >>                   return (head ss)  pushPred :: Predicate -> GenParser ParseState ()-pushPred p = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts) ->-                  setState (bUrl, dUrl, i, pms, ss, p:ps, cs, subjC, subjBNodeList, ts)+pushPred p = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->+                  setState (bUrl, dUrl, i, pms, ss, p:ps, cs, subjC, subjBNodeList, ts, genMap)  popPred :: GenParser ParseState Predicate-popPred = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts) ->-                setState (bUrl, dUrl, i, pms, ss, tail ps, cs, subjC, subjBNodeList, ts) >>+popPred = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->+                setState (bUrl, dUrl, i, pms, ss, tail ps, cs, subjC, subjBNodeList, ts, genMap) >>                   when (null ps) (error "Cannot pop predicate off empty stack.") >>                   return (head ps)  isInColl :: GenParser ParseState Bool-isInColl = getState >>= \(_, _, _, _, _, _, cs, _, _, _) -> return . not . null $ cs+isInColl = getState >>= \(_, _, _, _, _, _, cs, _, _, _, _) -> return . not . null $ cs  isInSubjColl :: GenParser ParseState Bool-isInSubjColl = getState >>= \(_, _, _, _, _, _, _, xs, _, _) -> do+isInSubjColl = getState >>= \(_, _, _, _, _, _, _, xs, _, _, _) -> do                if null xs then return False else return (head xs)  {-@@ -588,20 +606,20 @@ -}  pushSubjColl :: GenParser ParseState ()-pushSubjColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts) ->-                 setState (bUrl, dUrl, i, pms, s, p, cs, True:subjC, subjBNodeList, ts)+pushSubjColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts, genMap) ->+                 setState (bUrl, dUrl, i, pms, s, p, cs, True:subjC, subjBNodeList, ts, genMap)  popColl :: GenParser ParseState ()-popColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts) -> do+popColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts, genMap) -> do                 when (null subjC) $ error "null in popColl"-                setState (bUrl, dUrl, i, pms, s, p, cs, tail subjC, subjBNodeList, ts)+                setState (bUrl, dUrl, i, pms, s, p, cs, tail subjC, subjBNodeList, ts, genMap)  pushObjColl :: GenParser ParseState ()-pushObjColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts) ->-                 setState (bUrl, dUrl, i, pms, s, p, cs, False:subjC, subjBNodeList, ts)+pushObjColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->+                 setState (bUrl, dUrl, i, pms, s, p, cs, False:subjC, subjBNodeList, ts,genMap)  isSubjPropList :: GenParser ParseState Bool-isSubjPropList = getState >>= \(_, _, _, _, _, _, _, _, subjBNodeList, _) -> do+isSubjPropList = getState >>= \(_, _, _, _, _, _, _, _, subjBNodeList, _,_) -> do                 return subjBNodeList  {-@@ -611,12 +629,12 @@ -}  setSubjBlankNodePropList :: GenParser ParseState ()-setSubjBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts) ->-                 setState (bUrl, dUrl, i, pms, s, p, cs, subjC, True, ts)+setSubjBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts,genMap) ->+                 setState (bUrl, dUrl, i, pms, s, p, cs, subjC, True, ts,genMap)  setNotSubjBlankNodePropList :: GenParser ParseState ()-setNotSubjBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts) ->-                 setState (bUrl, dUrl, i, pms, s, p, cs, subjC, True, ts)+setNotSubjBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts,genMap) ->+                 setState (bUrl, dUrl, i, pms, s, p, cs, subjC, True, ts,genMap)  -- setObjBlankNodePropList :: GenParser ParseState () -- setObjBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts) ->@@ -632,32 +650,32 @@  -- combines get_current and increment into a single function nextIdCounter :: GenParser ParseState Int-nextIdCounter = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts) ->-                setState (bUrl, dUrl, i+1, pms, s, p, cs, subjC, subjBNodeList, ts) >> return i+nextIdCounter = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->+                setState (bUrl, dUrl, i+1, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) >> return i  updatePMs :: Maybe PrefixMappings -> GenParser ParseState () updatePMs val = _modifyState no no val no no no  -- Register that we have begun processing a collection beginColl :: GenParser ParseState ()-beginColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts) ->-            setState (bUrl, dUrl, i, pms, s, p, True:cs, subjC, subjBNodeList, ts)+beginColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->+            setState (bUrl, dUrl, i, pms, s, p, True:cs, subjC, subjBNodeList, ts,genMap)  onCollFirstItem :: GenParser ParseState Bool-onCollFirstItem = getState >>= \(_, _, _, _, _, _, cs, _, _, _) -> return (not (null cs) && head cs)+onCollFirstItem = getState >>= \(_, _, _, _, _, _, cs, _, _, _,_) -> return (not (null cs) && head cs)  collFirstItemProcessed :: GenParser ParseState ()-collFirstItemProcessed = getState >>= \(bUrl, dUrl, i, pms, s, p, _:cs, subjC, subjBNodeList, ts) ->-                         setState (bUrl, dUrl, i, pms, s, p, False:cs, subjC, subjBNodeList, ts)+collFirstItemProcessed = getState >>= \(bUrl, dUrl, i, pms, s, p, _:cs, subjC, subjBNodeList, ts,genMap) ->+                         setState (bUrl, dUrl, i, pms, s, p, False:cs, subjC, subjBNodeList, ts,genMap)  -- Register that a collection is finished being processed; the bool value -- in the monad is *not* the value that was popped from the stack, but whether -- we are still processing a parent collection or have finished processing -- all collections and are no longer in a collection at all. finishColl :: GenParser ParseState Bool-finishColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts) ->+finishColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->              let cs' = drop 1 cs-             in setState (bUrl, dUrl, i, pms, s, p, cs', subjC, subjBNodeList, ts) >> return (not $ null cs')+             in setState (bUrl, dUrl, i, pms, s, p, cs', subjC, subjBNodeList, ts,genMap) >> return (not $ null cs')  -- Alias for Nothing for use with _modifyState calls, which can get very long with -- many Nothing values.@@ -667,8 +685,8 @@ -- Update the subject and predicate values of the ParseState to Nothing. resetSubjectPredicate :: GenParser ParseState () resetSubjectPredicate =-  getState >>= \(bUrl, dUrl, n, pms, _, _, cs, subjC, subjBNodeList, ts) ->-  setState (bUrl, dUrl, n, pms, [], [], cs, subjC, subjBNodeList, ts)+  getState >>= \(bUrl, dUrl, n, pms, _, _, cs, subjC, subjBNodeList, ts,genMap) ->+  setState (bUrl, dUrl, n, pms, [], [], cs, subjC, subjBNodeList, ts,genMap)  -- Modifies the current parser state by updating any state values among the parameters -- that have non-Nothing values.@@ -676,7 +694,7 @@                 Maybe Subject -> Maybe Predicate -> Maybe (Seq Triple) ->                 GenParser ParseState () _modifyState mb_bUrl mb_n mb_pms mb_subj mb_pred mb_trps =-  do (_bUrl, _dUrl, _n, _pms, _s, _p, _cs, _subjC, _subjBNodeList, _ts) <- getState+  do (_bUrl, _dUrl, _n, _pms, _s, _p, _cs, _subjC, _subjBNodeList, _ts,genMap) <- getState      setState (fromMaybe _bUrl mb_bUrl,               _dUrl,               maybe _n (const _n) mb_n,@@ -686,16 +704,16 @@               _cs,               _subjC,               _subjBNodeList,-              fromMaybe _ts mb_trps)+              fromMaybe _ts mb_trps,genMap)  addTripleForObject :: Object -> GenParser ParseState () addTripleForObject obj =-  do (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts) <- getState+  do (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts,genMap) <- getState      when (null ss) $        unexpected $ "No Subject with which to create triple for: " ++ show obj      when (null ps) $        unexpected $ "No Predicate with which to create triple for: " ++ show obj-     setState (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts |> Triple (head ss) (head ps) obj)+     setState (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts |> Triple (head ss) (head ps) obj,genMap)  -- |Parse the document at the given location URL as a Turtle document, using an optional @BaseUrl@ -- as the base URI, and using the given document URL as the URI of the Turtle document itself.@@ -731,14 +749,14 @@ 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)+  where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], [], False, Seq.empty,Map.empty)  -- |Parse the given string as a Turtle document. The arguments and return type have the same semantics -- as <parseURL>, except that the last @String@ argument corresponds to the Turtle document itself as -- a string rather than a location URI. 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)+  where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], [], False, Seq.empty,Map.empty)  handleResult :: Rdf a => Maybe BaseUrl -> Either ParseError (Seq Triple, PrefixMappings) -> Either ParseFailure (RDF a) handleResult bUrl result =

@@ -18,7 +18,7 @@ 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)+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,hasNamePrefix,isElem,isWhiteSpace,xshow,listA,isA,isText,getText,this,unlistA,orElse,sattr,mkelem,xreadDoc,runSLA) -- TODO: write QuickCheck tests for XmlParser instance for RdfParser.  data XmlParser = XmlParser (Maybe BaseUrl) (Maybe T.Text)@@ -114,11 +114,16 @@             rdf <- isElem <<< getChildren -< xml             bUrl <- arr (BaseUrl . T.pack) <<< ((getAttrValue0 "xml:base" <<< isElem <<< getChildren) `orElse` getAttrValue "transfer-URI") -< xml             prefixMap <- arr toPrefixMap <<< toAttrMap                  -< rdf-            triples <- parseDescription' >. id -< (bUrl, rdf)+            triples <- (parseDescription' >. failOnEmptyList >>> unlistA) -< (bUrl,rdf)             returnA -< mkRdf triples (Just bUrl) prefixMap   where toAttrMap = (getAttrl >>> (getName &&& (getChildren >>> getText))) >. id         toPrefixMap = PrefixMappings . Map.fromList . map (\(n, m) -> (T.pack (drop 6 n), T.pack m)) . filter (isPrefixOf "xmlns:" . fst) +        failOnEmptyList :: [b] -> [[b]]+        failOnEmptyList [] = []+        failOnEmptyList xs = [xs]++ -- |Read the initial state from an rdf element parseDescription' :: forall a. (ArrowXml a, ArrowState GParseState a) => a (BaseUrl, XmlTree) Triple parseDescription' = proc (bUrl, rdf) -> do@@ -163,41 +168,119 @@          <+> isA (== "rdf:parseType")          <+> isA (== "xml:base") +-- See: Issue http://www.w3.org/2000/03/rdf-tracking/#rdfms-rdf-names-use+--   section: Illegal or unusual use of names from the RDF namespace+--+-- test cases:+--   rdf-tests/rdf-xml/rdfms-rdf-names-use/test-017.rdf to+--   rdf-tests/rdf-xml/rdfms-rdf-names-use/test-032.rdf+--   rdf:Seq, rdf:Bag, rdf:Alt, rdf:Statement, rdf:Property, rdf:List+--   rdf:subject, rdf:predicate, rdf:object, rdf:type, rdf:value,+--   rdf:first, rdf:rest, rdf:_1, rdf:li+--+-- but in fact the wording at the above URL says:+--+-- "The WG reaffirmed its decision not to restrict names in the RDF+--  namespaces which are not syntactic. The WG decided that an RDF+--  processor SHOULD emit a warning when encountering names in the RDF+--  namespace which are not defined, but should otherwise behave+--  normally."+--+-- And that specifically:+--+--   <rdf:Description> +--     <rdf:foo>foo</rdf:foo>+--    </rdf:Description>+--+-- is equivalent to:+--  _:a <rdf:foo> "foo" .+--+-- And hence the use of `hasNamePrefix "rdf"`+isValidPropElemName :: (ArrowXml a, ArrowState GParseState a) => a XmlTree XmlTree+isValidPropElemName = hasNamePrefix "rdf"+  -- hasName "rdf:Seq"+  -- <+> hasName "rdf:Bag"+  -- <+> hasName "rdf:Alt"+  -- <+> hasName "rdf:Statement"+  -- <+> hasName "rdf:Property"+  -- <+> hasName "rdf:List"+  -- <+> hasName "rdf:subject"+  -- <+> hasName "rdf:predicate"+  -- <+> hasName "rdf:object"+  -- <+> hasName "rdf:type"+  -- <+> hasName "rdf:value"+  -- <+> hasName "rdf:first"+  -- <+> hasName "rdf:rest"+  -- <+> hasName "rdf:_1"+  -- <+> hasName "rdf:li"++ -- |Read a children of an rdf:Description element.  These correspond to the Predicate portion of the Triple parsePredicatesFromChildren :: forall a. (ArrowXml a, ArrowState GParseState a)                             => a (LParseState, XmlTree) Triple parsePredicatesFromChildren = updateState+    >>> validPropElementName     >>> choiceA         [ second (hasAttrValue "rdf:parseType" (== "Literal")) :-> arr2A parseAsLiteralTriple         , second (hasAttrValue "rdf:parseType" (== "Resource")) :-> (mkBlankNode &&& arr id >>> arr2A parseAsResource)         , second (hasAttrValue "rdf:parseType" (== "Collection")) :-> (listA (defaultA >>> arr id &&& mkBlankNode) >>> mkCollectionTriples >>> unlistA)         , second (hasAttr "rdf:datatype") :-> arr2A getTypedTriple-        , second (hasAttr "rdf:resource") :-> arr2A getResourceTriple---        , second (hasAttr "rdf:nodeID") >>> hasAttr "rdf:ID" :-> ERROR.+        -- for the following case, see rdfms-syntax-incomplete-error006+        , second (hasAttr "rdf:nodeID") :-> (neg (second (hasAttr "rdf:resource")) >>> arr2A getResourceTriple)         , second (hasAttr "rdf:nodeID") :-> arr2A getNodeIdTriple         , second (hasAttr "rdf:ID") :-> (arr2A mkRelativeNode &&& defaultA >>> arr2A reifyTriple >>> unlistA)+        , second (hasAttr "rdf:resource") :-> arr2A validPropElemNames+        , second isValidPropElemName :-> arr2A validPropElemNames         , second hasPredicateAttr :-> (defaultA <+> (mkBlankNode &&& arr id >>> arr2A parsePredicateAttr))         , this :-> defaultA         ]-  where defaultA = proc (state, predXml) -> do+        -- See: Issue http://www.w3.org/2000/03/rdf-tracking/#rdfms-rdf-names-use+        --   section: Illegal or unusual use of names from the RDF namespace+        --+        -- Avoid making blank nodes for some property names.+  where validPropElemNames state = proc (predXml) -> do+            p <- arr(unode . T.pack) <<< getName -< predXml+            o <- getAttrValue "rdf:resource" -< predXml+            returnA -< Triple (stateSubject state) p (unode (T.pack o))++        defaultA = proc (state, predXml) -> do                          p <- arr(unode . T.pack) <<< getName -< predXml                          t <- arr2A (arr2A . parseObjectsFromChildren) <<< second (second getChildren) -< (state, (p, predXml))                          returnA -< t+        -- parsePredicateAttr :: Node -> a (LParseState,XmlTree) Triple         parsePredicateAttr n = (second getName >>> arr (\(s, p) -> Triple (stateSubject s) ((unode . T.pack) p) n))                            <+> (first (arr (\s -> s { stateSubject = n })) >>> arr2A parsePredicatesFromAttr)         hasPredicateAttr = getAttrl >>> neg (getName >>> isMetaAttr) -parseObjectsFromChildren :: forall a. (ArrowXml a, ArrowState GParseState a)+-- See https://www.w3.org/2000/03/rdf-tracking/+-- Section "Issue rdfms-rdf-names-use: Illegal or unusual use of names from the RDF namespace"+validPropElementName :: (ArrowXml a, ArrowState GParseState a) => a (LParseState,XmlTree) (LParseState,XmlTree)+validPropElementName = proc (state,predXml) -> do+  neg (hasName "rdf:Description") -< predXml+  neg (hasName "rdf:RDF") -< predXml+  neg (hasName "rdf:ID") -< predXml+  neg (hasName "rdf:about") -< predXml+  neg (hasName "rdf:bagID") -< predXml+  neg (hasName "rdf:parseType") -< predXml+  neg (hasName "rdf:resource") -< predXml+  neg (hasName "rdf:nodeID") -< predXml+  neg (hasName "rdf:aboutEach") -< predXml+  neg (hasName "rdf:aboutEachPrefix") -< predXml+  returnA -< (state,predXml)++parseObjectsFromChildren :: forall a. (ArrowIf a, ArrowXml a, ArrowState GParseState a)                          => LParseState -> Predicate -> a XmlTree Triple parseObjectsFromChildren s p = choiceA     [ isText :-> (neg( isWhiteSpace) >>> getText >>> arr (Triple (stateSubject s) p . mkLiteralNode s))     , isElem :-> (parseObjectDescription)     ]-  where parseObjectDescription = proc desc -> do-                                      o <- mkNode s -< desc-                                      t0 <- arr (\(sub, (p', o)) -> Triple sub p' o) -< (stateSubject s, (p, o))-                                      t <- arr fst <+> (parseDescription <<< arr snd) -< (t0, (s { stateSubject = o }, desc))-                                      returnA -< t+  where parseObjectDescription =+          proc desc -> do+            _ <- (second (neg (hasAttr "rdf:nodeID")) &&& (second (neg (hasName "rdf:resource")))) -< (p,desc)+            o <- mkNode s -< desc+            t0 <- arr (\(sub, (p', o)) -> Triple sub p' o) -< (stateSubject s, (p, o))+            t <- arr fst <+> (parseDescription <<< arr snd) -< (t0, (s { stateSubject = o }, desc))+            returnA -< t  attachSubject :: Subject -> (Predicate, Object) -> Triple attachSubject s (p, o) = Triple s p o@@ -254,8 +337,22 @@                        , hasAttr "rdf:resource" :-> (attrExpandURI state "rdf:resource" >>> mkUNode)                        , hasAttr "rdf:nodeID" :-> (getAttrValue "rdf:nodeID" >>> arr (bnode . T.pack))                        , hasAttr "rdf:ID" :-> mkRelativeNode state-                       , this :-> mkBlankNode+                       , this :-> (validNodeElementName >>> mkBlankNode)                        ]++-- See https://www.w3.org/2000/03/rdf-tracking/+-- Section "Issue rdfms-rdf-names-use: Illegal or unusual use of names from the RDF namespace"+validNodeElementName :: (ArrowXml a, ArrowState GParseState a) => a XmlTree XmlTree+validNodeElementName = neg (hasName "rdf:RDF")+                       >>> neg (hasName "rdf:ID")+                       >>> neg (hasName "rdf:about")+                       >>> neg (hasName "rdf:bagID")+                       >>> neg (hasName "rdf:parseType")+                       >>> neg (hasName "rdf:resource")+                       >>> neg (hasName "rdf:nodeID")+                       >>> neg (hasName "rdf:li")+                       >>> neg (hasName "rdf:aboutEach")+                       >>> neg (hasName "rdf:aboutEachPrefix")  rdfXmlLiteral :: T.Text rdfFirst,rdfRest,rdfNil,rdfType,rdfStatement,rdfSubject,rdfPredicate,rdfObject :: Node

@@ -0,0 +1,33 @@+{-# LANGUAGE FlexibleInstances #-}++module Data.RDF.Graph.AdjHashMap_Test (triplesOf',uniqTriplesOf',empty',mkRdf',addTriple',removeTriple') where++import Data.RDF.Types+import Data.RDF.Graph.AdjHashMap (AdjHashMap)+import Data.RDF.GraphTestUtils+import qualified Data.Map as Map+import Control.Monad++import Test.QuickCheck++instance Arbitrary (RDF AdjHashMap) where+  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)+  --coarbitrary = undefined++empty' :: RDF AdjHashMap+empty' = empty++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF AdjHashMap+mkRdf' = mkRdf++triplesOf' :: RDF AdjHashMap -> Triples+triplesOf' = triplesOf++uniqTriplesOf' :: RDF AdjHashMap -> Triples+uniqTriplesOf' = uniqTriplesOf++addTriple' :: RDF AdjHashMap -> Triple -> RDF AdjHashMap+addTriple' = addTriple++removeTriple' :: RDF AdjHashMap -> Triple -> RDF AdjHashMap+removeTriple' = removeTriple

@@ -1,28 +0,0 @@-{-# 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

@@ -1,29 +0,0 @@-{-# 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

@@ -1,29 +0,0 @@-{-# 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

@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} -module Data.RDF.Graph.TList_Test (empty',triplesOf',uniqTriplesOf',mkRdf') where+module Data.RDF.Graph.TList_Test (empty',triplesOf',uniqTriplesOf',mkRdf',addTriple',removeTriple') where  import Control.Monad import qualified Data.Map as Map@@ -10,8 +10,6 @@ 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@@ -27,3 +25,9 @@  uniqTriplesOf' :: RDF TList -> Triples uniqTriplesOf' = uniqTriplesOf++addTriple' :: RDF TList -> Triple -> RDF TList+addTriple' = addTriple++removeTriple' :: RDF TList -> Triple -> RDF TList+removeTriple' = removeTriple

@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} -module Data.RDF.GraphTestUtils where+module Data.RDF.GraphTestUtils (graphTests,arbitraryTs) where  import Data.RDF.Types import Data.RDF.Query@@ -14,7 +14,6 @@ import Control.Monad import GHC.Generics () import System.Directory (removeFile)-import System.IO.Unsafe(unsafePerformIO) import System.IO  import Test.Tasty@@ -25,11 +24,18 @@ --  property based quick check test cases         -- ---------------------------------------------------- -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+graphTests+  :: (Arbitrary (RDF rdf), Rdf rdf)+  => TestName+  -> (RDF rdf -> Triples) -- ^ triplesOf+  -> (RDF rdf -> Triples) -- ^ uniqTriplesOf+  -> RDF rdf -- ^ empty+  -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -- ^ mkRdf+  -> (RDF rdf -> Triple -> RDF rdf) -- ^ addTriple+  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple+  -> TestTree+graphTests testGroupName _triplesOf _uniqTriplesOf _empty _mkRdf _addTriple _removeTriple =+  testGroup testGroupName             [               testProperty "empty"                      (p_empty _triplesOf _empty)             , testProperty "mkRdf_triplesOf"            (p_mkRdf_triplesOf _triplesOf _mkRdf)@@ -54,20 +60,45 @@             , testProperty "select_match_po"            (p_select_match_po _triplesOf)             , testProperty "select_match_spo"           (p_select_match_spo _triplesOf)             , testProperty "reversed RDF handle write"  (p_reverseRdfTest _mkRdf)++            -- adding and removing triples from a graph.+            , testProperty "add_triple" (p_add_triple _mkRdf _triplesOf _addTriple)+            , testProperty "remove_triple" (p_remove_triple _mkRdf _triplesOf _removeTriple)+            , testProperty "remove_triple_from_graph" (p_remove_triple_from_graph _mkRdf _triplesOf _removeTriple)+            , testProperty "remove_triple_from_singleton_graph_query_s" (p_remove_triple_from_singleton_graph_query_s _triplesOf _removeTriple)+            , testProperty "remove_triple_from_singleton_graph_query_p" (p_remove_triple_from_singleton_graph_query_p _triplesOf _removeTriple)+            , testProperty "remove_triple_from_singleton_graph_query_o" (p_remove_triple_from_singleton_graph_query_o _triplesOf _removeTriple)             ] +newtype SingletonGraph rdf = SingletonGraph { rdfGraph :: (RDF rdf) } +instance (Rdf rdf) => Arbitrary (SingletonGraph rdf) where+  arbitrary = do+    pref <- arbitraryPrefixMappings+    baseU' <- arbitraryBaseUrl+    baseU <- oneof [return (Just baseU'), return Nothing]+    t <- liftM3 triple arbitraryS arbitraryP arbitraryO+    return SingletonGraph { rdfGraph = (mkRdf [t] baseU pref) }++instance (Rdf rdf) => Show (SingletonGraph rdf) where+  show singletonGraph = showGraph (rdfGraph singletonGraph)+ instance Arbitrary BaseUrl where-  arbitrary = oneof $ map (return . BaseUrl . T.pack) ["http://example.com/a","http://asdf.org/b","http://asdf.org/c"]-  --coarbitrary = undefined+  arbitrary = arbitraryBaseUrl  instance Arbitrary PrefixMappings where-  arbitrary = oneof [return $ PrefixMappings Map.empty, return $ PrefixMappings $+  arbitrary = arbitraryPrefixMappings++arbitraryBaseUrl :: Gen BaseUrl+arbitraryBaseUrl = oneof $ map (return . BaseUrl . T.pack) ["http://example.com/a","http://asdf.org/b","http://asdf.org/c"]++arbitraryPrefixMappings :: Gen PrefixMappings+arbitraryPrefixMappings = oneof [return $ PrefixMappings Map.empty, return $ PrefixMappings $                           Map.fromAscList [(T.pack "eg1", T.pack "http://example.com/1"),                                            (T.pack "eg2", T.pack "http://example.com/2"),                                            (T.pack "eg3", T.pack "http://example.com/3")]]-  --coarbitrary = undefined + -- Test stubs, which just require the appropriate RDF impl function -- passed in to determine the implementation to be tested. @@ -187,6 +218,7 @@         all_ts = _triplesOf rdf         all_ts_sorted = uordered all_ts         results = uordered $ queryC rdf (mkPatternFn t)+        -- `notResults` is the difference of the two sets of triples         notResults = ldiff all_ts_sorted results       in         all (tripleCompareFn t) results &&@@ -259,6 +291,117 @@                    Just (\n -> n == predicateOf t),                    Just (\n -> n /= objectOf t)) +-- |adding a triple to a graph.+p_add_triple+  :: (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)+  -> (RDF rdf -> Triples) -- ^ triplesOf+  -> (RDF rdf -> Triple -> RDF rdf) -- ^ addTriple+  -> Triples+  -> Maybe BaseUrl+  -> PrefixMappings+  -> Triple -- ^ new triple to be added+  -> Bool+p_add_triple _mkRdf _triplesOf _addTriple ts bUrl pms newTriple =+  uordered (newTriple : _triplesOf oldGr)+  == uordered (_triplesOf newGr) +  where+    oldGr = _mkRdf ts bUrl pms+    newGr =  _addTriple oldGr newTriple++-- |removing a triple that may or may not be in a graph. If it is not,+--  this operation is silently ignored.+p_remove_triple+  :: (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)+  -> (RDF rdf -> Triples) -- ^ triplesOf+  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple+  -> Triples+  -> Maybe BaseUrl+  -> PrefixMappings+  -> Triple -- ^ triple to be removed+  -> Bool+p_remove_triple _mkRdf _triplesOf _removeTriple ts bUrl pms tripleToBeRemoved =+  uordered (filter (/= tripleToBeRemoved) oldTriples)+  == uordered newTriples+  where+    oldGr      = _mkRdf ts bUrl pms+    newGr      = _removeTriple oldGr tripleToBeRemoved+    oldTriples = _triplesOf oldGr+    newTriples = _triplesOf newGr++-- |removing a triple from a graph. The new graph should not contain+-- any instances of the triple.+p_remove_triple_from_graph+  :: (Rdf rdf)+  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)+  -> (RDF rdf -> Triples) -- ^ triplesOf+  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple+  -> Triples+  -> Maybe BaseUrl+  -> PrefixMappings+  -> Property+p_remove_triple_from_graph  _mkRdf _triplesOf _removeTriple ts bUrl pms =+  classify (null ts) "p_remove_triple_from_graph tests were trivial" $+  forAll (tripleFromGen _triplesOf (_mkRdf ts bUrl pms)) f+  where+    f :: Maybe Triple -> Bool+    f Nothing = True+    f (Just tripleToBeRemoved) =+      p_remove_triple _mkRdf _triplesOf _removeTriple ts bUrl pms tripleToBeRemoved++-- TODO: refactor the following 3 functions.++-- |removing a triple from a graph that contained only that triple.+-- Performing a ((Just s) Nothing Nothing) query should return an+-- empty list.+p_remove_triple_from_singleton_graph_query_s+  :: (Rdf rdf)+  => (RDF rdf -> Triples) -- ^ triplesOf+  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple+  -> SingletonGraph rdf+  -> Bool+p_remove_triple_from_singleton_graph_query_s _tripleOf _removeTriple singletonGraph =+  query newGr (Just s) Nothing Nothing == []+  where+    tripleInGraph@(Triple s _p _o) = head (_tripleOf (rdfGraph singletonGraph))+    newGr = _removeTriple (rdfGraph singletonGraph) tripleInGraph++-- |removing a triple from a graph that contained only that triple.+-- Performing a (Nothing (Just p) Nothing) query should return an+-- empty list.+p_remove_triple_from_singleton_graph_query_p+  :: (Rdf rdf)+  => (RDF rdf -> Triples) -- ^ triplesOf+  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple+  -> SingletonGraph rdf+  -> Bool+p_remove_triple_from_singleton_graph_query_p _tripleOf _removeTriple singletonGraph =+  query newGr Nothing (Just p) Nothing == []+  where+    tripleInGraph@(Triple _s p _o) = head (_tripleOf (rdfGraph singletonGraph))+    newGr = _removeTriple (rdfGraph singletonGraph) tripleInGraph++-- |removing a triple from a graph that contained only that triple.+-- Performing a (Nothing Nothing (Just o)) query should return an+-- empty list.+p_remove_triple_from_singleton_graph_query_o+  :: (Rdf rdf)+  => (RDF rdf -> Triples) -- ^ triplesOf+  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple+  -> SingletonGraph rdf+  -> Bool+p_remove_triple_from_singleton_graph_query_o _tripleOf _removeTriple singletonGraph =+  query newGr Nothing Nothing (Just o) == []+  where+    tripleInGraph@(Triple _s _p o) = head (_tripleOf (rdfGraph singletonGraph))+    newGr = _removeTriple (rdfGraph singletonGraph) tripleInGraph++  +-- 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++ equivNode :: (Node -> Node -> Bool) -> (Triple -> Node) -> Triple -> Triple -> Bool equivNode eqFn exFn t1 t2 = exFn t1 `eqFn` exFn t2 @@ -280,9 +423,9 @@         all (tripleCompareFn t) results &&         all (not . tripleCompareFn t) notResults -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+-- 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   -- Utility functions and test data ... --@@ -295,16 +438,16 @@ 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-uncurry3 fn (x, y, z) = fn x y z+-- uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d+-- uncurry3 fn (x, y, z) = fn x y z -curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d-curry3 fn x y z = fn (x, y, z)+-- curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d+-- curry3 fn x y z = fn (x, y, z) -debug :: String -> Triples -> Bool-debug msg ts =-  unsafePerformIO $-    putStrLn msg >> mapM print ts >> return True+-- debug :: String -> Triples -> Bool+-- debug msg ts =+--   unsafePerformIO $+--     putStrLn msg >> mapM print ts >> return True  ldiff :: Triples -> Triples -> Triples ldiff l1 l2 = Set.toList $(Set.fromList l1) `Set.difference` Set.fromList l2@@ -318,10 +461,7 @@ sameObj :: Triple -> Triple -> Bool sameObj  t1 t2 = objectOf t1 == objectOf t2 --- Convert a list of triples into a sorted list of unique triples.-uordered :: Triples -> Triples-uordered  =  sort . nub-+-- |pick a random triple from an RDF graph if the graph is not empty. tripleFromGen :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Gen (Maybe Triple) tripleFromGen _triplesOf rdf =   if null ts@@ -373,19 +513,19 @@   arbitrary = oneof $ map return unodes   --coarbitrary = undefined -arbitraryTNum :: Gen Int-arbitraryTNum = choose (0, maxN - 1)+-- arbitraryTNum :: Gen Int+-- arbitraryTNum = choose (0, maxN - 1)  arbitraryTs :: Gen Triples arbitraryTs = do   n <- sized (\_ -> choose (0, maxN))   sequence [arbitrary | _ <- [1..n]] -arbitraryT :: Gen Triple-arbitraryT = elements test_triples+-- arbitraryTriple :: Gen Triple+-- arbitraryTriple = elements test_triples -arbitraryN :: Gen Int-arbitraryN = choose (0, maxN - 1)+-- arbitraryN :: Gen Int+-- arbitraryN = choose (0, maxN - 1)  arbitraryS, arbitraryP, arbitraryO :: Gen Node arbitraryS = oneof $ map return $ unodes ++ bnodes

@@ -3,9 +3,9 @@ import Test.Tasty (defaultMain,testGroup)  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+import qualified Data.RDF.Graph.AdjHashMap_Test as AdjHashMap+-- 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@@ -60,24 +60,28 @@           TList.uniqTriplesOf'           TList.empty'           TList.mkRdf'+          TList.addTriple'+          TList.removeTriple' -        , graphTests "HashS"-          HashS.triplesOf'-          HashS.uniqTriplesOf'-          HashS.empty'-          HashS.mkRdf'+        , graphTests "AdjHashMap"+          AdjHashMap.triplesOf'+          AdjHashMap.uniqTriplesOf'+          AdjHashMap.empty'+          AdjHashMap.mkRdf'+          AdjHashMap.addTriple'+          AdjHashMap.removeTriple' -        , graphTests "HashSP"-          HashSP.triplesOf'-          HashSP.uniqTriplesOf'-          HashSP.empty'-          HashSP.mkRdf'+        -- , graphTests "HashSP"+        --   HashSP.triplesOf'+        --   HashSP.uniqTriplesOf'+        --   HashSP.empty'+        --   HashSP.mkRdf' -        , graphTests "SP"-          SP.triplesOf'-          SP.uniqTriplesOf'-          SP.empty'-          SP.mkRdf'+        -- , graphTests "SP"+        --   SP.triplesOf'+        --   SP.uniqTriplesOf'+        --   SP.empty'+        --   SP.mkRdf'          -- , graphTests "TriplesPatriciaTree"         --   TriplesPatriciaTree.triplesOf'

@@ -6,7 +6,7 @@  -- Import common libraries to facilitate tests import Control.Monad (liftM)-import Data.RDF.GraphTestUtils+-- import Data.RDF.GraphTestUtils import Data.RDF.Query import Data.RDF.Graph.TList import Data.RDF.Types