rdf4h 1.3.6 → 2.0.0

raw patch · 35 files changed

+2015/−1380 lines, 35 filesdep +hgaldep +tastydep +tasty-hunitdep −knobdep −test-frameworkdep −test-framework-hunitdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: hgal, tasty, tasty-hunit, tasty-quickcheck, utf8-string

Dependencies removed: knob, test-framework, test-framework-hunit, test-framework-quickcheck2

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• bench/MainCriterion.hs +32/−16
• examples/ParseURLs.hs +1/−1
• rdf4h.cabal +27/−29
• src/Data/RDF.hs +13/−9
• src/Data/RDF/Graph/HashMapS.hs +203/−0
• src/Data/RDF/Graph/HashMapSP.hs +160/−0
• src/Data/RDF/Graph/MapSP.hs +185/−0
• src/Data/RDF/Graph/TriplesList.hs +112/−0
• src/Data/RDF/Graph/TriplesPatriciaTree.hs +276/−0
• src/Data/RDF/MGraph.hs +0/−204
• src/Data/RDF/PatriciaTreeGraph.hs +0/−275
• src/Data/RDF/Query.hs +32/−16
• src/Data/RDF/TriplesGraph.hs +0/−114
• src/Data/RDF/Types.hs +73/−38
• src/Rdf4hParseMain.hs +5/−5
• src/Text/RDF/RDF4H/Interact.hs +2/−2
• src/Text/RDF/RDF4H/NTriplesParser.hs +154/−93
• src/Text/RDF/RDF4H/TurtleParser.hs +316/−245
• testsuite/tests/Data/RDF/Graph/HashMapSP_Test.hs +24/−0
• testsuite/tests/Data/RDF/Graph/HashMapS_Test.hs +25/−0
• testsuite/tests/Data/RDF/Graph/MapSP_Test.hs +25/−0
• testsuite/tests/Data/RDF/Graph/TriplesList_Test.hs +25/−0
• testsuite/tests/Data/RDF/Graph/TriplesPatriciaTree_Test.hs +25/−0
• testsuite/tests/Data/RDF/GraphTestUtils.hs +12/−15
• testsuite/tests/Data/RDF/MGraph_Test.hs +0/−25
• testsuite/tests/Data/RDF/PatriciaTreeGraph_Test.hs +0/−25
• testsuite/tests/Data/RDF/TriplesGraph_Test.hs +0/−25
• testsuite/tests/Test.hs +82/−27
• testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs +48/−43
• testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs +29/−32
• testsuite/tests/W3C/Manifest.hs +19/−15
• testsuite/tests/W3C/NTripleTest.hs +13/−36
• testsuite/tests/W3C/RdfXmlTest.hs +18/−38
• testsuite/tests/W3C/TurtleTest.hs +25/−52
• testsuite/tests/W3C/W3CAssertions.hs +54/−0

@@ -27,12 +27,16 @@ main = defaultMain [    env (readFile "bills.102.ttl") $ \ ~(ttl_countries) ->    bgroup "parse" [-     bench "TriplesGraph" $-       nf (parseTurtle  :: String -> TriplesGraph) ttl_countries-   , bench "MGraph" $-       nf (parseTurtle  :: String -> MGraph) ttl_countries-   , bench "PatriciaTreeGraph" $-       nf (parseTurtle  :: String -> PatriciaTreeGraph) ttl_countries+     bench "HashMapS" $+       nf (parseTurtle  :: String -> HashMapS) ttl_countries+   , bench "HashMapSP" $+       nf (parseTurtle  :: String -> HashMapSP) ttl_countries+   , bench "MapSP" $+       nf (parseTurtle  :: String -> MapSP) ttl_countries+   , bench "TriplesList" $+       nf (parseTurtle  :: String -> TriplesList) ttl_countries+   , bench "ListPatriciaTree" $+       nf (parseTurtle  :: String -> TriplesPatriciaTree) ttl_countries    ]     ,@@ -40,24 +44,32 @@            let (Right rdf1) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries)            let (Right rdf2) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries)            let (Right rdf3) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries)-           return (rdf1 :: PatriciaTreeGraph,rdf2 :: TriplesGraph,rdf3 :: MGraph) )-     $ \ ~(patriciaTreeCountries,triplesGraph,mGraph) ->+           let (Right rdf4) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries)+           let (Right rdf5) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries)+           return (rdf1 :: TriplesPatriciaTree,rdf2 :: TriplesList,rdf3 :: HashMapS,rdf4 :: MapSP,rdf5::HashMapSP) )+     $ \ ~(triplesPatriciaTree,triplesList,hashMapS,mapSP,hashMapSP) ->    bgroup "query"-     (queryBench "TriplesGraph" triplesGraph-     ++ queryBench "MGraph" mGraph-     ++ queryBench "PatriciaTreeGraph" patriciaTreeCountries)+     (queryBench "TriplesList" triplesList+     ++ queryBench "HashMapS" hashMapS+     ++ queryBench "MapSP" mapSP+     ++ queryBench "HashMapSP" hashMapSP+     ++ queryBench "TriplesPatriciaTree" triplesPatriciaTree)     ,    env (do ttl_countries <- readFile "bills.102.ttl"            let (Right rdf1) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries)            let (Right rdf2) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries)            let (Right rdf3) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries)-           return (rdf1 :: PatriciaTreeGraph,rdf2 :: TriplesGraph,rdf3 :: MGraph) )-     $ \ ~(patriciaTreeCountries,triplesGraph,mGraph) ->+           let (Right rdf4) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries)+           let (Right rdf5) = parseString (TurtleParser Nothing Nothing) (T.pack ttl_countries)+           return (rdf1 :: TriplesPatriciaTree,rdf2 :: TriplesList,rdf3 :: HashMapS,rdf4 :: MapSP,rdf5 :: HashMapSP) )+     $ \ ~(triplesPatriciaTree,triplesList,hashMapS,mapSP,hashMapSP) ->    bgroup "select"-     (selectBench "TriplesGraph" triplesGraph-     ++ selectBench "MGraph" mGraph-     ++ selectBench "PatriciaTreeGraph" patriciaTreeCountries)+     (selectBench "TriplesList" triplesList+     ++ selectBench "HashMapS" hashMapS+     ++ selectBench "MapSP" mapSP+     ++ selectBench "HashMapSP" hashMapSP+     ++ selectBench "TriplesPatriciaTree" triplesPatriciaTree)  ]  selectBench :: forall rdf. RDF rdf => String -> rdf -> [Benchmark]@@ -66,6 +78,8 @@    , bench (label ++ " SP")  $ nf selectGr (subjSelect,predSelect,selectNothing,gr)    , bench (label ++ " S")   $ nf selectGr (subjSelect,selectNothing,selectNothing,gr)    , bench (label ++ " PO")  $ nf selectGr (selectNothing,predSelect,objSelect,gr)+   , bench (label ++ " SO")  $ nf selectGr (subjSelect,selectNothing,objSelect,gr)+   , bench (label ++ " P")   $ nf selectGr (selectNothing,predSelect,selectNothing,gr)    , bench (label ++ " O")   $ nf selectGr (selectNothing,selectNothing,objSelect,gr)    ] @@ -87,5 +101,7 @@    , bench (label ++ " SP")  $ nf queryGr (subjQuery,predQuery,queryNothing,gr)    , bench (label ++ " S")   $ nf queryGr (subjQuery,queryNothing,queryNothing,gr)    , bench (label ++ " PO")  $ nf queryGr (queryNothing,predQuery,objQuery,gr)+   , bench (label ++ " SO")  $ nf queryGr (subjQuery,queryNothing,objQuery,gr)+   , bench (label ++ " P")   $ nf queryGr (queryNothing,predQuery,queryNothing,gr)    , bench (label ++ " O")   $ nf queryGr (queryNothing,queryNothing,objQuery,gr)    ]

@@ -9,7 +9,7 @@ --   returns a single String element: [\"Designing the Web for an Open Society\"]. timBernersLee :: IO () timBernersLee = do-    Right (rdf::TriplesGraph) <- parseURL (XmlParser Nothing Nothing) "http://www.w3.org/People/Berners-Lee/card.rdf"+    Right (rdf::TriplesList) <- parseURL (XmlParser Nothing Nothing) "http://www.w3.org/People/Berners-Lee/card.rdf"     let ts = query rdf (Just (UNode "http://www.w3.org/2011/Talks/0331-hyderabad-tbl/data#talk")) (Just (UNode "dct:title")) Nothing     let talks = map (\(Triple _ _ (LNode (PlainL s))) -> s) ts     print talks

@@ -1,5 +1,5 @@ name:            rdf4h-version:         1.3.6+version:         2.0.0 synopsis:        A library for RDF processing in Haskell description:   'RDF for Haskell' is a library for working with RDF in Haskell.@@ -19,14 +19,10 @@ build-type:      Simple category:        RDF stability:       Experimental-tested-with:     GHC==7.6.3, GHC==7.8.3+tested-with:     GHC==7.6.3, GHC==7.8.3, GHC==7.10.2 extra-tmp-files: test extra-source-files: examples/ParseURLs.hs -flag small_base-  description: Choose the new smaller, split-up base package.-  default:     False- flag network-uri    description: Get Network.URI from the network-uri package    default: True@@ -36,19 +32,21 @@                  , Data.RDF.Namespace                  , Data.RDF.Types                  , Data.RDF.Query-                 , Data.RDF.MGraph-                 , Data.RDF.PatriciaTreeGraph-                 , Data.RDF.TriplesGraph+                 , Data.RDF.Graph.HashMapS+                 , Data.RDF.Graph.HashMapSP+                 , Data.RDF.Graph.MapSP+                 , Data.RDF.Graph.TriplesPatriciaTree+                 , Data.RDF.Graph.TriplesList                  , Text.RDF.RDF4H.TurtleParser                  , Text.RDF.RDF4H.TurtleSerializer                  , Text.RDF.RDF4H.NTriplesParser                  , Text.RDF.RDF4H.NTriplesSerializer                  , Text.RDF.RDF4H.XmlParser-  if flag(small_base)-    build-depends: base >= 3, bytestring, directory, containers-  else-    build-depends: base < 3-  build-depends:   parsec >= 3+  build-depends:   base >= 3+                 , bytestring+                 , directory+                 , containers+                 , parsec >= 3                  , fgl >= 5.5.2.0                  , HTTP >= 4000.0.0                  , hxt >= 9.3.1.2@@ -58,6 +56,8 @@                  , deepseq                  , binary                  , text-binary+                 , utf8-string+                 , hgal   if impl(ghc < 7.6)     build-depends: ghc-prim @@ -69,16 +69,13 @@   other-modules:   Text.RDF.RDF4H.ParserUtils                  , Text.RDF.RDF4H.Interact   hs-source-dirs:  src-  extensions:      BangPatterns RankNTypes MultiParamTypeClasses Arrows FlexibleContexts OverloadedStrings-  ghc-options:     -Wall -fno-warn-unused-do-bind -funbox-strict-fields -O2+  extensions:      BangPatterns RankNTypes MultiParamTypeClasses Arrows FlexibleContexts OverloadedStrings DoAndIfThenElse+  ghc-options:     -Wall -fno-warn-unused-do-bind -funbox-strict-fields  executable rdf4h   main-is:         src/Rdf4hParseMain.hs-  if flag(small_base)-    build-depends: base >= 3, bytestring-  else-    build-depends: base >= 4 && < 6-  build-depends:   rdf4h+  build-depends:   base >= 4 && < 6+                 , rdf4h                  , containers                  , text >= 1.2.1.0 @@ -97,27 +94,29 @@   type:          exitcode-stdio-1.0   main-is:       Test.hs   other-modules: Data.RDF.GraphTestUtils-                 Data.RDF.MGraph_Test-                 Data.RDF.PatriciaTreeGraph_Test+                 Data.RDF.Graph.HashMapS_Test+                 Data.RDF.Graph.HashMapSP_Test+                 Data.RDF.Graph.MapSP_Test+                 Data.RDF.Graph.TriplesPatriciaTree_Test+                 Data.RDF.Graph.TriplesList_Test                  Text.RDF.RDF4H.TurtleParser_ConformanceTest                  Text.RDF.RDF4H.XmlParser_Test-                 Data.RDF.TriplesGraph_Test                  W3C.Manifest                  W3C.NTripleTest                  W3C.RdfXmlTest+                 W3C.W3CAssertions   ghc-options:   -Wall -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-name-shadowing -funbox-strict-fields   extensions:    RankNTypes MultiParamTypeClasses Arrows FlexibleContexts OverloadedStrings   build-depends: base >= 4 && < 6                , rdf4h-               , test-framework >= 0.2.3-               , test-framework-quickcheck2-               , test-framework-hunit >= 0.2.7+               , tasty+               , tasty-hunit+               , tasty-quickcheck                , QuickCheck >= 1.2.0.0                , HUnit >= 1.2.2.1                , bytestring                , containers                , text >= 1.2.1.0-               , knob                , directory                , safe @@ -141,7 +140,6 @@                     rdf4h,                     text >= 1.2.1.0   ghc-options:      -Wall-                    -O2  source-repository head   type:     git

@@ -7,16 +7,18 @@   RdfSerializer(..),   RdfParser(..), -  -- * Export types and query functions+  -- * RDF types and query functions   module Data.RDF.Types,   module Data.RDF.Query, -  -- * Export RDF type class instances-  module Data.RDF.TriplesGraph,-  module Data.RDF.MGraph,-  module Data.RDF.PatriciaTreeGraph,+  -- * RDF type class instances+  module Data.RDF.Graph.TriplesList,+  module Data.RDF.Graph.HashMapS,+  module Data.RDF.Graph.HashMapSP,+  module Data.RDF.Graph.MapSP,+  module Data.RDF.Graph.TriplesPatriciaTree, -  -- * Export RDF parsers and serializers+  -- * RDF parsers and serializers   module Text.RDF.RDF4H.NTriplesSerializer,   module Text.RDF.RDF4H.NTriplesParser,   module Text.RDF.RDF4H.TurtleSerializer,@@ -26,9 +28,11 @@ where  import Data.RDF.Namespace-import Data.RDF.TriplesGraph-import Data.RDF.MGraph-import Data.RDF.PatriciaTreeGraph+import Data.RDF.Graph.TriplesList+import Data.RDF.Graph.HashMapS+import Data.RDF.Graph.HashMapSP+import Data.RDF.Graph.MapSP+import Data.RDF.Graph.TriplesPatriciaTree import Text.RDF.RDF4H.NTriplesSerializer import Text.RDF.RDF4H.TurtleSerializer import Text.RDF.RDF4H.NTriplesParser

@@ -0,0 +1,203 @@+{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-}+-- |A graph implementation mapping hashed S to a mapping of+--  hashed P to hashed O, backed by 'Data.HashMap'.++module Data.RDF.Graph.HashMapS (HashMapS) where++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++-- |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 HashMapS = HashMapS (TMaps, Maybe BaseUrl, PrefixMappings)+                 deriving (NFData)++instance RDF HashMapS where+  baseUrl           = baseUrl'+  prefixMappings    = prefixMappings'+  addPrefixMappings = addPrefixMappings'+  empty             = empty'+  mkRdf             = mkRdf'+  triplesOf         = triplesOf'+  uniqTriplesOf     = uniqTriplesOf'+  select            = select'+  query             = query'++instance Show HashMapS 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' :: HashMapS -> Maybe BaseUrl+baseUrl' (HashMapS (_, baseURL, _)) = baseURL++prefixMappings' :: HashMapS -> PrefixMappings+prefixMappings' (HashMapS (_, _, pms)) = pms++addPrefixMappings' :: HashMapS -> PrefixMappings -> Bool -> HashMapS+addPrefixMappings' (HashMapS (ts, baseURL, pms)) pms' replace = +  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings+  in  HashMapS (ts, baseURL, merge pms pms')++empty' :: HashMapS+empty' = HashMapS ((HashMap.empty, HashMap.empty), Nothing, PrefixMappings Map.empty)++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> HashMapS+mkRdf' ts baseURL pms = HashMapS (mergeTs (HashMap.empty, HashMap.empty) ts, baseURL, pms)++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' :: HashMapS -> Triples+triplesOf' (HashMapS ((spoMap, _), _, _)) = concatMap (uncurry tripsSubj) subjPredMaps+  where subjPredMaps = HashMap.toList spoMap++-- naive implementation for now+uniqTriplesOf' :: HashMapS -> 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' :: HashMapS -> NodeSelector -> NodeSelector -> NodeSelector -> Triples+select' (HashMapS ((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' :: HashMapS -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples+query' (HashMapS (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

@@ -0,0 +1,160 @@+{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-}+-- |A graph implementation mapping (S,P) pairs to O, backed by 'Data.Map'.++module Data.RDF.Graph.HashMapSP (HashMapSP) 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++-- |A map-based graph implementation.++newtype HashMapSP = HashMapSP (SPMap, Maybe BaseUrl, PrefixMappings)+                 deriving (NFData)++instance RDF HashMapSP where+  baseUrl           = baseUrl'+  prefixMappings    = prefixMappings'+  addPrefixMappings = addPrefixMappings'+  empty             = empty'+  mkRdf             = mkRdf'+  triplesOf         = triplesOf'+  uniqTriplesOf     = uniqTriplesOf'+  select            = select'+  query             = query'++instance Show HashMapSP where+  show gr = concatMap (\t -> show t ++ "\n")  (triplesOf gr)++type SPMap = HashMap (Subject,Predicate) [Object]++baseUrl' :: HashMapSP -> Maybe BaseUrl+baseUrl' (HashMapSP (_, baseURL, _)) = baseURL++prefixMappings' :: HashMapSP -> PrefixMappings+prefixMappings' (HashMapSP (_, _, pms)) = pms++addPrefixMappings' :: HashMapSP -> PrefixMappings -> Bool -> HashMapSP+addPrefixMappings' (HashMapSP (tsMap, baseURL, pms)) pms' replace =+  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings+  in  HashMapSP (tsMap, baseURL, merge pms pms')++empty' :: HashMapSP+empty' = HashMapSP (HashMap.empty, Nothing, PrefixMappings Map.empty)++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> HashMapSP+mkRdf' triples baseURL pms = HashMapSP (tsMap, baseURL, pms)+    where+      tsMap = sortAndGroup triples+      sortAndGroup xs = HashMap.fromListWith (++) [((s,p), [o]) | Triple s p o <- xs]++triplesOf' :: HashMapSP -> Triples+triplesOf' (HashMapSP (tsMap,_,_)) = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . HashMap.toList) tsMap++uniqTriplesOf' :: HashMapSP -> Triples+uniqTriplesOf' = nub . expandTriples++select' :: HashMapSP -> NodeSelector -> NodeSelector -> NodeSelector -> Triples+select' gr Nothing Nothing Nothing =+    triplesOf' gr++select' (HashMapSP (tsMap,_,_))    Nothing  (Just pSelector) Nothing  =+    HashMap.foldrWithKey findTripleWithP [] tsMap+    where+      findTripleWithP (s,p) oList ts = if pSelector p+                                       then map (Triple s p) oList ++ ts+                                       else ts++select' (HashMapSP (tsMap,_,_))    Nothing  Nothing  (Just oSelector) =+    HashMap.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = map (Triple s p) (filter oSelector oList) ++ ts++select' (HashMapSP (tsMap,_,_))    Nothing  (Just pSelector) (Just oSelector) =+    HashMap.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = if pSelector p+                                       then map (Triple s p) (filter oSelector oList) ++ ts+                                       else ts++select' (HashMapSP (tsMap,_,_))    (Just sSelector) Nothing  Nothing  =+    HashMap.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = if sSelector s+                                       then map (Triple s p) oList ++ ts+                                       else ts++select' (HashMapSP (tsMap,_,_))    (Just sSelector) (Just pSelector) Nothing =+    HashMap.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = if sSelector s && pSelector p+                                       then map (Triple s p) oList ++ ts+                                       else ts++select' (HashMapSP (tsMap,_,_))    (Just sSelector) Nothing  (Just oSelector) =+    HashMap.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = if sSelector s+                                        then map (Triple s p) (filter oSelector oList) ++ ts+                                        else ts++select' (HashMapSP (tsMap,_,_))    (Just sSelector) (Just pSelector) (Just oSelector) =+    HashMap.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = if sSelector s && pSelector p+                                       then map (Triple s p) (filter oSelector oList) ++ ts+                                       else ts++query' :: HashMapSP -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples+query' gr Nothing  Nothing  Nothing  =+    triplesOf' gr++query' (HashMapSP (tsMap,_,_))    Nothing  (Just p) Nothing  =+    HashMap.foldrWithKey findTripleWithP [] tsMap+    where+      findTripleWithP (s,p') oList ts = if p == p'+                                        then map (Triple s p) oList ++ ts+                                        else ts++query' (HashMapSP (tsMap,_,_))    Nothing  Nothing  (Just o) =+    HashMap.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = map (Triple s p) (filter (== o) oList) ++ ts++query' (HashMapSP (tsMap,_,_))    Nothing  (Just p) (Just o) =+    HashMap.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p') oList ts = if p == p'+                                        then map (Triple s p) (filter (== o) oList) ++ ts+                                        else ts++query' (HashMapSP (tsMap,_,_))    (Just s) Nothing  Nothing  =+    HashMap.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s',p) oList ts = if s == s'+                                        then map (Triple s p) oList ++ ts+                                        else ts++-- optimal pattern for this HashMapSP instance+query' (HashMapSP (tsMap,_,_))    (Just s) (Just p) Nothing =+    (map (Triple s p) . HashMap.lookupDefault [] (s,p)) tsMap++query' (HashMapSP (tsMap,_,_))    (Just s) Nothing  (Just o) =+    HashMap.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s',p) oList ts = if s == s'+                                        then map (Triple s p) (filter (== o) oList) ++ ts+                                        else ts++query' (HashMapSP (tsMap,_,_))    (Just s) (Just p) (Just o) =+    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

@@ -0,0 +1,185 @@+{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-}+-- |A graph implementation mapping (S,P) pairs to O, backed by 'Data.Map'.++module Data.RDF.Graph.MapSP (MapSP) 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++-- |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];+-- @++newtype MapSP = MapSP (SPMap, Maybe BaseUrl, PrefixMappings)+                 deriving (NFData)++instance RDF MapSP where+  baseUrl           = baseUrl'+  prefixMappings    = prefixMappings'+  addPrefixMappings = addPrefixMappings'+  empty             = empty'+  mkRdf             = mkRdf'+  triplesOf         = triplesOf'+  uniqTriplesOf     = uniqTriplesOf'+  select            = select'+  query             = query'++instance Show MapSP where+  show gr = concatMap (\t -> show t ++ "\n")  (triplesOf gr)++type SPMap = Map (Subject,Predicate) [Object]++baseUrl' :: MapSP -> Maybe BaseUrl+baseUrl' (MapSP (_, baseURL, _)) = baseURL++prefixMappings' :: MapSP -> PrefixMappings+prefixMappings' (MapSP (_, _, pms)) = pms++addPrefixMappings' :: MapSP -> PrefixMappings -> Bool -> MapSP+addPrefixMappings' (MapSP (tsMap, baseURL, pms)) pms' replace =+  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings+  in  MapSP (tsMap, baseURL, merge pms pms')++empty' :: MapSP+empty' = MapSP (Map.empty, Nothing, PrefixMappings Map.empty)++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> MapSP+mkRdf' triples baseURL pms = MapSP (tsMap, baseURL, pms)+    where+      tsMap = sortAndGroup triples+      sortAndGroup xs = Map.fromListWith (++) [((s,p), [o]) | Triple s p o <- xs]++triplesOf' :: MapSP -> Triples+triplesOf' (MapSP (tsMap,_,_)) = (concatMap (\((s,p),oList) -> map (Triple s p) oList) . Map.toList) tsMap++uniqTriplesOf' :: MapSP -> Triples+uniqTriplesOf' = nub . expandTriples++select' :: MapSP -> NodeSelector -> NodeSelector -> NodeSelector -> Triples+select' gr Nothing Nothing Nothing =+    triplesOf' gr++select' (MapSP (tsMap,_,_))    Nothing  (Just pSelector) Nothing  =+    Map.foldrWithKey findTripleWithP [] tsMap+    where+      findTripleWithP (s,p) oList ts = if pSelector p+                                       then map (Triple s p) oList ++ ts+                                       else ts++select' (MapSP (tsMap,_,_))    Nothing  Nothing  (Just oSelector) =+    Map.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = map (Triple s p) (filter oSelector oList) ++ ts++select' (MapSP (tsMap,_,_))    Nothing  (Just pSelector) (Just oSelector) =+    Map.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = if pSelector p+                                       then map (Triple s p) (filter oSelector oList) ++ ts+                                       else ts++select' (MapSP (tsMap,_,_))    (Just sSelector) Nothing  Nothing  =+    Map.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = if sSelector s+                                       then map (Triple s p) oList ++ ts+                                       else ts++select' (MapSP (tsMap,_,_))    (Just sSelector) (Just pSelector) Nothing =+    Map.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = if sSelector s && pSelector p+                                       then map (Triple s p) oList ++ ts+                                       else ts++select' (MapSP (tsMap,_,_))    (Just sSelector) Nothing  (Just oSelector) =+    Map.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = if sSelector s+                                        then map (Triple s p) (filter oSelector oList) ++ ts+                                        else ts++select' (MapSP (tsMap,_,_))    (Just sSelector) (Just pSelector) (Just oSelector) =+    Map.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = if sSelector s && pSelector p+                                       then map (Triple s p) (filter oSelector oList) ++ ts+                                       else ts++query' :: MapSP -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples+query' gr Nothing  Nothing  Nothing  =+    triplesOf' gr++query' (MapSP (tsMap,_,_))    Nothing  (Just p) Nothing  =+    Map.foldrWithKey findTripleWithP [] tsMap+    where+      findTripleWithP (s,p') oList ts = if p == p'+                                        then map (Triple s p) oList ++ ts+                                        else ts++query' (MapSP (tsMap,_,_))    Nothing  Nothing  (Just o) =+    Map.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p) oList ts = map (Triple s p) (filter (== o) oList) ++ ts++query' (MapSP (tsMap,_,_))    Nothing  (Just p) (Just o) =+    Map.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s,p') oList ts = if p == p'+                                        then map (Triple s p) (filter (== o) oList) ++ ts+                                        else ts++query' (MapSP (tsMap,_,_))    (Just s) Nothing  Nothing  =+    Map.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s',p) oList ts = if s == s'+                                        then map (Triple s p) oList ++ ts+                                        else ts++-- optimal pattern for this MapSP instance+query' (MapSP (tsMap,_,_))    (Just s) (Just p) Nothing =+    (map (Triple s p) . Map.findWithDefault [] (s,p)) tsMap++query' (MapSP (tsMap,_,_))    (Just s) Nothing  (Just o) =+    Map.foldrWithKey findTripleWithS [] tsMap+    where+      findTripleWithS (s',p) oList ts = if s == s'+                                        then map (Triple s p) (filter (== o) oList) ++ ts+                                        else ts++query' (MapSP (tsMap,_,_))    (Just s) (Just p) (Just o) =+    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

@@ -0,0 +1,112 @@+{-# LANGUAGE GeneralizedNewtypeDeriving , DeriveGeneric #-}++-- |"TriplesGraph" contains a list-backed graph implementation suitable+-- for smallish graphs or for temporary graphs that will not be queried.+-- It maintains the triples in the order that they are given in, and is+-- especially useful for holding N-Triples, where it is often desirable+-- to preserve the order of the triples when they were originally parsed.+-- Duplicate triples are not filtered. If you might have duplicate triples,+-- use @MGraph@ instead, which is also more efficient. However, the query+-- functions of this graph (select, query) remove duplicates from their+-- result triples (but triplesOf does not) since it is usually cheap+-- to do so.+module Data.RDF.Graph.TriplesList (TriplesList) where++import Prelude hiding (pred)+import Control.DeepSeq (NFData)+import Data.Binary+import qualified Data.Map as Map+import Data.RDF.Namespace+import Data.RDF.Query+import Data.RDF.Types+import Data.List (nub)+import GHC.Generics++-- |A simple implementation of the 'RDF' type class that represents+-- the graph internally as a list of triples.+--+-- Note that this type of RDF is fine for interactive+-- experimentation and querying of smallish (<10,000 triples) graphs,+-- but there are better options for larger graphs or graphs that you+-- will do many queries against (e.g., @MGraph@ is faster for queries).+--+-- The time complexity of the functions (where n == num_triples) are:+--+--  * 'empty'    : O(1)+--+--  * 'mkRdf'  : O(n)+--+--  * 'triplesOf': O(1)+--+--  * 'select'   : O(n)+--+--  * 'query'    : O(n)+newtype TriplesList = TriplesList (Triples, Maybe BaseUrl, PrefixMappings)+                       deriving (Generic,NFData)++instance Binary TriplesList++instance RDF TriplesList where+  baseUrl           = baseUrl'+  prefixMappings    = prefixMappings'+  addPrefixMappings = addPrefixMappings'+  empty             = empty'+  mkRdf             = mkRdf'+  triplesOf         = triplesOf'+  uniqTriplesOf     = uniqTriplesOf'+  select            = select'+  query             = query'++instance Show TriplesList where+  show gr = concatMap (\t -> show t ++ "\n")  (triplesOf gr)++prefixMappings' :: TriplesList -> PrefixMappings+prefixMappings' (TriplesList (_, _, pms)) = pms++addPrefixMappings' :: TriplesList -> PrefixMappings -> Bool -> TriplesList+addPrefixMappings' (TriplesList (ts, baseURL, pms)) pms' replace =+  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings+  in  TriplesList (ts, baseURL, merge pms pms')+  +baseUrl' :: TriplesList -> Maybe BaseUrl+baseUrl' (TriplesList (_, baseURL, _)) = baseURL++empty' :: TriplesList+empty' = TriplesList ([], Nothing, PrefixMappings Map.empty)++-- We no longer remove duplicates here, as it is very time consuming and is often not+-- necessary (raptor does not seem to remove dupes either). Instead, we remove dupes+-- from the results of the select' and query' functions, since it is cheap to do+-- there in most cases, but not when triplesOf' is called.+mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesList+mkRdf' ts baseURL pms = TriplesList (ts, baseURL, pms)++triplesOf' :: TriplesList -> Triples+triplesOf' (TriplesList (ts, _, _)) = ts++uniqTriplesOf' :: TriplesList -> Triples+uniqTriplesOf' = nub . expandTriples++select' :: TriplesList -> NodeSelector -> NodeSelector -> NodeSelector -> Triples+select' g s p o = filter (matchSelect s p o) $ triplesOf g++query' :: TriplesList -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples+query' g s p o = filter (matchPattern s p o) $ triplesOf g++matchSelect :: NodeSelector -> NodeSelector -> NodeSelector -> Triple -> Bool+matchSelect s p o t =+  match s (subjectOf t) && match p (predicateOf t) && match o (objectOf t)+  where+    match Nothing   _ = True+    match (Just fn) n = fn n++matchPattern :: Maybe Subject -> Maybe Predicate -> Maybe Object -> Triple -> Bool+matchPattern subj pred obj t = smatch t && pmatch t && omatch t+  where+    smatch trp = matchNode subj (subjectOf trp)+    pmatch trp = matchNode pred (predicateOf trp)+    omatch trp = matchNode obj (objectOf trp)++matchNode :: Maybe Node -> Node -> Bool+matchNode Nothing   _  = True+matchNode (Just n1) n2 = n1 == n2

@@ -0,0 +1,276 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, BangPatterns #-}++module Data.RDF.Graph.TriplesPatriciaTree (TriplesPatriciaTree) where++import Data.RDF.Namespace+import Data.RDF.Query+import Data.RDF.Types++import Control.DeepSeq (NFData)+import qualified Data.Graph.Inductive.Graph as G+import qualified Data.Graph.Inductive.PatriciaTree as PT+import qualified Data.Graph.Inductive.Query.DFS as DFS+import qualified Data.IntMap as IntMap+import Data.List+import qualified Data.Map as Map+import Data.Maybe++newtype TriplesPatriciaTree = TriplesPatriciaTree (PT.Gr Node Node,IntMap.IntMap Node, Maybe BaseUrl, PrefixMappings)+                            deriving (Show,NFData)++instance RDF TriplesPatriciaTree where+  baseUrl           = baseUrl'+  prefixMappings    = prefixMappings'+  addPrefixMappings = addPrefixMappings'+  empty             = empty'+  mkRdf             = mkRdf'+  triplesOf         = triplesOf'+  uniqTriplesOf     = uniqTriplesOf'+  select            = select'+  query             = query'++empty' :: TriplesPatriciaTree+empty' = TriplesPatriciaTree (G.empty,IntMap.empty, Nothing, PrefixMappings Map.empty)++prefixMappings' :: TriplesPatriciaTree -> PrefixMappings+prefixMappings' (TriplesPatriciaTree (_,_,_,pms')) = pms'++addPrefixMappings' :: TriplesPatriciaTree -> PrefixMappings -> Bool -> TriplesPatriciaTree+addPrefixMappings' (TriplesPatriciaTree (g, idxLookup, baseURL, pms)) pms' replace =+  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings+  in  TriplesPatriciaTree (g, idxLookup, baseURL, merge pms pms')++baseUrl' :: TriplesPatriciaTree -> Maybe BaseUrl+baseUrl' (TriplesPatriciaTree _) = Nothing++data AutoIncrMap = AutoIncrMap+    { theMap :: Map.Map Node (Int,Node)+    , idxPtr :: !Int }++{-+init       -> []+insert www -> [0,www]+insert ttt -> [1,ttt]+insert ttt -> [1,ttt]+-}+insertIncr :: Node -> AutoIncrMap -> (Int,AutoIncrMap)+insertIncr !node mp =+    let x = Map.lookup node (theMap mp)+    in if isJust x+       then+           let (i,_) = fromJust x+           in (i,mp)+       else+           let curIdx = idxPtr mp+               mp' = mp { idxPtr = curIdx + 1+                        , theMap = Map.insert node (idxPtr mp, node) (theMap mp) }+           in (curIdx, mp')++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesPatriciaTree+mkRdf' ts base' pms' =+    -- step 1: subjects and objects assigned node ID (an Int)+    let (mp,ledges) = foldl' f ((AutoIncrMap Map.empty 0),[]) ts++        -- step 2: for all triples, create arc with+        --         - predicate node the arc label+        --         - subject the source node ID+        --         - object the target node ID+        f (mp',edges) (Triple s p o) =+            let (sIdx,mp'')  = insertIncr s mp'+                (oIdx,mp''') = insertIncr o mp''+                edge = (sIdx,oIdx,p)+            in (mp''',edge : edges)++        lnodes = Map.elems (theMap mp)+        intIdx = IntMap.fromList lnodes+        ptGraph = G.mkGraph lnodes ledges++    in TriplesPatriciaTree (ptGraph ,intIdx, base', pms')++triplesOf' :: TriplesPatriciaTree -> Triples+triplesOf' (TriplesPatriciaTree (g,idxLookup,_,_)) =+    map (\(sIdx,oIdx,p) ->+             let [s,o] = map (\idx -> fromJust $ IntMap.lookup idx idxLookup) [sIdx,oIdx]+             in Triple s p o) (G.labEdges g)++uniqTriplesOf' :: TriplesPatriciaTree -> Triples+uniqTriplesOf' ptG@(TriplesPatriciaTree (g,idxLookup,_,_)) =+    nub $ map (\(sIdx,oIdx,p) ->+             let [s,o] = map (\idx -> fromJust $ IntMap.lookup idx idxLookup) [sIdx,oIdx]+             in expandTriple (prefixMappings ptG) (Triple s p o)) (G.labEdges g)++mkTriples :: IntMap.IntMap Node -> Node -> [(Node, IntMap.Key)] -> [(Node, IntMap.Key)] ->  [Triple]+mkTriples idxLookup thisNode adjsIn adjsOut =+    let ts1 = map (\(predNode,subjIdx) ->+                   let s = fromJust (IntMap.lookup subjIdx idxLookup)+                   in Triple s predNode thisNode+                  )  adjsIn++        ts2 = map (\(predNode,objIdx) ->+                       let o = fromJust (IntMap.lookup objIdx idxLookup)+                       in Triple thisNode predNode o+                  ) adjsOut+    in ts1 ++ ts2++select' :: TriplesPatriciaTree -> NodeSelector -> NodeSelector -> NodeSelector -> Triples+select' (TriplesPatriciaTree (g,idxLookup,_,_)) maybeSubjSel maybePredSel maybeObjSel =++    let cfun ( adjsIn , _nodeIdx , thisNode , adjsOut )+            | isNothing  maybeSubjSel && isNothing maybePredSel && isNothing maybeObjSel =+                         mkTriples idxLookup thisNode adjsIn adjsOut++            | isJust maybeSubjSel && isNothing maybePredSel && isNothing maybeObjSel =+                       let adjsIn' = filter (\(_p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup))) adjsIn+                           ts1 = mkTriples idxLookup thisNode adjsIn' []+                           ts2 = if fromJust maybeSubjSel thisNode+                                 then mkTriples idxLookup thisNode [] adjsOut+                                 else []+                       in ts1 ++ ts2+            | isNothing maybeSubjSel && isJust maybePredSel && isNothing maybeObjSel =+                       let adjsIn'  = filter (\(p,_idxSubj) -> fromJust maybePredSel p ) adjsIn+                           adjsOut' = filter (\(p,_idxObj) -> fromJust maybePredSel p ) adjsOut+                           ts1 = if not (null adjsIn')+                                 then mkTriples idxLookup thisNode adjsIn' []+                                 else []+                           ts2 = if not (null adjsOut')+                                 then mkTriples idxLookup thisNode [] adjsOut'+                                 else []+                       in ts1 ++ ts2++            | isNothing maybeSubjSel && isNothing maybePredSel && isJust maybeObjSel =+                       let adjsOut' = filter (\(_p,idxObj) -> fromJust maybeObjSel (fromJust (IntMap.lookup idxObj idxLookup)) ) adjsOut+                           ts1 = mkTriples idxLookup thisNode [] adjsOut'+                           ts2 = if fromJust maybeObjSel thisNode+                                 then mkTriples idxLookup thisNode adjsIn []+                                 else []+                       in ts1 ++ ts2++            | isJust maybeSubjSel && isJust maybePredSel && isNothing maybeObjSel =+                       let adjsIn' = filter (\(p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup))+                                                            && fromJust maybePredSel p ) adjsIn+                           adjsOut' = filter (\(p,_idxObj) -> fromJust maybePredSel p ) adjsOut+                           ts1 = mkTriples idxLookup thisNode adjsIn' []+                           ts2 = if fromJust maybeSubjSel thisNode+                                 then mkTriples idxLookup thisNode [] adjsOut'+                                 else []+                       in ts1 ++ ts2++            | isJust maybeSubjSel && isNothing maybePredSel && isJust maybeObjSel =+                       let adjsIn' = filter (\(_p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup)) ) adjsIn+                           adjsOut' = filter (\(_p,idxObj) -> fromJust maybeObjSel  (fromJust (IntMap.lookup idxObj idxLookup))  ) adjsOut+                           ts1 = if fromJust maybeObjSel thisNode+                                 then mkTriples idxLookup thisNode adjsIn' []+                                 else []+                           ts2 = if fromJust maybeSubjSel thisNode+                                 then mkTriples idxLookup thisNode [] adjsOut'+                                 else []+                       in ts1 ++ ts2++            | isNothing maybeSubjSel && isJust maybePredSel && isJust maybeObjSel =+                       let adjsIn' = filter (\(p,_idxSubj) -> fromJust maybePredSel p ) adjsIn+                           adjsOut' = filter (\(p,idxObj) -> fromJust maybeObjSel (fromJust (IntMap.lookup idxObj idxLookup))+                                                            && fromJust maybePredSel p ) adjsOut+                           ts1 = if fromJust maybeObjSel thisNode+                                 then mkTriples idxLookup thisNode adjsIn' []+                                 else []+                           ts2 = mkTriples idxLookup thisNode [] adjsOut'+                       in ts1 ++ ts2++            | isJust maybeSubjSel && isJust maybePredSel && isJust maybeObjSel =+                       let adjsIn' = filter (\(p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup))+                                                            && fromJust maybePredSel p ) adjsIn+                           adjsOut' = filter (\(p,idxObj) -> fromJust maybeObjSel (fromJust (IntMap.lookup idxObj idxLookup))+                                                            && fromJust maybePredSel p ) adjsOut+                           ts1 = if fromJust maybeObjSel thisNode+                                 then mkTriples idxLookup thisNode adjsIn' []+                                 else []+                           ts2 = if fromJust maybeSubjSel thisNode+                                 then mkTriples idxLookup thisNode [] adjsOut'+                                 else []+                       in ts1 ++ ts2++        cfun ( _ , _ , _ , _) = undefined -- not sure why this pattern is needed to exhaust cfun arg patterns++    in concat $ DFS.dfsWith' cfun g++query' :: TriplesPatriciaTree -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples+query' (TriplesPatriciaTree (g,idxLookup,_,_)) maybeSubj maybePred maybeObj =++    let cfun ( adjsIn , _nodeIdx , thisNode , adjsOut )+            | isNothing  maybeSubj && isNothing maybePred && isNothing maybeObj =+                       mkTriples idxLookup thisNode adjsIn adjsOut++            | isJust maybeSubj && isNothing maybePred && isNothing maybeObj =+                       let adjsIn' = filter (\(_p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj ) adjsIn+                           ts1 = mkTriples idxLookup thisNode adjsIn' []+                           ts2 = if thisNode == fromJust maybeSubj+                                 then mkTriples idxLookup thisNode [] adjsOut+                                 else []+                       in ts1 ++ ts2++            | isNothing maybeSubj && isJust maybePred && isNothing maybeObj =+                       let adjsIn'  = filter (\(p,_idxSubj) -> p == fromJust maybePred ) adjsIn+                           adjsOut' = filter (\(p,_idxObj) -> p  == fromJust maybePred ) adjsOut+                           ts1 = if not (null adjsIn')+                                 then mkTriples idxLookup thisNode adjsIn' []+                                 else []+                           ts2 = if not (null adjsOut')+                                 then mkTriples idxLookup thisNode [] adjsOut'+                                 else []+                       in ts1 ++ ts2++            | isNothing maybeSubj && isNothing maybePred && isJust maybeObj =+                       let adjsOut' = filter (\(_p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj ) adjsOut+                           ts1 = mkTriples idxLookup thisNode [] adjsOut'+                           ts2 = if thisNode == fromJust maybeObj+                                 then mkTriples idxLookup thisNode adjsIn []+                                 else []+                       in ts1 ++ ts2++            | isJust maybeSubj && isJust maybePred && isNothing maybeObj =+                       let adjsIn' = filter (\(p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj+                                                            && p  == fromJust maybePred ) adjsIn+                           adjsOut' = filter (\(p,_idxObj) -> p  == fromJust maybePred ) adjsOut+                           ts1 = mkTriples idxLookup thisNode adjsIn' []+                           ts2 = if thisNode == fromJust maybeSubj+                                 then mkTriples idxLookup thisNode [] adjsOut'+                                 else []+                       in ts1 ++ ts2++            | isJust maybeSubj && isNothing maybePred && isJust maybeObj =+                       let adjsIn' = filter (\(_p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj ) adjsIn+                           adjsOut' = filter (\(_p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj ) adjsOut+                           ts1 = if thisNode == fromJust maybeObj+                                 then mkTriples idxLookup thisNode adjsIn' []+                                 else []+                           ts2 = if thisNode == fromJust maybeSubj+                                 then mkTriples idxLookup thisNode [] adjsOut'+                                 else []+                       in ts1 ++ ts2++            | isNothing maybeSubj && isJust maybePred && isJust maybeObj =+                       let adjsIn' = filter (\(p,_idxSubj) -> p  == fromJust maybePred ) adjsIn+                           adjsOut' = filter (\(p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj+                                                            && p  == fromJust maybePred ) adjsOut+                           ts1 = if thisNode == fromJust maybeObj+                                 then mkTriples idxLookup thisNode adjsIn' []+                                 else []+                           ts2 = mkTriples idxLookup thisNode [] adjsOut'+                       in ts1 ++ ts2++            | isJust maybeSubj && isJust maybePred && isJust maybeObj =+                       let adjsIn' = filter (\(p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj+                                                            && p  == fromJust maybePred ) adjsIn+                           adjsOut' = filter (\(p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj+                                                            && p  == fromJust maybePred ) adjsOut+                           ts1 = if thisNode == fromJust maybeObj+                                 then mkTriples idxLookup thisNode adjsIn' []+                                 else []+                           ts2 = if thisNode == fromJust maybeSubj+                                 then mkTriples idxLookup thisNode [] adjsOut'+                                 else []+                       in ts1 ++ ts2++        cfun ( _ , _ , _ , _ ) = undefined  -- not sure why this pattern is needed to exhaust cfun arg patterns++    in concat $ DFS.dfsWith' cfun g

@@ -1,204 +0,0 @@-{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-}--- |A simple graph implementation backed by 'Data.HashMap'.--module Data.RDF.MGraph(MGraph, empty, mkRdf, triplesOf, uniqTriplesOf, select, query)--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---- |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 MGraph = MGraph (TMaps, Maybe BaseUrl, PrefixMappings)-                 deriving (NFData)--instance RDF MGraph where-  baseUrl           = baseUrl'-  prefixMappings    = prefixMappings'-  addPrefixMappings = addPrefixMappings'-  empty             = empty'-  mkRdf             = mkRdf'-  triplesOf         = triplesOf'-  uniqTriplesOf     = uniqTriplesOf'-  select            = select'-  query             = query'--instance Show MGraph 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' :: MGraph -> Maybe BaseUrl-baseUrl' (MGraph (_, baseURL, _)) = baseURL--prefixMappings' :: MGraph -> PrefixMappings-prefixMappings' (MGraph (_, _, pms)) = pms--addPrefixMappings' :: MGraph -> PrefixMappings -> Bool -> MGraph-addPrefixMappings' (MGraph (ts, baseURL, pms)) pms' replace = -  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings-  in  MGraph (ts, baseURL, merge pms pms')--empty' :: MGraph-empty' = MGraph ((HashMap.empty, HashMap.empty), Nothing, PrefixMappings Map.empty)--mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> MGraph-mkRdf' ts baseURL pms = MGraph (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' :: MGraph -> Triples-triplesOf' (MGraph ((spoMap, _), _, _)) = concatMap (uncurry tripsSubj) subjPredMaps-  where subjPredMaps = HashMap.toList spoMap---- naive implementation for now-uniqTriplesOf' :: MGraph -> 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' :: MGraph -> NodeSelector -> NodeSelector -> NodeSelector -> Triples-select' (MGraph ((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' :: MGraph -> Maybe Node -> Maybe Predicate -> Maybe Node -> Triples-query' (MGraph (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,275 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, BangPatterns #-}--module Data.RDF.PatriciaTreeGraph where--import Data.RDF.Namespace-import Data.RDF.Query-import Data.RDF.Types--import qualified Data.Graph.Inductive.Graph as G-import qualified Data.Graph.Inductive.PatriciaTree as PT-import qualified Data.Graph.Inductive.Query.DFS as DFS-import qualified Data.IntMap as IntMap-import Data.List-import qualified Data.Map as Map-import Data.Maybe--newtype PatriciaTreeGraph = PatriciaTreeGraph (PT.Gr Node Node,IntMap.IntMap Node, Maybe BaseUrl, PrefixMappings)-                            deriving (Show)--instance RDF PatriciaTreeGraph where-  baseUrl           = baseUrl'-  prefixMappings    = prefixMappings'-  addPrefixMappings = addPrefixMappings'-  empty             = empty'-  mkRdf             = mkRdf'-  triplesOf         = triplesOf'-  uniqTriplesOf     = uniqTriplesOf'-  select            = select'-  query             = query'--empty' :: PatriciaTreeGraph-empty' = PatriciaTreeGraph (G.empty,IntMap.empty, Nothing, PrefixMappings Map.empty)--prefixMappings' :: PatriciaTreeGraph -> PrefixMappings-prefixMappings' (PatriciaTreeGraph (_,_,_,pms')) = pms'--addPrefixMappings' :: PatriciaTreeGraph -> PrefixMappings -> Bool -> PatriciaTreeGraph-addPrefixMappings' (PatriciaTreeGraph (g, idxLookup, baseURL, pms)) pms' replace =-  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings-  in  PatriciaTreeGraph (g, idxLookup, baseURL, merge pms pms')--baseUrl' :: PatriciaTreeGraph -> Maybe BaseUrl-baseUrl' (PatriciaTreeGraph _) = Nothing--data AutoIncrMap = AutoIncrMap-    { theMap :: Map.Map Node (Int,Node)-    , idxPtr :: !Int }--{--init       -> []-insert www -> [0,www]-insert ttt -> [1,ttt]-insert ttt -> [1,ttt]--}-insertIncr :: Node -> AutoIncrMap -> (Int,AutoIncrMap)-insertIncr !node mp =-    let x = Map.lookup node (theMap mp)-    in if isJust x-       then-           let (i,_) = fromJust x-           in (i,mp)-       else-           let curIdx = idxPtr mp-               mp' = mp { idxPtr = curIdx + 1-                        , theMap = Map.insert node (idxPtr mp, node) (theMap mp) }-           in (curIdx, mp')--mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> PatriciaTreeGraph-mkRdf' ts base' pms' =-    -- step 1: subjects and objects assigned node ID (an Int)-    let (mp,ledges) = foldl' f ((AutoIncrMap Map.empty 0),[]) ts--        -- step 2: for all triples, create arc with-        --         - predicate node the arc label-        --         - subject the source node ID-        --         - object the target node ID-        f (mp',edges) (Triple s p o) =-            let (sIdx,mp'')  = insertIncr s mp'-                (oIdx,mp''') = insertIncr o mp''-                edge = (sIdx,oIdx,p)-            in (mp''',edge : edges)--        lnodes = Map.elems (theMap mp)-        intIdx = IntMap.fromList lnodes-        ptGraph = G.mkGraph lnodes ledges--    in PatriciaTreeGraph (ptGraph ,intIdx, base', pms')--triplesOf' :: PatriciaTreeGraph -> Triples-triplesOf' (PatriciaTreeGraph (g,idxLookup,_,_)) =-    map (\(sIdx,oIdx,p) ->-             let [s,o] = map (\idx -> fromJust $ IntMap.lookup idx idxLookup) [sIdx,oIdx]-             in Triple s p o) (G.labEdges g)--uniqTriplesOf' :: PatriciaTreeGraph -> Triples-uniqTriplesOf' ptG@(PatriciaTreeGraph (g,idxLookup,_,_)) =-    nub $ map (\(sIdx,oIdx,p) ->-             let [s,o] = map (\idx -> fromJust $ IntMap.lookup idx idxLookup) [sIdx,oIdx]-             in expandTriple (prefixMappings ptG) (Triple s p o)) (G.labEdges g)--mkTriples :: IntMap.IntMap Node -> Node -> [(Node, IntMap.Key)] -> [(Node, IntMap.Key)] ->  [Triple]-mkTriples idxLookup thisNode adjsIn adjsOut =-    let ts1 = map (\(predNode,subjIdx) ->-                   let s = fromJust (IntMap.lookup subjIdx idxLookup)-                   in Triple s predNode thisNode-                  )  adjsIn--        ts2 = map (\(predNode,objIdx) ->-                       let o = fromJust (IntMap.lookup objIdx idxLookup)-                       in Triple thisNode predNode o-                  ) adjsOut-    in ts1 ++ ts2--select' :: PatriciaTreeGraph -> NodeSelector -> NodeSelector -> NodeSelector -> Triples-select' (PatriciaTreeGraph (g,idxLookup,_,_)) maybeSubjSel maybePredSel maybeObjSel =--    let cfun ( adjsIn , _nodeIdx , thisNode , adjsOut )-            | isNothing  maybeSubjSel && isNothing maybePredSel && isNothing maybeObjSel =-                         mkTriples idxLookup thisNode adjsIn adjsOut--            | isJust maybeSubjSel && isNothing maybePredSel && isNothing maybeObjSel =-                       let adjsIn' = filter (\(_p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup))) adjsIn-                           ts1 = mkTriples idxLookup thisNode adjsIn' []-                           ts2 = if fromJust maybeSubjSel thisNode-                                 then mkTriples idxLookup thisNode [] adjsOut-                                 else []-                       in ts1 ++ ts2-            | isNothing maybeSubjSel && isJust maybePredSel && isNothing maybeObjSel =-                       let adjsIn'  = filter (\(p,_idxSubj) -> fromJust maybePredSel p ) adjsIn-                           adjsOut' = filter (\(p,_idxObj) -> fromJust maybePredSel p ) adjsOut-                           ts1 = if not (null adjsIn')-                                 then mkTriples idxLookup thisNode adjsIn' []-                                 else []-                           ts2 = if not (null adjsOut')-                                 then mkTriples idxLookup thisNode [] adjsOut'-                                 else []-                       in ts1 ++ ts2--            | isNothing maybeSubjSel && isNothing maybePredSel && isJust maybeObjSel =-                       let adjsOut' = filter (\(_p,idxObj) -> fromJust maybeObjSel (fromJust (IntMap.lookup idxObj idxLookup)) ) adjsOut-                           ts1 = mkTriples idxLookup thisNode [] adjsOut'-                           ts2 = if fromJust maybeObjSel thisNode-                                 then mkTriples idxLookup thisNode adjsIn []-                                 else []-                       in ts1 ++ ts2--            | isJust maybeSubjSel && isJust maybePredSel && isNothing maybeObjSel =-                       let adjsIn' = filter (\(p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup))-                                                            && fromJust maybePredSel p ) adjsIn-                           adjsOut' = filter (\(p,_idxObj) -> fromJust maybePredSel p ) adjsOut-                           ts1 = mkTriples idxLookup thisNode adjsIn' []-                           ts2 = if fromJust maybeSubjSel thisNode-                                 then mkTriples idxLookup thisNode [] adjsOut'-                                 else []-                       in ts1 ++ ts2--            | isJust maybeSubjSel && isNothing maybePredSel && isJust maybeObjSel =-                       let adjsIn' = filter (\(_p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup)) ) adjsIn-                           adjsOut' = filter (\(_p,idxObj) -> fromJust maybeObjSel  (fromJust (IntMap.lookup idxObj idxLookup))  ) adjsOut-                           ts1 = if fromJust maybeObjSel thisNode-                                 then mkTriples idxLookup thisNode adjsIn' []-                                 else []-                           ts2 = if fromJust maybeSubjSel thisNode-                                 then mkTriples idxLookup thisNode [] adjsOut'-                                 else []-                       in ts1 ++ ts2--            | isNothing maybeSubjSel && isJust maybePredSel && isJust maybeObjSel =-                       let adjsIn' = filter (\(p,_idxSubj) -> fromJust maybePredSel p ) adjsIn-                           adjsOut' = filter (\(p,idxObj) -> fromJust maybeObjSel (fromJust (IntMap.lookup idxObj idxLookup))-                                                            && fromJust maybePredSel p ) adjsOut-                           ts1 = if fromJust maybeObjSel thisNode-                                 then mkTriples idxLookup thisNode adjsIn' []-                                 else []-                           ts2 = mkTriples idxLookup thisNode [] adjsOut'-                       in ts1 ++ ts2--            | isJust maybeSubjSel && isJust maybePredSel && isJust maybeObjSel =-                       let adjsIn' = filter (\(p,idxSubj) -> fromJust maybeSubjSel (fromJust (IntMap.lookup idxSubj idxLookup))-                                                            && fromJust maybePredSel p ) adjsIn-                           adjsOut' = filter (\(p,idxObj) -> fromJust maybeObjSel (fromJust (IntMap.lookup idxObj idxLookup))-                                                            && fromJust maybePredSel p ) adjsOut-                           ts1 = if fromJust maybeObjSel thisNode-                                 then mkTriples idxLookup thisNode adjsIn' []-                                 else []-                           ts2 = if fromJust maybeSubjSel thisNode-                                 then mkTriples idxLookup thisNode [] adjsOut'-                                 else []-                       in ts1 ++ ts2--        cfun ( _ , _ , _ , _) = undefined -- not sure why this pattern is needed to exhaust cfun arg patterns--    in concat $ DFS.dfsWith' cfun g--query' :: PatriciaTreeGraph -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples-query' (PatriciaTreeGraph (g,idxLookup,_,_)) maybeSubj maybePred maybeObj =--    let cfun ( adjsIn , _nodeIdx , thisNode , adjsOut )-            | isNothing  maybeSubj && isNothing maybePred && isNothing maybeObj =-                       mkTriples idxLookup thisNode adjsIn adjsOut--            | isJust maybeSubj && isNothing maybePred && isNothing maybeObj =-                       let adjsIn' = filter (\(_p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj ) adjsIn-                           ts1 = mkTriples idxLookup thisNode adjsIn' []-                           ts2 = if thisNode == fromJust maybeSubj-                                 then mkTriples idxLookup thisNode [] adjsOut-                                 else []-                       in ts1 ++ ts2--            | isNothing maybeSubj && isJust maybePred && isNothing maybeObj =-                       let adjsIn'  = filter (\(p,_idxSubj) -> p == fromJust maybePred ) adjsIn-                           adjsOut' = filter (\(p,_idxObj) -> p  == fromJust maybePred ) adjsOut-                           ts1 = if not (null adjsIn')-                                 then mkTriples idxLookup thisNode adjsIn' []-                                 else []-                           ts2 = if not (null adjsOut')-                                 then mkTriples idxLookup thisNode [] adjsOut'-                                 else []-                       in ts1 ++ ts2--            | isNothing maybeSubj && isNothing maybePred && isJust maybeObj =-                       let adjsOut' = filter (\(_p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj ) adjsOut-                           ts1 = mkTriples idxLookup thisNode [] adjsOut'-                           ts2 = if thisNode == fromJust maybeObj-                                 then mkTriples idxLookup thisNode adjsIn []-                                 else []-                       in ts1 ++ ts2--            | isJust maybeSubj && isJust maybePred && isNothing maybeObj =-                       let adjsIn' = filter (\(p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj-                                                            && p  == fromJust maybePred ) adjsIn-                           adjsOut' = filter (\(p,_idxObj) -> p  == fromJust maybePred ) adjsOut-                           ts1 = mkTriples idxLookup thisNode adjsIn' []-                           ts2 = if thisNode == fromJust maybeSubj-                                 then mkTriples idxLookup thisNode [] adjsOut'-                                 else []-                       in ts1 ++ ts2--            | isJust maybeSubj && isNothing maybePred && isJust maybeObj =-                       let adjsIn' = filter (\(_p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj ) adjsIn-                           adjsOut' = filter (\(_p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj ) adjsOut-                           ts1 = if thisNode == fromJust maybeObj-                                 then mkTriples idxLookup thisNode adjsIn' []-                                 else []-                           ts2 = if thisNode == fromJust maybeSubj-                                 then mkTriples idxLookup thisNode [] adjsOut'-                                 else []-                       in ts1 ++ ts2--            | isNothing maybeSubj && isJust maybePred && isJust maybeObj =-                       let adjsIn' = filter (\(p,_idxSubj) -> p  == fromJust maybePred ) adjsIn-                           adjsOut' = filter (\(p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj-                                                            && p  == fromJust maybePred ) adjsOut-                           ts1 = if thisNode == fromJust maybeObj-                                 then mkTriples idxLookup thisNode adjsIn' []-                                 else []-                           ts2 = mkTriples idxLookup thisNode [] adjsOut'-                       in ts1 ++ ts2--            | isJust maybeSubj && isJust maybePred && isJust maybeObj =-                       let adjsIn' = filter (\(p,idxSubj) -> fromJust (IntMap.lookup idxSubj idxLookup) == fromJust maybeSubj-                                                            && p  == fromJust maybePred ) adjsIn-                           adjsOut' = filter (\(p,idxObj) -> fromJust (IntMap.lookup idxObj idxLookup) == fromJust maybeObj-                                                            && p  == fromJust maybePred ) adjsOut-                           ts1 = if thisNode == fromJust maybeObj-                                 then mkTriples idxLookup thisNode adjsIn' []-                                 else []-                           ts2 = if thisNode == fromJust maybeSubj-                                 then mkTriples idxLookup thisNode [] adjsOut'-                                 else []-                       in ts1 ++ ts2--        cfun ( _ , _ , _ , _ ) = undefined  -- not sure why this pattern is needed to exhaust cfun arg patterns--    in concat $ DFS.dfsWith' cfun g

@@ -4,10 +4,10 @@   equalSubjects, equalPredicates, equalObjects,   subjectOf, predicateOf, objectOf, isEmpty,   rdfContainsNode, tripleContainsNode,-  listSubjectsWithPredicate, listObjectsOfPredicate,+  subjectsWithPredicate, objectsOfPredicate,    -- * RDF graph functions-  isIsomorphic, expandTriples, fromEither,+  isIsomorphic, isGraphIsomorphic, expandTriples, fromEither,    -- * expansion functions   expandTriple, expandNode, expandURI,@@ -22,7 +22,10 @@ import qualified Data.RDF.Namespace as NS (toPMList, uriOf, rdf) import qualified Data.Text as T import Data.Maybe (catMaybes)-+import Data.Graph (Graph,graphFromEdges)+import qualified Data.Graph.Automorphism as Automorphism+import qualified Data.HashMap.Strict as HashMap+import Data.HashMap.Strict (HashMap)  -- |Answer the subject node of the triple. {-# INLINE subjectOf #-}@@ -50,7 +53,7 @@ -- Note that it doesn't perform namespace expansion! tripleContainsNode :: Node -> Triple -> Bool {-# INLINE tripleContainsNode #-}-tripleContainsNode node t = +tripleContainsNode node t =  subjectOf t == node || predicateOf t == node || objectOf t == node  -- |Determine whether two triples have equal subjects.@@ -75,20 +78,12 @@   in null ts  -- |Lists of all subjects of triples with the given predicate.-listSubjectsWithPredicate :: RDF rdf => rdf -> Predicate -> [Subject]-listSubjectsWithPredicate rdf pred =-  listNodesWithPredicate rdf pred subjectOf+subjectsWithPredicate :: RDF rdf => rdf -> Predicate -> [Subject]+subjectsWithPredicate rdf pred = map subjectOf $ query rdf Nothing (Just pred) Nothing  -- |Lists of all objects of triples with the given predicate.-listObjectsOfPredicate :: RDF rdf => rdf -> Predicate -> [Object]-listObjectsOfPredicate rdf pred =-  listNodesWithPredicate rdf pred objectOf--listNodesWithPredicate :: RDF rdf => rdf -> Predicate -> (Triple -> Node) -> [Node]-listNodesWithPredicate rdf pred f =-  let ts = triplesOf rdf-      xs = filter (\t -> predicateOf t == pred) ts-  in map f xs+objectsOfPredicate :: RDF rdf => rdf -> Predicate -> [Object]+objectsOfPredicate rdf pred = map objectOf $ query rdf Nothing (Just pred) Nothing  -- |Convert a parse result into an RDF if it was successful -- and error and terminate if not.@@ -98,6 +93,8 @@     (Left err) -> error (show err)     (Right rdf) -> rdf +-- graphFromEdges :: Ord key => [(node, key, [key])] -> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex)+ -- |This determines if two RDF representations are equal regardless of blank -- node names, triple order and prefixes.  In math terms, this is the \simeq -- latex operator, or ~=@@ -121,6 +118,25 @@      normalize :: forall rdf. (RDF rdf) => rdf -> Triples     normalize = sort . nub . expandTriples++-- | Compares the structure of two graphs and returns 'True' if+--   their graph structures are identical. This does not consider the nature of+--   each node in the graph, i.e. the URI text of 'UNode' nodes, the generated+--   index of a blank node, or the values in literal nodes.+isGraphIsomorphic :: forall rdf1 rdf2. (RDF rdf1, RDF rdf2) => rdf1 -> rdf2 -> Bool+isGraphIsomorphic g1 g2 = Automorphism.isIsomorphic g1' g2'+    where+      g1' = rdfGraphToDataGraph g1+      g2' = rdfGraphToDataGraph g2+      rdfGraphToDataGraph :: RDF rdf3 => rdf3 -> Graph+      rdfGraphToDataGraph g = dataGraph+          where+            triples = expandTriples g+            triplesHashMap :: HashMap (Subject,Predicate) [Object]+            triplesHashMap = HashMap.fromListWith (++) [((s,p), [o]) | Triple s p o <- triples]+            triplesGrouped :: [((Subject,Predicate),[Object])]+            triplesGrouped = HashMap.toList triplesHashMap+            (dataGraph,_,_) = (graphFromEdges . map (\((s,p),os) -> (s,p,os))) triplesGrouped  -- |Expand the triples in a graph with the prefix map and base URL for that -- graph.

@@ -1,114 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving , DeriveGeneric #-}---- |"TriplesGraph" contains a list-backed graph implementation suitable--- for smallish graphs or for temporary graphs that will not be queried.--- It maintains the triples in the order that they are given in, and is--- especially useful for holding N-Triples, where it is often desirable--- to preserve the order of the triples when they were originally parsed.--- Duplicate triples are not filtered. If you might have duplicate triples,--- use @MGraph@ instead, which is also more efficient. However, the query--- functions of this graph (select, query) remove duplicates from their--- result triples (but triplesOf does not) since it is usually cheap--- to do so.-module Data.RDF.TriplesGraph(TriplesGraph, empty, mkRdf, triplesOf, uniqTriplesOf, select, query)--where--import Prelude hiding (pred)-import Control.DeepSeq (NFData)-import Data.Binary-import qualified Data.Map as Map-import Data.RDF.Namespace-import Data.RDF.Query-import Data.RDF.Types-import Data.List (nub)-import GHC.Generics---- |A simple implementation of the 'RDF' type class that represents--- the graph internally as a list of triples.------ Note that this type of RDF is fine for interactive--- experimentation and querying of smallish (<10,000 triples) graphs,--- but there are better options for larger graphs or graphs that you--- will do many queries against (e.g., @MGraph@ is faster for queries).------ The time complexity of the functions (where n == num_triples) are:------  * 'empty'    : O(1)------  * 'mkRdf'  : O(n)------  * 'triplesOf': O(1)------  * 'select'   : O(n)------  * 'query'    : O(n)-newtype TriplesGraph = TriplesGraph (Triples, Maybe BaseUrl, PrefixMappings)-                       deriving (Generic,NFData)--instance Binary TriplesGraph--instance RDF TriplesGraph where-  baseUrl           = baseUrl'-  prefixMappings    = prefixMappings'-  addPrefixMappings = addPrefixMappings'-  empty             = empty'-  mkRdf             = mkRdf'-  triplesOf         = triplesOf'-  uniqTriplesOf     = uniqTriplesOf'-  select            = select'-  query             = query'--instance Show TriplesGraph where-  show gr = concatMap (\t -> show t ++ "\n")  (triplesOf gr)--prefixMappings' :: TriplesGraph -> PrefixMappings-prefixMappings' (TriplesGraph (_, _, pms)) = pms--addPrefixMappings' :: TriplesGraph -> PrefixMappings -> Bool -> TriplesGraph-addPrefixMappings' (TriplesGraph (ts, baseURL, pms)) pms' replace =-  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings-  in  TriplesGraph (ts, baseURL, merge pms pms')-  -baseUrl' :: TriplesGraph -> Maybe BaseUrl-baseUrl' (TriplesGraph (_, baseURL, _)) = baseURL--empty' :: TriplesGraph-empty' = TriplesGraph ([], Nothing, PrefixMappings Map.empty)---- We no longer remove duplicates here, as it is very time consuming and is often not--- necessary (raptor does not seem to remove dupes either). Instead, we remove dupes--- from the results of the select' and query' functions, since it is cheap to do--- there in most cases, but not when triplesOf' is called.-mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesGraph-mkRdf' ts baseURL pms = TriplesGraph (ts, baseURL, pms)--triplesOf' :: TriplesGraph -> Triples-triplesOf' (TriplesGraph (ts, _, _)) = ts--uniqTriplesOf' :: TriplesGraph -> Triples-uniqTriplesOf' = nub . expandTriples--select' :: TriplesGraph -> NodeSelector -> NodeSelector -> NodeSelector -> Triples-select' g s p o = filter (matchSelect s p o) $ triplesOf g--query' :: TriplesGraph -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples-query' g s p o = filter (matchPattern s p o) $ triplesOf g--matchSelect :: NodeSelector -> NodeSelector -> NodeSelector -> Triple -> Bool-matchSelect s p o t =-  match s (subjectOf t) && match p (predicateOf t) && match o (objectOf t)-  where-    match Nothing   _ = True-    match (Just fn) n = fn n--matchPattern :: Maybe Subject -> Maybe Predicate -> Maybe Object -> Triple -> Bool-matchPattern subj pred obj t = smatch t && pmatch t && omatch t-  where-    smatch trp = matchNode subj (subjectOf trp)-    pmatch trp = matchNode pred (predicateOf trp)-    omatch trp = matchNode obj (objectOf trp)--matchNode :: Maybe Node -> Node -> Bool-matchNode Nothing   _  = True-matchNode (Just n1) n2 = n1 == n2

@@ -9,7 +9,7 @@    -- * Constructor functions   plainL,plainLL,typedL,-  unode,bnode,lnode,triple,unodeValidate,+  unode,bnode,lnode,triple,unodeValidate,uriValidate,uriValidateString,    -- * Node query function   isUNode,isLNode,isBNode,@@ -40,14 +40,19 @@ import System.IO import Text.Printf import Data.Binary+import Control.Monad (guard) import Data.Map(Map)+import Data.Maybe (fromJust) import GHC.Generics (Generic) import Data.Hashable(Hashable) import qualified Data.List as List import qualified Data.Map as Map-import qualified Network.URI as Network (isURI,uriPath,parseURI)+import qualified Network.URI as Network (uriPath,parseURI) import Control.DeepSeq (NFData,rnf) import Text.Parsec+import Text.Parsec.Text+import Network.URI+import Codec.Binary.UTF8.String  ------------------- -- LValue and constructor functions@@ -67,7 +72,7 @@   -- |A typed literal value consisting of the literal value and   -- the URI of the datatype of the value, respectively.   | TypedL !T.Text  !T.Text-    deriving Generic+    deriving (Generic,Show)  instance Binary LValue @@ -118,7 +123,7 @@   -- <http://www.w3.org/TR/rdf-concepts/#section-Graph-Literal> for more   -- information.   | LNode !LValue-    deriving Generic+    deriving (Generic,Show)  instance Binary Node @@ -156,12 +161,54 @@ --  2. checks validity of this unescaped URI using 'isURI' from 'Network.URI' --  3. if the unescaped URI is valid then 'Node' constructed with 'UNode' unodeValidate :: T.Text -> Maybe Node-unodeValidate t = if Network.isURI (T.unpack uri)-                  then Just (UNode uri)-                  else Nothing-    where-      uri = escapeRDFSyntax t+unodeValidate t = case isRdfURI t of+                    Left _err -> Nothing+                    Right uri -> Just (UNode uri) +isRdfURI :: T.Text -> Either ParseError T.Text+isRdfURI t = parse (isRdfURIParser  <* eof) ("Invalid URI: " ++ T.unpack t) t++-- [18]	IRIREF from Turtle spec+isRdfURIParser :: GenParser () T.Text+isRdfURIParser = T.concat <$> many (T.singleton <$> noneOf (['\x00'..'\x20'] ++ [' ','<','>','"','{','}','|','^','`','\\']) <|> nt_uchar)++-- [10] UCHAR+nt_uchar :: GenParser () T.Text+nt_uchar =+    (try (char '\\' >> char 'u' >> count 4 hexDigit >>= \cs -> return $ T.pack (uEscapedToXEscaped cs)) <|>+     try (char '\\' >> char 'U' >> count 8 hexDigit >>= \cs -> return $ T.pack (uEscapedToXEscaped cs)))++uEscapedToXEscaped :: String -> String+uEscapedToXEscaped ss =+    let str = ['\\','x'] ++ ss+    in read ("\"" ++ str ++ "\"")++-- |Validate a Text URI and return it in a @Just Text@ if it is+--  valid, otherwise @Nothing@ is returned. See 'unodeValidate'.+uriValidate :: T.Text -> Maybe T.Text+uriValidate t = case isRdfURI t of+                  Left _err -> Nothing+                  Right uri -> Just uri++-- |Same as 'uriValidate', but on 'String' rather than 'T.Text'+uriValidateString :: String -> Maybe String+uriValidateString t = case isRdfURIString of+                Left _err -> Nothing+                Right uri -> Just uri+  where+    isRdfURIString = parse (isRdfURIParserS  <* eof) ("Invalid URI: " ++ t) t+    isRdfURIParserS = many (validUriChar <|> nt_ucharS)+    nt_ucharS =+        (try (char '\\' >> char 'u' >> count 4 hexDigit >>= return . head . uEscapedToXEscaped) <|>+         try (char '\\' >> char 'U' >> count 8 hexDigit >>= return . head . uEscapedToXEscaped))+    -- [18]	IRIREF from Turtle spec+    validUriChar = try $ do+        c <- anyChar+        guard $ not (c >= '\x00' && c <= '\x20') && c `notElem` [' ','<','>','"','{','}','|','^','`','\\']+        return c++-- | Escapes @\Uxxxxxxxx@ and @\uxxxx@ character sequences according+--   to the RDF specification. escapeRDFSyntax :: T.Text -> T.Text escapeRDFSyntax t = T.pack uri     where@@ -214,7 +261,7 @@ -- See <http://www.w3.org/TR/rdf-concepts/#section-triples> for -- more information. data Triple = Triple !Node !Node !Node-            deriving (Generic)+            deriving (Generic,Show)  instance Binary Triple @@ -254,8 +301,15 @@ isLNode _         = False  {-# INLINE isAbsoluteUri #-}+-- | returns @True@ if URI is absolute. isAbsoluteUri :: T.Text -> Bool-isAbsoluteUri = Network.isURI . T.unpack+isAbsoluteUri = not+                . uriIsRelative+                . fromJust+                . parseURIReference+                . escapeURIString isUnescapedInURI+                . encodeString+                . T.unpack  -- |A type class for ADTs that expose views to clients. class View a b where@@ -524,23 +578,6 @@  instance Hashable LValue --- String representations of the various data types; generally NTriples-like.--instance Show Triple where-  show (Triple s p o) =-    printf "Triple(%s,%s,%s)" (show s) (show p) (show o)--instance Show Node where-  show (UNode uri)                   = "UNode(" ++ show uri ++ ")"-  show (BNode  i)                    = "BNode(" ++ show i ++ ")"-  show (BNodeGen genId)              = "BNodeGen(" ++ show genId ++ ")"-  show (LNode lvalue)                = "LNode(" ++ show lvalue ++ ")"--instance Show LValue where-  show (PlainL lit)               = "PlainL(" ++ T.unpack lit ++ ")"-  show (PlainLL lit lang)         = "PlainLL(" ++ T.unpack lit ++ ", " ++ T.unpack lang ++ ")"-  show (TypedL lit dtype)         = "TypedL(" ++ T.unpack lit ++ "," ++ show dtype ++ ")"- ------------------------ -- Prefix mappings @@ -581,14 +618,13 @@ ----------------- -- Miscellaneous helper functions used throughout the project --- Resolve a prefix using the given prefix mappings and base URL. If the prefix is--- empty, then the base URL will be used if there is a base URL and if the map--- does not contain an entry for the empty prefix.+-- | Resolve a prefix using the given prefix mappings and base URL. If the prefix is+--   empty, then the base URL will be used if there is a base URL and+--   if the map does not contain an entry for the empty prefix. resolveQName :: Maybe BaseUrl -> T.Text -> PrefixMappings -> Maybe T.Text resolveQName mbaseUrl prefix (PrefixMappings pms') =   case (mbaseUrl, T.null prefix) of     (Just (BaseUrl base), True)  ->  Just $ Map.findWithDefault base T.empty pms'-    (Nothing,             True)  ->  Nothing     (_,                   _   )  ->  Map.lookup prefix pms'  {- alternative implementation from Text.RDF.RDF4H.ParserUtils@@ -607,8 +643,8 @@     err2 = error ("Cannot resolve QName prefix: " ++ T.unpack prefix) -} --- Resolve a URL fragment found on the right side of a prefix mapping--- by converting it to an absolute URL if possible.+-- | Resolve a URL fragment found on the right side of a prefix mapping+--   by converting it to an absolute URL if possible. absolutizeUrl :: Maybe BaseUrl -> Maybe T.Text -> T.Text -> T.Text absolutizeUrl mbUrl mdUrl urlFrag =   if isAbsoluteUri urlFrag then urlFrag else@@ -642,12 +678,11 @@ -}  {-# INLINE mkAbsoluteUrl #-}--- Make an absolute URL by returning as is if already an absolute URL and otherwise--- appending the URL to the given base URL.+-- | Make an absolute URL by returning as is if already an absolute URL and otherwise+--   appending the URL to the given base URL. mkAbsoluteUrl :: T.Text -> T.Text -> T.Text mkAbsoluteUrl base url =-  if isAbsoluteUri url then url else base `T.append` url-+    if isAbsoluteUri url then url else base `T.append` url  ----------------- -- Internal canonicalize functions, don't export

@@ -6,7 +6,7 @@ module Main where  import Data.RDF.Types-import Data.RDF.TriplesGraph+import Data.RDF.Graph.TriplesList import Text.RDF.RDF4H.NTriplesParser import Text.RDF.RDF4H.NTriplesSerializer import Text.RDF.RDF4H.TurtleParser@@ -65,22 +65,22 @@          ("turtle", True) -> parseURL (TurtleParser mInputUri docUri)                                inputUri                                >>=-                               \ (res :: Either ParseFailure TriplesGraph) ->+                               \ (res :: Either ParseFailure TriplesList) ->                                  write outputFormat docUri emptyPms res          ("turtle", False) -> (if inputUri /= "-" then                                  parseFile (TurtleParser mInputUri docUri) inputUri else                                  liftM (parseString (TurtleParser mInputUri docUri)) TIO.getContents)                                 >>=-                                \ (res :: Either ParseFailure TriplesGraph) ->+                                \ (res :: Either ParseFailure TriplesList) ->                                   write outputFormat docUri emptyPms res          ("ntriples", True) -> parseURL NTriplesParser inputUri >>=-                                 \ (res :: Either ParseFailure TriplesGraph) ->+                                 \ (res :: Either ParseFailure TriplesList) ->                                    write outputFormat Nothing emptyPms res          ("ntriples", False) -> (if inputUri /= "-" then                                    parseFile NTriplesParser inputUri else                                    liftM (parseString NTriplesParser) TIO.getContents)                                   >>=-                                  \ (res :: Either ParseFailure TriplesGraph) ->+                                  \ (res :: Either ParseFailure TriplesList) ->                                     write outputFormat Nothing emptyPms res          (str, _) -> putStrLn ("Invalid format: " ++ str) >> exitFailure 

@@ -17,8 +17,8 @@ import qualified Data.Text as T  import Data.RDF.Types hiding (baseUrl)-import Data.RDF.TriplesGraph()-import Data.RDF.MGraph()+import Data.RDF.Graph.TriplesList()+import Data.RDF.Graph.HashMapS()  import Text.RDF.RDF4H.NTriplesParser import Text.RDF.RDF4H.TurtleParser

@@ -1,24 +1,24 @@--- |A parser for RDF in N-Triples format +-- |A parser for RDF in N-Triples format -- <http://www.w3.org/TR/rdf-testcases/#ntriples>. -module Text.RDF.RDF4H.NTriplesParser(-  NTriplesParser(NTriplesParser), ParseFailure-) where+module Text.RDF.RDF4H.NTriplesParser+  (NTriplesParser(NTriplesParser), ParseFailure)+  where  import Prelude hiding (init,pred) import Data.RDF.Types import Text.RDF.RDF4H.ParserUtils-import Data.Char(isLetter, isDigit, isLower,isAlphaNum)-import qualified Data.Map as Map+import Data.Char (isLetter, isDigit,isAlphaNum)+import Data.Map as Map (empty) import Text.Parsec import Text.Parsec.Text import qualified Data.Text as T import qualified Data.Text.IO as TIO-import Control.Monad (liftM,void)+import Control.Monad (liftM,void,guard)  -- |NTriplesParser is an 'RdfParser' implementation for parsing RDF in the -- NTriples format. It requires no configuration options. To use this parser,--- pass an 'NTriplesParser' value as the first argument to any of the +-- pass an 'NTriplesParser' value as the first argument to any of the -- 'parseString', 'parseFile', or 'parseURL' methods of the 'RdfParser' type -- class. data NTriplesParser = NTriplesParser@@ -38,60 +38,90 @@ nt_ntripleDoc = manyTill nt_line eof  nt_line :: GenParser () (Maybe Triple)-nt_line       = +nt_line =     skipMany nt_space >>-     (nt_comment <|> nt_triple <|> nt_empty) >>=-     \res -> nt_eoln >> return res+     ((nt_comment >>= \res -> return res)+      <|> try (nt_triple >>= \res -> nt_eoln >> return res)+      <|> try (nt_triple >>= \res -> char '#' >> manyTill anyChar nt_eoln >> return res)+      <|> (nt_empty >>= \res -> nt_eoln >> return res))+     >>= \res -> return res --- A comment consists of an initial # character, followed by any number of--- characters except cr or lf. The spec is redundant in specifying that--- comment is hash followed by "character - (cr | lf)", since character--- is already defined as the range #x0020-#x007E, so cr #x000D and--- lf #x000A are both already excluded. This returns Nothing as we are--- ignoring comments for now. nt_comment :: GenParser () (Maybe Triple)-nt_comment   = char '#' >> skipMany nt_character >> return Nothing+nt_comment   = char '#' >> manyTill anyChar nt_eoln >> return Nothing  -- A triple consists of whitespace-delimited subject, predicate, and object, -- followed by optional whitespace and a period, and possibly more -- whitespace.+--+-- NTriples W3C test "minimal_whitespace" proposes no space:+--+-- "tests absense of whitespace between subject, predicate, object and+-- end-of-statement"+--+-- `optional` lets this nt_triple parser succeed even if there is not+-- a space or tab character between resources or the object and the '.'. nt_triple :: GenParser () (Maybe Triple) nt_triple    =   do     subj <- nt_subject-    skipMany1 nt_space+    optional (skipMany1 nt_space)     pred <- nt_predicate-    skipMany1 nt_space+    optional (skipMany1 nt_space)     obj <- nt_object-    skipMany nt_space+    optional (skipMany1 nt_space)     void (char '.')     void (many nt_space)     return $ Just (Triple subj pred obj) --- A literal is either a language literal (with optional language--- specified) or a datatype literal (with required datatype--- specified). The literal value is always enclosed in double--- quotes. A language literal may have '@' after the closing quote,--- followed by a language specifier. A datatype literal follows--- the closing quote with ^^ followed by the URI of the datatype.+-- [6] literal nt_literal :: GenParser () LValue-nt_literal = -  do lit_str <- between (char '"') (char '"') inner_literal-     liftM (plainLL lit_str) (char '@' >> nt_language) <|>-       liftM (typedL lit_str) (count 2 (char '^') >> nt_uriref) <|>-       return (plainL lit_str)-  where inner_literal = inner_string+nt_literal = do+  s' <- nt_string_literal_quote+  let s = escapeRDFSyntax s'+  option (plainL s) $ do+               ((count 2 (char '^') >> nt_iriref >>= validateURI >>= isAbsoluteParser >>= \iri -> return (typedL s iri))+                <|> (nt_langtag >>= \lang -> return (plainLL s lang))) --- A language specifier of a language literal is any number of lowercase--- letters followed by any number of blocks consisting of a hyphen followed--- by one or more lowercase letters or digits.-nt_language :: GenParser () T.Text-nt_language =-  do str <- liftM T.pack (many (satisfy (\ c -> c == '-' || isLower c)))-     if T.null str || T.last str == '-' || T.head str == '-'-        then fail ("Invalid language string: '" ++ T.unpack str ++ "'")-        else return str+-- [9] STRING_LITERAL_QUOTE+nt_string_literal_quote :: GenParser () T.Text+nt_string_literal_quote =+    between (char '"') (char '"') $ do+      T.concat <$> (many ((T.singleton <$> noneOf ['\x22','\x5C','\xA','\xD']) <|>+                          nt_echar <|>+                          nt_uchar)) +-- [144s] LANGTAG+nt_langtag :: GenParser () T.Text+nt_langtag = do+  void (char '@')+  ss   <- many1 (satisfy (\ c -> isLetter c))+  rest <- concat <$> many (char '-' >> many1 (satisfy (\ c -> isAlphaNum c)) >>= \lang_str -> return ('-':lang_str))+  return (T.pack (ss ++ rest))++-- [8] IRIREF+nt_iriref :: GenParser () T.Text+nt_iriref = do+  between (char '<') (char '>') $ do+              T.concat <$> many ( T.singleton <$> noneOf (['\x00'..'\x20'] ++ ['<','>','"','{','}','|','^','`','\\']) <|>+                                  nt_uchar )++-- [153s] ECHAR+nt_echar :: GenParser () T.Text+nt_echar = try $ do+  void (char '\\')+  c2 <- anyChar+  guard $ isEchar c2+  return (T.pack [c2])++isEchar :: Char -> Bool+isEchar = (`elem` ['t','b','n','r','f','"','\'','\\'])++-- [10] UCHAR+nt_uchar :: GenParser () T.Text+nt_uchar =+    (try (char '\\' >> char 'u' >> count 4 hexDigit >>= \cs -> return $ T.pack ('\\':'u':cs)) <|>+     try (char '\\' >> char 'U' >> count 8 hexDigit >>= \cs -> return $ T.pack ('\\':'U':cs)))+ -- nt_empty is a line that isn't a comment or a triple. They appear in the -- parsed output as Nothing, whereas a real triple appears as (Just triple). nt_empty :: GenParser () (Maybe Triple)@@ -102,7 +132,7 @@ nt_subject :: GenParser () Node nt_subject   =   liftM unode nt_uriref <|>-  liftM bnode nt_nodeID+  liftM bnode nt_blank_node_label  -- A predicate may only be a URI reference to a resource. nt_predicate :: GenParser () Node@@ -113,40 +143,97 @@ nt_object :: GenParser () Node nt_object =   liftM unode nt_uriref <|>-  liftM bnode nt_nodeID <|>+  liftM bnode nt_blank_node_label <|>   liftM LNode nt_literal +validateUNode :: T.Text -> GenParser () Node+validateUNode t =+    case unodeValidate t of+      Nothing        -> unexpected ("Invalid URI in NTriples parser URI validation: " ++ show t)+      Just u@(UNode{}) -> return u+      Just node      -> unexpected ("Unexpected node in NTriples parser URI validation: " ++ show node)++validateURI :: T.Text -> GenParser () T.Text+validateURI t = do+    UNode uri <- validateUNode t+    return uri++isAbsoluteParser :: T.Text -> GenParser () T.Text+isAbsoluteParser t =+    if isAbsoluteUri t+    then return t+    else unexpected ("Only absolute IRIs allowed in NTriples format, which this isn't: " ++ show t)++absoluteURI :: T.Text -> GenParser () T.Text+absoluteURI t = do+    uri <- isAbsoluteParser t+    return uri+ -- A URI reference is one or more nrab_character inside angle brackets. nt_uriref :: GenParser () T.Text-nt_uriref = between (char '<') (char '>') (liftM T.pack (many (satisfy ( /= '>'))))+nt_uriref = between (char '<') (char '>') $ do+              unvalidatedUri <- many (satisfy ( /= '>'))+              t <- validateURI (T.pack unvalidatedUri)+              absoluteURI t --- A node id is "_:" followed by a name.-nt_nodeID :: GenParser () T.Text-nt_nodeID = char '_' >> char ':' >> nt_name >>= \n -> -                return ('_' `T.cons` (':' `T.cons` n))+-- [141s] BLANK_NODE_LABEL+nt_blank_node_label :: GenParser () T.Text+nt_blank_node_label = do+  void (char '_' >> char ':')+  s1 <- (nt_pn_chars_u <|> satisfy isDigit)+  s2 <- option "" $ try $ do+          sub_dots <- many (char '.')+          sub_s1   <- many1 nt_pn_chars+          return (sub_dots ++ sub_s1)+  return (T.pack ("_:" ++ [s1] ++ s2)) --- A name is a letter followed by any number of alpha-numeric characters.-nt_name :: GenParser () T.Text-nt_name =-  do init <- letter-     rest <- many (satisfy isLetterOrDigit)-     return $ T.pack (init:rest)+-- [157s] PN_CHARS_BASE+-- Not used. It used to be. What's happened?+{-+nt_pn_chars_base :: GenParser () Char+nt_pn_chars_base = try $ do+    c <- anyChar+    guard $ isBaseChar c+    return c+-} -isLetterOrDigit :: Char -> Bool-isLetterOrDigit c = isLetter c || isDigit c+isBaseChar :: Char -> Bool+isBaseChar c+    =  (c >= 'A' && c <= 'Z')+    || (c >= 'a' && c <= 'z')+    || (c >= '\x00C0' && c <= '\x00D6')+    || (c >= '\x00D8' && c <= '\x00F6')+    || (c >= '\x00F8' && c <= '\x02FF')+    || (c >= '\x0370' && c <= '\x037D')+    || (c >= '\x037F' && c <= '\x1FFF')+    || (c >= '\x200C' && c <= '\x200D')+    || (c >= '\x2070' && c <= '\x218F')+    || (c >= '\x2C00' && c <= '\x2FEF')+    || (c >= '\x3001' && c <= '\xD7FF')+    || (c >= '\xF900' && c <= '\xFDCF')+    || (c >= '\xFDF0' && c <= '\xFFFD')+    || (c >= '\x10000' && c <= '\xEFFFF') --- An nt_character is any character except a double quote character.-nt_character :: GenParser () Char-nt_character   =   satisfy is_nonquote_char --- A character is any Unicode value from ASCII space to decimal 126 (tilde).-is_character :: Char -> Bool-is_character = isAlphaNum+-- [158s] PN_CHARS_U+nt_pn_chars_u :: GenParser () Char+nt_pn_chars_u = try $ do+    c <- anyChar+    guard $ c == '_' || c == ':' || isBaseChar c+    return c --- A non-quote character is a character that isn't the double-quote character.-is_nonquote_char :: Char -> Bool-is_nonquote_char c = is_character c && c/= '"' +-- [160s] PN_CHARS+nt_pn_chars :: GenParser () Char+nt_pn_chars = nt_pn_chars_u <|> try (do+    c <- anyChar+    guard $ c == '-' || c == '\x00B7'+           || isDigit c+           || (c >= '\x0300' && c <= '\x036F')+           || (c >= '\x203F' && c <= '\x2040')+    return c+    )+ -- End-of-line consists of either lf or crlf. -- We also test for eof and consider that to match as well. nt_eoln :: GenParser () ()@@ -169,32 +256,6 @@ nt_tab :: GenParser () Char nt_tab         =   char '\t' --- An inner_string is a fragment of a string (this is used inside double--- quotes), and consists of the non-quote characters allowed and the--- standard escapes for a backslash (\\), a tab (\t), a carriage  return (\r),--- a newline (\n), a double-quote (\"), a 4-digit Unicode escape (\uxxxx--- where x is a hexadecimal digit), and an 8-digit Unicode escape--- (\Uxxxxxxxx where x is a hexadecimaldigit).-inner_string :: GenParser () T.Text-inner_string =-  try (char '\\' >>-         ((char 't' >> return b_tab)  <|>-          (char 'r' >> return b_ret)  <|>-          (char 'n' >> return b_nl)  <|>-          (char '\\' >> return b_slash) <|>-          (char '"' >> return b_quote)   <|>-          (char 'u' >> count 4 hexDigit >>= \cs -> return $ T.pack ('\\':'u':cs)) <|>-          (char 'U' >> count 8 hexDigit >>= \cs -> return $ T.pack ('\\':'U':cs))))-  <|> liftM T.pack-    (many (satisfy (\ c -> is_nonquote_char c && c /= '\\')))--b_tab, b_ret, b_nl, b_slash, b_quote :: T.Text-b_tab = T.singleton '\t'-b_ret = T.singleton '\r'-b_nl  = T.singleton '\n'-b_slash = T.singleton '\\'-b_quote = T.singleton '"'- parseString' :: forall rdf. (RDF rdf) => T.Text -> Either ParseFailure rdf parseString' bs = handleParse mkRdf (runParser nt_ntripleDoc () "" bs) @@ -210,7 +271,7 @@                                         Either ParseFailure rdf handleParse _mkRdf result --  | T.length rem /= 0 = (Left $ ParseFailure $ "Invalid Document. Unparseable end of document: " ++ T.unpack rem)-  | otherwise          = +  | otherwise          =       case result of         Left err -> Left  $ ParseFailure $ "Parse failure: \n" ++ show err         Right ts -> Right $ _mkRdf (conv ts) Nothing (PrefixMappings Map.empty)

@@ -7,7 +7,7 @@  where -import Data.Char (toLower,toUpper)+import Data.Char (isLetter,isAlphaNum,toLower,toUpper) import Data.Maybe import Data.RDF.Types import Data.RDF.Namespace@@ -49,12 +49,14 @@    [Subject],        -- stack of current subject nodes, if we have parsed a subject but not finished the triple    [Predicate],      -- stack of current predicate nodes, if we've parsed a predicate but not finished the triple    [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  -- 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 ()@@ -69,14 +71,27 @@       (many t_ws <?> "triple-whitespace2"))  -- grammar rule: [6] triples+-- subject predicateObjectList | blankNodePropertyList predicateObjectList? t_triples :: GenParser ParseState ()-t_triples = t_subject >> (many1 t_ws <?> "subject-predicate-whitespace") >> t_predicateObjectList >> resetSubjectPredicate+t_triples = do+  try (t_subject >> many t_ws >> t_predicateObjectList >> resetSubjectPredicate) <|> (setSubjBlankNodePropList >> t_blankNodePropertyList >> many t_ws >> optional (t_predicateObjectList) >> resetSubjectPredicate >> setNotSubjBlankNodePropList) +-- [14]	blankNodePropertyList ::= '[' predicateObjectList ']'+t_blankNodePropertyList :: GenParser ParseState ()+t_blankNodePropertyList = between (char '[') (char ']') $ do+                            subjPropList <- isSubjPropList+                            blankNode <- liftM BNodeGen nextIdCounter+                            unless subjPropList $ addTripleForObject blankNode+                            pushSubj blankNode+                            (many t_ws >> t_predicateObjectList >> void (many t_ws))+                            unless subjPropList $ void popSubj+ -- grammar rule: [3] directive t_directive :: GenParser ParseState () t_directive = t_prefixID <|> t_base <|> t_sparql_prefix <|> t_sparql_base  -- grammar rule: [135s] iri+-- IRIREF | PrefixedName t_iri :: GenParser ParseState T.Text t_iri =  try t_iriref <|> t_prefixedName @@ -95,7 +110,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 () @@ -106,7 +121,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 () @@ -133,34 +148,33 @@      updateBaseUrl (Just $ Just $ newBaseUrl bUrl (absolutizeUrl bUrl dUrl urlFrag))  t_verb :: GenParser ParseState ()+-- [9]	verb ::= predicate | 'a' t_verb = (try t_predicate <|> (char 'a' >> return rdfTypeNode)) >>= pushPred  -- grammar rule: [11] predicate t_predicate :: GenParser ParseState Node t_predicate = liftM UNode (t_iri <?> "resource")---  res <- t_iri <?> "resource"---  validateUNode res -t_nodeID  :: GenParser ParseState T.Text-t_nodeID = do { void (try (string "_:")); cs <- t_name; return $! "_:" `T.append` cs }- -- grammar rules: [139s] PNAME_NS t_pname_ns :: GenParser ParseState T.Text 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+    Just n  -> return n     Nothing -> unexpected ("Cannot resolve QName prefix: " ++ T.unpack pre)  -- grammar rules: [168s] PN_LOCAL+-- [168s] PN_LOCAL ::= (PN_CHARS_U | ':' | [0-9] | PLX) ((PN_CHARS | '.' | ':' | PLX)* (PN_CHARS | ':' | PLX))? t_pn_local :: GenParser ParseState T.Text t_pn_local = do   x <- t_pn_chars_u_str <|> string ":" <|> satisfy_str <|> t_plx-  xs <- option "" $ do-               ys <- many ( t_pn_chars_str <|> string "." <|> string ":" <|> t_plx )-               return (concat ys)+  xs <- option "" $ try $ do+               let recsve = (t_pn_chars_str <|> string ":" <|> t_plx) <|>+                            (t_pn_chars_str <|> string ":" <|> t_plx <|> try (string "." <* lookAhead (try recsve))) <|>+                            (t_pn_chars_str <|> string ":" <|> t_plx <|> try (string "." >> notFollowedBy t_ws >> return "."))+               concat <$> many recsve   return (T.pack (x ++ xs))     where       satisfy_str = satisfy (flip in_range [('0', '9')]) >>= \c -> return [c]@@ -194,34 +208,61 @@ t_pname_ln =   do pre <- t_pname_ns      name <- t_pn_local-     return (pre `T.append` name)             +     return (pre `T.append` name)  -- grammar rule: [10] subject+-- [10] subject	::= iri | BlankNode | collection t_subject :: GenParser ParseState () t_subject =   iri <|>-  simpleBNode <|>-  nodeId <|>-  between (char '[') (char ']') poList+  (t_blankNode >>= pushSubj) <|>+   (liftM BNodeGen nextIdCounter >>= pushSubj+    >> pushPred rdfFirstNode+    >> pushSubjColl+    >> t_collection)   where-    iri         = liftM unode (try t_iri <?> "subject resource") >>= pushSubj-    nodeId      = liftM BNode (try t_nodeID <?> "subject nodeID") >>= pushSubj-    simpleBNode = try (string "[]") >> nextIdCounter >>=  pushSubj . BNodeGen-    poList      = void-                (nextIdCounter >>= pushSubj . BNodeGen >> many t_ws >>-                t_predicateObjectList >>-                many t_ws)+    iri         = liftM unode (try t_iri <?> "subject resource") >>= \s -> pushSubj s --- verb objectList (';' (verb objectList)?)*------ verb ws+ objectList ( ws* ';' ws* verb ws+ objectList )* (ws* ';')?--- grammar rule: [7] predicateObjectlist+-- [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+  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 = do+  void (string "_:")+  void (t_pn_chars_u <|> oneOf ['0'..'9'])+  optional $ try $ do+    ss <- option "" $ do+            xs <- many (t_pn_chars <|> char '.')+            if null xs+            then return xs+            else if last xs == '.'+                 then unexpected "'.' at the end of a blank node label"+                 else return xs+    return ss++-- [162s] ANON ::= '[' WS* ']'+t_anon :: GenParser ParseState ()+t_anon = between (char '[') (char ']') (void (many t_ws))++-- [7] predicateObjectList ::= verb objectList (';' (verb objectList)?)* t_predicateObjectList :: GenParser ParseState ()-t_predicateObjectList =-  do void (sepEndBy1 (try (t_verb >> many1 t_ws >> t_objectList >> popPred)) (try (many t_ws >> char ';' >> optional (char ';') >> many t_ws)))---     return ()+t_predicateObjectList = do+  void (sepEndBy1+        (optional (try (do { t_verb+                           ; many1 t_ws+                           ; t_objectList+                           ; void popPred})))+        (try (many t_ws >> char ';' >> many t_ws)))  -- grammar rule: [8] objectlist+-- [8] objectList ::= object (',' object)* t_objectList :: GenParser ParseState () t_objectList = -- t_object actually adds the triples   void@@ -229,60 +270,57 @@   many (try (many t_ws >> char ',' >> many t_ws >> t_object)))  -- grammar rule: [12] object+-- [12]	object ::= iri | BlankNode | collection | blankNodePropertyList | literal t_object :: GenParser ParseState ()-t_object =-  do inColl      <- isInColl          -- whether this object is in a collection-     onFirstItem <- onCollFirstItem   -- whether we're on the first item of the collection-     let processObject = (t_literal >>= addTripleForObject) <|>-                          (liftM UNode t_iri >>= addTripleForObject) <|>-                          blank_as_obj <|> t_collection-     case (inColl, onFirstItem) of-       (False, _)    -> processObject-       (True, True)  -> liftM BNodeGen nextIdCounter >>= \bSubj -> addTripleForObject bSubj >>-                          pushSubj bSubj >> pushPred rdfFirstNode >> processObject >> collFirstItemProcessed-       (True, False) -> liftM BNodeGen nextIdCounter >>= \bSubj -> pushPred rdfRestNode >>-                          addTripleForObject bSubj >> popPred >> popSubj >>-                          pushSubj bSubj >> processObject+t_object = do+  inColl <- isInColl+  inSubjColl <- isInSubjColl+  onFirstItem <- onCollFirstItem+  let processObject =+           (liftM UNode t_iri >>= addTripleForObject) <|>+           (try t_blankNode >>= addTripleForObject) <|>+           (try t_collection >> pushObjColl) <|>+           (try t_blankNodePropertyList) <|>+           (t_literal >>= addTripleForObject)+  case (inColl,inSubjColl,onFirstItem) of+    (False,_,_)    -> processObject+    (True,False,True)  -> liftM BNodeGen nextIdCounter >>= \bSubj -> addTripleForObject bSubj+                          >> pushSubj bSubj >> pushPred rdfFirstNode >> processObject >> collFirstItemProcessed+--    (True,True,True)  -> processObject >> collFirstItemProcessed+    (True,True,True)  -> processObject >> collFirstItemProcessed >> popColl+    (True,_,False) -> liftM BNodeGen nextIdCounter >>= \bSubj -> pushPred rdfRestNode >>+                      addTripleForObject bSubj >> popPred >> popSubj >>+                      pushSubj bSubj >> processObject  -- collection: '(' ws* itemList? ws* ')' -- itemList:      object (ws+ object)* -- grammar rule: [15] collection-t_collection:: GenParser ParseState ()+-- 15]	collection ::= '(' object* ')'+t_collection :: GenParser ParseState () t_collection =-  -- ( object1 object2 ) is short for:-  -- [ rdf:first object1; rdf:rest [ rdf:first object2; rdf:rest rdf:nil ] ]-  -- ( ) is short for the resource:  rdf:nil-  between (char '(') (char ')') $-    do beginColl-       void (many t_ws)-       emptyColl <- option True (try t_object  >> many t_ws >> return False)-       if emptyColl then void (addTripleForObject rdfNilNode) else-        void-         (many (many t_ws >> try t_object >> many t_ws) >> popPred >>-         pushPred rdfRestNode >>-         addTripleForObject rdfNilNode >>-         popPred >> popSubj)-       void finishColl-       return ()+  between (char '(') (char ')') $ do+    beginColl+    (try empty_list <|> non_empty_list)+    void finishColl+    -- popColl+      where+        non_empty_list = do+          many1 (many t_ws >> t_object >> many t_ws) -blank_as_obj :: GenParser ParseState ()-blank_as_obj =-  -- if a node id, like _:a1, then create a BNode and add the triple-  (liftM BNode t_nodeID >>= addTripleForObject) <|>-  -- if a simple blank like [], do likewise-  (genBlank >>= addTripleForObject) <|>-  -- if a blank containing a predicateObjectList, like [ :b :c; :b :d ]-  poList-  where-    genBlank = liftM BNodeGen (try (string "[]") >> nextIdCounter)-    poList   = between (char '[') (char ']') $-                 liftM BNodeGen nextIdCounter >>= \bSubj ->   -- generate new bnode-                  void-                  (addTripleForObject bSubj >>   -- add triple with bnode as object-                  many t_ws >> pushSubj bSubj >> -- push bnode as new subject-                  t_predicateObjectList >> popSubj >> many t_ws) -- process polist, which uses bnode as subj, then pop bnode+          _inSubjColl <- isInSubjColl +          popPred+          pushPred rdfRestNode+          addTripleForObject rdfNilNode +          -- popPred+          -- if inSubjColl then trace "is sub" popColl else trace "not sub" $ void popSubj+          -- if inSubjColl then return () else trace "not sub" $ void popSubj++        empty_list = do+          lookAhead (try (many t_ws >> char ')'))+          addTripleForObject rdfNilNode+ rdfTypeNode, rdfNilNode, rdfFirstNode, rdfRestNode :: Node rdfTypeNode   = UNode $ mkUri rdf "type" rdfNilNode    = UNode $ mkUri rdf "nil"@@ -297,67 +335,129 @@  t_literal :: GenParser ParseState Node t_literal =-  try str_literal <|>-  liftM (`mkLNode` xsdDoubleUri) (try t_double)  <|>-  liftM (`mkLNode` xsdIntUri) (try t_integer)   <|>-  liftM (`mkLNode` xsdDecimalUri) (try t_decimal) <|>+  (try t_rdf_literal >>= \l -> return (LNode l))   <|>+  liftM (`mkLNode` xsdDoubleUri) (try t_double)    <|>+  liftM (`mkLNode` xsdDecimalUri) (try t_decimal)  <|>+  liftM (`mkLNode` xsdIntUri) (try t_integer)      <|>   liftM (`mkLNode` xsdBooleanUri) t_boolean-  where+   where     mkLNode :: T.Text -> T.Text -> Node     mkLNode bsType bs' = LNode (typedL bsType bs') -str_literal :: GenParser ParseState Node-str_literal =-  do str' <- t_quotedString <?> "quotedString"-     let str = escapeRDFSyntax str' -     liftM (LNode . typedL str)-      (try (count 2 (char '^')) >> t_iri) <|>-      liftM (lnode . plainLL str) (char '@' >> t_language) <|>-      return (lnode $ plainL str)--t_quotedString :: GenParser ParseState T.Text-t_quotedString = try t_longString <|> t_string+-- [128s] RDFLiteral+-- String (LANGTAG | '^^' iri)?+t_rdf_literal :: GenParser ParseState LValue+t_rdf_literal = do+  str' <- t_string+  let str = escapeRDFSyntax str'+  option (plainL str) $ do+                  (try (t_langtag >>= \lang -> return (plainLL str lang)) <|>+                   ((count 2 (char '^') >> t_iri >>= \iri -> return (typedL str iri)))) --- a non-long string: any number of scharacters (echaracter without ") inside doublequotes or singlequotes.+-- [17] String+-- STRING_LITERAL_QUOTE | STRING_LITERAL_SINGLE_QUOTE | STRING_LITERAL_LONG_SINGLE_QUOTE | STRING_LITERAL_LONG_QUOTE t_string :: GenParser ParseState T.Text-t_string = liftM T.concat (between (char '"') (char '"') (many t_scharacter_in_dquot) <|> between (char '\'') (char '\'') (many t_scharacter_in_squot))+t_string = try t_string_literal_long_quote <|>+           try t_string_literal_long_single_quote <|>+           try t_string_literal_quote <|>+           t_string_literal_single_quote -t_longString :: GenParser ParseState T.Text-t_longString =-    try ( do { void tripleQuoteDbl;-               strVal <- liftM T.concat (many longString_char);-               void tripleQuoteDbl;-               return strVal }) <|>-    try ( do { void tripleQuoteSingle;-               strVal <- liftM T.concat (many longString_char);-               void tripleQuoteSingle;-               return strVal })-  where-    tripleQuoteDbl = count 3 (char '"')-    tripleQuoteSingle = count 3 (char '\'')+-- [22]	STRING_LITERAL_QUOTE+-- '"' ([^#x22#x5C#xA#xD] | ECHAR | UCHAR)* '"'+t_string_literal_quote :: GenParser ParseState T.Text+t_string_literal_quote =+     between (char '"') (char '"') $ do+      T.concat <$> many (T.singleton <$> noneOf ['\x22','\x5C','\xA','\xD'] <|>+            t_echar <|>+            t_uchar) +-- [23] STRING_LITERAL_SINGLE_QUOTE+-- "'" ([^#x27#x5C#xA#xD] | ECHAR | UCHAR)* "'"+t_string_literal_single_quote :: GenParser ParseState T.Text+t_string_literal_single_quote =+    between (char '\'') (char '\'') $ do+      T.concat <$>+       many (T.singleton <$> noneOf ['\x27','\x5C','\xA','\xD'] <|>+             t_echar <|>+             t_uchar)++-- [24] STRING_LITERAL_LONG_SINGLE_QUOTE+-- "'''" (("'" | "''")? ([^'\] | ECHAR | UCHAR))* "'''"+t_string_literal_long_single_quote :: GenParser ParseState T.Text+t_string_literal_long_single_quote =+    between ((string "'''")) ((string "'''")) $ do+      ss <- many $ try $ do+        s1 <- T.pack <$> option "" (try (string "''") <|> string "'")+        s2 <- T.singleton <$> noneOf ['\'','\\'] <|> t_echar <|> t_uchar+        return (s1 `T.append` s2)+      return (T.concat ss)++-- [25] STRING_LITERAL_LONG_QUOTE+-- '"""' (('"' | '""')? ([^"\] | ECHAR | UCHAR))* '"""'+t_string_literal_long_quote :: GenParser ParseState T.Text+t_string_literal_long_quote =+     between (string "\"\"\"") (string "\"\"\"") $ do+      ss <- many $ try $ do+              s1 <- T.pack <$> option "" (try (string "\"\"") <|> string "\"")+              s2 <- (T.singleton <$> noneOf ['"','\\']) <|> t_echar <|> t_uchar+              return (s1 `T.append` s2)+      return (T.concat ss)++-- [144s] LANGTAG+-- '@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)*+t_langtag :: GenParser ParseState T.Text+t_langtag = do+    void (char '@')+    ss   <- many1 (satisfy (\ c -> isLetter c))+    rest <- concat <$> many (char '-' >> many1 (satisfy (\ c -> isAlphaNum c)) >>= \lang_str -> return ('-':lang_str))+    return (T.pack (ss ++ rest))++-- [159s]	ECHAR+-- '\' [tbnrf"'\]+t_echar :: GenParser ParseState T.Text+t_echar = try $ do+    void (char '\\')+    c2 <- oneOf ['t','b','n','r','f','"','\'','\\']+    return $ case c2 of+               't'  -> T.singleton '\t'+               'b'  -> T.singleton '\b'+               'n'  -> T.singleton '\n'+               'r'  -> T.singleton '\r'+               'f'  -> T.singleton '\f'+               '"'  -> T.singleton '\"'+               '\'' -> T.singleton '\''+               '\\' -> T.singleton '\\'+               _    -> error "nt_echar: impossible error."++-- [26]	UCHAR+-- '\u' HEX HEX HEX HEX | '\U' HEX HEX HEX HEX HEX HEX HEX HEX+t_uchar :: GenParser ParseState T.Text+t_uchar =+    (try (string "\\u" >> count 4 hexDigit) >>= \cs -> return $ T.pack ('\\':'u':cs)) <|>+     (char '\\' >> char 'U' >> count 8 hexDigit >>= \cs -> return $ T.pack ('\\':'U':cs))++-- [19] INTEGER ::= [+-]? [0-9]+ t_integer :: GenParser ParseState T.Text-t_integer =+t_integer = try $   do sign <- sign_parser <?> "+-"-     ds <- many1 digit   <?> "digit"-     notFollowedBy (char '.')-     -- integer must be in canonical format, with no leading plus sign or leading zero+     ds <- many1 (oneOf ['0'..'9'] <?> "digit")      return $! ( T.pack sign `T.append` T.pack ds)  -- grammar rule: [21] DOUBLE+-- [21] DOUBLE ::= [+-]? ([0-9]+ '.' [0-9]* EXPONENT | '.' [0-9]+ EXPONENT | [0-9]+ EXPONENT) t_double :: GenParser ParseState T.Text t_double =   do sign <- sign_parser <?> "+-"-     rest <- try (do { ds <- many1 digit <?> "digit";+     rest <- try (do { ds <- many1 (oneOf ['0'..'9']) <?> "digit";                       void (char '.');-                      ds' <- many digit <?> "digit";+                      ds' <- many (oneOf ['0'..'9']) <?> "digit";                       e <- t_exponent <?> "exponent";                       return ( T.pack ds `T.snoc` '.' `T.append`  T.pack ds' `T.append` e) }) <|>              try (do { void (char '.');-                       ds <- many1 digit <?> "digit";+                       ds <- many1 (oneOf ['0'..'9']) <?> "digit";                        e <- t_exponent <?> "exponent";                        return ('.' `T.cons`  T.pack ds `T.append` e) }) <|>-             try (do { ds <- many1 digit <?> "digit";+                 (do { ds <- many1 (oneOf ['0'..'9']) <?> "digit";                        e <- t_exponent <?> "exponent";                        return ( T.pack ds `T.append` e) })      return $! T.pack sign `T.append` rest@@ -365,13 +465,14 @@ sign_parser :: GenParser ParseState String sign_parser = option "" (oneOf "-+" >>= (\c -> return [c])) +-- [20]	DECIMAL ::= [+-]? [0-9]* '.' [0-9]+ t_decimal :: GenParser ParseState T.Text-t_decimal =-  do sign <- sign_parser-     rest <- try (do ds <- many digit <?> "digit"; void (char '.'); ds' <- option "" (many digit); return (ds ++ ('.':ds')))-             <|> try (do { void (char '.'); ds <- many1 digit <?> "digit"; return ('.':ds) })-             <|> many1 digit <?> "digit"-     return $ T.pack sign `T.append`  T.pack rest+t_decimal = try $ do+              sign <- sign_parser+              dig1 <- many (oneOf ['0'..'9'])+              void (char '.')+              dig2 <- many1 (oneOf ['0'..'9'])+              return (T.pack sign `T.append`  T.pack dig1 `T.append` T.pack "." `T.append` T.pack dig2)  t_exponent :: GenParser ParseState T.Text t_exponent = do e <- oneOf "eE"@@ -388,81 +489,36 @@ t_comment =   void (char '#' >> many (satisfy (\ c -> c /= '\n' && c /= '\r'))) +-- [161s] WS ::= #x20 | #x9 | #xD | #xA t_ws :: GenParser ParseState () t_ws =     (void (try (char '\t' <|> char '\n' <|> char '\r' <|> char ' '))      <|> try t_comment)     <?> "whitespace-or-comment" --t_language :: GenParser ParseState T.Text-t_language =-  do initial <- many1 lower;-     rest <- many (do {void (char '-'); cs <- many1 (lower <|> digit); return ( T.pack ('-':cs))})-     return $! ( T.pack initial `T.append` T.concat rest)--identifier :: GenParser ParseState Char -> GenParser ParseState Char -> GenParser ParseState T.Text-identifier initial rest = initial >>= \i -> many rest >>= \r -> return ( T.pack (i:r))- -- grammar rule: [167s] PN_PREFIX t_pn_prefix :: GenParser ParseState T.Text t_pn_prefix = do   i <- try t_pn_chars_base-  r <- option "" (many (try t_pn_chars <|> char '.'))+  r <- option "" (many (try t_pn_chars <|> char '.')) -- TODO: ensure t_pn_chars is last char   return (T.pack (i:r)) -t_name :: GenParser ParseState T.Text-t_name = identifier t_pn_chars_u t_pn_chars-+-- [18] IRIREF t_iriref :: GenParser ParseState T.Text-t_iriref = between (char '<') (char '>') t_relativeURI--t_relativeURI :: GenParser ParseState T.Text-t_relativeURI =-  do frag <- liftM (T.pack . concat) (many t_ucharacter)-     bUrl <- currBaseUrl-     dUrl <- currDocUrl-     let frag' = escapeRDFSyntax frag-     validateURI (absolutizeUrl bUrl dUrl frag')---- We make this String rather than T.Text because we want--- t_relativeURI (the only place it's used) to have chars so that--- when it creates a T.Text it can all be in one chunk.-t_ucharacter :: GenParser ParseState String-t_ucharacter =-  try (liftM T.unpack unicode_escape) <|>-  try (string "\\>") <|>-  liftM T.unpack (non_ctrl_char_except ">")+t_iriref =+  between (char '<') (char '>') $ do+    iri <- T.concat <$> many ( T.singleton <$> noneOf (['\x00'..'\x20'] ++ ['<','>','"','{','}','|','^','`','\\']) <|>+                               t_uchar )+    bUrl <- currBaseUrl+    dUrl <- currDocUrl+    let iri' = escapeRDFSyntax iri+    validateURI (absolutizeUrl bUrl dUrl iri')  t_pn_chars :: GenParser ParseState Char t_pn_chars = t_pn_chars_u <|> char '-' <|> char '\x00B7' <|> satisfy f   where     f = flip in_range [('0', '9'), ('\x0300', '\x036F'), ('\x203F', '\x2040')] -longString_char :: GenParser ParseState T.Text-longString_char =-  specialChar        <|> -- \r|\n|\t as single char-  try escapedChar    <|> -- an backslash-escaped tab, newline, linefeed, backslash or doublequote-  try twoDoubleQuote <|> -- two doublequotes not followed by a doublequote-  try oneDoubleQuote <|> -- a single doublequote-  safeNonCtrlChar    <|> -- anything but a single backslash or doublequote-  try unicode_escape     -- a unicode escape sequence (\uxxxx or \Uxxxxxxxx)-  where-    specialChar     = oneOf "\t\n\r" >>= bs1-    escapedChar     =-      do void (char '\\')-         (char 't'  >> bs1 '\t') <|> (char 'n' >> bs1 '\n') <|> (char 'r' >> bs1 '\r') <|>-          (char '\\' >> bs1 '\\') <|> (char '"' >> bs1 '"')-    twoDoubleQuote  = string "\"\"" >> notFollowedBy (char '"') >> bs "\"\""-    oneDoubleQuote  = char '"' >> notFollowedBy (char '"') >> bs1 '"'-    safeNonCtrlChar = non_ctrl_char_except "\\\""--bs1 :: Char -> GenParser ParseState T.Text-bs1 = return . T.singleton--bs :: String -> GenParser ParseState T.Text-bs = return . T.pack- -- grammar rule: [163s] PN_CHARS_BASE t_pn_chars_base :: GenParser ParseState Char t_pn_chars_base = try $ satisfy $ flip in_range blocks@@ -483,44 +539,6 @@ t_hex :: GenParser ParseState Char t_hex = satisfy (\c -> isDigit c || (c >= 'A' && c <= 'F')) <?> "hexadecimal digit" --- characters used in (non-long) strings; any echaracters except ", or an escaped \"--- echaracter - #x22 ) | '\"'-t_scharacter_in_dquot :: GenParser ParseState T.Text-t_scharacter_in_dquot =-  (try (string "\\\"") >> return (T.singleton '"'))-     <|> (try (string "\\'") >> return (T.singleton '\''))-     <|> try (do {void (char '\\');-                  (char 't' >> return (T.singleton '\t')) <|>-                  (char 'n' >> return (T.singleton '\n')) <|>-                  (char 'r' >> return (T.singleton '\r'))}) -- echaracter part 1-     <|> unicode_escape-     <|> (non_ctrl_char_except "\\\"" >>= \s -> return $! s) -- echaracter part 2 minus "---- characters used in (non-long) strings; any echaracters except ', or an escaped \'--- echaracter - #x22 ) | '\''-t_scharacter_in_squot :: GenParser ParseState T.Text-t_scharacter_in_squot =-  (try (string "\\'") >> return (T.singleton '\''))-     <|> (try (string "\\\"") >> return (T.singleton '"'))-     <|> try (do {void (char '\\');-                  (char 't' >> return (T.singleton '\t')) <|>-                  (char 'n' >> return (T.singleton '\n')) <|>-                  (char 'r' >> return (T.singleton '\r'))}) -- echaracter part 1-     <|> unicode_escape-     <|> (non_ctrl_char_except "\\'" >>= \s -> return $! s) -- echaracter part 2 minus '--unicode_escape :: GenParser ParseState T.Text-unicode_escape =- (char '\\' >> return (T.singleton '\\')) >>- ((char '\\' >> return "\\\\") <|>-  (char 'u' >> count 4 t_hex >>= \cs -> return $!  "\\u" `T.append`  T.pack cs) <|>-  (char 'U' >> count 8 t_hex >>= \cs -> return $!  "\\U" `T.append` T.pack cs))--non_ctrl_char_except :: String -> GenParser ParseState T.Text-non_ctrl_char_except cs =-  liftM T.singleton-    (satisfy (\ c -> c <= '\1114111' && (c >= ' ' && c `notElem` cs)))- {-# INLINE in_range #-} in_range :: Char -> [(Char, Char)] -> Bool in_range c = any (\(c1, c2) -> c >= c1 && c <= c2)@@ -530,65 +548,116 @@ newBaseUrl (Just (BaseUrl bUrl)) url = BaseUrl $! mkAbsoluteUrl bUrl url  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, ts) ->-                  setState (bUrl, dUrl, i, pms, s:ss, ps, cs, ts)+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)  popSubj :: GenParser ParseState Subject-popSubj = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, ts) ->-                setState (bUrl, dUrl, i, pms, tail ss, ps, cs, ts) >>+popSubj = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts) ->+                setState (bUrl, dUrl, i, pms, tail ss, ps, cs, subjC, subjBNodeList, ts) >>                   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, ts) ->-                  setState (bUrl, dUrl, i, pms, ss, p:ps, cs, ts)+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)  popPred :: GenParser ParseState Predicate-popPred = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, ts) ->-                setState (bUrl, dUrl, i, pms, ss, tail ps, cs, ts) >>+popPred = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts) ->+                setState (bUrl, dUrl, i, pms, ss, tail ps, cs, subjC, subjBNodeList, ts) >>                   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+               if null xs then return False else return (head xs)++{-+isInObjColl :: GenParser ParseState Bool+isInObjColl = getState >>= \(_, _, _, _, _, _, _, xs, _, _) -> do+               when (null xs) $ error "null in isInObjColl"+               return (not (head xs))+-}++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)++popColl :: GenParser ParseState ()+popColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts) -> do+                when (null subjC) $ error "null in popColl"+                setState (bUrl, dUrl, i, pms, s, p, cs, tail subjC, subjBNodeList, ts)++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)++isSubjPropList :: GenParser ParseState Bool+isSubjPropList = getState >>= \(_, _, _, _, _, _, _, _, subjBNodeList, _) -> do+                return subjBNodeList++{-+isObjPropList :: GenParser ParseState Bool+isObjPropList = getState >>= \(_, _, _, _, _, _, _, _, subjBNodeList, _) -> do+                return subjBNodeList+-}++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)++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)++-- setObjBlankNodePropList :: GenParser ParseState ()+-- setObjBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts) ->+--                  setState (bUrl, dUrl, i, pms, s, p, cs, subjC, False, ts)++-- popBlankNodePropList :: GenParser ParseState ()+-- popBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _:subjBNodeList, ts) ->+--                  when (null subjBNodeList) $ "no subj/obj flag to pop when exiting collection"+--                  setState (bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts)+ updateBaseUrl :: Maybe (Maybe BaseUrl) -> GenParser ParseState () updateBaseUrl val = _modifyState val no no no no no  -- combines get_current and increment into a single function nextIdCounter :: GenParser ParseState Int-nextIdCounter = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, ts) ->-                setState (bUrl, dUrl, i+1, pms, s, p, cs, ts) >> return i+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  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, ts) ->-            setState (bUrl, dUrl, i, pms, s, p, True:cs, ts)+beginColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts) ->+            setState (bUrl, dUrl, i, pms, s, p, True:cs, subjC, subjBNodeList, ts)  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, ts) ->-                         setState (bUrl, dUrl, i, pms, s, p, False:cs, ts)+collFirstItemProcessed = getState >>= \(bUrl, dUrl, i, pms, s, p, _:cs, subjC, subjBNodeList, ts) ->+                         setState (bUrl, dUrl, i, pms, s, p, False:cs, subjC, subjBNodeList, ts)  -- 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, ts) ->+finishColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts) ->              let cs' = drop 1 cs-             in setState (bUrl, dUrl, i, pms, s, p, cs', ts) >> return (not $ null cs')+             in setState (bUrl, dUrl, i, pms, s, p, cs', subjC, subjBNodeList, ts) >> return (not $ null cs')  -- Alias for Nothing for use with _modifyState calls, which can get very long with -- many Nothing values.@@ -598,8 +667,8 @@ -- Update the subject and predicate values of the ParseState to Nothing. resetSubjectPredicate :: GenParser ParseState () resetSubjectPredicate =-  getState >>= \(bUrl, dUrl, n, pms, _, _, cs, ts) ->-  setState (bUrl, dUrl, n, pms, [], [], cs, ts)+  getState >>= \(bUrl, dUrl, n, pms, _, _, cs, subjC, subjBNodeList, ts) ->+  setState (bUrl, dUrl, n, pms, [], [], cs, subjC, subjBNodeList, ts)  -- Modifies the current parser state by updating any state values among the parameters -- that have non-Nothing values.@@ -607,7 +676,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, _ts) <- getState+  do (_bUrl, _dUrl, _n, _pms, _s, _p, _cs, _subjC, _subjBNodeList, _ts) <- getState      setState (fromMaybe _bUrl mb_bUrl,               _dUrl,               maybe _n (const _n) mb_n,@@ -615,16 +684,18 @@               maybe _s (: _s) mb_subj,               maybe _p (: _p) mb_pred,               _cs,+              _subjC,+              _subjBNodeList,               fromMaybe _ts mb_trps)  addTripleForObject :: Object -> GenParser ParseState () addTripleForObject obj =-  do (bUrl, dUrl, i, pms, ss, ps, cs, ts) <- getState+  do (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts) <- 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, ts |> Triple (head ss) (head ps) obj)+     setState (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts |> Triple (head ss) (head ps) obj)  -- |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.@@ -658,16 +729,16 @@ -- -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples. parseFile' :: forall rdf. (RDF rdf) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure rdf)-parseFile' bUrl docUrl fpath =+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, [], [], [], Seq.empty)+  where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], [], False, Seq.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' :: forall rdf. (RDF rdf) => Maybe BaseUrl -> Maybe T.Text -> T.Text -> Either ParseFailure rdf parseString' bUrl docUrl ttlStr = handleResult bUrl (runParser t_turtleDoc initialState "" ttlStr)-  where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], Seq.empty)+  where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], [], False, Seq.empty)  handleResult :: RDF rdf => Maybe BaseUrl -> Either ParseError (Seq Triple, PrefixMappings) -> Either ParseFailure rdf handleResult bUrl result =

@@ -0,0 +1,24 @@+module Data.RDF.Graph.HashMapSP_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where++import Data.RDF.Types+import Data.RDF.Graph.HashMapSP (HashMapSP)+import Data.RDF.GraphTestUtils+import qualified Data.Map as Map+import Control.Monad++import Test.QuickCheck++instance Arbitrary HashMapSP where+  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)++empty' :: HashMapSP+empty' = empty++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> HashMapSP+mkRdf' = mkRdf++triplesOf' :: HashMapSP -> Triples+triplesOf' = triplesOf++uniqTriplesOf' :: HashMapSP -> Triples+uniqTriplesOf' = uniqTriplesOf

@@ -0,0 +1,25 @@+module Data.RDF.Graph.HashMapS_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where++import Data.RDF.Types+import Data.RDF.Graph.HashMapS (HashMapS)+import Data.RDF.GraphTestUtils+import qualified Data.Map as Map+import Control.Monad++import Test.QuickCheck++instance Arbitrary HashMapS where+  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)+  --coarbitrary = undefined++empty' :: HashMapS+empty' = empty++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> HashMapS+mkRdf' = mkRdf++triplesOf' :: HashMapS -> Triples+triplesOf' = triplesOf++uniqTriplesOf' :: HashMapS -> Triples+uniqTriplesOf' = uniqTriplesOf

@@ -0,0 +1,25 @@+module Data.RDF.Graph.MapSP_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where++import Data.RDF.Types+import Data.RDF.Graph.MapSP (MapSP)+import Data.RDF.GraphTestUtils+import qualified Data.Map as Map+import Control.Monad++import Test.QuickCheck++instance Arbitrary MapSP where+  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)+  --coarbitrary = undefined++empty' :: MapSP+empty' = empty++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> MapSP+mkRdf' = mkRdf++triplesOf' :: MapSP -> Triples+triplesOf' = triplesOf++uniqTriplesOf' :: MapSP -> Triples+uniqTriplesOf' = uniqTriplesOf

@@ -0,0 +1,25 @@+module Data.RDF.Graph.TriplesList_Test (empty',triplesOf',uniqTriplesOf',mkRdf') where++import Control.Monad+import qualified Data.Map as Map+import Data.RDF.GraphTestUtils+import Data.RDF.Namespace+import Data.RDF.Graph.TriplesList+import Data.RDF.Types+import Test.QuickCheck.Arbitrary++instance Arbitrary TriplesList where+  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)+  --coarbitrary = undefined++empty' :: TriplesList+empty' = empty++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesList+mkRdf' = mkRdf++triplesOf' :: TriplesList -> Triples+triplesOf' = triplesOf++uniqTriplesOf' :: TriplesList -> Triples+uniqTriplesOf' = uniqTriplesOf

@@ -0,0 +1,25 @@+module Data.RDF.Graph.TriplesPatriciaTree_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where++import Data.RDF.Types+import Data.RDF.Graph.TriplesPatriciaTree (TriplesPatriciaTree)+import Data.RDF.GraphTestUtils+import qualified Data.Map as Map+import Control.Monad++import Test.QuickCheck++instance Arbitrary TriplesPatriciaTree where+  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)+  --coarbitrary = undefined++empty' :: TriplesPatriciaTree+empty' = empty++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesPatriciaTree+mkRdf' = mkRdf++triplesOf' :: TriplesPatriciaTree -> Triples+triplesOf' = triplesOf++uniqTriplesOf' :: TriplesPatriciaTree -> Triples+uniqTriplesOf' = uniqTriplesOf

@@ -1,9 +1,5 @@ module Data.RDF.GraphTestUtils where -import Control.Applicative ((<$>))-import Data.ByteString (pack)-import qualified Data.ByteString.Char8 as C-import Data.Knob import Data.RDF.Types import Data.RDF.Query import Data.RDF.Namespace@@ -14,11 +10,12 @@ import qualified Data.Set as Set import qualified Data.Map as Map import Control.Monad+import System.Directory (removeFile) import System.IO.Unsafe(unsafePerformIO) import System.IO -import Test.Framework (Test,TestName,testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Tasty+import Test.Tasty.QuickCheck import Test.QuickCheck.Monadic (assert, monadicIO,run)  ----------------------------------------------------@@ -26,8 +23,8 @@ ----------------------------------------------------  graphTests :: forall rdf. (Arbitrary rdf, RDF rdf, Show rdf)-           => TestName -> (rdf -> Triples) -> (rdf -> Triples) -> rdf -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> [Test]-graphTests testGroupName _triplesOf _uniqTriplesOf _empty _mkRdf = [ testGroup testGroupName+           => TestName -> (rdf -> Triples) -> (rdf -> Triples) -> rdf -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> TestTree+graphTests testGroupName _triplesOf _uniqTriplesOf _empty _mkRdf = testGroup testGroupName             [               testProperty "empty"                      (p_empty _triplesOf _empty)             , testProperty "mkRdf_triplesOf"            (p_mkRdf_triplesOf _triplesOf _mkRdf)@@ -53,7 +50,6 @@             , testProperty "select_match_spo"           (p_select_match_spo _triplesOf)             , testProperty "reversed RDF handle write"  (p_reverseRdfTest _mkRdf)             ]-        ]   instance Arbitrary BaseUrl where@@ -400,12 +396,13 @@  p_reverseRdfTest :: RDF rdf => (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> Property p_reverseRdfTest _mkRdf = monadicIO $ do-    fileContents <- run $ do-      knob <- newKnob (pack [])-      h <- newFileHandle knob "test.rdf" WriteMode-      hWriteRdf NTriplesSerializer h rdfGraph-      hClose h-      C.unpack <$> Data.Knob.getContents knob+    fileContents <- Test.QuickCheck.Monadic.run $ do+      (pathFile,hFile) <- openTempFile "." "tmp."+      hWriteRdf NTriplesSerializer hFile rdfGraph+      hClose hFile+      contents <- readFile pathFile+      removeFile pathFile+      return contents     let expected = "<file:///this/is/not/a/palindrome> <file:///this/is/not/a/palindrome> \"literal string\" .\n"     assert $ expected == fileContents 

@@ -1,25 +0,0 @@-module Data.RDF.MGraph_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where--import Data.RDF.Types-import Data.RDF.MGraph (MGraph)-import Data.RDF.GraphTestUtils-import qualified Data.Map as Map-import Control.Monad--import Test.QuickCheck--instance Arbitrary MGraph where-  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)-  --coarbitrary = undefined--empty' :: MGraph-empty' = empty--mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> MGraph-mkRdf' = mkRdf--triplesOf' :: MGraph -> Triples-triplesOf' = triplesOf--uniqTriplesOf' :: MGraph -> Triples-uniqTriplesOf' = uniqTriplesOf

@@ -1,25 +0,0 @@-module Data.RDF.PatriciaTreeGraph_Test (triplesOf',uniqTriplesOf',empty',mkRdf') where--import Data.RDF.Types-import Data.RDF.PatriciaTreeGraph (PatriciaTreeGraph)-import Data.RDF.GraphTestUtils-import qualified Data.Map as Map-import Control.Monad--import Test.QuickCheck--instance Arbitrary PatriciaTreeGraph where-  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)-  --coarbitrary = undefined--empty' :: PatriciaTreeGraph-empty' = empty--mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> PatriciaTreeGraph-mkRdf' = mkRdf--triplesOf' :: PatriciaTreeGraph -> Triples-triplesOf' = triplesOf--uniqTriplesOf' :: PatriciaTreeGraph -> Triples-uniqTriplesOf' = uniqTriplesOf

@@ -1,25 +0,0 @@-module Data.RDF.TriplesGraph_Test (empty',triplesOf',uniqTriplesOf',mkRdf') where--import Control.Monad-import qualified Data.Map as Map-import Data.RDF.GraphTestUtils-import Data.RDF.Namespace-import Data.RDF.TriplesGraph-import Data.RDF.Types-import Test.QuickCheck.Arbitrary--instance Arbitrary TriplesGraph where-  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)-  --coarbitrary = undefined--empty' :: TriplesGraph-empty' = empty--mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesGraph-mkRdf' = mkRdf--triplesOf' :: TriplesGraph -> Triples-triplesOf' = triplesOf--uniqTriplesOf' :: TriplesGraph -> Triples-uniqTriplesOf' = uniqTriplesOf

@@ -1,40 +1,95 @@ module Main where -import Test.Framework (defaultMain)+import Test.Tasty (defaultMain,testGroup) -import qualified Data.RDF.TriplesGraph_Test as TriplesGraph-import qualified Data.RDF.MGraph_Test as MGraph-import qualified Data.RDF.PatriciaTreeGraph_Test as PatriciaTreeGraph+import qualified Data.RDF.Graph.TriplesList_Test as TriplesList+import qualified Data.RDF.Graph.HashMapS_Test as HashMapS+import qualified Data.RDF.Graph.HashMapSP_Test as HashMapSP+import qualified Data.RDF.Graph.MapSP_Test as MapSP+import qualified Data.RDF.Graph.TriplesPatriciaTree_Test as TriplesPatriciaTree+import           Data.RDF.Types import qualified Text.RDF.RDF4H.XmlParser_Test as XmlParser import qualified Text.RDF.RDF4H.TurtleParser_ConformanceTest as TurtleParser import qualified W3C.TurtleTest as W3CTurtleTest import qualified W3C.RdfXmlTest as W3CRdfXmlTest import qualified W3C.NTripleTest as W3CNTripleTest-import Data.RDF.GraphTestUtils+import           Data.RDF.GraphTestUtils +import qualified Data.Text as T+import System.Directory (getCurrentDirectory)+import W3C.Manifest++suiteFilesDirTurtle,suiteFilesDirXml,suiteFilesDirNTriples :: T.Text+suiteFilesDirTurtle = "rdf-tests/turtle/"+suiteFilesDirXml = "rdf-tests/rdf-xml/"+suiteFilesDirNTriples = "rdf-tests/ntriples/"++mfPathTurtle,mfPathXml,mfPathNTriples :: T.Text+mfPathTurtle = T.concat [suiteFilesDirTurtle, "manifest.ttl"]+mfPathXml = T.concat [suiteFilesDirXml, "manifest.ttl"]+mfPathNTriples = T.concat [suiteFilesDirNTriples, "manifest.ttl"]++mfBaseURITurtle,mfBaseURIXml,mfBaseURINTriples :: BaseUrl+mfBaseURITurtle   = BaseUrl "http://www.w3.org/2013/TurtleTests/"+mfBaseURIXml      = BaseUrl "http://www.w3.org/2013/RDFXMLTests/"+mfBaseURINTriples = BaseUrl "http://www.w3.org/2013/N-TriplesTests/"++ main :: IO ()-main = defaultMain (-                      graphTests "TriplesGraph"-                         TriplesGraph.triplesOf'-                         TriplesGraph.uniqTriplesOf'-                         TriplesGraph.empty'-                         TriplesGraph.mkRdf'+main = do+  -- obtain manifest files for W3C tests before running tests+  -- justification for separation: http://stackoverflow.com/a/33046723+  dir <- getCurrentDirectory+  let fileSchemeUri suitesDir = T.pack ("file://" ++ dir ++ "/" ++ T.unpack suitesDir)+  turtleManifest <-+         loadManifest mfPathTurtle   (fileSchemeUri suiteFilesDirTurtle) -                   ++ graphTests "MGraph"-                         MGraph.triplesOf'-                         MGraph.uniqTriplesOf'-                         MGraph.empty'-                         MGraph.mkRdf'+  xmlManifest <-+         loadManifest mfPathXml      (fileSchemeUri suiteFilesDirXml) -                   ++ graphTests "PatriciaTreeGraph"-                         PatriciaTreeGraph.triplesOf'-                         PatriciaTreeGraph.uniqTriplesOf'-                         PatriciaTreeGraph.empty'-                         PatriciaTreeGraph.mkRdf'+  nTriplesManifest <-+         loadManifest mfPathNTriples (fileSchemeUri suiteFilesDirNTriples) -                   ++ TurtleParser.tests-                   ++ XmlParser.tests-                   ++ W3CTurtleTest.tests-                   ++ W3CRdfXmlTest.tests-                   ++ W3CNTripleTest.tests-                   )+  -- run tests+  defaultMain+       (testGroup "rdf4h tests"+        [ -- RDF graph API tests+          graphTests "TriplesList"+          TriplesList.triplesOf'+          TriplesList.uniqTriplesOf'+          TriplesList.empty'+          TriplesList.mkRdf'++        , graphTests "HashMapS"+          HashMapS.triplesOf'+          HashMapS.uniqTriplesOf'+          HashMapS.empty'+          HashMapS.mkRdf'++        , graphTests "HashMapSP"+          HashMapSP.triplesOf'+          HashMapSP.uniqTriplesOf'+          HashMapSP.empty'+          HashMapSP.mkRdf'++        , graphTests "MapSP"+          MapSP.triplesOf'+          MapSP.uniqTriplesOf'+          MapSP.empty'+          MapSP.mkRdf'++        , graphTests "TriplesPatriciaTree"+          TriplesPatriciaTree.triplesOf'+          TriplesPatriciaTree.uniqTriplesOf'+          TriplesPatriciaTree.empty'+          TriplesPatriciaTree.mkRdf'++          -- rdf4h unit tests+        , TurtleParser.tests+        , XmlParser.tests++          -- W3C tests+        , W3CTurtleTest.tests   turtleManifest+        , W3CRdfXmlTest.tests   xmlManifest+        , W3CNTripleTest.tests  nTriplesManifest+        ])

@@ -1,23 +1,22 @@ module Text.RDF.RDF4H.TurtleParser_ConformanceTest where  -- Testing imports-import Test.Framework.Providers.API-import Test.Framework.Providers.HUnit-import qualified Test.HUnit as TU+import Test.Tasty+import Test.Tasty.HUnit as TU  -- Import common libraries to facilitate tests import Control.Monad (liftM) import Data.RDF.GraphTestUtils import Data.RDF.Query-import Data.RDF.TriplesGraph+import Data.RDF.Graph.TriplesList import Data.RDF.Types import qualified Data.Text as T import qualified Data.Text.IO as TIO import Text.Printf import Text.RDF.RDF4H.TurtleParser -tests :: [Test]-tests = [ testGroup "TurtleParser" allCTests ]+tests :: TestTree+tests = testGroup "TurtleParser" allCTests  -- A list of other tests to run, each entry of which is (directory, fname_without_ext). otherTestFiles :: [(String, String)]@@ -41,40 +40,38 @@ fpath :: String -> Int -> String -> String fpath name i ext = printf "data/ttl/conformance/%s-%02d.%s" name i ext :: String -allCTests :: [Test]+allCTests :: [TestTree] allCTests = ts1 ++ ts2 ++ ts3    where-        ts1 = map (buildTest . checkGoodConformanceTest) [0..30]-        ts2 = map (buildTest . checkBadConformanceTest) [0..14]-        ts3 = map (buildTest . uncurry checkGoodOtherTest) otherTestFiles+        ts1 = map (checkGoodConformanceTest) [0..30]+        ts2 = map (checkBadConformanceTest) [0..14]+        ts3 = map (uncurry checkGoodOtherTest) otherTestFiles -checkGoodConformanceTest :: Int -> IO Test+checkGoodConformanceTest :: Int -> TestTree checkGoodConformanceTest i =-  do-    expGr <- loadExpectedGraph "test" i-    inGr  <- loadInputGraph    "test" i-    doGoodConformanceTest expGr inGr (printf "test %d" i :: String)+  let expGr = loadExpectedGraph "test" i+      inGr  = loadInputGraph    "test" i+  in doGoodConformanceTest expGr inGr (printf "test %d" i :: String) -checkGoodOtherTest :: String -> String -> IO Test+checkGoodOtherTest :: String -> String -> TestTree checkGoodOtherTest dir fname =-  do -    expGr <- loadExpectedGraph1 (printf "%s/%s.out" dir fname :: String)-    inGr  <- loadInputGraph1 dir fname-    doGoodConformanceTest expGr inGr $ printf "test using file \"%s\"" fname+    let expGr = loadExpectedGraph1 (printf "%s/%s.out" dir fname :: String)+        inGr  = loadInputGraph1 dir fname+    in doGoodConformanceTest expGr inGr $ printf "test using file \"%s\"" fname -doGoodConformanceTest   :: Either ParseFailure TriplesGraph -> -                           Either ParseFailure TriplesGraph -> -                           String -> IO Test-doGoodConformanceTest expGr inGr testname = do+doGoodConformanceTest   :: IO (Either ParseFailure TriplesList) -> +                           IO (Either ParseFailure TriplesList) -> +                           String -> TestTree+doGoodConformanceTest expGr inGr testname =     let t1 = assertLoadSuccess (printf "expected (%s): " testname) expGr         t2 = assertLoadSuccess (printf "   input (%s): " testname) inGr         t3 = assertEquivalent testname expGr inGr-    return $ testGroup (printf "Conformance %s" testname) $ map (uncurry testCase) [("Loading expected graph data", t1), ("Loading input graph data", t2), ("Comparing graphs", t3)]+    in testGroup (printf "Conformance %s" testname) $ map (uncurry testCase) [("Loading expected graph data", t1), ("Loading input graph data", t2), ("Comparing graphs", t3)] -checkBadConformanceTest :: Int -> IO Test-checkBadConformanceTest i = do-  let t = loadInputGraph "bad" i >>= assertLoadFailure (show i)-  return $ testCase (printf "Loading test %d (negative)" i) t+checkBadConformanceTest :: Int -> TestTree+checkBadConformanceTest i =+  let t = assertLoadFailure (show i) (loadInputGraph "bad" i)+  in testCase (printf "Loading test %d (negative)" i) t  -- Determines if graphs are equivalent, returning Nothing if so or else a diagnostic message. -- First graph is expected graph, second graph is actual.@@ -104,17 +101,17 @@  -- Returns a graph for a good ttl test that is intended to pass, and normalizes -- triples into a format so that they can be compared with the expected output triples.-loadInputGraph :: String -> Int -> IO (Either ParseFailure TriplesGraph)+loadInputGraph :: String -> Int -> IO (Either ParseFailure TriplesList) loadInputGraph name n =   TIO.readFile (fpath name n "ttl") >>=   return . parseString (TurtleParser mtestBaseUri (mkDocUrl testBaseUri name n)) >>= return . handleLoad -loadInputGraph1 :: String -> String -> IO (Either ParseFailure TriplesGraph)+loadInputGraph1 :: String -> String -> IO (Either ParseFailure TriplesList) loadInputGraph1 dir fname =   TIO.readFile (printf "%s/%s.ttl" dir fname :: String) >>=   return . parseString (TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname)) >>= return . handleLoad -handleLoad :: Either ParseFailure TriplesGraph -> Either ParseFailure TriplesGraph+handleLoad :: Either ParseFailure TriplesList -> Either ParseFailure TriplesList handleLoad res =   case res of     l@(Left _)  -> l@@ -129,24 +126,32 @@ normalizeN (BNodeGen i) = BNode (T.pack $ "_:genid" ++ show i) normalizeN n            = n -loadExpectedGraph :: String -> Int -> IO (Either ParseFailure TriplesGraph)+loadExpectedGraph :: String -> Int -> IO (Either ParseFailure TriplesList) loadExpectedGraph name n = loadExpectedGraph1 (fpath name n "out")-loadExpectedGraph1 :: String -> IO (Either ParseFailure TriplesGraph)+loadExpectedGraph1 :: String -> IO (Either ParseFailure TriplesList) loadExpectedGraph1 fname =   liftM (parseString (TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname))) (TIO.readFile fname) -assertLoadSuccess, assertLoadFailure :: String -> Either ParseFailure TriplesGraph -> TU.Assertion-assertLoadSuccess idStr (Left (ParseFailure err)) = TU.assertFailure $ idStr  ++ err-assertLoadSuccess _     (Right _) = return ()-assertLoadFailure _     (Left _)  = return ()-assertLoadFailure idStr _         = TU.assertFailure $ "Bad test " ++ idStr ++ " loaded successfully."+assertLoadSuccess, assertLoadFailure :: String -> IO (Either ParseFailure TriplesList) -> TU.Assertion+assertLoadSuccess idStr exprGr = do+  g <- exprGr+  case g of+    Left (ParseFailure err) -> TU.assertFailure $ idStr  ++ err+    Right _ -> return () -assertEquivalent :: RDF rdf => String -> Either ParseFailure rdf -> Either ParseFailure rdf -> TU.Assertion-assertEquivalent testname r1 r2 =-  case equiv of+assertLoadFailure idStr exprGr = do+  g <- exprGr+  case g of+    Left _ -> return ()+    Right _ -> TU.assertFailure $ "Bad test " ++ idStr ++ " loaded successfully."++assertEquivalent :: RDF rdf => String -> IO (Either ParseFailure rdf) -> IO (Either ParseFailure rdf) -> TU.Assertion+assertEquivalent testname r1 r2 = do+  gr1 <- r1+  gr2 <- r2+  case equivalent gr1 gr2 of     Nothing    -> TU.assert True     (Just msg) -> fail $ "Graph " ++ testname ++ " not equivalent to expected:\n" ++ msg-  where equiv = equivalent r1 r2  mkDocUrl :: String -> String -> Int -> Maybe T.Text mkDocUrl baseDocUrl fname testNum = Just $ T.pack $ printf "%s%s-%02d.ttl" baseDocUrl fname testNum

@@ -3,55 +3,52 @@ -- todo: QuickCheck tests  -- Testing imports-import Test.Framework (Test,testGroup)-import Test.Framework.Providers.HUnit-import Test.HUnit (Assertion,assertBool,assertFailure)+import Test.Tasty+import Test.Tasty.HUnit  -- Import common libraries to facilitate tests import qualified Data.Map as Map import Data.RDF.Query-import Data.RDF.TriplesGraph (TriplesGraph)+import Data.RDF.Graph.TriplesList (TriplesList) import Data.RDF.Types import qualified Data.Text as T (Text, unlines) import Text.RDF.RDF4H.XmlParser  -tests :: [Test]-tests = [ testGroup "XmlParser:parseXmlRDF" [ testCase "simpleStriping1" test_simpleStriping1-                                            , testCase "simpleStriping2" test_simpleStriping2-                                            , testCase "simpleSingleton1" test_simpleSingleton1-                                            , testCase "simpleSingleton2" test_simpleSingleton2-                                            , testCase "example07" test_parseXmlRDF_example07-                                            , testCase "example08" test_parseXmlRDF_example08-                                            , testCase "example09" test_parseXmlRDF_example09-                                            , testCase "example10" test_parseXmlRDF_example10-                                            , testCase "example11" test_parseXmlRDF_example11-                                            , testCase "example12" test_parseXmlRDF_example12-                                            , testCase "example13" test_parseXmlRDF_example13-                                            , testCase "example14" test_parseXmlRDF_example14-                                            , testCase "example15" test_parseXmlRDF_example15-                                            , testCase "example16" test_parseXmlRDF_example16-                                            , testCase "example17" test_parseXmlRDF_example17-                                            , testCase "example18" test_parseXmlRDF_example18-                                            , testCase "example19" test_parseXmlRDF_example19-                                            , testCase "example20" test_parseXmlRDF_example20-                                            , testCase "vCardPersonal" test_parseXmlRDF_vCardPersonal-                                            , testCase "NML" test_parseXmlRDF_NML-                                            , testCase "NML2" test_parseXmlRDF_NML2-                                            , testCase "NML3" test_parseXmlRDF_NML3-                                            ]-        ]-+tests :: TestTree+tests = testGroup "XmlParser:parseXmlRDF" [ testCase "simpleStriping1" test_simpleStriping1+                                          , testCase "simpleStriping2" test_simpleStriping2+                                          , testCase "simpleSingleton1" test_simpleSingleton1+                                          , testCase "simpleSingleton2" test_simpleSingleton2+                                          , testCase "example07" test_parseXmlRDF_example07+                                          , testCase "example08" test_parseXmlRDF_example08+                                          , testCase "example09" test_parseXmlRDF_example09+                                          , testCase "example10" test_parseXmlRDF_example10+                                          , testCase "example11" test_parseXmlRDF_example11+                                          , testCase "example12" test_parseXmlRDF_example12+                                          , testCase "example13" test_parseXmlRDF_example13+                                          , testCase "example14" test_parseXmlRDF_example14+                                          , testCase "example15" test_parseXmlRDF_example15+                                          , testCase "example16" test_parseXmlRDF_example16+                                          , testCase "example17" test_parseXmlRDF_example17+                                          , testCase "example18" test_parseXmlRDF_example18+                                          , testCase "example19" test_parseXmlRDF_example19+                                          , testCase "example20" test_parseXmlRDF_example20+                                          , testCase "vCardPersonal" test_parseXmlRDF_vCardPersonal+                                          , testCase "NML" test_parseXmlRDF_NML+                                          , testCase "NML2" test_parseXmlRDF_NML2+                                          , testCase "NML3" test_parseXmlRDF_NML3+                                          ]  mkTextNode :: T.Text -> Node mkTextNode = lnode . plainL -testParse :: T.Text -> TriplesGraph -> Assertion+testParse :: T.Text -> TriplesList -> Assertion testParse exRDF ex =     case parsed of       Right result ->           assertBool             ("expected: " ++ show ex ++ "but got: " ++ show result)-            (isIsomorphic (result :: TriplesGraph) (ex :: TriplesGraph))+            (isIsomorphic (result :: TriplesList) (ex :: TriplesList))       Left (ParseFailure err) ->           assertFailure err   where parsed = parseString (XmlParser Nothing Nothing) exRDF

@@ -5,7 +5,7 @@   TestEntry(..) ) where -import Data.RDF.TriplesGraph+import Data.RDF.Graph.TriplesList import Data.RDF.Query import Data.RDF.Types import Data.RDF.Namespace@@ -100,10 +100,14 @@     deriving (Show)  -- TODO: Perhaps these should be pulled from the manifest graph+rdfType,rdfsComment,rdfsLabel,rdftApproval,rdfsApproval,mfName,mfManifest,mfAction,+  mfResult,mfEntries,mfEntailmentRegime,mfRecognizedDatatypes,mfUnrecognizedDatatypes :: Node+ rdfType = unode $ mkUri rdf "type" rdfsComment = unode $ mkUri rdfs "comment"-rdftTestTurtleEval = unode "http://www.w3.org/ns/rdftest#TestTurtleEval"-rdftTestTurtleNegativeEval = unode "http://www.w3.org/ns/rdftest#TestTurtleNegativeEval"+rdfsLabel = unode $ mkUri rdfs "label"+-- rdftTestTurtleEval = unode "http://www.w3.org/ns/rdftest#TestTurtleEval"+-- rdftTestTurtleNegativeEval = unode "http://www.w3.org/ns/rdftest#TestTurtleNegativeEval" rdftApproval = unode "http://www.w3.org/ns/rdftest#approval" rdfsApproval = unode $ mkUri rdfs "approval" -- FIXME: incorrect namespace "rdfs:approval" in rdf-mt/manifest.ttl, must be "rdft:approval" mfName = unode "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#name"@@ -122,21 +126,21 @@   parseFile testParser (T.unpack manifestPath) >>= return . rdfToManifest . fromEither   where testParser = TurtleParser (Just $ BaseUrl baseIRI) Nothing -rdfToManifest :: TriplesGraph -> Manifest+rdfToManifest :: TriplesList -> Manifest rdfToManifest rdf = Manifest desc tpls   where desc = lnodeText $ objectOf $ headDef (error ("query empty: subject mf:node & predicate mf:name in:\n\n" ++ show (triplesOf rdf))) descNode         -- FIXME: Inconsistent use of nodes for describing the manifest (W3C bug)-        descNode = query rdf (Just manifestNode) (Just rdfsComment) Nothing+        descNode = query rdf (Just manifestNode) (Just rdfsLabel) Nothing                    ++ query rdf (Just manifestNode) (Just mfName) Nothing --        descNode = query rdf (Just manifestNode) (Just mfName) Nothing         tpls = map (rdfToTestEntry rdf) $ rdfCollectionToList rdf collectionHead         collectionHead = objectOf $ headDef (error "query: mf:node & mf:entries") $ query rdf (Just manifestNode) (Just mfEntries) Nothing         manifestNode = headDef (error "manifestSubjectNodes yielding empty list") $ manifestSubjectNodes rdf -rdfToTestEntry :: TriplesGraph -> Node -> TestEntry+rdfToTestEntry :: TriplesList -> Node -> TestEntry rdfToTestEntry rdf teSubject = triplesToTestEntry rdf $ query rdf (Just teSubject) Nothing Nothing -triplesToTestEntry :: TriplesGraph -> Triples -> TestEntry+triplesToTestEntry :: TriplesList -> Triples -> TestEntry triplesToTestEntry rdf ts =   case objectByPredicate rdfType ts of     (UNode "http://www.w3.org/ns/rdftest#TestTurtleEval") -> mkTestTurtleEval ts@@ -184,7 +188,7 @@                                   action = objectByPredicate mfAction ts                                 } -mkPositiveEntailmentTest :: Triples -> TriplesGraph -> TestEntry+mkPositiveEntailmentTest :: Triples -> TriplesList -> TestEntry mkPositiveEntailmentTest ts rdf = PositiveEntailmentTest {                                     name = lnodeText $ objectByPredicate mfName ts,                                     comment = lnodeText $ objectByPredicate rdfsComment ts,@@ -202,7 +206,7 @@           uDT = rdfCollectionToList rdf uDTCollectionHead           uDTCollectionHead = objectByPredicate mfUnrecognizedDatatypes ts -mkNegativeEntailmentTest :: Triples -> TriplesGraph -> TestEntry+mkNegativeEntailmentTest :: Triples -> TriplesList -> TestEntry mkNegativeEntailmentTest ts rdf = NegativeEntailmentTest {                                     name = lnodeText $ objectByPredicate mfName ts,                                     comment = lnodeText $ objectByPredicate rdfsComment ts,@@ -250,7 +254,7 @@                                   }  mkTestNTriplesNegativeSyntax :: Triples -> TestEntry-mkTestNTriplesNegativeSyntax ts = TestNTriplesPositiveSyntax {+mkTestNTriplesNegativeSyntax ts = TestNTriplesNegativeSyntax {                                     name = lnodeText $ objectByPredicate mfName ts,                                     comment = lnodeText $ objectByPredicate rdfsComment ts,                                     approval = objectByPredicate rdftApproval ts,@@ -262,10 +266,10 @@ objectByPredicate :: Predicate -> Triples -> Object objectByPredicate p = objectOf . fromJust . L.find (\t -> predicateOf t == p) -manifestSubjectNodes :: TriplesGraph -> [Subject]+manifestSubjectNodes :: TriplesList -> [Subject] manifestSubjectNodes rdf = subjectNodes rdf [mfManifest] -subjectNodes :: TriplesGraph -> [Object] -> [Subject]+subjectNodes :: TriplesList -> [Object] -> [Subject] subjectNodes rdf = (map subjectOf) . concatMap queryType   where queryType n = query rdf Nothing (Just rdfType) (Just n) @@ -290,15 +294,15 @@ -- | second argument (`tip`) is the "collection head" (<c1> in the example above), -- | (all triples with <rdf:first> and <rdf:rest> pairs). -- TODO: Looks useful. Move it to RDF4H lib?-rdfCollectionToList :: TriplesGraph -> Node -> [Node]+rdfCollectionToList :: TriplesList -> Node -> [Node] rdfCollectionToList _ (UNode("http://www.w3.org/1999/02/22-rdf-syntax-ns#nil")) = [] rdfCollectionToList rdf tip = concatMap (tripleToList rdf) $ nextCollectionTriples rdf tip -tripleToList :: TriplesGraph -> Triple -> [Node]+tripleToList :: TriplesList -> Triple -> [Node] tripleToList _ (Triple _ (UNode("http://www.w3.org/1999/02/22-rdf-syntax-ns#first")) n@(UNode _)) = [n] tripleToList rdf (Triple _ (UNode("http://www.w3.org/1999/02/22-rdf-syntax-ns#rest")) tip) = rdfCollectionToList rdf tip tripleToList _ _ = error "Invalid collection format" -nextCollectionTriples :: TriplesGraph -> Node -> Triples+nextCollectionTriples :: TriplesList -> Node -> Triples nextCollectionTriples rdf tip@(BNodeGen _) = query rdf (Just tip) Nothing Nothing nextCollectionTriples _ _ = error "Invalid collection format"

@@ -1,58 +1,35 @@ module W3C.NTripleTest where  import Data.Maybe (fromJust)-import Test.Framework.Providers.API-import Test.Framework.Providers.HUnit-import qualified Test.HUnit as TU+import Test.Tasty+import qualified Test.Tasty.HUnit as TU import qualified Data.Text as T-import System.Directory  import W3C.Manifest+import W3C.W3CAssertions  import Data.RDF.Types import Text.RDF.RDF4H.NTriplesParser-import Data.RDF.TriplesGraph--suiteFilesDir = "data/w3c/n3/"--mfPath = T.concat [suiteFilesDir, "manifest.ttl"]-mfBaseURI = BaseUrl "http://www.w3.org/2013/N-TriplesTests/"--tests :: [Test]-tests = [ buildTest allNTripleTests ]+import Data.RDF.Graph.TriplesList -allNTripleTests :: IO Test-allNTripleTests = do-  dir <- getCurrentDirectory-  let fileSchemeURI = T.pack ("file://" ++ dir ++ "/" ++ T.unpack suiteFilesDir)-  m <- loadManifest mfPath fileSchemeURI-  return $ testGroup (T.unpack $ description m) $ map (buildTest . mfEntryToTest) $ entries m+tests :: Manifest -> TestTree+tests = runManifestTests mfEntryToTest  -- Functions to map manifest test entries to unit tests. -- They are defined here to avoid cluttering W3C.Manifest -- with functions that may not be needed to those who -- just want to parse Manifest files. -- TODO: They should probably be moved to W3C.Manifest after all.-mfEntryToTest :: TestEntry -> IO Test-mfEntryToTest (TestNTriplesPositiveSyntax nm _ _ act') = do+mfEntryToTest :: TestEntry -> TestTree+mfEntryToTest (TestNTriplesPositiveSyntax nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-  rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph)-  return $ testCase (T.unpack nm) $ TU.assert $ isParsed rdf-mfEntryToTest (TestNTriplesNegativeSyntax nm _ _ act') = do+      rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList)+  in TU.testCase (T.unpack nm) $ assertIsParsed rdf+mfEntryToTest (TestNTriplesNegativeSyntax nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-  rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph)-  return $ testCase (T.unpack nm) $ TU.assert $ isNotParsed rdf+      rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList)+  in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x--isParsed :: Either a b -> Bool-isParsed (Left _) = False-isParsed (Right _) = True--isNotParsed :: Either a b -> Bool-isNotParsed = not . isParsed--nodeURI :: Node -> String-nodeURI = \(UNode u) -> T.unpack u  testParser :: NTriplesParser testParser = NTriplesParser

@@ -1,62 +1,42 @@ module W3C.RdfXmlTest where  import Data.Maybe (fromJust)-import Test.Framework.Providers.API-import Test.Framework.Providers.HUnit-import qualified Test.HUnit as TU+import Test.Tasty+import qualified Test.Tasty.HUnit as TU import qualified Data.Text as T-import System.Directory  import W3C.Manifest+import W3C.W3CAssertions  import Data.RDF.Types import Data.RDF.Query import Text.RDF.RDF4H.XmlParser import Text.RDF.RDF4H.NTriplesParser-import Data.RDF.TriplesGraph--suiteFilesDir = "data/w3c/rdf-xml/"--mfPath = T.concat [suiteFilesDir, "manifest.ttl"]-mfBaseURI = BaseUrl "http://www.w3.org/2013/RDFXMLTests/"--tests :: [Test]-tests = [ buildTest allRdfXmlTests ]+import Data.RDF.Graph.TriplesList -allRdfXmlTests :: IO Test-allRdfXmlTests = do-  dir <- getCurrentDirectory-  let fileSchemeURI = T.pack ("file://" ++ dir ++ "/" ++ T.unpack suiteFilesDir)-  m <- loadManifest mfPath fileSchemeURI-  return $ testGroup (T.unpack $ description m) $ map (buildTest . mfEntryToTest) $ entries m+tests :: Manifest -> TestTree+tests = runManifestTests mfEntryToTest  -- Functions to map manifest test entries to unit tests. -- They are defined here to avoid cluttering W3C.Manifest -- with functions that may not be needed to those who -- just want to parse Manifest files. -- TODO: They should probably be moved to W3C.Manifest after all.-mfEntryToTest :: TestEntry -> IO Test-mfEntryToTest (TestXMLEval nm _ _ act' res') = do+mfEntryToTest :: TestEntry -> TestTree+mfEntryToTest (TestXMLEval nm _ _ act' res') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-  let res = (UNode . fromJust . fileSchemeToFilePath) res'-  parsedRDF <- parseFile testParser (nodeURI act) >>= return . fromEither :: IO TriplesGraph-  expectedRDF <- parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO TriplesGraph-  return $ testCase (T.unpack nm) $ TU.assert $ isIsomorphic parsedRDF expectedRDF-mfEntryToTest (TestXMLNegativeSyntax nm _ _ act') = do+      res = (UNode . fromJust . fileSchemeToFilePath) res'+      parsedRDF = parseFile testParser (nodeURI act) >>= return . fromEither :: IO TriplesList+      expectedRDF = parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO TriplesList+  in TU.testCase (T.unpack nm) $ assertIsIsomorphic parsedRDF expectedRDF+mfEntryToTest (TestXMLNegativeSyntax nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-  rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph)-  return $ testCase (T.unpack nm) $ TU.assert $ isNotParsed rdf+      rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList)+  in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x -isParsed :: Either a b -> Bool-isParsed (Left _) = False-isParsed (Right _) = True--isNotParsed :: Either a b -> Bool-isNotParsed = not . isParsed--nodeURI :: Node -> String-nodeURI = \(UNode u) -> T.unpack u+mfBaseURIXml :: BaseUrl+mfBaseURIXml = BaseUrl "http://www.w3.org/2013/RDFXMLTests/"  testParser :: XmlParser-testParser = XmlParser (Just mfBaseURI) Nothing+testParser = XmlParser (Just mfBaseURIXml) Nothing

@@ -1,73 +1,46 @@ module W3C.TurtleTest where -import Test.Framework.Providers.API-import Test.Framework.Providers.HUnit-import qualified Test.HUnit as TU+import Test.Tasty+import qualified Test.Tasty.HUnit as TU+ import Data.Maybe (fromJust) import qualified Data.Text as T-import Network.URI (parseURI,uriPath)-import System.Directory (getCurrentDirectory)  import W3C.Manifest+import W3C.W3CAssertions  import Data.RDF.Types import Data.RDF.Query import Text.RDF.RDF4H.TurtleParser import Text.RDF.RDF4H.NTriplesParser-import Data.RDF.TriplesGraph--suiteFilesDir :: T.Text-suiteFilesDir = "data/w3c/turtle/TurtleTests/"--mfPath = T.concat [suiteFilesDir, "manifest.ttl"]-mfBaseURI = BaseUrl "http://www.w3.org/2013/TurtleTests/"--tests :: [Test]-tests = [ buildTest allTurtleTests ]--allTurtleTests :: IO Test-allTurtleTests = do-  dir <- getCurrentDirectory-  let fileSchemeURI = T.pack ("file://" ++ dir ++ "/" ++ T.unpack suiteFilesDir)-  m <- loadManifest mfPath fileSchemeURI-  return $ testGroup (T.unpack $ description m) $ map (buildTest . mfEntryToTest) $ entries m+import Data.RDF.Graph.TriplesList +tests :: Manifest -> TestTree+tests = runManifestTests mfEntryToTest --- Functions to map manifest test entries to unit tests.--- They are defined here to avoid cluttering W3C.Manifest--- with functions that may not be needed to those who--- just want to parse Manifest files.--- TODO: They should probably be moved to W3C.Manifest after all.-mfEntryToTest :: TestEntry -> IO Test-mfEntryToTest (TestTurtleEval nm _ _ act' res') = do+mfEntryToTest :: TestEntry -> TestTree+mfEntryToTest (TestTurtleEval nm _ _ act' res') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-  let res = (UNode . fromJust . fileSchemeToFilePath) res'-  parsedRDF <- parseFile testParser (nodeURI act) >>= return . fromEither :: IO TriplesGraph-  expectedRDF <- parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO TriplesGraph-  return $ testCase (T.unpack nm) $ TU.assert $ isIsomorphic parsedRDF expectedRDF-mfEntryToTest (TestTurtleNegativeEval nm _ _ act') = do+      res = (UNode . fromJust . fileSchemeToFilePath) res'+      parsedRDF   = parseFile testParser (nodeURI act) >>= return . fromEither :: IO TriplesList+      expectedRDF = parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO TriplesList+  in TU.testCase (T.unpack nm) $ assertIsIsomorphic parsedRDF expectedRDF+mfEntryToTest (TestTurtleNegativeEval nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-  rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph)-  return $ testCase (T.unpack nm) $ TU.assert $ isNotParsed rdf-mfEntryToTest (TestTurtlePositiveSyntax nm _ _ act') = do+      rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList)+  in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf+mfEntryToTest (TestTurtlePositiveSyntax nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-  rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph)-  return $ testCase (T.unpack nm) $ TU.assert $ isParsed rdf-mfEntryToTest (TestTurtleNegativeSyntax nm _ _ act') = do+      rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList)+  in TU.testCase (T.unpack nm) $ assertIsParsed rdf+mfEntryToTest (TestTurtleNegativeSyntax nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-  rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph)-  return $ testCase (T.unpack nm) $ TU.assert $ isNotParsed rdf+      rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesList)+  in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x -isParsed :: Either a b -> Bool-isParsed (Left _) = False-isParsed (Right _) = True--isNotParsed :: Either a b -> Bool-isNotParsed = not . isParsed--nodeURI :: Node -> String-nodeURI = \(UNode u) -> T.unpack u+mfBaseURITurtle :: BaseUrl+mfBaseURITurtle   = BaseUrl "http://www.w3.org/2013/TurtleTests/"  testParser :: TurtleParser-testParser = TurtleParser (Just mfBaseURI) Nothing+testParser = TurtleParser (Just mfBaseURITurtle) Nothing

@@ -0,0 +1,54 @@+module W3C.W3CAssertions where++import qualified Data.Text as T+import           Data.RDF+import qualified Test.HUnit as TU+import           Test.Tasty+import           W3C.Manifest++runManifestTests :: (TestEntry -> TestTree) -> Manifest -> TestTree+runManifestTests mfEntryToTest manifest =+    testGroup (T.unpack $ description manifest) $ map mfEntryToTest $ entries manifest++assertIsIsomorphic :: forall rdf1 rdf2.+                      (Show rdf1, Show rdf2, RDF rdf1, RDF rdf2) =>+                      IO rdf1 -> IO rdf2 -> IO ()+assertIsIsomorphic r1 r2 = do+  gr1 <- r1+  gr2 <- r2+  TU.assertBool ("not isomorphic: " ++ show gr1 ++ " compared with " ++ show gr2) (isSame gr1 gr2) -- (isGraphIsomorphic gr1 gr2)++      where+        noBlankNodes g = (all noBlanks . expandTriples) g+        noBlanks (Triple s p o) = not (blankNode s)+                               && not (blankNode p)+                               && not (blankNode o)+        blankNode (BNode _)    = True+        blankNode (BNodeGen _) = True+        blankNode _            = False+        isSame g1 g2 =+            if (noBlankNodes g1) && (noBlankNodes g2)+            -- can compare URIs and literals as well as structure+            then isIsomorphic g1 g2+            -- cannot compare blank nodes with generated blank nodes,+            -- so instead just compare the RDF graph structure of the+            -- mf:action parsed RDF with the expected mf:result structure.+            else isGraphIsomorphic g1 g2++assertIsParsed :: (Show rdf, RDF rdf) => IO (Either ParseFailure rdf) -> TU.Assertion+assertIsParsed r1 = do+  gr1 <- r1+  TU.assertBool ("unable to parse, reason:\n" ++ show gr1) (isParsed gr1)++assertIsNotParsed :: (Show rdf, RDF rdf) => IO (Either ParseFailure rdf) -> TU.Assertion+assertIsNotParsed r1 = do+  gr1 <- r1+  TU.assertBool ("parsed unexpectantly:\n" ++ show gr1) (not (isParsed gr1))++isParsed :: Either a b -> Bool+isParsed (Left _) = False+isParsed (Right _) = True++nodeURI :: Node -> String+nodeURI (UNode u) = T.unpack u+nodeURI node = error $ "W3CAssertions: unexpected node in `nodeURI`: " ++ show node