rdf4h 1.3.0 → 1.3.1

raw patch · 14 files changed

+768/−96 lines, 14 filesdep +binarydep +criteriondep +deepseqdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: binary, criterion, deepseq, fgl, rdf4h, text-binary

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• bench/MainCriterion.hs +92/−0
• rdf4h.cabal +26/−4
• src/Data/RDF.hs +2/−0
• src/Data/RDF/MGraph.hs +3/−1
• src/Data/RDF/Namespace.hs +1/−1
• src/Data/RDF/PatriciaTreeGraph.hs +274/−0
• src/Data/RDF/Query.hs +4/−2
• src/Data/RDF/TriplesGraph.hs +8/−0
• src/Data/RDF/Types.hs +69/−4
• src/Text/RDF/RDF4H/NTriplesParser.hs +0/−7
• src/Text/RDF/RDF4H/ParserUtils.hs +1/−0
• src/Text/RDF/RDF4H/TurtleParser.hs +201/−75
• testsuite/tests/Test.hs +26/−2
• testsuite/tests/W3C/TurtleTest.hs +61/−0

@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings, LambdaCase #-}++module Main where++import Criterion+import Criterion.Main+import Data.RDF+import qualified Data.Text as T++-- The `countries.ttl` Turtle file is needed to run this benchmark suite+--+-- $ wget http://telegraphis.net/data/countries/countries.ttl++parseTurtle :: RDF rdf => String -> rdf+parseTurtle s =+    let (Right rdf) = parseString (TurtleParser Nothing Nothing) (T.pack s)+    in rdf++queryGr :: RDF rdf => (Maybe Node,Maybe Node,Maybe Node,rdf) -> [Triple]+queryGr (maybeS,maybeP,maybeO,rdf) = query rdf maybeS maybeP maybeO++selectGr :: RDF rdf => (NodeSelector,NodeSelector,NodeSelector,rdf) -> [Triple]+selectGr (selectorS,selectorP,selectorO,rdf) = select rdf selectorS selectorP selectorO++main :: IO ()+main = defaultMain [+   env (readFile "countries.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+   ]++   ,+   env (do ttl_countries <- readFile "countries.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) ->+   bgroup "query" [+     bench "TriplesGraph" $+       nf (queryGr  :: (Maybe Node,Maybe Node,Maybe Node,TriplesGraph) -> [Triple])+              (Just (UNode "http://telegraphis.net/data/countries/AF#AF"),+               Just (UNode "geographis:capital"),+               Just (UNode "http://telegraphis.net/data/capitals/AF/Kabul#Kabul"),+               triplesGraph)+   , bench "MGraph" $+       nf (queryGr  :: (Maybe Node,Maybe Node,Maybe Node,MGraph) -> [Triple])+              (Just (UNode "http://telegraphis.net/data/countries/AF#AF"),+               Just (UNode "geographis:capital"),+               Just (UNode "http://telegraphis.net/data/capitals/AF/Kabul#Kabul"),+               mGraph)+   , bench "PatriciaTreeGraph" $+       nf (queryGr  :: (Maybe Node,Maybe Node,Maybe Node,PatriciaTreeGraph) -> [Triple])+              (Just (UNode "http://telegraphis.net/data/countries/AF#AF"),+               Just (UNode "geographis:capital"),+               Just (UNode "http://telegraphis.net/data/capitals/AF/Kabul#Kabul"),+               patriciaTreeCountries)+   ]++   ,+   env (do ttl_countries <- readFile "countries.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) ->+   bgroup "select" [+     bench "TriplesGraph" $+       nf (selectGr  :: (NodeSelector,NodeSelector,NodeSelector,TriplesGraph) -> [Triple])+              (Just (\case { (UNode n) -> T.length n > 12 ; _ -> False } ),+               Just (\case { (UNode n) -> T.length n > 12 ; _ -> False } ),+               Just (\case { (UNode n) -> T.length n > 12 ; _ -> False } ),+               triplesGraph)+   , bench "MGraph" $+       nf (selectGr  :: (NodeSelector,NodeSelector,NodeSelector,MGraph) -> [Triple])+              (Just (\case { (UNode n) -> T.length n > 12 ; _ -> False } ),+               Just (\case { (UNode n) -> T.length n > 12 ; _ -> False } ),+               Just (\case { (UNode n) -> T.length n > 12 ; _ -> False } ),+               mGraph)+   , bench "PatriciaTreeGraph" $+       nf (selectGr  :: (NodeSelector,NodeSelector,NodeSelector,PatriciaTreeGraph) -> [Triple])+              (Just (\case { (UNode n) -> T.length n > 12 ; _ -> False } ),+               Just (\case { (UNode n) -> T.length n > 12 ; _ -> False } ),+               Just (\case { (UNode n) -> T.length n > 12 ; _ -> False } ),+               patriciaTreeCountries)+   ]+ ]

@@ -1,5 +1,5 @@ name:            rdf4h-version:         1.3.0+version:         1.3.1 synopsis:        A library for RDF processing in Haskell description:        'RDF for Haskell' is a library for working with RDF in Haskell.@@ -10,7 +10,7 @@  author:          Calvin Smith, Rob Stewart, Slava Kravchenko copyright:       (c) Calvin Smith, Rob Stewart, Slava Kravchenko-maintainer:      Rob Stewart <robstewart@gmail.com>+maintainer:      Rob Stewart <robstewart@gmail.com>, Slava Kravchenko homepage:        https://github.com/robstewart57/rdf4h bug-reports:     https://github.com/robstewart57/rdf4h/issues license:         BSD3@@ -19,7 +19,7 @@ build-type:      Simple category:        RDF stability:       Experimental-tested-with:     GHC==7.6.3+tested-with:     GHC==7.6.3, GHC==7.8.3 extra-tmp-files: test extra-source-files: examples/ParseURLs.hs @@ -45,6 +45,7 @@                  , Data.RDF.Types                  , Data.RDF.Query                  , Data.RDF.MGraph+                 , Data.RDF.PatriciaTreeGraph                  , Data.RDF.TriplesGraph                  , Text.RDF.RDF4H.TurtleParser                  , Text.RDF.RDF4H.TurtleSerializer@@ -56,12 +57,15 @@   else     build-depends: base < 3   build-depends:   parsec >= 3+                 , fgl                  , HTTP >= 4000.0.0                  , hxt >= 9.3.1.2                  , text                  , unordered-containers                  , hashable-+                 , deepseq+                 , binary+                 , text-binary   if impl(ghc < 7.6)     build-depends: ghc-prim @@ -88,6 +92,9 @@                  , containers                  , text                  , hashable+                 , deepseq+                 , binary+                 , text-binary    if impl(ghc < 7.6)     build-depends: ghc-prim@@ -121,6 +128,8 @@                , knob                , unordered-containers                , hashable+               , fgl+               , deepseq    if impl(ghc < 7.6)     build-depends: ghc-prim@@ -133,13 +142,26 @@   other-modules: Data.RDF                , Data.RDF.Namespace                , Data.RDF.MGraph+               , Data.RDF.PatriciaTreeGraph                , Data.RDF.TriplesGraph                , Text.RDF.RDF4H.NTriplesParser                , Text.RDF.RDF4H.NTriplesSerializer                , Text.RDF.RDF4H.TurtleParser                , Text.RDF.RDF4H.TurtleSerializer                , Text.RDF.RDF4H.XmlParser+               , W3C.TurtleTest   hs-source-dirs: src, testsuite/tests++benchmark rdf4h-bench+  type:             exitcode-stdio-1.0+  hs-source-dirs:   bench+  main-is:          MainCriterion.hs+  build-depends:    base,+                    criterion,+                    rdf4h,+                    text+  ghc-options:      -Wall+                    -O2  source-repository head   type:     git

@@ -14,6 +14,7 @@   -- * Export RDF type class instances   module Data.RDF.TriplesGraph,   module Data.RDF.MGraph,+  module Data.RDF.PatriciaTreeGraph,    -- * Export RDF parsers and serializers   module Text.RDF.RDF4H.NTriplesSerializer,@@ -27,6 +28,7 @@ import Data.RDF.Namespace import Data.RDF.TriplesGraph import Data.RDF.MGraph+import Data.RDF.PatriciaTreeGraph import Text.RDF.RDF4H.NTriplesSerializer import Text.RDF.RDF4H.TurtleSerializer import Text.RDF.RDF4H.NTriplesParser

@@ -1,4 +1,4 @@-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-} -- |A simple graph implementation backed by 'Data.HashMap'.  module Data.RDF.MGraph(MGraph, empty, mkRdf, triplesOf, uniqTriplesOf, select, query)@@ -6,6 +6,7 @@ where  import Prelude hiding (pred)+import Control.DeepSeq (NFData) import Data.RDF.Types import Data.RDF.Query import Data.RDF.Namespace@@ -32,6 +33,7 @@ -- --  * 'query'    : O(log n) newtype MGraph = MGraph (TMaps, Maybe BaseUrl, PrefixMappings)+                 deriving (NFData)  instance RDF MGraph where   baseUrl           = baseUrl'

@@ -38,7 +38,7 @@ rdfs :: Namespace rdfs  =   mkPrefixedNS'  "rdfs"  "http://www.w3.org/2000/01/rdf-schema#" --- |The Dublic Core namespace.+-- |The Dublin Core namespace. dc   :: Namespace dc    =   mkPrefixedNS'  "dc"    "http://purl.org/dc/elements/1.1/" 

@@ -0,0 +1,274 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, BangPatterns #-}++module Data.RDF.PatriciaTreeGraph 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 PatriciaTreeGraph = PatriciaTreeGraph (PT.Gr Node Node,IntMap.IntMap Node, Maybe BaseUrl, PrefixMappings)+                            deriving (Show,NFData)++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 = mkTriples idxLookup thisNode [] adjsOut'+                       in ts1 ++ ts2++        cfun ( _ , _ , _ , _ ) = undefined  -- not sure why this pattern is needed to exhaust cfun arg patterns++    in concat $ DFS.dfsWith' cfun g

@@ -9,9 +9,11 @@   -- * RDF graph functions   isIsomorphic, expandTriples, fromEither, -  -- * Miscellaneous functions-  expandTriple, expandNode, expandURI+  -- * expansion functions+  expandTriple, expandNode, expandURI, +  -- * absolutizing functions+  absolutizeTriple, absolutizeNode ) where  import Prelude hiding (pred)

@@ -1,3 +1,5 @@+{-# 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@@ -13,11 +15,14 @@ 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.@@ -39,6 +44,9 @@ -- --  * 'query'    : O(n) newtype TriplesGraph = TriplesGraph (Triples, Maybe BaseUrl, PrefixMappings)+                       deriving (Generic,NFData)++instance Binary TriplesGraph  instance RDF TriplesGraph where   baseUrl           = baseUrl'

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric, OverloadedStrings, GeneralizedNewtypeDeriving #-}  module Data.RDF.Types ( @@ -31,7 +31,7 @@   PrefixMappings(PrefixMappings),PrefixMapping(PrefixMapping),    -- * Supporting types-  BaseUrl(BaseUrl), NodeSelector, ParseFailure(ParseFailure),+  BaseUrl(BaseUrl), NodeSelector, ParseFailure(ParseFailure)  ) where @@ -39,13 +39,18 @@ import qualified Data.Text as T import System.IO import Text.Printf+import Data.Binary import Data.Map(Map) import GHC.Generics (Generic) import Data.Hashable(Hashable) import qualified Data.List as List import qualified Data.Map as Map+import Data.Text.Binary () import qualified Network.URI as Network (isURI)+import Control.DeepSeq (NFData,rnf)+import GHC.Generics () + ------------------- -- LValue and constructor functions @@ -66,6 +71,13 @@   | TypedL !T.Text  !T.Text     deriving Generic +instance Binary LValue++instance NFData LValue where+  rnf (PlainL t) = rnf t+  rnf (PlainLL t1 t2) = rnf t1 `seq` rnf t2+  rnf (TypedL t1 t2) = rnf t1 `seq` rnf t2+ -- |Return a PlainL LValue for the given string value. {-# INLINE plainL #-} plainL :: T.Text -> LValue@@ -110,6 +122,14 @@   | LNode !LValue     deriving Generic +instance Binary Node++instance NFData Node where+  rnf (UNode t) = rnf t+  rnf (BNode b) = rnf b+  rnf (BNodeGen bgen) = rnf bgen+  rnf (LNode lvalue) = rnf lvalue+ -- |An alias for 'Node', defined for convenience and readability purposes. type Subject = Node @@ -143,7 +163,13 @@ -- See <http://www.w3.org/TR/rdf-concepts/#section-triples> for -- more information. data Triple = Triple !Node !Node !Node+            deriving (Generic) +instance Binary Triple++instance NFData Triple where+  rnf (Triple s p o) = rnf s `seq` rnf p `seq` rnf o+ -- |A list of triples. This is defined for convenience and readability. type Triples = [Triple] @@ -326,8 +352,10 @@  -- |The base URL of an RDF. newtype BaseUrl = BaseUrl T.Text-  deriving (Eq, Ord, Show)+  deriving (Eq, Ord, Show, NFData, Generic) +instance Binary BaseUrl+ -- |A 'NodeSelector' is either a function that returns 'True' --  or 'False' for a node, or Nothing, which indicates that all -- nodes would return 'True'.@@ -482,7 +510,10 @@  -- |An alias for a map from prefix to namespace URI. newtype PrefixMappings   = PrefixMappings (Map T.Text T.Text)-  deriving (Eq, Ord)+  deriving (Eq, Ord,NFData, Generic)++instance Binary PrefixMappings+ instance Show PrefixMappings where   -- This is really inefficient, but it's not used much so not what   -- worth optimizing yet.@@ -509,6 +540,22 @@     (Nothing,             True)  ->  Nothing     (_,                   _   )  ->  Map.lookup prefix pms' +{- alternative implementation from Text.RDF.RDF4H.ParserUtils+--+-- 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 -> T.Text+resolveQName mbaseUrl prefix (PrefixMappings pms') =+  case (mbaseUrl, T.null prefix) of+    (Just (BaseUrl base), True)  ->  Map.findWithDefault base T.empty pms'+    (Nothing,             True)  ->  err1+    (_,                   _   )  ->  Map.findWithDefault err2 prefix pms'+  where+    err1 = error  "Cannot resolve empty QName prefix to a Base URL."+    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. absolutizeUrl :: Maybe BaseUrl -> Maybe T.Text -> T.Text -> T.Text@@ -524,6 +571,24 @@                                                  `T.append` urlFrag)   where     isHash bs' = bs' == "#"++{- alternative implementation from Text.RDF.RDF4H.ParserUtils+--+-- 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+    (case (mbUrl, mdUrl) of+         (Nothing, Nothing) -> urlFrag+         (Just (BaseUrl bUrl), Nothing) -> bUrl `T.append` urlFrag+         (Nothing, Just dUrl) -> if isHash urlFrag then+                                     dUrl `T.append` urlFrag else urlFrag+         (Just (BaseUrl bUrl), Just dUrl) -> (if isHash urlFrag then dUrl+                                                  else bUrl)+                                                 `T.append` urlFrag)+  where+    isHash bs' = T.length bs' == 1 && T.head bs' == '#'+-}  {-# INLINE mkAbsoluteUrl #-} -- Make an absolute URL by returning as is if already an absolute URL and otherwise

@@ -221,10 +221,3 @@     conv []            = []     conv (Nothing:ts)  = conv ts     conv (Just t:ts) = t : conv ts--_test :: GenParser () a -> String -> IO a-_test p str =-    case result of-      (Left err) -> putStr "ParseError: '" >> putStr (show err) >> putStr "\n" >> error ""-      (Right a)  -> return a-  where result = runParser p () "" (T.pack str)

@@ -10,6 +10,7 @@ import Data.Text.Encoding (decodeUtf8) import qualified Data.ByteString.Char8 as B import qualified Data.Text as T+-- import qualified Data.Map as Map import Data.Maybe (fromMaybe)  -- | A convenience function for terminating a parse with a parse failure, using

@@ -7,6 +7,7 @@  where +import Data.Char (toLower,toUpper) import Data.RDF.Types import Data.RDF.Namespace import Text.RDF.RDF4H.ParserUtils@@ -23,7 +24,9 @@ import Data.Maybe (fromMaybe)  -- |An 'RdfParser' implementation for parsing RDF in the --- Turtle format. It takes optional arguments representing the base URL to use+-- Turtle format. It is an implementation of W3C Turtle grammar rules at+-- http://www.w3.org/TR/turtle/#sec-grammar-grammar .+-- It takes optional arguments representing the base URL to use -- for resolving relative URLs in the document (may be overridden in the document -- itself using the \@base directive), and the URL to use for the document itself -- for resolving references to <> in the document.@@ -40,7 +43,7 @@  type ParseState =   (Maybe BaseUrl,    -- the current BaseUrl, may be Nothing initially, but not after it is once set-   Maybe T.Text, -- the docUrl, which never changes and is used to resolve <> in the document.+   Maybe T.Text,     -- the docUrl, which never changes and is used to resolve <> in the document.    Int,              -- the id counter, containing the value of the next id to be used    PrefixMappings,   -- the mappings from prefix to URI that are encountered while parsing    [Subject],        -- stack of current subject nodes, if we have parsed a subject but not finished the triple@@ -48,106 +51,185 @@    [Bool],           -- a stack of values to indicate that we're processing a (possibly nested) collection; top True indicates just started (on first element)    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) +-- grammar rule: [2] statement t_statement :: GenParser ParseState () t_statement = d <|> t <|> void (many1 t_ws <?> "blankline-whitespace")   where     d = void-      (try t_directive >> (many t_ws <?> "directive-whitespace1") >>-      (char '.' <?> "end-of-directive-period") >>+      (try t_directive >>       (many t_ws <?> "directive-whitespace2"))     t = void       (t_triples >> (many t_ws <?> "triple-whitespace1") >>       (char '.' <?> "end-of-triple-period") >>       (many t_ws <?> "triple-whitespace2")) +-- grammar rule: [6] triples t_triples :: GenParser ParseState () t_triples = t_subject >> (many1 t_ws <?> "subject-predicate-whitespace") >> t_predicateObjectList >> resetSubjectPredicate +-- grammar rule: [3] directive t_directive :: GenParser ParseState ()-t_directive = t_prefixID <|> t_base+t_directive = t_prefixID <|> t_base <|> t_sparql_prefix <|> t_sparql_base -t_resource :: GenParser ParseState T.Text-t_resource =  try t_uriref <|> t_qname+-- grammar rule: [135s] iri+t_iri :: GenParser ParseState T.Text+t_iri =  try t_iriref <|> t_prefixedName +-- grammar rule: [136s] PrefixedName+t_prefixedName :: GenParser ParseState T.Text+t_prefixedName = do+  t <- try t_pname_ln <|> try t_pname_ns+  return t++-- grammar rule: [4] prefixID t_prefixID :: GenParser ParseState () t_prefixID =   do try (string "@prefix" <?> "@prefix-directive")-     pre <- (many1 t_ws <?> "whitespace-after-@prefix") >> option T.empty t_prefixName+     pre <- (many1 t_ws <?> "whitespace-after-@prefix") >> option T.empty t_pn_prefix      char ':' >> (many1 t_ws <?> "whitespace-after-@prefix-colon")-     uriFrag <- t_uriref+     uriFrag <- t_iriref+     (many t_ws <?> "prefixID-whitespace")+     (char '.' <?> "end-of-prefixID-period")      (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _) <- getState      updatePMs $ Just (PrefixMappings $ Map.insert pre (absolutizeUrl bUrl dUrl uriFrag) pms)      return () +-- grammar rule: [6s] sparqlPrefix+t_sparql_prefix :: GenParser ParseState ()+t_sparql_prefix =+  do try (caseInsensitiveString "PREFIX" <?> "@prefix-directive")+     pre <- (many1 t_ws <?> "whitespace-after-@prefix") >> option T.empty t_pn_prefix+     char ':' >> (many1 t_ws <?> "whitespace-after-@prefix-colon")+     uriFrag <- t_iriref+     (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _) <- getState+     updatePMs $ Just (PrefixMappings $ Map.insert pre (absolutizeUrl bUrl dUrl uriFrag) pms)+     return ()++-- grammar rule: [5] base t_base :: GenParser ParseState () t_base =   do try (string "@base" <?> "@base-directive")      many1 t_ws <?> "whitespace-after-@base"-     urlFrag <- t_uriref+     urlFrag <- t_iriref+     (many t_ws <?> "base-whitespace")+     (char '.' <?> "end-of-base-period")      bUrl <- currBaseUrl      dUrl <- currDocUrl      updateBaseUrl (Just $ Just $ newBaseUrl bUrl (absolutizeUrl bUrl dUrl urlFrag)) +-- grammar rule: [5s] sparqlBase+t_sparql_base :: GenParser ParseState ()+t_sparql_base =+  do try (caseInsensitiveString "BASE" <?> "@sparql-base-directive")+     many1 t_ws <?> "whitespace-after-BASE"+     urlFrag <- t_iriref+     bUrl <- currBaseUrl+     dUrl <- currDocUrl+     updateBaseUrl (Just $ Just $ newBaseUrl bUrl (absolutizeUrl bUrl dUrl urlFrag))+ t_verb :: GenParser ParseState () t_verb = (try t_predicate <|> (char 'a' >> return rdfTypeNode)) >>= pushPred +-- grammar rule: [11] predicate t_predicate :: GenParser ParseState Node-t_predicate = liftM UNode (t_resource <?> "resource")+t_predicate = liftM UNode (t_iri <?> "resource")  t_nodeID  :: GenParser ParseState T.Text t_nodeID = do { try (string "_:"); cs <- t_name; return $! "_:" `T.append` cs } -t_qname :: GenParser ParseState T.Text-t_qname =-  do pre <- option T.empty (try t_prefixName)-     char ':'-     name <- option T.empty t_name+-- grammar rules: [139s] PNAME_NS+t_pname_ns :: GenParser ParseState T.Text+t_pname_ns =do+  pre <- option T.empty (try t_pn_prefix)+  char ':'+  return pre++-- grammar rules: [168s] PN_LOCAL+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)+  return (T.pack (x ++ xs))+    where+      satisfy_str = satisfy (flip in_range [('0', '9')]) >>= \c -> return [c]+      t_pn_chars_str = t_pn_chars >>= \c -> return [c]+      t_pn_chars_u_str = t_pn_chars_u >>= \c -> return [c]++-- PERCENT | PN_LOCAL_ESC+-- grammar rules: [169s] PLX+t_plx = t_percent <|> t_pn_local_esc_str+    where+      t_pn_local_esc_str = do+        c <- t_pn_local_esc+        return ([c])++--        '%' HEX HEX+-- grammar rules: [170s] PERCENT+t_percent = do+  char '%'+  h1 <- t_hex+  h2 <- t_hex+  return ([h1,h2])++-- grammar rules: [172s] PN_LOCAL_ESC+t_pn_local_esc = char '\\' >> oneOf "_~.-!$&'()*+,;=/?#@%"++-- grammar rules: [140s] PNAME_LN+t_pname_ln :: GenParser ParseState T.Text+t_pname_ln =+  do pre <- t_pname_ns+     name <- t_pn_local      (bUrl, _, _, pms, _, _, _, _) <- getState      case resolveQName bUrl pre pms of        Just n -> return $ n `T.append` name        Nothing -> error ("Cannot resolve QName prefix: " ++ T.unpack pre) +-- grammar rule: [10] subject t_subject :: GenParser ParseState () t_subject =+  iri <|>   simpleBNode <|>-  resource <|>   nodeId <|>   between (char '[') (char ']') poList   where-    resource    = liftM UNode (t_resource <?> "subject resource") >>= pushSubj-    nodeId      = liftM BNode (t_nodeID <?> "subject nodeID") >>= pushSubj+    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) +-- verb objectList (';' (verb objectList)?)*+-- -- verb ws+ objectList ( ws* ';' ws* verb ws+ objectList )* (ws* ';')?+-- grammar rule: [7] predicateObjectlist t_predicateObjectList :: GenParser ParseState () t_predicateObjectList =-  do t_verb <?> "verb"     -- pushes pred onto pred stack-     many1 t_ws   <?> "polist-whitespace-after-verb"-     t_objectList <?> "polist-objectList"-     many (try (many t_ws >> char ';') >> many t_ws >> t_verb >> many1 t_ws >> t_objectList >> popPred)-     popPred               -- pop off the predicate pushed by 1st t_verb+  do sepEndBy1 (try (t_verb >> many1 t_ws >> t_objectList >> popPred)) (try (many t_ws >> char ';' >> many t_ws))      return () +-- grammar rule: [8] objectlist t_objectList :: GenParser ParseState () t_objectList = -- t_object actually adds the triples   void   ((t_object <?> "object") >>   many (try (many t_ws >> char ',' >> many t_ws >> t_object))) +-- grammar rule: [12] object 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_resource >>= addTripleForObject) <|>+                          (liftM UNode t_iri >>= addTripleForObject) <|>                           blank_as_obj <|> t_collection      case (inColl, onFirstItem) of        (False, _)    -> processObject@@ -159,6 +241,7 @@  -- collection: '(' ws* itemList? ws* ')' -- itemList:      object (ws+ object)*+-- grammar rule: [15] collection t_collection:: GenParser ParseState () t_collection =    -- ( object1 object2 ) is short for:@@ -173,7 +256,7 @@          (many (many t_ws >> try t_object >> many t_ws) >> popPred >>          pushPred rdfRestNode >>          addTripleForObject rdfNilNode >>-         popPred)+         popPred >> popSubj)        finishColl        return () @@ -202,10 +285,10 @@ rdfRestNode   = UNode $ mkUri rdf "rest"  xsdIntUri, xsdDoubleUri, xsdDecimalUri, xsdBooleanUri :: T.Text-xsdIntUri     =   mkUri xsd "integer"-xsdDoubleUri  =   mkUri xsd "double"-xsdDecimalUri =  mkUri xsd "decimal"-xsdBooleanUri =  mkUri xsd "boolean"+xsdIntUri     = mkUri xsd "integer"+xsdDoubleUri  = mkUri xsd "double"+xsdDecimalUri = mkUri xsd "decimal"+xsdBooleanUri = mkUri xsd "boolean"  t_literal :: GenParser ParseState Node t_literal =@@ -222,26 +305,30 @@ str_literal =   do str <- t_quotedString <?> "quotedString"      liftM (LNode . typedL str)-      (try (count 2 (char '^')) >> t_resource) <|>+      (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 = t_longString <|> t_string+t_quotedString :: GenParser ParseState T.Text+t_quotedString = try t_longString <|> t_string --- a non-long string: any number of scharacters (echaracter without ") inside doublequotes.-t_string  :: GenParser ParseState T.Text-t_string = liftM T.concat (between (char '"') (char '"') (many t_scharacter))+-- a non-long string: any number of scharacters (echaracter without ") inside doublequotes or singlequotes.+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_longString  :: GenParser ParseState T.Text+t_longString :: GenParser ParseState T.Text t_longString =-  do-    try tripleQuote-    strVal <- liftM T.concat (many longString_char)-    tripleQuote-    return strVal+    try ( do { tripleQuoteDbl;+               strVal <- liftM T.concat (many longString_char);+               tripleQuoteDbl;+               return strVal }) <|>+    try ( do { tripleQuoteSingle;+               strVal <- liftM T.concat (many longString_char);+               tripleQuoteSingle;+               return strVal })   where-    tripleQuote = count 3 (char '"')+    tripleQuoteDbl = count 3 (char '"')+    tripleQuoteSingle = count 3 (char '\'')  t_integer :: GenParser ParseState T.Text t_integer =@@ -251,12 +338,22 @@      -- integer must be in canonical format, with no leading plus sign or leading zero      return $! ( T.pack sign `T.append` T.pack ds) +-- grammar rule: [21] DOUBLE t_double :: GenParser ParseState T.Text t_double =   do sign <- sign_parser <?> "+-"-     rest <- try (do { ds <- many1 digit <?> "digit";  char '.'; ds' <- many digit <?> "digit"; e <- t_exponent <?> "exponent"; return ( T.pack ds `T.snoc` '.' `T.append`  T.pack ds' `T.append` e) }) <|>-             try (do { char '.'; ds <- many1 digit <?> "digit"; e <- t_exponent <?> "exponent"; return ('.' `T.cons`  T.pack ds `T.append` e) }) <|>-             try (do { ds <- many1 digit <?> "digit"; e <- t_exponent <?> "exponent"; return ( T.pack ds `T.append` e) })+     rest <- try (do { ds <- many1 digit <?> "digit";+                      char '.';+                      ds' <- many digit <?> "digit";+                      e <- t_exponent <?> "exponent";+                      return ( T.pack ds `T.snoc` '.' `T.append`  T.pack ds' `T.append` e) }) <|>+             try (do { char '.';+                       ds <- many1 digit <?> "digit";+                       e <- t_exponent <?> "exponent";+                       return ('.' `T.cons`  T.pack ds `T.append` e) }) <|>+             try (do { ds <- many1 digit <?> "digit";+                       e <- t_exponent <?> "exponent";+                       return ( T.pack ds `T.append` e) })      return $! T.pack sign `T.append` rest  sign_parser :: GenParser ParseState String@@ -285,14 +382,14 @@ t_comment =   void (char '#' >> many (satisfy (\ c -> c /= '\n' && c /= '\r'))) -t_ws  :: GenParser ParseState ()+t_ws :: GenParser ParseState () t_ws =     (void (try (char '\t' <|> char '\n' <|> char '\r' <|> char ' '))-    <|> try t_comment)-   <?> "whitespace-or-comment"+     <|> try t_comment)+    <?> "whitespace-or-comment"  -t_language  :: GenParser ParseState T.Text+t_language :: GenParser ParseState T.Text t_language =   do initial <- many1 lower;      rest <- many (do {char '-'; cs <- many1 (lower <|> digit); return ( T.pack ('-':cs))})@@ -301,16 +398,20 @@ identifier :: GenParser ParseState Char -> GenParser ParseState Char -> GenParser ParseState T.Text identifier initial rest = initial >>= \i -> many rest >>= \r -> return ( T.pack (i:r)) -t_prefixName :: GenParser ParseState T.Text-t_prefixName = identifier t_nameStartCharMinusUnderscore t_nameChar+-- 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 '.'))+  return (T.pack (i:r))  t_name :: GenParser ParseState T.Text-t_name = identifier t_nameStartChar t_nameChar+t_name = identifier t_pn_chars_u t_pn_chars -t_uriref :: GenParser ParseState T.Text-t_uriref = between (char '<') (char '>') t_relativeURI+t_iriref :: GenParser ParseState T.Text+t_iriref = between (char '<') (char '>') t_relativeURI -t_relativeURI  :: GenParser ParseState T.Text+t_relativeURI :: GenParser ParseState T.Text t_relativeURI =   do frag <- liftM (T.pack . concat) (many t_ucharacter)      bUrl <- currBaseUrl@@ -320,19 +421,19 @@ -- 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 :: GenParser ParseState String t_ucharacter =   try (liftM T.unpack unicode_escape) <|>   try (string "\\>") <|>   liftM T.unpack (non_ctrl_char_except ">") -t_nameChar :: GenParser ParseState Char-t_nameChar = t_nameStartChar <|> char '-' <|> char '\x00B7' <|> satisfy f+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  =+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@@ -355,11 +456,9 @@ bs :: String -> GenParser ParseState T.Text bs = return . T.pack -t_nameStartChar  :: GenParser ParseState Char-t_nameStartChar = char '_' <|> t_nameStartCharMinusUnderscore--t_nameStartCharMinusUnderscore  :: GenParser ParseState Char-t_nameStartCharMinusUnderscore = try $ satisfy $ flip in_range blocks+-- grammar rule: [163s] PN_CHARS_BASE+t_pn_chars_base :: GenParser ParseState Char+t_pn_chars_base = try $ satisfy $ flip in_range blocks   where     blocks = [('A', 'Z'), ('a', 'z'), ('\x00C0', '\x00D6'),               ('\x00D8', '\x00F6'), ('\x00F8', '\x02FF'),@@ -369,14 +468,20 @@               ('\xF900', '\xFDCF'), ('\xFDF0', '\xFFFD'),               ('\x10000', '\xEFFFF')] -t_hex  :: GenParser ParseState Char+-- grammar rule: [164s] PN_CHARS_U+t_pn_chars_u :: GenParser ParseState Char+t_pn_chars_u = t_pn_chars_base <|> char '_'++-- grammar rules: [171s] HEX+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  :: GenParser ParseState T.Text-t_scharacter =+t_scharacter_in_dquot :: GenParser ParseState T.Text+t_scharacter_in_dquot =   (try (string "\\\"") >> return (T.singleton '"'))+     <|> (try (string "\\'") >> return (T.singleton '\''))      <|> try (do {char '\\';                   (char 't' >> return (T.singleton '\t')) <|>                   (char 'n' >> return (T.singleton '\n')) <|>@@ -384,14 +489,27 @@      <|> unicode_escape      <|> (non_ctrl_char_except "\\\"" >>= \s -> return $! s) -- echaracter part 2 minus " -unicode_escape  :: GenParser ParseState T.Text+-- 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 {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 :: String -> GenParser ParseState T.Text non_ctrl_char_except cs =   liftM T.singleton     (satisfy (\ c -> c <= '\1114111' && (c >= ' ' && c `notElem` cs)))@@ -516,11 +634,11 @@ -- to @\<>@ within the document is expanded to the value given here. Additionally, if no @BaseUrl@ is  -- given and no @\@base@ directive has appeared before a relative URI occurs, this value is used as the -- base URI against which the relative URI is resolved.---p+-- -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples. parseURL' :: forall rdf. (RDF rdf) =>                   Maybe BaseUrl       -- ^ The optional base URI of the document.-                 -> Maybe T.Text -- ^ The document URI (i.e., the URI of the document itself); if Nothing, use location URI.+                 -> Maybe T.Text     -- ^ The document URI (i.e., the URI of the document itself); if Nothing, use location URI.                  -> String           -- ^ The location URI from which to retrieve the Turtle document.                  -> IO (Either ParseFailure rdf)                                      -- ^ The parse result, which is either a @ParseFailure@ or the RDF@@ -550,5 +668,13 @@     (Left err)         -> Left (ParseFailure $ show err)     (Right (ts, pms))  -> Right $! mkRdf (F.toList ts) bUrl pms -_testParseState :: ParseState-_testParseState = (Nothing, Nothing, 1, PrefixMappings Map.empty, [], [], [], Seq.empty)+--------------+-- auxiliary parsing functions++-- Match the lowercase or uppercase form of 'c'+caseInsensitiveChar :: Char -> GenParser ParseState Char+caseInsensitiveChar c = char (toLower c) <|> char (toUpper c)++-- Match the string 's', accepting either lowercase or uppercase form of each character+caseInsensitiveString :: String -> GenParser ParseState String+caseInsensitiveString s = try (mapM caseInsensitiveChar s) <?> "\"" ++ s ++ "\""

@@ -4,13 +4,37 @@  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 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  main :: IO ()-main = defaultMain (  graphTests "TriplesGraph" TriplesGraph.triplesOf' TriplesGraph.uniqTriplesOf' TriplesGraph.empty' TriplesGraph.mkRdf'-                   ++ graphTests "MGraph" MGraph.triplesOf' MGraph.uniqTriplesOf' MGraph.empty' MGraph.mkRdf'+main = defaultMain (+                      graphTests "TriplesGraph"+                         TriplesGraph.triplesOf'+                         TriplesGraph.uniqTriplesOf'+                         TriplesGraph.empty'+                         TriplesGraph.mkRdf'++                   ++ graphTests "MGraph"+                         MGraph.triplesOf'+                         MGraph.uniqTriplesOf'+                         MGraph.empty'+                         MGraph.mkRdf'++                   ++ graphTests "PatriciaTreeGraph"+                         PatriciaTreeGraph.triplesOf'+                         PatriciaTreeGraph.uniqTriplesOf'+                         PatriciaTreeGraph.empty'+                         PatriciaTreeGraph.mkRdf'+                    ++ TurtleParser.tests                    ++ XmlParser.tests+                   ++ W3CTurtleTest.tests+                   ++ W3CRdfXmlTest.tests+                   -- ++ W3CNTripleTest.tests -- contains infinite loop                    )

@@ -0,0 +1,61 @@+module W3C.TurtleTest where++import Test.Framework.Providers.API+import Test.Framework.Providers.HUnit+import qualified Test.HUnit as TU+import qualified Data.Text as T++import W3C.Manifest++import Data.RDF.Types+import Data.RDF.Query+import Text.RDF.RDF4H.TurtleParser+import Text.RDF.RDF4H.NTriplesParser+import Data.RDF.TriplesGraph++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+  m <- loadManifest mfPath suiteFilesDir+  return $ testGroup (T.unpack $ description m) $ map (buildTest . mfEntryToTest) $ entries m++-- 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+  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+  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 TriplesGraph)+  return $ testCase (T.unpack nm) $ TU.assert $ isParsed rdf+mfEntryToTest (TestTurtleNegativeSyntax nm _ _ act) = do+  rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph)+  return $ testCase (T.unpack nm) $ TU.assert $ isNotParsed 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 :: TurtleParser+testParser = TurtleParser (Just mfBaseURI) Nothing