rdf4h 3.0.4 → 3.1.0

raw patch · 24 files changed

+1796/−1557 lines, 24 filesdep +filepathdep +semigroupsdep −networkdep −text-binarydep −utf8-stringPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath, semigroups

Dependencies removed: network, text-binary, utf8-string

API changes (from Hackage documentation)

Files

• bench/MainCriterion.hs +17/−32
• rdf4h.cabal +14/−17
• src/Data/RDF.hs +3/−2
• src/Data/RDF/Graph/AdjHashMap.hs +51/−152
• src/Data/RDF/Graph/TList.hs +12/−41
• src/Data/RDF/IRI.hs +494/−0
• src/Data/RDF/Query.hs +38/−53
• src/Data/RDF/Types.hs +189/−255
• src/Rdf4hParseMain.hs +13/−20
• src/Text/RDF/RDF4H/Interact.hs +0/−88
• src/Text/RDF/RDF4H/NTriplesParser.hs +134/−173
• src/Text/RDF/RDF4H/NTriplesSerializer.hs +29/−46
• src/Text/RDF/RDF4H/TurtleParser.hs +318/−484
• testsuite/tests/Data/RDF/GraphImplTests.hs +104/−0
• testsuite/tests/Data/RDF/IRITests.hs +177/−0
• testsuite/tests/Data/RDF/PropertyTests.hs +92/−73
• testsuite/tests/Test.hs +20/−24
• testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs +50/−70
• testsuite/tests/Text/RDF/RDF4H/XmlParser_Test.hs +4/−4
• testsuite/tests/W3C/Manifest.hs +3/−2
• testsuite/tests/W3C/NTripleTest.hs +4/−1
• testsuite/tests/W3C/RdfXmlTest.hs +3/−1
• testsuite/tests/W3C/TurtleTest.hs +4/−1
• testsuite/tests/W3C/W3CAssertions.hs +23/−18

@@ -3,6 +3,7 @@  module Main where +import Prelude hiding (readFile) import Criterion import Criterion.Types import Criterion.Main@@ -40,30 +41,22 @@ selectGr :: Rdf a => (NodeSelector,NodeSelector,NodeSelector,RDF a) -> [Triple] selectGr (selectorS,selectorP,selectorO,rdf) = select rdf selectorS selectorP selectorO +xmlFile :: FilePath+xmlFile = "bills.099.actions.rdf"+ main :: IO ()-main =-  defaultMainWith+main = defaultMainWith     (defaultConfig {resamples = 100})     [ env-        (do rdfContent <- T.pack <$> readFile "bills.099.actions.rdf"-            fawltyContentTurtle <- T.pack <$> readFile "data/ttl/fawlty1.ttl"-            fawltyContentNTriples <- T.pack <$> readFile "data/nt/all-fawlty-towers.nt"-            let (Right rdf1) =-                  parseString (XmlParser Nothing Nothing) rdfContent-            let (Right rdf2) =-                  parseString (XmlParser Nothing Nothing) rdfContent+        (do fawltyContentTurtle <- readFile "data/ttl/fawlty1.ttl"+            fawltyContentNTriples <- readFile "data/nt/all-fawlty-towers.nt"+            rdf1' <- parseFile (XmlParser Nothing Nothing) xmlFile+            rdf2' <- parseFile (XmlParser Nothing Nothing) xmlFile+            let rdf1 = either (error . show) id rdf1' :: RDF TList+                rdf2 = either (error . show) id rdf2' :: RDF AdjHashMap                 triples = triplesOf rdf1-            -- let (Right rdf3) =-            --       parseString (XmlParser Nothing Nothing) rdfContent-            -- let (Right rdf4) =-            --       parseString (XmlParser Nothing Nothing) rdfContent-            return-              ( rdf1 :: RDF TList-              , rdf2 :: RDF AdjHashMap-              , triples :: Triples-              , fawltyContentNTriples :: T.Text-              , fawltyContentTurtle :: T.Text-              )) $ \ ~(triplesList, adjMap, triples, fawltyContentNTriples, fawltyContentTurtle) ->+            return (rdf1, rdf2, triples, fawltyContentNTriples, fawltyContentTurtle)) $+            \ ~(triplesList, adjMap, triples, fawltyContentNTriples, fawltyContentTurtle) ->         bgroup           "rdf4h"            [ bgroup@@ -71,30 +64,22 @@               [ bench "ntriples-parsec" $                 nf (\t ->                       let res = parseString (NTriplesParserCustom Parsec) t :: Either ParseFailure (RDF TList)-                      in case res of-                        Left e -> error (show e)-                        Right rdfG -> rdfG+                      in either (error . show) id res                    ) fawltyContentNTriples               , bench "ntriples-attoparsec" $                 nf (\t ->                       let res = parseString (NTriplesParserCustom Attoparsec) t :: Either ParseFailure (RDF TList)-                      in case res of-                        Left e -> error (show e)-                        Right rdfG -> rdfG+                      in either (error . show) id res                    ) fawltyContentNTriples               , bench "turtle-parsec" $                 nf (\t ->                       let res = parseString (TurtleParserCustom Nothing Nothing Parsec) t :: Either ParseFailure (RDF TList)-                      in case res of-                        Left e -> error (show e)-                        Right rdfG -> rdfG+                      in either (error . show) id res                    ) fawltyContentTurtle               , bench "turtle-attoparsec" $                 nf (\t ->                       let res = parseString (TurtleParserCustom Nothing Nothing Attoparsec)  t :: Either ParseFailure (RDF TList)-                      in case res of-                        Left e -> error (show e)-                        Right rdfG -> rdfG+                      in either (error . show) id res                    ) fawltyContentTurtle               ]           ,

@@ -1,5 +1,5 @@ name:            rdf4h-version:         3.0.4+version:         3.1.0 synopsis:        A library for RDF processing in Haskell description:   'RDF for Haskell' is a library for working with RDF in Haskell.@@ -8,9 +8,9 @@   for triples  containing a particular subject, predicate, or object, or   selecting triples that satisfy an arbitrary predicate function. -author:          Calvin Smith, Rob Stewart, Slava Kravchenko-copyright:       (c) Calvin Smith, Rob Stewart, Slava Kravchenko-maintainer:      Rob Stewart <robstewart@gmail.com>+author:          Rob Stewart, Pierre Le Marre, Slava Kravchenko, Calvin Smith+copyright:       (c) Rob Stewart, Pierre Le Marre, Slava Kravchenko, Calvin Smith+maintainer:      Rob Stewart <robstewart57@gmail.com> homepage:        https://github.com/robstewart57/rdf4h bug-reports:     https://github.com/robstewart57/rdf4h/issues license:         BSD3@@ -26,6 +26,7 @@  library   exposed-modules: Data.RDF+                 , Data.RDF.IRI                  , Data.RDF.Namespace                  , Data.RDF.Types                  , Data.RDF.Query@@ -40,7 +41,7 @@   build-depends:   attoparsec                  , base >= 4.8.0.0                  , bytestring-                 , directory+                 , filepath                  , containers                  , parsec >= 3                  , HTTP >= 4000.0.0@@ -50,19 +51,17 @@                  , hashable                  , deepseq                  , binary-                 , text-binary-                 , utf8-string                  , hgal                  , parsers                  , mtl                  , network-uri >= 2.6-                 , network >= 2.6   if impl(ghc < 7.6)     build-depends: ghc-prim+  if !impl(ghc >= 8.0)+    build-depends: semigroups == 0.18.* -  other-modules:   Text.RDF.RDF4H.Interact   hs-source-dirs:  src-  ghc-options:     -Wall -fno-warn-unused-do-bind -funbox-strict-fields+  ghc-options:     -Wall -funbox-strict-fields  executable rdf4h   main-is:         src/Rdf4hParseMain.hs@@ -70,25 +69,25 @@                  , rdf4h                  , containers                  , text >= 1.2.1.0-                 , network-uri >= 2.6-                 , network >= 2.6    if impl(ghc < 7.6)     build-depends: ghc-prim -  ghc-options:     -Wall -fno-warn-unused-do-bind -funbox-strict-fields+  ghc-options:   -Wall -funbox-strict-fields  test-suite test-rdf4h   type:          exitcode-stdio-1.0   main-is:       Test.hs   other-modules: Data.RDF.PropertyTests+                 Data.RDF.GraphImplTests+                 Data.RDF.IRITests                  Text.RDF.RDF4H.TurtleParser_ConformanceTest                  Text.RDF.RDF4H.XmlParser_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+  ghc-options:   -Wall -fno-warn-orphans -funbox-strict-fields   build-depends: base >= 4.8.0.0 && < 6                , rdf4h                , tasty@@ -96,13 +95,11 @@                , tasty-quickcheck                , QuickCheck >= 1.2.0.0                , HUnit >= 1.2.2.1-               , bytestring                , containers                , text >= 1.2.1.0+               , filepath                , directory                , safe-               , network-uri >= 2.6-               , network >= 2.6    if impl(ghc < 7.6)     build-depends: ghc-prim

@@ -8,6 +8,7 @@   RdfParser(..),    -- * RDF types and query functions+  module Data.RDF.IRI,   module Data.RDF.Types,   module Data.RDF.Query, @@ -23,8 +24,7 @@   module Text.RDF.RDF4H.TurtleSerializer,   module Text.RDF.RDF4H.TurtleParser,   module Text.RDF.RDF4H.XmlParser,-)-where+) where  import Data.RDF.Namespace import Data.RDF.Graph.TList@@ -36,5 +36,6 @@ import Text.RDF.RDF4H.NTriplesParser import Text.RDF.RDF4H.TurtleParser import Text.RDF.RDF4H.XmlParser+import Data.RDF.IRI import Data.RDF.Types import Data.RDF.Query

@@ -13,24 +13,24 @@ module Data.RDF.Graph.AdjHashMap (AdjHashMap) where  import Prelude hiding (pred)-import Control.DeepSeq (NFData)+import Data.List+import Data.Binary (Binary) 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 Data.Hashable ()+import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap-import Data.HashSet(HashSet)+import Data.HashSet (HashSet) import qualified Data.HashSet as Set-import Data.List+import Control.Monad (mfilter)+import Control.DeepSeq (NFData) import GHC.Generics-import Data.Binary (Binary)  -- |A map-based graph implementation. -- -- This instance of 'RDF' is an adjacency map with each subject--- mapping to a mapping from a predicate node to to the adjacent nodes+-- mapping to a mapping from a predicate node to the adjacent nodes -- via that predicate. -- -- Given the following triples graph::@@ -118,14 +118,12 @@  -- 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 AdjacencyMap = HashMap Predicate Adjacencies type Adjacencies = HashSet Node  type TMap   = HashMap Node AdjacencyMap type TMaps  = (TMap, TMap) - baseUrl' :: RDF AdjHashMap -> Maybe BaseUrl baseUrl' (AdjHashMap (_, baseURL, _)) = baseURL @@ -133,15 +131,15 @@ prefixMappings' (AdjHashMap (_, _, pms)) = pms  addPrefixMappings' :: RDF AdjHashMap -> PrefixMappings -> Bool -> RDF AdjHashMap-addPrefixMappings' (AdjHashMap (ts, baseURL, pms)) pms' replace = +addPrefixMappings' (AdjHashMap (ts, baseURL, pms)) pms' replace =   let merge = if replace then flip mergePrefixMappings else mergePrefixMappings   in  AdjHashMap (ts, baseURL, merge pms pms')  empty' :: RDF AdjHashMap-empty' = AdjHashMap ((HashMap.empty, HashMap.empty), Nothing, PrefixMappings Map.empty)+empty' = AdjHashMap ((mempty, mempty), Nothing, PrefixMappings mempty)  mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF AdjHashMap-mkRdf' ts baseURL pms = AdjHashMap (mergeTs (HashMap.empty, HashMap.empty) ts, baseURL, pms)+mkRdf' ts baseURL pms = AdjHashMap (mergeTs (mempty, mempty) ts, baseURL, pms)  addTriple' :: RDF AdjHashMap -> Triple -> RDF AdjHashMap addTriple' (AdjHashMap (tmaps, baseURL, pms)) t =@@ -149,66 +147,22 @@   in AdjHashMap (newTMaps, baseURL, pms)  removeTriple' :: RDF AdjHashMap -> Triple -> RDF AdjHashMap-removeTriple' (AdjHashMap ((spoMap, opsMap), baseURL, pms)) (Triple s p o) =-  (AdjHashMap (new_tmaps, baseURL, pms))+removeTriple' (AdjHashMap ((spo, ops), baseURL, pms)) (Triple s p o) =+  AdjHashMap (new_tmaps, baseURL, pms)   where-    new_tmaps = (newSpoMap, newOpsMap)-    newSpoMap =-      case HashMap.lookup s spoMap of-        Nothing -> spoMap-        Just poAdjMap ->-          case HashMap.lookup p poAdjMap of-            Nothing -> spoMap-            Just oHashSet ->-              if not (Set.member o oHashSet)-                then spoMap-                else let newPoAdjMap =-                           HashMap.adjust-                             (\oHashSet' -> Set.delete o oHashSet')-                             p-                             poAdjMap-                     in HashMap.adjust (\_poAdjMap' -> newPoAdjMap) s spoMap-    newOpsMap =-      case HashMap.lookup o opsMap of-        Nothing -> opsMap-        Just poAdjMap ->-          case HashMap.lookup p poAdjMap of-            Nothing -> opsMap-            Just sHashSet ->-              if not (Set.member s sHashSet)-                then opsMap-                else let newPoAdjMap =-                           HashMap.adjust-                             (\sHashSet' -> Set.delete s sHashSet')-                             p-                             poAdjMap-                     in HashMap.adjust (\_poAdjMap' -> newPoAdjMap) o opsMap      +    new_tmaps = (removeT s p o spo, removeT o p s ops)+    removeT s' p' o' = HashMap.alter (removePO p' o') s'+    removePO p' o' po = mfilter (not . null) $ HashMap.alter (removeO o') p' <$> po+    removeO o' os = mfilter (not . null) $ Set.delete o' <$> os -mergeTs :: TMaps -> [Triple] -> TMaps+mergeTs :: TMaps -> Triples -> 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+    mergeT (spo, ops) (Triple s p o) = (insertT s p o spo, insertT o p s ops)+    insertT :: Node -> Predicate -> Node -> TMap -> TMap+    insertT s p o = let newPO = HashMap.singleton p (Set.singleton o)+                    in HashMap.insertWith (HashMap.unionWith mappend) s newPO  -- 3 following functions support triplesOf triplesOf' :: RDF AdjHashMap -> Triples@@ -220,98 +174,43 @@ 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)+tripsSubj s adjMap = concatMap (tfsp s) (HashMap.toList adjMap)+  where tfsp s' (p, m) = Triple s' p <$> Set.toList m  -- supports select select' :: RDF AdjHashMap -> NodeSelector -> NodeSelector -> NodeSelector -> Triples-select' (AdjHashMap ((spoMap,_),_,_)) subjFn predFn objFn =-  map (\(s,p,o) -> Triple s p o) $ Set.toList $ sel1 subjFn predFn objFn spoMap+select' r Nothing Nothing Nothing = triplesOf r+select' (AdjHashMap ((_, ops),_,_)) Nothing p o = selectSPO o p Nothing (\a b c -> Triple c b a) ops+select' (AdjHashMap ((spo, _),_,_)) s       p o = selectSPO s p o       Triple                   spo -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+selectSPO :: NodeSelector -> NodeSelector -> NodeSelector -> (Node -> Node -> Node -> Triple) -> TMap -> Triples+selectSPO Nothing  p o t = concatMap (selectPO p o t) . HashMap.toList+selectSPO (Just s) p o t = concatMap (selectPO p o t) . filter (s . fst) . HashMap.toList -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+selectPO :: NodeSelector -> NodeSelector -> (Node -> Node -> Node -> Triple) -> (Node, AdjacencyMap) -> Triples+selectPO Nothing  o t (s, po) = concatMap (selectO o t s) . HashMap.toList $ po+selectPO (Just p) o t (s, po) = concatMap (selectO o t s) . filter (p . fst) . HashMap.toList $ po -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+selectO :: NodeSelector -> (Node -> Node -> Node -> Triple) -> Node -> (Node, Adjacencies) -> Triples+selectO o t s (p, os) = t s p <$> Set.toList os'+  where os' = maybe os (`Set.filter` os) o  -- support query query' :: RDF AdjHashMap -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples-query' (AdjHashMap (m,_ , _)) subj pred obj = map (\(s, p, o) -> Triple s p o) $ Set.toList (q1 subj pred obj m)--q1 :: Maybe Node -> Maybe Node -> Maybe Node -> TMaps -> HashSet (Node, Node, Node)-q1 (Just s) p o        (spoMap, _     ) = q2 p o (s, HashMap.lookupDefault HashMap.empty s spoMap)-q1 s        p (Just o) (_     , opsMap) = Set.map (\(o',p',s') -> (s',p',o')) $ q2 p s (o, HashMap.lookupDefault HashMap.empty o opsMap)-q1 Nothing (Just p) Nothing (spoMap,_) =-  let (filtered::HashMap Node (HashMap Node (HashSet Node)))-        = HashMap.filter (\poAdjMap -> HashMap.member p poAdjMap) spoMap-      subjXS = HashMap.toList filtered :: [(Node,AdjacencyMap)]-      ys = concatMap (\(s,poMap) ->-                        let objs = map snd (HashMap.toList poMap :: [(Predicate,HashSet Node)])-                        in concatMap (\objHash -> map (\o -> (s,p,o)) (Set.toList objHash)) objs-                     ) subjXS-  in Set.fromList ys-{--      (xs::[(Subject,Predicate,Object)]) = HashMap.foldlWithKey' f [] filtered-      f triples s poAdjMap =-        let objs = HashMap.elems poAdjMap-        in triples ++ concatMap (\oSet -> map (\o -> (s,p,o)) (Set.toList oSet)) objs-  in Set.fromList xs--}+query' r Nothing Nothing Nothing = triplesOf r+query' (AdjHashMap ((_, ops), _, _)) Nothing p o = querySPO o p Nothing (\a b c -> Triple c b a)  ops+query' (AdjHashMap ((spo, _), _, _)) s       p o = querySPO s p o       Triple                    spo -q1 Nothing  p o        (spoMap, _     ) =-  let hashSets = map (q2 p o) (HashMap.toList spoMap) :: [HashSet (Node,Node,Node)]-  in Set.unions hashSets+querySPO :: Maybe Node -> Maybe Node -> Maybe Node -> (Node -> Node -> Node -> Triple) -> TMap -> Triples+querySPO Nothing  p o t = concatMap (uncurry $ queryPO p o t) . HashMap.toList+querySPO (Just s) p o t = maybe mempty (queryPO p o t s) . HashMap.lookup s --- | takes a @Maybe Predicate@ and a @Maybe Object@, a subject and--- predicate map tuple, and returns a (s,p,o) hash set.-q2-  :: Maybe Node-  -> Maybe Node-  -> (Node, HashMap Node (HashSet Node))-  -> HashSet (Node, Node, Node)-q2 (Just p) o (s, pmap) =-  let objAdjHashMapetMaybe = HashMap.lookup p pmap :: Maybe (HashSet Node) -- lookup object hash set-  in case objAdjHashMapetMaybe of-       Nothing -> Set.empty-       Just objAdjHashMapet ->-         let poAdjHashMapet = q3 o (p,objAdjHashMapet)-         in Set.map (\(p', o') -> (s, p', o')) poAdjHashMapet-q2 Nothing o (s, pmap) =-  Set.map (\(x, y) -> (s, x, y)) $ Set.unions $ map (q3 o) opmaps-  where-    opmaps :: [(Node, HashSet Node)]-    opmaps = HashMap.toList pmap+queryPO :: Maybe Node -> Maybe Node -> (Node -> Node -> Node -> Triple) -> Node -> AdjacencyMap -> Triples+queryPO Nothing  o t s po = concatMap (uncurry $ queryO o t s) . HashMap.toList $ po+queryPO (Just p) o t s po = maybe mempty (queryO o t s p) $ HashMap.lookup p po --- | looks up an object in an object hash set. If it exists, then this--- function returns a hashset with a set with single (p,o) tuple--- element. If the @Maybe Object@ value is @Empty@, then create a hash--- set of (p,o) tuples for every object in the object hash set.-q3 :: Maybe Node -- ^ object-   -> (Node, HashSet Node) -- ^ predicate and object hash set tuple-   -> HashSet (Node, Node) -- ^ hash set of (p,o) tuples-q3 (Just o) (p, os) =-  if o `Set.member` os -- if the queried object is in the object set-    then Set.singleton (p, o) -- return a set with a single (p,o) tuple element -    else Set.empty -- otherwise return an empty set-q3 Nothing (p, os) = Set.map (\o -> (p, o)) os+queryO :: Maybe Node -> (Node -> Node -> Node -> Triple) -> Node -> Node -> Adjacencies -> Triples+queryO Nothing  t s p os = t s p <$> Set.toList os+queryO (Just o) t s p os+  | o `Set.member` os = [t s p o]+  | otherwise         = mempty

@@ -19,13 +19,12 @@ -- to do so. module Data.RDF.Graph.TList (TList) where -import Prelude hiding (pred)+import Prelude import Control.DeepSeq (NFData) import Data.Binary-import qualified Data.Map as Map import Data.RDF.Namespace import Data.RDF.Query-import Data.RDF.Types (RDF,Rdf(..),Triple,Node,Subject,Predicate,Object,NodeSelector,Triples,BaseUrl)+import Data.RDF.Types (RDF,Rdf(..),Triple(..),Subject,Predicate,Object,NodeSelector,Triples,BaseUrl) import Data.List (nub) import GHC.Generics @@ -48,27 +47,16 @@ --  * 'select'   : O(n) -- --  * 'query'    : O(n)--- newtype TList = TList (Triples, Maybe BaseUrl, PrefixMappings)---                        deriving (Generic,NFData)  data TList deriving (Generic) --- data TList = TListC (Triples, Maybe BaseUrl, PrefixMappings)---                        deriving (Generic,NFData)- instance Binary TList instance NFData TList --- instance Show TList where---   show ((TListC (a,b,c,d))) = ""- data instance RDF TList = TListC (Triples, Maybe BaseUrl, PrefixMappings)                        deriving (Generic,NFData) --- data instance RDF TList- instance Rdf TList where-  -- data RDF TList = RDF TList   baseUrl           = baseUrl'   prefixMappings    = prefixMappings'   addPrefixMappings = addPrefixMappings'@@ -82,11 +70,7 @@   query             = query'   showGraph         = showGraph' --- instance Show TList where---  show ((TListC (ts, _, _))) = concatMap (\t -> show t ++ "\n") ts- showGraph' :: RDF TList -> [Char]--- showGraph' ((TListC (ts, _, _))) = concatMap (\t -> show t ++ "\n") ts showGraph' gr = concatMap (\t -> show t ++ "\n") (expandTriples gr)  prefixMappings' :: RDF TList -> PrefixMappings@@ -96,12 +80,12 @@ addPrefixMappings' (TListC(ts, baseURL, pms)) pms' replace =   let merge = if replace then flip mergePrefixMappings else mergePrefixMappings   in  TListC(ts, baseURL, merge pms pms')-  + baseUrl' :: RDF TList -> Maybe BaseUrl baseUrl' (TListC(_, baseURL, _)) = baseURL  empty' :: RDF TList-empty' = TListC([], Nothing, PrefixMappings Map.empty)+empty' = TListC(mempty, Nothing, PrefixMappings mempty)  -- 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@@ -113,12 +97,9 @@ addTriple' :: RDF TList -> Triple -> RDF TList addTriple' (TListC (ts, bURL, preMapping)) t = TListC (t:ts,bURL,preMapping) --- | yes, broken for now. use property tests to fix. removeTriple' :: RDF TList -> Triple -> RDF TList-removeTriple' (TListC (ts, bURL, preMapping)) t =-  TListC (newTs,bURL,preMapping)-  where-    newTs = filter (/= t) ts+removeTriple' (TListC (ts, bURL, preMapping)) t = TListC (newTs,bURL,preMapping)+  where newTs = filter (/= t) ts  triplesOf' :: RDF TList -> Triples triplesOf' ((TListC(ts, _, _))) = ts@@ -127,25 +108,15 @@ uniqTriplesOf' = nub . expandTriples  select' :: RDF TList -> NodeSelector -> NodeSelector -> NodeSelector -> Triples-select' g s p o = filter (matchSelect s p o) $ triplesOf g+select' g s p o = nub $ filter (matchSelect s p o) $ triplesOf g  query' :: RDF TList -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples-query' g s p o = filter (matchPattern s p o) $ triplesOf g+query' g s p o = nub $ 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+matchSelect s p o (Triple s' p' o') = match s s' && match p p' && match o o'+  where match fn n = maybe True ($ n) fn  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+matchPattern s p o (Triple s' p' o') = match s s' && match p p' && match o o'+  where match n1 n2 = maybe True (==n2) n1

@@ -0,0 +1,494 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++-- |An implementation of the RFC3987+-- [RFC3987]: http://www.ietf.org/rfc/rfc3987.txt++module Data.RDF.IRI+  ( IRI(..), IRIRef(..)+  , Scheme(..), Authority(..), UserInfo(..), Host(..), Port(..)+  , Path(..), Query(..), Fragment(..)+  , IRIError(..), SchemaError(..)+  , mkIRI+  , serializeIRI+  , parseIRI, parseRelIRI+  , validateIRI, resolveIRI+  ) where++import Data.Semigroup (Semigroup(..))+import Data.Maybe (fromMaybe, isJust)+import Data.Functor+import Data.List (intersperse)+import Control.Applicative+import Control.Monad (guard)+import Control.Arrow ((***), (&&&), (>>>))+import Data.Char (isAlpha, isDigit, isAlphaNum, toUpper, toLower)+import           Data.Text (Text)+import qualified Data.Text as T+import           Data.Attoparsec.Text (Parser, (<?>))+import qualified Data.Attoparsec.Text as P++-- | A serialized IRI representation.+newtype IRI = IRI { getIRI :: Text }+  deriving (Show, Eq)++-- | A detailed IRI representation with its components.+data IRIRef = IRIRef+  !(Maybe Scheme)+  !(Maybe Authority)+  !Path+  !(Maybe Query)+  !(Maybe Fragment)+  deriving (Show, Eq, Ord)++newtype Scheme = Scheme Text+  deriving (Show, Eq, Ord)++data Authority = Authority+  !(Maybe UserInfo)+  !Host+  !(Maybe Port)+  deriving (Show, Eq, Ord)++newtype UserInfo = UserInfo Text+  deriving (Show, Eq, Ord)++newtype Host = Host Text+  deriving (Show, Eq, Ord)++newtype Port = Port Int+  deriving (Show, Eq, Ord)++newtype Path = Path Text+  deriving (Show, Eq, Semigroup, Monoid, Ord)++newtype Query = Query Text+  deriving (Show, Eq, Semigroup, Ord)++instance Monoid Query where+  mempty = Query mempty+#if !(MIN_VERSION_base(4,11,0))+  mappend = (<>)+#endif++newtype Fragment = Fragment Text+  deriving (Show, Eq, Semigroup, Ord)++instance Monoid Fragment where+  mempty = Fragment mempty+#if !(MIN_VERSION_base(4,11,0))+  mappend = (<>)+#endif++data IRIError = InvalidIRI+  deriving (Show, Eq)++data SchemaError+  = NonAlphaLeading  -- ^ Scheme must start with an alphabet character+  | InvalidChars     -- ^ Subsequent characters in the schema were invalid+  | MissingColon     -- ^ Schemas must be followed by a colon+  deriving (Show, Eq)++-- [TODO] use Builder+serializeIRI :: IRIRef -> Text+serializeIRI (IRIRef s a p q f) = mconcat+  [ fromMaybe mempty (scheme <$> s)+  , fromMaybe mempty (authority <$> a)+  , path p+  , fromMaybe mempty (query <$> q)+  , fromMaybe mempty (fragment <$> f)]+  where+    scheme (Scheme s') = s' <> ":"+    authority (Authority u (Host h) p') = mconcat+      [ "//"+      , fromMaybe mempty (userInfo <$> u)+      , h+      , fromMaybe mempty (port <$> p') ]+    userInfo (UserInfo u) = u <> "@"+    port (Port p') = (":" <>) . T.pack . show $ p'+    path (Path p') = p'+    query (Query q') = "?" <> q'+    fragment (Fragment f') = "#" <> f'++mkIRI :: Text -> Either String IRI+mkIRI t = IRI . serializeIRI <$> parseIRI t++parseIRI :: Text -> Either String IRIRef+parseIRI = P.parseOnly $ iriParser <* (P.endOfInput <?> "Unexpected characters at the end")++parseRelIRI :: Text -> Either String IRIRef+parseRelIRI = P.parseOnly $ irelativeRefParser <* (P.endOfInput <?> "Unexpected characters at the end")++validateIRI :: Text -> Either String Text+validateIRI t = const t <$> parseIRI t++-- | IRI parsing and resolution according to algorithm 5.2 from RFC3986+-- See: http://www.ietf.org/rfc/rfc3986.txt+-- [FIXME] Currently, this is a correct but naive implemenation.+resolveIRI :: Text -> Text -> Either String Text+resolveIRI baseIri iri = serializeIRI <$> resolvedIRI+  where+    resolvedIRI = either (const resolvedRelativeIRI) resolveAbsoluteIRI (parseIRI iri)+    resolveAbsoluteIRI (IRIRef s a (Path p) q f) = return $ IRIRef s a (removeDotSegments p) q f+    resolvedRelativeIRI = do+      -- Parse as a relative IRI+      (IRIRef _ ra rp@(Path rp') rq rf) <- parseRelIRI iri+      -- Parse base IRI+      (IRIRef bs ba bp bq _) <- parseIRI baseIri+      let rIriWithoutAuth = resolveIriWithoutAuth rp rq rf bs ba bp bq+          rIriWithAuth    = return (IRIRef bs ra (removeDotSegments rp') rq rf)+      maybe rIriWithoutAuth (const rIriWithAuth) ra+    resolveIriWithoutAuth rp rq rf bs ba bp bq = return $!+      if (rp == mempty)+        then maybe (IRIRef bs ba bp bq rf) (const (IRIRef bs ba bp rq rf)) rq+        else let (Path rp') = rp in if (T.head rp' == '/')+          then IRIRef bs ba (removeDotSegments rp') rq rf+          else IRIRef bs ba (removeDotSegments (merge ba bp rp)) rq rf+    removeDotSegments p = removeDotSegments' (T.split (== '/') p) mempty+    removeDotSegments' [] os = Path $ mconcat (intersperse "/" os)+    removeDotSegments' ["."] os = removeDotSegments' mempty (os <> [mempty])+    removeDotSegments' [".."] [] = removeDotSegments' mempty mempty+    removeDotSegments' [".."] os = removeDotSegments' mempty (init os <> [mempty])+    removeDotSegments' ss@[_] os = removeDotSegments' mempty (os <> ss)+    removeDotSegments' (".":ss) os = removeDotSegments' ss os+    removeDotSegments' ("..":ss) [] = removeDotSegments' ss mempty+    removeDotSegments' ("..":ss) os@[""] = removeDotSegments' ss os+    removeDotSegments' ("..":ss) os = removeDotSegments' ss (init os)+    removeDotSegments' (s:ss) os = removeDotSegments' ss (os <> [s])+    merge ba (Path bp) (Path rp)+      | isJust ba && bp == mempty = "/" <> rp+      | otherwise                 = T.dropWhileEnd (/= '/') bp <> rp+++-- IRI = scheme ":" ihier-part [ "?" iquery ] [ "#" ifragment ]+iriParser :: Parser IRIRef+iriParser = do+  scheme <- Just <$> schemeParser+  _ <- P.string ":" <?> "Missing colon after scheme"+  (authority, path) <- ihierPartParser+  query <- P.option Nothing (Just <$> iqueryParser)+  fragment <- P.option Nothing (Just <$> ifragmentParser)+  return (IRIRef scheme authority path query fragment)++-- ihier-part = "//" iauthority ipath-abempty+--            / ipath-absolute+--            / ipath-rootless+--            / ipath-empty+ihierPartParser :: Parser (Maybe Authority, Path)+ihierPartParser =+  iauthWithPathParser <|>+  ipathAbsoluteParser <|>+  ipathRootlessParser <|>+  ipathEmptyParser++-- IRI-reference = IRI / irelative-ref+-- [TODO]++-- absolute-IRI = scheme ":" ihier-part [ "?" iquery ]+-- [TODO]++-- irelative-ref = irelative-part [ "?" iquery ] [ "#" ifragment ]+irelativeRefParser :: Parser IRIRef+irelativeRefParser = do+  (authority, path) <- irelativePartParser+  query <- P.option Nothing (Just <$> iqueryParser)+  fragment <- P.option Nothing (Just <$> ifragmentParser)+  return (IRIRef Nothing authority path query fragment)++-- irelative-part = "//" iauthority ipath-abempty+--                / ipath-absolute+--                / ipath-noscheme+--                / ipath-empty+irelativePartParser :: Parser (Maybe Authority, Path)+irelativePartParser =+  iauthWithPathParser <|>+  ipathAbsoluteParser <|>+  ipathNoSchemeParser <|>+  ipathEmptyParser++-- iauthority = [ iuserinfo "@" ] ihost [ ":" port ]+iauthorityParser :: Parser Authority+iauthorityParser =+  Authority <$> P.option Nothing (Just <$> (iuserInfoParser <* P.string "@"))+            <*> ihostParser+            <*> P.option Nothing (Just <$> (P.string ":" *> portParser))+            <?> "Authority"++-- iuserinfo = *( iunreserved / pct-encoded / sub-delims / ":" )+iuserInfoParser :: Parser UserInfo+iuserInfoParser = UserInfo . mconcat <$> P.many1 iuserInfoP+  where iuserInfoP = iunreservedP <|> pctEncodedParser <|> subDelimsP <|> P.string ":"++-- ihost = IP-literal / IPv4address / ireg-name+ihostParser :: Parser Host+ihostParser = Host <$> (ipLiteralParser <|> ipV4AddressParser <|> iregNameParser)+                   <?> "Host"++-- ireg-name = *( iunreserved / pct-encoded / sub-delims )+iregNameParser :: Parser Text+iregNameParser = mconcat <$> P.many' (iunreservedP <|> pctEncodedParser <|> subDelimsP)++{-+ipath          = ipath-abempty   ; begins with "/" or is empty+                  / ipath-absolute  ; begins with "/" but not "//"+                  / ipath-noscheme  ; begins with a non-colon segment+                  / ipath-rootless  ; begins with a segment+                  / ipath-empty     ; zero characters+-}+-- [TODO]++-- ipath-abempty = *( "/" isegment )+ipathAbEmptyParser :: Parser Path+ipathAbEmptyParser = Path <$> ipathAbEmptyParser'++ipathAbEmptyParser' :: Parser Text+ipathAbEmptyParser' = mconcat <$> P.many' (mconcat <$> sequence [P.string "/", isegmentParser])++-- ipath-absolute = "/" [ isegment-nz *( "/" isegment ) ]+ipathAbsoluteParser :: Parser (Maybe Authority, Path)+ipathAbsoluteParser = (Nothing,) <$> (Path <$> ipathAbsoluteParser')++ipathAbsoluteParser' :: Parser Text+ipathAbsoluteParser' = mconcat <$> sequence [P.string "/", ipathRootlessParser']++-- ipath-noscheme = isegment-nz-nc *( "/" isegment )+ipathNoSchemeParser :: Parser (Maybe Authority, Path)+ipathNoSchemeParser = (Nothing,) <$> (Path <$> ipathNoSchemeParser')++ipathNoSchemeParser' :: Parser Text+ipathNoSchemeParser' = mconcat <$> sequence [isegmentNzNcParser, ipathAbEmptyParser']++-- ipath-rootless = isegment-nz *( "/" isegment )+ipathRootlessParser :: Parser (Maybe Authority, Path)+ipathRootlessParser = (Nothing,) <$> (Path <$> ipathRootlessParser')++ipathRootlessParser' :: Parser Text+ipathRootlessParser' = mconcat <$> sequence [isegmentNzParser, ipathAbEmptyParser']++-- ipath-empty = 0<ipchar>+ipathEmptyParser :: Parser (Maybe Authority, Path)+ipathEmptyParser = const (Nothing, mempty) <$> ipathEmptyParser'++ipathEmptyParser' :: Parser Text+ipathEmptyParser' = P.string mempty <?> "Empty path"++-- isegment = *ipchar+isegmentParser :: Parser Text+isegmentParser = mconcat <$> (P.many' ipcharParser)++-- isegment-nz = 1*ipchar+isegmentNzParser :: Parser Text+isegmentNzParser = mconcat <$> (P.many1 ipcharParser)++-- isegment-nz-nc = 1*( iunreserved / pct-encoded / sub-delims / "@" )+--                ; non-zero-length segment without any colon ":"+isegmentNzNcParser :: Parser Text+isegmentNzNcParser = mconcat <$> (P.many1 _isegmentNzNcParser)+  where _isegmentNzNcParser = iunreservedP <|> pctEncodedParser <|> subDelimsP <|> P.string "@"++-- ipchar = iunreserved / pct-encoded / sub-delims / ":" / "@"+ipcharParser :: Parser Text+ipcharParser = iunreservedP <|> pctEncodedParser <|> subDelimsP <|> P.string ":" <|> P.string "@"++-- iquery = *( ipchar / iprivate / "/" / "?" )+iqueryParser :: Parser Query+iqueryParser = Query <$> iqueryParser'++iqueryParser' :: Parser Text+iqueryParser' =+  P.char '?' *> (mconcat <$> P.many' (ipcharParser <|> iprivateParser <|> P.string "/" <|> P.string "?"))+  <?> "Query"++-- ifragment = *( ipchar / "/" / "?" )+ifragmentParser :: Parser Fragment+ifragmentParser = Fragment <$> ifragmentParser'++ifragmentParser' :: Parser Text+ifragmentParser' =+  P.char '#' *> (mconcat <$> P.many' (ipcharParser <|> P.string "/" <|> P.string "?"))+  <?> "Fragment"++-- iunreserved = ALPHA / DIGIT / "-" / "." / "_" / "~" / ucschar+iunreservedP :: Parser Text+iunreservedP = T.singleton <$> P.satisfy isIunreserved++isIunreserved :: Char -> Bool+isIunreserved c = isUnreserved c || isUcsChar c++-- ucschar = %xA0-D7FF / %xF900-FDCF / %xFDF0-FFEF+--         / %x10000-1FFFD / %x20000-2FFFD / %x30000-3FFFD+--         / %x40000-4FFFD / %x50000-5FFFD / %x60000-6FFFD+--         / %x70000-7FFFD / %x80000-8FFFD / %x90000-9FFFD+--         / %xA0000-AFFFD / %xB0000-BFFFD / %xC0000-CFFFD+--         / %xD0000-DFFFD / %xE1000-EFFFD+isUcsChar :: Char -> Bool+isUcsChar c = ('\x000A0' <= c && c <= '\x0D7FF')+           || ('\x0F900' <= c && c <= '\x0FDCF')+           || ('\x0FDF0' <= c && c <= '\x0FFEF')+           || ('\x10000' <= c && c <= '\x1FFFD')+           || ('\x20000' <= c && c <= '\x2FFFD')+           || ('\x30000' <= c && c <= '\x3FFFD')+           || ('\x40000' <= c && c <= '\x4FFFD')+           || ('\x50000' <= c && c <= '\x5FFFD')+           || ('\x60000' <= c && c <= '\x6FFFD')+           || ('\x70000' <= c && c <= '\x7FFFD')+           || ('\x80000' <= c && c <= '\x8FFFD')+           || ('\x90000' <= c && c <= '\x9FFFD')+           || ('\xA0000' <= c && c <= '\xAFFFD')+           || ('\xB0000' <= c && c <= '\xBFFFD')+           || ('\xC0000' <= c && c <= '\xCFFFD')+           || ('\xD0000' <= c && c <= '\xDFFFD')+           || ('\xE1000' <= c && c <= '\xEFFFD')++-- iprivate = %xE000-F8FF / %xF0000-FFFFD / %x100000-10FFFD+iprivateParser :: Parser Text+iprivateParser = T.singleton <$> P.satisfy isIPrivate++isIPrivate :: Char -> Bool+isIPrivate c = ('\x00E000' <= c && c <= '\x00F8FF')+            || ('\x0F0000' <= c && c <= '\x0FFFFD')+            || ('\x100000' <= c && c <= '\x10FFFD')++-- scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )+schemeParser :: Parser Scheme+schemeParser =+  -- Force lower case (RFC page 25)+  Scheme . T.map toLower <$> (T.cons <$> schemeHead <*> schemeRest)+  where+    schemeHead = P.satisfy isAlpha <?> "Scheme head"+    schemeRest = P.takeWhile isSchemeTailChar <?> "Scheme tail"+    isSchemeTailChar c = isAlphaNum c+                      || c == '+' || c == '.' || c == '_' || c == '-'++-- port = *DIGIT+portParser :: Parser Port+portParser = Port <$> portParser'++portParser' :: Parser Int+portParser' = P.decimal <?> "Port"++-- IP-literal = "[" ( IPv6address / IPvFuture  ) "]"+ipLiteralParser :: Parser Text+ipLiteralParser = P.string "[" *> (ipV6AddressParser <|> ipFutureParser) <* P.string "]"++-- IPvFuture = "v" 1*HEXDIG "." 1*( unreserved / sub-delims / ":" )+ipFutureParser :: Parser Text+ipFutureParser =+  mconcat <$> sequence [+    P.string "v",+    P.takeWhile1 isHexaDigit,+    P.string ".",+    P.takeWhile1 isValidFinalChar]+  where isValidFinalChar c = isUnreserved c || isSubDelims c || c == ':'++-- IPv6address =                            6( h16 ":" ) ls32+--             /                       "::" 5( h16 ":" ) ls32+--             / [               h16 ] "::" 4( h16 ":" ) ls32+--             / [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32+--             / [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32+--             / [ *3( h16 ":" ) h16 ] "::"    h16 ":"   ls32+--             / [ *4( h16 ":" ) h16 ] "::"              ls32+--             / [ *5( h16 ":" ) h16 ] "::"              h16+--             / [ *6( h16 ":" ) h16 ] "::"+ipV6AddressParser :: Parser Text+ipV6AddressParser = do+  l <- leadingP+  t <- trailingP l+  joinParts l t+  <?> "IPV6"+  where+    leadingP = h16 `P.sepBy` ":"+    trailingP = (id &&& length) >>> \l -> ipNotElided l <|> ipElided l+    joinParts leading trailing = pure $ (T.intercalate ":" leading) <> trailing+    h16 = parseBetween 1 4 (P.takeWhile isHexaDigit)+    ipNotElided (leading, lengthL) =+      guard (lengthL == 7 && isDecOctet (last leading)) *> partialIpV4 <|>+      guard (lengthL == 8) *> pure mempty+    ipElided (_, lengthL) = do+      guard $ lengthL <= 8+      elision <- P.string "::"+      trailing <- h16 `P.sepBy` ":"+      let lengthT = length trailing+      let lengthTotal = lengthL + lengthT+      guard $ lengthT < 8+      embeddedIpV4 <-+        guard (lengthT > 0 && lengthTotal < 7 && isDecOctet (last trailing)) *> partialIpV4 <|>+        pure mempty+      pure $ mconcat [elision, (T.intercalate ":" trailing), embeddedIpV4]+    partialIpV4 = mconcat <$> sequence [dotP, decOctetP, dotP, decOctetP, dotP, decOctetP]++-- h16 = 1*4HEXDIG+-- [TODO]++-- ls32 = ( h16 ":" h16 ) / IPv4address+-- [TODO]++-- IPv4address = dec-octet "." dec-octet "." dec-octet "." dec-octet+ipV4AddressParser :: Parser Text+ipV4AddressParser = mconcat <$> sequence [decOctetP, dotP, decOctetP, dotP, decOctetP, dotP, decOctetP]+++-- dec-octet = DIGIT                 ; 0-9+--           / %x31-39 DIGIT         ; 10-99+--           / "1" 2DIGIT            ; 100-199+--           / "2" %x30-34 DIGIT     ; 200-249+--           / "25" %x30-35          ; 250-255+decOctetP :: Parser Text+decOctetP = do+  -- [TODO] 1-liner ?+  s <- P.takeWhile1 isDigit+  guard (isDecOctet s)+  pure s++isDecOctet :: Text -> Bool+isDecOctet s = len > 0 && T.all isDigit s && (len < 3 || (len == 3 && s <= "255"))+  where len = T.length s++-- pct-encoded = "%" HEXDIG HEXDIG+pctEncodedParser :: Parser Text+pctEncodedParser =+  T.cons <$> P.char '%'+         <*> (T.pack . fmap toUpper <$> (P.count 2 (P.satisfy isHexaDigit)))+         <?> "Percent encoding"++-- unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"+isUnreserved :: Char -> Bool+isUnreserved c = isAlphaNum c+              || c == '-' || c == '.' || c == '_' || c == '~'++-- reserved = gen-delims / sub-delims+-- [TODO]++-- gen-delims = ":" / "/" / "?" / "#" / "[" / "]" / "@"++-- sub-delims     = "!" / "$" / "&" / "'" / "(" / ")"+--                / "*" / "+" / "," / ";" / "="+subDelimsP :: Parser Text+subDelimsP = T.singleton <$> P.satisfy isSubDelims++isSubDelims :: Char -> Bool+isSubDelims c = c `elem` ("!$&'()*+,;=" :: String)++-- "//" iauthority ipath-abempty+iauthWithPathParser :: Parser (Maybe Authority, Path)+iauthWithPathParser = do+  void (P.string "//")+  curry (Just *** id) <$> iauthorityParser <*> ipathAbEmptyParser++isHexaDigit :: Char -> Bool+isHexaDigit c = (c >= '0' && c <= '9') ||+                (c >= 'a' && c <= 'f') ||+                (c >= 'A' && c <= 'F')++dotP :: Parser Text+dotP = P.string "."++parseBetween :: Int -> Int -> Parser Text -> Parser Text+parseBetween i j p = do+  s <- p+  let len = T.length s+  guard $ len >= i && len <= j+  return s

@@ -21,13 +21,14 @@ import Prelude hiding (pred) import Data.List import Data.RDF.Types-import qualified Data.RDF.Namespace as NS (toPMList, uriOf, rdf)+import qualified Data.RDF.Namespace as NS+import           Data.Text (Text) 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)+import Control.Applicative ((<|>))  -- |Answer the subject node of the triple. {-# INLINE subjectOf #-}@@ -46,17 +47,13 @@  -- |Answer if rdf contains node. rdfContainsNode :: (Rdf a) => RDF a -> Node -> Bool-rdfContainsNode rdf node =-  let ts = triplesOf rdf-      xs = map (tripleContainsNode node) ts-  in elem True xs+rdfContainsNode rdf node = any (tripleContainsNode node) (triplesOf rdf)  -- |Answer if triple contains node. -- Note that it doesn't perform namespace expansion! tripleContainsNode :: Node -> Triple -> Bool {-# INLINE tripleContainsNode #-}-tripleContainsNode node t =- subjectOf t == node || predicateOf t == node || objectOf t == node+tripleContainsNode node (Triple s p o) = s == node || p == node || o == node  -- |Determine whether two triples have equal subjects. -- Note that it doesn't perform namespace expansion!@@ -75,34 +72,30 @@  -- |Determines whether the 'RDF' contains zero triples. isEmpty :: Rdf a => RDF a -> Bool-isEmpty rdf =-  let ts = triplesOf rdf-  in null ts+isEmpty = null . triplesOf  -- |Lists of all subjects of triples with the given predicate. subjectsWithPredicate :: Rdf a => RDF a -> Predicate -> [Subject]-subjectsWithPredicate rdf pred = map subjectOf $ query rdf Nothing (Just pred) Nothing+subjectsWithPredicate rdf pred = subjectOf <$> query rdf Nothing (Just pred) Nothing  -- |Lists of all objects of triples with the given predicate. objectsOfPredicate :: Rdf a => RDF a -> Predicate -> [Object]-objectsOfPredicate rdf pred = map objectOf $ query rdf Nothing (Just pred) Nothing+objectsOfPredicate rdf pred = objectOf <$> query rdf Nothing (Just pred) Nothing  -- |Convert a parse result into an RDF if it was successful -- and error and terminate if not. fromEither :: Rdf a => Either ParseFailure (RDF a) -> RDF a-fromEither res =-  case res of-    (Left err) -> error (show err)-    (Right rdf) -> rdf+fromEither (Left err)  = error (show err)+fromEither (Right rdf) = rdf  -- |Convert a list of triples into a sorted list of unique triples. uordered :: Triples -> Triples-uordered  =  sort . nub+uordered = sort . nub  -- 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+-- node names, triple order and prefixes. In math terms, this is the \simeq -- latex operator, or ~= isIsomorphic :: (Rdf a, Rdf b) => RDF a -> RDF b -> Bool isIsomorphic g1 g2 = and $ zipWith compareTripleUnlessBlank (normalize g1) (normalize g2)@@ -131,55 +124,47 @@ --   index of a blank node, or the values in literal nodes. isGraphIsomorphic :: (Rdf a, Rdf b) => RDF a -> RDF b -> Bool isGraphIsomorphic g1 g2 = Automorphism.isIsomorphic g1' g2'-    where-      g1' = rdfGraphToDataGraph g1-      g2' = rdfGraphToDataGraph g2-      rdfGraphToDataGraph :: Rdf c => RDF c -> 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+  where+    g1' = rdfGraphToDataGraph g1+    g2' = rdfGraphToDataGraph g2+    rdfGraphToDataGraph :: Rdf c => RDF c -> 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 . fmap (\((s,p),os) -> (s,p,os))) triplesGrouped --- |Expand the triples in a graph with the prefix map and base URL for that--- graph.+-- |Expand the triples in a graph with the prefix map and base URL for that graph. expandTriples :: (Rdf a) => RDF a -> Triples-expandTriples rdf = expandTriples' [] (baseUrl rdf) (prefixMappings rdf) (triplesOf rdf)--expandTriples' :: Triples -> Maybe BaseUrl -> PrefixMappings -> Triples -> Triples-expandTriples' acc _ _ [] = acc-expandTriples' acc baseURL prefixMaps (t:rest) = expandTriples' (normalize baseURL prefixMaps t : acc) baseURL prefixMaps rest-  where normalize baseURL' prefixMaps' = absolutizeTriple baseURL' . expandTriple prefixMaps'+expandTriples rdf = normalize <$> triplesOf rdf+  where normalize = absolutizeTriple (baseUrl rdf) . expandTriple (prefixMappings rdf)  -- |Expand the triple with the prefix map. expandTriple :: PrefixMappings -> Triple -> Triple-expandTriple pms t = triple (expandNode pms $ subjectOf t) (expandNode pms $ predicateOf t) (expandNode pms $ objectOf t)+expandTriple pms (Triple s p o) = triple (expandNode pms s) (expandNode pms p) (expandNode pms o)  -- |Expand the node with the prefix map. -- Only UNodes are expanded, other kinds of nodes are returned as-is. expandNode :: PrefixMappings -> Node -> Node-expandNode pms (UNode n) = unode $ expandURI pms n-expandNode _ n'          = n'+expandNode pms (UNode u) = unode $ expandURI pms u+expandNode _   n         = n  -- |Expand the URI with the prefix map. -- Also expands "a" to "http://www.w3.org/1999/02/22-rdf-syntax-ns#type".-expandURI :: PrefixMappings -> T.Text -> T.Text-expandURI _ "a"  = T.append (NS.uriOf NS.rdf) "type"-expandURI pms' x = firstExpandedOrOriginal x $ catMaybes $ map (resourceTail x) (NS.toPMList pms')-  where resourceTail :: T.Text -> (T.Text, T.Text) -> Maybe T.Text-        resourceTail x' (p', u') = T.stripPrefix (T.append p' ":") x' >>= Just . T.append u'-        firstExpandedOrOriginal :: a -> [a] -> a-        firstExpandedOrOriginal orig' [] = orig'-        firstExpandedOrOriginal _ (e:_)  = e+expandURI :: PrefixMappings -> Text -> Text+expandURI _ "a"  = NS.mkUri NS.rdf "type"+expandURI pms iri = maybe iri id $ foldl' f Nothing (NS.toPMList pms)+  where f :: Maybe Text -> (Text, Text) -> Maybe Text+        f x (p, u) = x <|> (T.append u <$> T.stripPrefix (T.append p ":") iri)  -- |Prefixes relative URIs in the triple with BaseUrl. absolutizeTriple :: Maybe BaseUrl -> Triple -> Triple-absolutizeTriple base t = triple (absolutizeNode base $ subjectOf t) (absolutizeNode base $ predicateOf t) (absolutizeNode base $ objectOf t)+absolutizeTriple base (Triple s p o) = triple (absolutizeNode base s) (absolutizeNode base p) (absolutizeNode base o)  -- |Prepends BaseUrl to UNodes with relative URIs. absolutizeNode :: Maybe BaseUrl -> Node -> Node-absolutizeNode (Just (BaseUrl b')) (UNode u') = unode $ mkAbsoluteUrl b' u'-absolutizeNode _ n                     = n+absolutizeNode (Just (BaseUrl b)) (UNode u) = unode $ mkAbsoluteUrl b u+absolutizeNode _                  n         = n

@@ -1,7 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, OverloadedLists #-} {-# LANGUAGE MultiParamTypeClasses #-}  module Data.RDF.Types (@@ -12,14 +12,16 @@   Triple(Triple), Triples, View(view),    -- * Constructor functions-  plainL,plainLL,typedL,-  unode,bnode,lnode,triple,unodeValidate,uriValidate,uriValidateString,+  plainL, plainLL, typedL,+  unode, bnode, lnode, triple, unodeValidate, uriValidate, uriValidateString,    -- * Node query function-  isUNode,isLNode,isBNode,+  isUNode, isLNode, isBNode,    -- * Miscellaneous-  resolveQName, absolutizeUrl, isAbsoluteUri, mkAbsoluteUrl,escapeRDFSyntax,fileSchemeToFilePath,+  resolveQName, isAbsoluteUri, mkAbsoluteUrl, escapeRDFSyntax, unescapeUnicode,+  fileSchemeToFilePath, filePathToUri,+  iriFragment, uchar,    -- * RDF data family   RDF,@@ -43,25 +45,32 @@ ) where  import Prelude hiding (pred)+import           Data.Text (Text) import qualified Data.Text as T import System.IO import Text.Printf import Data.Binary-import Data.Map(Map)-import Data.Maybe (fromJust)+import Data.Char (chr, ord)+import Data.Either (isRight)+import Data.String (IsString(..))+import Data.Semigroup (Semigroup(..))+import Data.Map (Map)+import Data.RDF.IRI+import           Control.Applicative+import qualified Control.Applicative as A+import Control.Monad ((<=<), guard) import GHC.Generics (Generic)-import Data.Hashable(Hashable)+import Data.Hashable (Hashable) import qualified Data.List as List import qualified Data.Map as Map+import qualified System.FilePath as FP import qualified Network.URI as Network (uriPath,parseURI)+import           Network.URI import Control.DeepSeq (NFData,rnf)-import Text.Parsec(ParseError,parse)-import Network.URI-import Codec.Binary.UTF8.String+import Text.Parsec (ParseError, parse)  import Text.Parser.Char import Text.Parser.Combinators-import Control.Applicative  ------------------- -- LValue and constructor functions@@ -73,15 +82,15 @@   -- control over the format of the literal text that we store.    -- |A plain (untyped) literal value in an unspecified language.-  PlainL !T.Text+  PlainL !Text    -- |A plain (untyped) literal value with a language specifier.-  | PlainLL !T.Text !T.Text+  | PlainLL !Text !Text    -- |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,Show)+  | TypedL !Text  !Text+  deriving (Generic,Show)  instance Binary LValue @@ -92,19 +101,19 @@  -- |Return a PlainL LValue for the given string value. {-# INLINE plainL #-}-plainL :: T.Text -> LValue+plainL :: Text -> LValue plainL =  PlainL  -- |Return a PlainLL LValue for the given string value and language, -- respectively. {-# INLINE plainLL #-}-plainLL :: T.Text -> T.Text -> LValue+plainLL :: Text -> Text -> LValue plainLL = PlainLL  -- |Return a TypedL LValue for the given string value and datatype URI, -- respectively. {-# INLINE typedL #-}-typedL :: T.Text -> T.Text -> LValue+typedL :: Text -> Text -> LValue typedL val dtype = TypedL (canonicalize dtype val) dtype  -------------------@@ -117,12 +126,12 @@   -- |An RDF URI reference. URIs conform to the RFC3986 standard. See   -- <http://www.w3.org/TR/rdf-concepts/#section-Graph-URIref> for more   -- information.-  UNode !T.Text+  UNode !Text    -- |An RDF blank node. See   -- <http://www.w3.org/TR/rdf-concepts/#section-blank-nodes> for more   -- information.-  | BNode !T.Text+  | BNode !Text    -- |An RDF blank node with an auto-generated identifier, as used in   -- Turtle.@@ -132,7 +141,7 @@   -- <http://www.w3.org/TR/rdf-concepts/#section-Graph-Literal> for more   -- information.   | LNode !LValue-    deriving (Generic,Show)+  deriving (Generic,Show)  instance Binary Node @@ -153,7 +162,7 @@  -- |Return a URIRef node for the given URI. {-# INLINE unode #-}-unode :: T.Text -> Node+unode :: Text -> Node unode = UNode  -- For background on 'unodeValidate', see:@@ -169,71 +178,71 @@ --  1. unescape unicode RDF literals --  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 = 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 :: CharParsing m => m T.Text-isRdfURIParser = T.concat <$> many (T.singleton <$> noneOf (['\x00'..'\x20'] ++ " <>\"{}|^`\\") <|> nt_uchar)---- [10] UCHAR-nt_uchar :: CharParsing m => m T.Text-nt_uchar =-    try (T.pack . uEscapedToXEscaped <$> (string "\\u" *> count 4 hexDigit)) <|>-    try (T.pack . uEscapedToXEscaped <$> (string "\\U" *> count 8 hexDigit))--uEscapedToXEscaped :: String -> String-uEscapedToXEscaped ss = read ("\"\\x" ++ ss ++ "\"")+unodeValidate :: Text -> Maybe Node+unodeValidate t = UNode <$> uriValidate t  -- |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+uriValidate :: Text -> Maybe Text+uriValidate = either (const Nothing) Just . isRdfURI --- |Same as 'uriValidate', but on 'String' rather than 'T.Text'+-- |Same as 'uriValidate', but on 'String' rather than 'Text' uriValidateString :: String -> Maybe String-uriValidateString t = case isRdfURIString of-                Left _err -> Nothing-                Right uri -> Just uri+uriValidateString = liftA T.unpack . uriValidate . fromString++isRdfURI :: Text -> Either ParseError Text+isRdfURI t = parse (iriFragment  <* eof) ("Invalid URI: " ++ T.unpack t) t++-- IRIREF from NTriples spec (without <> enclosing)+-- [8] IRIREF ::= '<' ([^#x00-#x20<>"{}|^`\] | UCHAR)* '>'+iriFragment :: (CharParsing m, Monad m) => m Text+iriFragment = T.pack <$> many validUriChar   where-    isRdfURIString = parse (isRdfURIParserS  <* eof) ("Invalid URI: " ++ t) t-    isRdfURIParserS = many (validUriChar <|> nt_ucharS)-    nt_ucharS =-        try (head . uEscapedToXEscaped <$> (string "\\u" *> count 4 hexDigit)) <|>-        try (head . uEscapedToXEscaped <$> (string "\\U" *> count 8 hexDigit))-    -- [18]	IRIREF from Turtle spec-    validUriChar = try $ satisfy $ \c ->+    validUriChar = try (satisfy isValidUriChar) <|> validUnicodeEscaped+    validUnicodeEscaped = do+      c <- uchar+      guard (isValidUriChar c)+      return c+    isValidUriChar c =       not (c >= '\x00' && c <= '\x20')-      && c `notElem` [' ','<','>','"','{','}','|','^','`','\\']+      && c `notElem` ("<>\"{}|^`\\" :: String) --- | Escapes @\Uxxxxxxxx@ and @\uxxxx@ character sequences according---   to the RDF specification.-escapeRDFSyntax :: T.Text -> T.Text-escapeRDFSyntax t = T.pack uri-    where-      Right uri = parse unicodeEscParser "" (T.unpack t)-      unicodeEscParser :: (CharParsing m, Monad m) => m String-      unicodeEscParser =-                concat <$> many (-                    try (do { str <- ("\\x"++) <$> (string "\\U" *> count 8 hexDigit)-                            ; pure (read ("\"" ++ str ++ "\"") :: String)})-                   <|>-                    try (do { str <- ("\\x"++) <$> (string "\\u" *> count 4 hexDigit)-                            ; pure (read ("\"" ++ str ++ "\"") :: String)})-                   <|> (pure <$> anyChar)-                   )+-- UCHAR from NTriples spec+-- [10] UCHAR ::= '\u' HEX HEX HEX HEX | '\U' HEX HEX HEX HEX HEX HEX HEX HEX+uchar :: (CharParsing m, Monad m) => m Char+uchar = try shortUnicode <|> try longUnicode+  where shortUnicode = string "\\u" *> unescapeUnicodeParser 4+        longUnicode  = string "\\U" *> unescapeUnicodeParser 8 +unescapeUnicodeParser :: (CharParsing m, Monad m) => Int -> m Char+unescapeUnicodeParser n = do+  c <- go n 0+  guard (c <= 0x10FFFF)+  return $ chr c+  where+    {-# INLINE go #-}+    go 0 t = pure t+    go k t = do+      h <- anyChar >>= getHex+      let t' = t * 16 + h+      seq t' <$> go (k - 1) t'+    {-# INLINE getHex #-}+    getHex c | '0' <= c && c <= '9' = pure (ord c - ord '0')+             | 'A' <= c && c <= 'F' = pure (ord c - ord 'A' + 10)+             | 'a' <= c && c <= 'f' = pure (ord c - ord 'a' + 10)+             | otherwise            = A.empty +-- | Unescapes @\Uxxxxxxxx@ and @\uxxxx@ character sequences according+--   to the RDF specification.+unescapeUnicode, escapeRDFSyntax :: Text -> Either ParseError Text+unescapeUnicode t = T.pack <$> parse (many unicodeEsc) "" t+  where unicodeEsc = uchar <|> anyChar+{-# DEPRECATED escapeRDFSyntax "Use unescapeUnicode instead" #-}+escapeRDFSyntax = unescapeUnicode+ -- |Return a blank node using the given string identifier. {-# INLINE bnode #-}-bnode :: T.Text ->  Node+bnode :: Text ->  Node bnode = BNode  -- |Return a literal node using the given LValue.@@ -250,7 +259,7 @@ -- See <http://www.w3.org/TR/rdf-concepts/#section-triples> for -- more information. data Triple = Triple !Node !Node !Node-            deriving (Generic,Show)+  deriving (Generic,Show)  instance Binary Triple @@ -264,11 +273,11 @@ -- are of the correct type and creates the new 'Triple' if so or calls 'error'. -- /subj/ must be a 'UNode' or 'BNode', and /pred/ must be a 'UNode'. triple :: Subject -> Predicate -> Object -> Triple-triple subj pred obj-  | isLNode subj     =  error $ "subject must be UNode or BNode: "     ++ show subj-  | isLNode pred     =  error $ "predicate must be UNode, not LNode: " ++ show pred-  | isBNode pred     =  error $ "predicate must be UNode, not BNode: " ++ show pred-  | otherwise        =  Triple subj pred obj+triple s p o+  | isLNode s = error $ "subject must be UNode or BNode: "     ++ show s+  | isLNode p = error $ "predicate must be UNode, not LNode: " ++ show p+  | isBNode p = error $ "predicate must be UNode, not BNode: " ++ show p+  | otherwise =  Triple s p o  -- |Answer if given node is a URI Ref node. {-# INLINE isUNode #-}@@ -291,14 +300,8 @@  {-# INLINE isAbsoluteUri #-} -- | returns @True@ if URI is absolute.-isAbsoluteUri :: T.Text -> Bool-isAbsoluteUri = not-                . uriIsRelative-                . fromJust-                . parseURIReference-                . escapeURIString isUnescapedInURI-                . encodeString-                . T.unpack+isAbsoluteUri :: Text -> Bool+isAbsoluteUri = isRight . parseIRI  -- |A type class for ADTs that expose views to clients. class View a b where@@ -330,7 +333,7 @@   addPrefixMappings :: RDF rdfImpl -> PrefixMappings -> Bool -> RDF rdfImpl    -- |Return an empty RDF.-  empty  :: RDF rdfImpl+  empty :: RDF rdfImpl    -- |Return a RDF containing all the given triples. Handling of duplicates   -- in the input depend on the particular RDF implementation.@@ -373,7 +376,7 @@   --   -- Note: this function may be very slow; see the documentation for the   -- particular RDF implementation for more information.-  select    :: RDF rdfImpl -> NodeSelector -> NodeSelector -> NodeSelector -> Triples+  select :: RDF rdfImpl -> NodeSelector -> NodeSelector -> NodeSelector -> Triples    -- |Return the triples in the RDF that match the given pattern, where   -- the pattern (3 Maybe Node parameters) is interpreted as a triple pattern.@@ -386,10 +389,10 @@   -- For example, @ query rdf (Just n1) Nothing (Just n2) @ would return all   -- and only the triples that have @n1@ as subject and @n2@ as object,   -- regardless of the predicate of the triple.-  query         :: RDF rdfImpl -> Maybe Node -> Maybe Node -> Maybe Node -> Triples+  query :: RDF rdfImpl -> Maybe Node -> Maybe Node -> Maybe Node -> Triples    -- |pretty prints the RDF graph-  showGraph     :: RDF rdfImpl -> String+  showGraph :: RDF rdfImpl -> String  instance (Rdf a) => Show (RDF a) where   show = showGraph@@ -401,34 +404,34 @@    -- |Parse RDF from the given text, yielding a failure with error message or   -- the resultant RDF.-  parseString :: (Rdf a) => p -> T.Text -> Either ParseFailure (RDF a)+  parseString :: (Rdf a) => p -> Text -> Either ParseFailure (RDF a)    -- |Parse RDF from the local file with the given path, yielding a failure with error   -- message or the resultant RDF in the IO monad.-  parseFile   :: (Rdf a) => p -> String -> IO (Either ParseFailure (RDF a))+  parseFile :: (Rdf a) => p -> String -> IO (Either ParseFailure (RDF a))    -- |Parse RDF from the remote file with the given HTTP URL (https is not supported),   -- yielding a failure with error message or the resultant graph in the IO monad.-  parseURL    :: (Rdf a) => p -> String -> IO (Either ParseFailure (RDF a))+  parseURL :: (Rdf a) => p -> String -> IO (Either ParseFailure (RDF a))  -- |An RdfSerializer is a serializer of RDF to some particular output format, such as -- NTriples or Turtle. class RdfSerializer s where   -- |Write the RDF to a file handle using whatever configuration is specified by   -- the first argument.-  hWriteRdf     :: (Rdf a) => s -> Handle -> RDF a -> IO ()+  hWriteRdf :: (Rdf a) => s -> Handle -> RDF a -> IO ()    -- |Write the RDF to stdout; equivalent to @'hWriteRdf' stdout@.-  writeRdf      :: (Rdf a) => s -> RDF a -> IO ()+  writeRdf :: (Rdf a) => s -> RDF a -> IO ()    -- |Write to the file handle whatever header information is required based on   -- the output format. For example, if serializing to Turtle, this method would   -- write the necessary \@prefix declarations and possibly a \@baseUrl declaration,   -- whereas for NTriples, there is no header section at all, so this would be a no-op.-  hWriteH     :: (Rdf a) => s -> Handle -> RDF a -> IO ()+  hWriteH :: (Rdf a) => s -> Handle -> RDF a -> IO ()    -- |Write header information to stdout; equivalent to @'hWriteRdf' stdout@.-  writeH      :: (Rdf a) => s -> RDF a -> IO ()+  writeH :: (Rdf a) => s -> RDF a -> IO ()    -- |Write some triples to a file handle using whatever configuration is specified   -- by the first argument.@@ -438,29 +441,29 @@   -- use 'hWriteG' instead of this method unless you're sure this is safe to use, since   -- otherwise the resultant document will be missing the header information and   -- will not be valid.-  hWriteTs    :: s -> Handle  -> Triples -> IO ()+  hWriteTs :: s -> Handle  -> Triples -> IO ()    -- |Write some triples to stdout; equivalent to @'hWriteTs' stdout@.-  writeTs     :: s -> Triples -> IO ()+  writeTs :: s -> Triples -> IO ()    -- |Write a single triple to the file handle using whatever configuration is   -- specified by the first argument. The same WARNING applies as to 'hWriteTs'.-  hWriteT     :: s -> Handle  -> Triple  -> IO ()+  hWriteT :: s -> Handle  -> Triple  -> IO ()    -- |Write a single triple to stdout; equivalent to @'hWriteT' stdout@.-  writeT      :: s -> Triple  -> IO ()+  writeT :: s -> Triple  -> IO ()    -- |Write a single node to the file handle using whatever configuration is   -- specified by the first argument. The same WARNING applies as to 'hWriteTs'.-  hWriteN     :: s -> Handle  -> Node    -> IO ()+  hWriteN :: s -> Handle  -> Node    -> IO ()    -- |Write a single node to sdout; equivalent to @'hWriteN' stdout@.-  writeN      :: s -> Node    -> IO ()+  writeN :: s -> Node    -> IO ()   -- |The base URL of an RDF.-newtype BaseUrl = BaseUrl T.Text-  deriving (Eq, Ord, Show, NFData, Generic)+newtype BaseUrl = BaseUrl Text+  deriving (Eq, Ord, Show, NFData, Semigroup, Generic)  instance Binary BaseUrl @@ -483,8 +486,8 @@ -- |A node is equal to another node if they are both the same type -- of node and if the field values are equal. instance Eq Node where-  (UNode bs1)    ==  (UNode bs2)     =   bs1 ==  bs2-  (BNode bs1)    ==  (BNode bs2)     =   bs1 ==  bs2+  (UNode bs1)    ==  (UNode bs2)     =  bs1 == bs2+  (BNode bs1)    ==  (BNode bs2)     =  bs1 == bs2   (BNodeGen i1)  ==  (BNodeGen i2)   =  i1 == i2   (LNode l1)     ==  (LNode l2)      =  l1 == l2   _              ==  _               =  False@@ -498,33 +501,16 @@ -- of '(BNodeGen 44)' and '(BNodeGen 3)' is that of the values, or -- 'compare 44 3', GT. instance Ord Node where-  compare = compareNode--compareNode :: Node -> Node -> Ordering-compareNode (UNode bs1)                      (UNode bs2)                      = compare bs1 bs2-compareNode (UNode _)                        _                                = LT-compareNode (BNode bs1)                      (BNode bs2)                      = compare bs1 bs2-compareNode (BNode _)                        (UNode _)                        = GT-compareNode (BNode _)                        _                                = LT-compareNode (BNodeGen i1)                    (BNodeGen i2)                    = compare i1 i2-compareNode (BNodeGen _)                     (LNode _)                        = LT-compareNode (BNodeGen _)                     _                                = GT-compareNode (LNode (PlainL bs1))             (LNode (PlainL bs2))             = compare bs1 bs2-compareNode (LNode (PlainL _))               (LNode _)                        = LT-compareNode (LNode (PlainLL bs1 bs1'))       (LNode (PlainLL bs2 bs2'))       =-  case compare bs1' bs2' of-    EQ -> compare bs1 bs2-    LT -> LT-    GT -> GT-compareNode (LNode (PlainLL _ _))            (LNode (PlainL _))               = GT-compareNode (LNode (PlainLL _ _))            (LNode _)                        = LT-compareNode (LNode (TypedL bsType1 bs1))         (LNode (TypedL bsType2 bs2))         =-  case compare bs1 bs2 of-    EQ -> compare bsType1 bsType2-    LT -> LT-    GT -> GT-compareNode (LNode (TypedL _ _))             (LNode _)                        = GT-compareNode (LNode _)                        _                                = GT+  compare (UNode bs1)       (UNode bs2)   = compare bs1 bs2+  compare (UNode _)         _             = LT+  compare _                 (UNode _)     = GT+  compare (BNode bs1)       (BNode bs2)   = compare bs1 bs2+  compare (BNode _)         _             = LT+  compare _                 (BNode _)     = GT+  compare (BNodeGen i1)     (BNodeGen i2) = compare i1 i2+  compare (BNodeGen _)      _             = LT+  compare _                 (BNodeGen _)  = GT+  compare (LNode lv1)       (LNode lv2)   = compare lv1 lv2  instance Hashable Node @@ -536,22 +522,16 @@ -- |The ordering of triples is based on that of the subject, predicate, and object -- of the triple, in that order. instance Ord Triple where+  {-# INLINE compare #-}   (Triple s1 p1 o1) `compare` (Triple s2 p2 o2) =-    case compareNode s1 s2 of-      EQ -> case compareNode p1 p2 of-              EQ -> compareNode o1 o2-              LT -> LT-              GT -> GT-      GT -> GT-      LT -> LT+    compare s1 s2 `mappend` compare p1 p2 `mappend` compare o1 o2 --- |Two 'LValue' values are equal iff they are of the same type and all fields are--- equal.+-- |Two 'LValue' values are equal iff they are of the same type and all fields are equal. instance Eq LValue where-  (PlainL bs1)        ==  (PlainL bs2)        =  bs1 == bs2-  (PlainLL bs1 bs1')  ==  (PlainLL bs2 bs2')  =  T.toLower bs1' == T.toLower bs2'    &&  bs1 == bs2-  (TypedL bsType1 bs1)    ==  (TypedL bsType2 bs2)    =  bsType1 == bsType2 &&  bs1 == bs2-  _                   ==  _                   =  False+  (PlainL v1)      ==  (PlainL v2)      =  v1 == v2+  (PlainLL v1 lt1) ==  (PlainLL v2 lt2) =  T.toLower lt1 == T.toLower lt2 && v1 == v2+  (TypedL v1 dt1)  ==  (TypedL v2 dt2)  =  v1 == v2 && dt1 == dt2+  _                ==  _                =  False  -- |Ordering of 'LValue' values is as follows: (PlainL _) < (PlainLL _ _) -- < (TypedL _ _), and values of the same type are ordered by field values,@@ -559,25 +539,14 @@ -- literal value second, and '(TypedL literalValue datatypeUri)' being ordered -- by datatype first and literal value second. instance Ord LValue where-  compare = compareLValue--{-# INLINE compareLValue #-}-compareLValue :: LValue -> LValue -> Ordering-compareLValue (PlainL bs1)       (PlainL bs2)       = compare bs1 bs2-compareLValue (PlainL _)         _                  = LT-compareLValue _                  (PlainL _)         = GT-compareLValue (PlainLL bs1 bs1') (PlainLL bs2 bs2') =-  case compare bs1' bs2' of-    EQ -> compare bs1 bs2-    GT -> GT-    LT -> LT-compareLValue (PlainLL _ _)       _                 = LT-compareLValue _                   (PlainLL _ _)     = GT-compareLValue (TypedL l1 t1) (TypedL l2 t2) =-  case compare t1 t2 of-    EQ -> compare l1 l2-    GT -> GT-    LT -> LT+  {-# INLINE compare #-}+  compare (PlainL v1)      (PlainL v2)      = compare v1 v2+  compare (PlainL _)       _                = LT+  compare _                (PlainL _)       = GT+  compare (PlainLL v1 lt1) (PlainLL v2 lt2) = compare lt1 lt2 `mappend` compare v1 v2+  compare (PlainLL _ _)   _                 = LT+  compare _               (PlainLL _ _)     = GT+  compare (TypedL v1 dt1) (TypedL v2 dt2)   = compare dt1 dt2 `mappend` compare v1 v2  instance Hashable LValue @@ -586,8 +555,8 @@  -- |Represents a namespace as either a prefix and uri, respectively, --  or just a uri.-data Namespace = PrefixedNS  T.Text T.Text -- prefix and ns uri-               | PlainNS     T.Text            -- ns uri alone+data Namespace = PrefixedNS Text Text -- prefix and ns uri+               | PlainNS    Text        -- ns uri alone  instance Eq Namespace where   (PrefixedNS _ u1) == (PrefixedNS _ u2)  = u1 == u2@@ -600,7 +569,7 @@   show (PrefixedNS prefix uri)  =  printf "(PrefixNS %s %s)" (T.unpack prefix) (T.unpack uri)  -- |An alias for a map from prefix to namespace URI.-newtype PrefixMappings   = PrefixMappings (Map T.Text T.Text)+newtype PrefixMappings   = PrefixMappings (Map Text Text)   deriving (Eq, Ord,NFData, Generic)  instance Binary PrefixMappings@@ -613,7 +582,7 @@           mappingsStr = List.intercalate ", " (map showPM (Map.toList pmap))  -- |A mapping of a prefix to the URI for that prefix.-newtype PrefixMapping = PrefixMapping (T.Text, T.Text)+newtype PrefixMapping = PrefixMapping (Text, Text)   deriving (Eq, Ord) instance Show PrefixMapping where   show (PrefixMapping (prefix, uri)) = printf "PrefixMapping (%s, %s)" (show prefix) (show uri)@@ -621,102 +590,46 @@ ----------------- -- 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.-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'-    (_,                   _   )  ->  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-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' = 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' == '#'--}+-- | Resolve a prefix using the given prefix mappings.+resolveQName :: Text -> PrefixMappings -> Maybe Text+resolveQName prefix (PrefixMappings pms') = Map.lookup prefix pms'  {-# INLINE mkAbsoluteUrl #-}+{-# DEPRECATED mkAbsoluteUrl "Use resolveIRI instead, because mkAbsoluteUrl is a partial function" #-} -- | 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+mkAbsoluteUrl :: Text -> Text -> Text+mkAbsoluteUrl base iri = either error id (resolveIRI base iri)  ----------------- -- Internal canonicalize functions, don't export --- |Canonicalize the given 'T.Text' value using the 'T.Text'+-- |Canonicalize the given 'Text' value using the 'Text' -- as the datatype URI. {-# NOINLINE canonicalize #-}-canonicalize :: T.Text -> T.Text -> T.Text+canonicalize :: Text -> Text -> Text canonicalize typeTxt litValue =-  case Map.lookup typeTxt canonicalizerTable of-    Nothing   ->  litValue-    Just fn   ->  fn litValue+  maybe litValue ($ litValue) (Map.lookup typeTxt canonicalizerTable) --- A table of mappings from a 'T.Text' URI--- to a function that canonicalizes a T.Text+-- A table of mappings from a 'Text' URI+-- to a function that canonicalizes a Text -- assumed to be of that type. {-# NOINLINE canonicalizerTable #-}-canonicalizerTable :: Map T.Text (T.Text -> T.Text)+canonicalizerTable :: Map Text (Text -> Text) canonicalizerTable =-  Map.fromList [(integerUri, _integerStr), (doubleUri, _doubleStr),-                (decimalUri, _decimalStr)]+  [(integerUri, _integerStr), (doubleUri, _doubleStr), (decimalUri, _decimalStr)]   where-    integerUri =  "http://www.w3.org/2001/XMLSchema#integer"-    decimalUri =  "http://www.w3.org/2001/XMLSchema#decimal"-    doubleUri  =  "http://www.w3.org/2001/XMLSchema#double"+    integerUri = "http://www.w3.org/2001/XMLSchema#integer"+    decimalUri = "http://www.w3.org/2001/XMLSchema#decimal"+    doubleUri  = "http://www.w3.org/2001/XMLSchema#double" -_integerStr, _decimalStr, _doubleStr :: T.Text -> T.Text+_integerStr, _decimalStr, _doubleStr :: Text -> Text _integerStr t =   if T.length t == 1   then t-  else T.dropWhile (== '0') t+  else if T.head t == '0'+       then _integerStr (T.tail t)+       else t  -- exponent: [eE] ('-' | '+')? [0-9]+ -- ('-' | '+') ? ( [0-9]+ '.' [0-9]* exponent | '.' ([0-9])+ exponent | ([0-9])+ exponent )@@ -730,10 +643,31 @@   where f s' = T.pack $ show (read $ T.unpack s' :: Double)  -- | Removes "file://" schema from URIs in 'UNode' nodes-fileSchemeToFilePath :: Node -> Maybe T.Text+fileSchemeToFilePath :: (IsString s) => Node -> Maybe s fileSchemeToFilePath (UNode fileScheme)-    | T.pack "file://" `T.isPrefixOf` fileScheme-      = fmap (T.pack . Network.uriPath) (Network.parseURI (T.unpack fileScheme))-    | T.pack "http://" `T.isPrefixOf` fileScheme-      = fmap (T.pack . Network.uriPath) (Network.parseURI (T.unpack fileScheme))+  | "file://" `T.isPrefixOf` fileScheme = textToFilePath fileScheme+  | otherwise = Nothing+  where+    textToFilePath = pure . fromString <=< stringToFilePath . T.unpack+    stringToFilePath = fixPrefix <=< pure . Network.uriPath <=< Network.parseURI+    fixPrefix "" = Nothing+    fixPrefix p@(p':p'')+      | p' == FP.pathSeparator = Just (FP.normalise p) -- Posix path+      | p' == '/' = Just (FP.normalise p'')            -- Windows classic Path+      | otherwise = Just ("\\\\" ++ FP.normalise p)    -- Windows UNC Path fileSchemeToFilePath _ = Nothing++-- | Converts a file path to a URI with "file:" scheme+filePathToUri :: (IsString s) => FilePath -> Maybe s+filePathToUri p+  | FP.isRelative p = Nothing+  | otherwise       = Just . fromString . as_uri . FP.normalise $ p+  where+    as_uri = ("file://" ++) . escapeURIString isAllowedInURI . as_posix . fix_prefix+    fix_prefix p' = case (FP.takeDrive p') of+      "/" -> p'+      '\\':'\\':_ -> drop 2 p'+      _ -> '/':p'+    as_posix = fmap repl+    repl '\\' = '/'+    repl c = c

@@ -6,12 +6,6 @@ module Main where  import Data.RDF--- import Data.RDF.Types--- import Data.RDF.Graph.TList--- import Text.RDF.RDF4H.NTriplesParser--- import Text.RDF.RDF4H.NTriplesSerializer--- import Text.RDF.RDF4H.TurtleParser--- import Text.RDF.RDF4H.TurtleSerializer  import qualified Data.Text as T import qualified Data.Text.IO as TIO@@ -25,8 +19,8 @@  import Data.List import qualified Data.Map as Map-import Data.Char(isLetter)-import Text.Printf(hPrintf)+import Data.Char (isLetter)+import Text.Printf (hPrintf)  -- TODO: cleanup and refactor main and elsewhere in this module @@ -70,7 +64,7 @@                                  write outputFormat docUri emptyPms res          ("turtle", False) -> (if inputUri /= "-" then                                  parseFile (TurtleParser mInputUri docUri) inputUri else-                                 liftM (parseString (TurtleParser mInputUri docUri)) TIO.getContents)+                                 parseString (TurtleParser mInputUri docUri) <$> TIO.getContents)                                 >>=                                 \ (res :: Either ParseFailure (RDF TList)) ->                                   write outputFormat docUri emptyPms res@@ -79,7 +73,7 @@                                    write outputFormat Nothing emptyPms res          ("ntriples", False) -> (if inputUri /= "-" then                                    parseFile NTriplesParser inputUri else-                                   liftM (parseString NTriplesParser) TIO.getContents)+                                   parseString NTriplesParser <$> TIO.getContents)                                   >>=                                   \ (res :: Either ParseFailure (RDF TList)) ->                                     write outputFormat Nothing emptyPms res@@ -90,21 +84,21 @@                             write outputFormat docUri emptyPms res          ("xml", False) -> (if inputUri /= "-" then                                    parseFile (XmlParser mInputUri docUri) inputUri else-                                   liftM (parseString (XmlParser mInputUri docUri)) TIO.getContents)+                                   parseString (XmlParser mInputUri docUri) <$> TIO.getContents)                                   >>=                                   \ (res :: Either ParseFailure (RDF TList)) ->                                     write outputFormat docUri emptyPms res          (str, _) -> putStrLn ("Invalid format: " ++ str) >> exitFailure  write :: (Rdf a) => String -> Maybe T.Text -> PrefixMappings -> Either ParseFailure (RDF a) -> IO ()-write format docUri pms res =-  case res of-    (Left (ParseFailure msg)) -> putStrLn msg >> exitWith (ExitFailure 1)-    (Right rdf)               -> doWriteRdf rdf-  where doWriteRdf rdf = case format of -                           "turtle"   -> writeRdf (TurtleSerializer docUri pms) rdf-                           "ntriples" -> writeRdf NTriplesSerializer rdf-                           unknown    -> error $ "Unknown output format: " ++ unknown+write format docUri pms res = case res of+  (Left (ParseFailure msg)) -> putStrLn msg >> exitWith (ExitFailure 1)+  (Right rdf)               -> doWriteRdf rdf+  where+    doWriteRdf rdf = case format of+      "turtle"   -> writeRdf (TurtleSerializer docUri pms) rdf+      "ntriples" -> writeRdf NTriplesSerializer rdf+      unknown    -> error $ "Unknown output format: " ++ unknown  -- Get the input base URI from the argument list or flags, using the -- first string arg as the default if not found in string args (as@@ -196,4 +190,3 @@    case getOpt Permute options argv of       (o,n,[]  ) -> return (o,n)       (_,_,errs) -> ioError (userError ("\n\n" ++ concat errs ++ usageInfo header options))-

@@ -1,88 +0,0 @@--- |This module re-exports most of the other modules of this library and also--- defines some convenience methods for interactive experimentation, such as--- simplified functions for parsing and serializing RDF, etc.------ All the load functions can be used with any 'RDF' implementation, so you--- must declare a type in order to help the type system disambiguate the --- @RDF rdf@ constraint in those function's types.--- --- Many of the simplified functions in this module call 'error' when there is --- a failure. This is so that you don't have to deal with 'Maybe' or 'Either'--- return values while interacting. These functions are thus only intended--- to be used when interactively exploring via ghci, and should not otherwise--- be used.--module Text.RDF.RDF4H.Interact where--import qualified Data.Text as T--import Data.RDF.Types hiding (baseUrl)-import Data.RDF.Graph.TList()-import Data.RDF.Graph.AdjHashMap()--import Text.RDF.RDF4H.NTriplesParser-import Text.RDF.RDF4H.TurtleParser-import Text.RDF.RDF4H.NTriplesSerializer()-import Text.RDF.RDF4H.TurtleSerializer()---- |Load a Turtle file from the filesystem using the optional base URL --- (used to resolve relative URI fragments) and optional document URI--- (used to resolve <> in the document). --- --- This function calls 'error' with an error message if unable to load the file.-loadTurtleFile :: (Rdf a) => Maybe String -> Maybe String -> String -> IO (RDF a)-loadTurtleFile baseUrl docUri = _load parseFile (mkTurtleParser baseUrl docUri)---- |Load a Turtle file from a URL just like 'loadTurtleFile' does from the local--- filesystem. See that function for explanation of args, etc.-loadTurtleURL  :: (Rdf a) => Maybe String -> Maybe String -> String -> IO (RDF a)-loadTurtleURL baseUrl docUri  = _load parseURL (mkTurtleParser baseUrl docUri)---- |Parse a Turtle document from the given 'T.Text' using the given @baseUrl@ and --- @docUri@, which have the same semantics as in the loadTurtle* functions.-parseTurtleString :: (Rdf a) => Maybe String -> Maybe String -> T.Text -> RDF a-parseTurtleString baseUrl docUri = _parse parseString (mkTurtleParser baseUrl docUri)--mkTurtleParser :: Maybe String -> Maybe String -> TurtleParser-mkTurtleParser b d = TurtleParser ((BaseUrl . T.pack) `fmap` b) (T.pack `fmap` d)---- |Load an NTriples file from the filesystem.--- --- This function calls 'error' with an error message if unable to load the file.-loadNTriplesFile :: (Rdf a) => String -> IO (RDF a)-loadNTriplesFile = _load parseFile NTriplesParser---- |Load an NTriples file from a URL just like 'loadNTriplesFile' does from the local--- filesystem. See that function for more info.-loadNTriplesURL :: (Rdf a) => String -> IO (RDF a)-loadNTriplesURL  = _load parseURL  NTriplesParser---- |Parse an NTriples document from the given 'T.Text', as 'loadNTriplesFile' does--- from a file.-parseNTriplesString :: (Rdf a) => T.Text -> RDF a-parseNTriplesString = _parse parseString NTriplesParser----- |Print a list of triples to stdout; useful for debugging and interactive use.-printTriples :: Triples -> IO ()-printTriples  = mapM_ print---- Load an RDF using the given parseFunc, parser, and the location (filesystem path--- or HTTP URL), calling error with the 'ParseFailure' message if unable to load--- or parse for any reason.-_load :: (Rdf a) => -            (p -> String -> IO (Either ParseFailure (RDF a))) -> -             p -> String -> IO (RDF a)-_load parseFunc parser location = parseFunc parser location >>= _handle---- Use the given parseFunc and parser to parse the given 'T.Text', calling error--- with the 'ParseFailure' message if unable to load or parse for any reason.-_parse :: (RdfParser p, Rdf a) => -                        (p -> T.Text -> Either ParseFailure (RDF a)) -> -                         p -> T.Text -> RDF a-_parse parseFunc parser rdfBs = either (error . show) id $ parseFunc parser rdfBs---- Handle the result of an IO parse by returning the graph if parse was successful--- and calling 'error' with the 'ParseFailure' error message if unsuccessful.-_handle :: (Rdf a) => Either ParseFailure (RDF a) -> IO (RDF a)-_handle = either (error . show) return

@@ -2,26 +2,36 @@ -- <http://www.w3.org/TR/rdf-testcases/#ntriples>.  module Text.RDF.RDF4H.NTriplesParser-  (NTriplesParser(NTriplesParser), NTriplesParserCustom(NTriplesParserCustom),ParseFailure)-  where+  ( NTriplesParser(NTriplesParser)+  , NTriplesParserCustom(NTriplesParserCustom)+  , ParseFailure+  , nt_echar, nt_uchar, nt_langtag+  , string_literal_quote, nt_string_literal_quote+  , nt_pn_chars_base, nt_comment+  , readFile+  ) where -import Prelude hiding (init,pred)-import Data.RDF.Types-import Text.RDF.RDF4H.ParserUtils-import Data.Attoparsec.ByteString (parse,IResult(..))-import Data.Char (isLetter, isDigit,isAlphaNum, isAsciiUpper, isAsciiLower)-import Data.Map as Map (empty)-import qualified Data.Text.Encoding as T-import Text.Parsec (runParser,ParseError)-import qualified Data.Text as T-import qualified Data.Text.IO as TIO+import Prelude hiding (readFile)+import Data.Semigroup ((<>))+import Data.Char (isDigit, isLetter, isAlphaNum)+import Control.Applicative import Control.Monad (void) +import Data.RDF.Types hiding (empty)+import Data.RDF.IRI+import Text.RDF.RDF4H.ParserUtils++import Data.Attoparsec.ByteString (parse, IResult(..))+import Text.Parsec (runParser, ParseError)+import Text.Parser.LookAhead import Text.Parser.Char import Text.Parser.Combinators-import Control.Applicative-import Data.Maybe (catMaybes)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import System.IO (IOMode(..), withFile, hSetNewlineMode, noNewlineTranslation, hSetEncoding, utf8) + -- |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@@ -39,11 +49,11 @@  -- |'NTriplesParser' is an instance of 'RdfParser'. instance RdfParser NTriplesParserCustom where-  parseString (NTriplesParserCustom Parsec) = parseStringParsec+  parseString (NTriplesParserCustom Parsec)     = parseStringParsec   parseString (NTriplesParserCustom Attoparsec) = parseStringAttoparsec-  parseFile   (NTriplesParserCustom Parsec) = parseFileParsec+  parseFile   (NTriplesParserCustom Parsec)     = parseFileParsec   parseFile   (NTriplesParserCustom Attoparsec) = parseFileAttoparsec-  parseURL    (NTriplesParserCustom Parsec) = parseURLParsec+  parseURL    (NTriplesParserCustom Parsec)     = parseURLParsec   parseURL    (NTriplesParserCustom Attoparsec) = parseURLAttoparsec  -- We define or redefine all here using same names as the spec, but with an@@ -51,20 +61,10 @@ -- nt_ntripleDoc).  -- |nt_ntripleDoc is simply zero or more lines.-nt_ntripleDoc :: (CharParsing m, Monad m) => m [Maybe Triple]-nt_ntripleDoc = manyTill nt_line eof--nt_line :: (CharParsing m, Monad m) => m (Maybe Triple)-nt_line =-    skipMany nt_space *>-     (nt_comment-      <|> try (nt_triple <* nt_eoln)-      <|> try (nt_triple <* char '#' <* manyTill anyChar nt_eoln)-      <|> (nt_empty <* nt_eoln)-      )--nt_comment :: CharParsing m => m (Maybe Triple)-nt_comment   = char '#' *> manyTill anyChar nt_eoln *> pure Nothing+-- grammar [1] ntriplesDoc ::= triple? (EOL triple)* EOL?+nt_ntripleDoc :: (CharParsing m, LookAheadParsing m, Monad m) => m [Triple]+nt_ntripleDoc = many sep *> sepEndBy (try nt_triple) (many sep) <* eof+  where sep = many nt_space *> (try nt_comment <|> try nt_eoln) *> many nt_space  -- A triple consists of whitespace-delimited subject, predicate, and object, -- followed by optional whitespace and a period, and possibly more@@ -77,176 +77,135 @@ -- -- `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 :: (CharParsing m, Monad m) => m (Maybe Triple)-nt_triple    =-  do-    subj <- nt_subject   <* optional (skipSome nt_space)-    pred <- nt_predicate <* optional (skipSome nt_space)-    obj  <- nt_object    <* optional (skipSome nt_space) <* char '.' <* many nt_space-    pure $ Just (Triple subj pred obj)--- [6] literal+-- Grammar [2] triple ::= subject predicate object '.'+nt_triple :: (CharParsing m, LookAheadParsing m, Monad m) => m Triple+nt_triple = Triple+  <$> (nt_subject   <* optional (skipSome nt_space))+  <*> (nt_predicate <* optional (skipSome nt_space))+  <*> (nt_object    <* optional (skipSome nt_space) <* char '.' <* many nt_space)++-- Grammar [6] literal ::= STRING_LITERAL_QUOTE ('^^' IRIREF | LANGTAG)? nt_literal :: (CharParsing m, Monad m) => m LValue nt_literal = do-  s <- escapeRDFSyntax <$> nt_string_literal_quote-  option (plainL s) $-               (count 2 (char '^') *> nt_iriref >>= validateURI >>= isAbsoluteParser >>= \iri -> pure (typedL s iri))-                <|> (plainLL s <$> nt_langtag)+  str <- nt_string_literal_quote+  option (plainL str) (langTag str <|> typeIRI str)+  where+    langTag str = plainLL str <$> try nt_langtag+    typeIRI str = typedL str <$> try (count 2 (char '^') *> nt_iriref) --- [9] STRING_LITERAL_QUOTE-nt_string_literal_quote :: CharParsing m => m T.Text-nt_string_literal_quote =-    between (char '"') (char '"') $-      T.concat <$> many ((T.singleton <$> noneOf ['\x22','\x5C','\xA','\xD']) <|>-                          nt_echar <|>-                          nt_uchar)+-- Grammar [9] STRING_LITERAL_QUOTE ::= '"' ([^#x22#x5C#xA#xD] | ECHAR | UCHAR)* '"'+nt_string_literal_quote :: (CharParsing m, Monad m) => m T.Text+nt_string_literal_quote = string_literal_quote '"' --- [144s] LANGTAG+string_literal_quote :: (CharParsing m, Monad m) => Char -> m T.Text+string_literal_quote d = between (char d) (char d) string_literal+  where string_literal = T.pack <$> many (try validLiteralChar)+        validLiteralChar = noneOf [d,'\x5C','\xA','\xD']+                       <|> nt_echar+                       <|> nt_uchar++-- Grammar [144s] LANGTAG ::= '@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)* nt_langtag :: (CharParsing m, Monad m) => m T.Text nt_langtag = do   ss   <- char '@' *> some (satisfy isLetter)-  rest <- concat <$> many ((:) <$> char '-' <*> some (satisfy isAlphaNum))+  rest <- concat <$> many (char '-' *> some (satisfy isAlphaNum) >>= \lang_str -> pure ('-':lang_str))   pure (T.pack (ss ++ rest))  -- [8] IRIREF-nt_iriref :: CharParsing m => m T.Text-nt_iriref =-  between (char '<') (char '>') $-              T.concat <$> many ( T.singleton <$> noneOf (['\x00'..'\x20'] ++ "<>\"{}|^`\\") <|> nt_uchar )+nt_iriref :: (CharParsing m, Monad m) => m T.Text+nt_iriref = between (char '<') (char '>') $ do+  raw_iri <- iriFragment+  either (const empty) pure (validateIRI raw_iri) <?> "Only absolute IRIs allowed in NTriples format, which this isn't: " ++ show raw_iri  -- [153s] ECHAR-nt_echar :: CharParsing m => m T.Text-nt_echar = try $ T.singleton <$> (char '\\' *> satisfy isEchar)--isEchar :: Char -> Bool-isEchar = (`elem` ['t','b','n','r','f','"','\'','\\'])---- [10] UCHAR-nt_uchar :: CharParsing m => m T.Text-nt_uchar =-    try (T.pack <$> ((++) <$> string "\\u" <*> count 4 hexDigit)) <|>-    try (T.pack <$> ((++) <$> string "\\U" <*> count 8 hexDigit))+nt_echar :: (CharParsing m, Monad m) => m Char+nt_echar = try $ do+  c2 <- char '\\' *> anyChar+  case c2 of+    't'  -> pure '\t'+    'b'  -> pure '\b'+    'n'  -> pure '\n'+    'r'  -> pure '\r'+    'f'  -> pure '\f'+    '"'  -> pure '\"'+    '\'' -> pure '\''+    '\\' -> pure '\\'+    _    -> empty --- 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 :: CharParsing m => m (Maybe Triple)-nt_empty     = skipMany nt_space *> pure Nothing+-- [10] UCHAR ::= '\u' HEX HEX HEX HEX | '\U' HEX HEX HEX HEX HEX HEX HEX HEX+nt_uchar :: (CharParsing m, Monad m) => m Char+nt_uchar = uchar  -- A subject is either a URI reference for a resource or a node id for a -- blank node.-nt_subject :: (CharParsing m, Monad m) => m Node-nt_subject   =-  unode <$> nt_uriref <|>-  bnode <$> nt_blank_node_label+nt_subject :: (CharParsing m, LookAheadParsing m, Monad m) => m Node+nt_subject = unode <$> try nt_iriref+         <|> bnode <$> nt_blank_node_label  -- A predicate may only be a URI reference to a resource. nt_predicate :: (CharParsing m, Monad m) => m Node-nt_predicate = unode <$> nt_uriref+nt_predicate = unode <$> nt_iriref  -- An object may be either a resource (represented by a URI reference), -- a blank node (represented by a node id), or an object literal.-nt_object :: (CharParsing m, Monad m) => m Node-nt_object =-  unode <$> nt_uriref <|>-  bnode <$> nt_blank_node_label <|>-  LNode <$> nt_literal--validateUNode :: CharParsing m => T.Text -> m Node-validateUNode t =-    case unodeValidate t of-      Just u@UNode{} -> pure u-      Just node      -> unexpected ("Unexpected node in NTriples parser URI validation: " ++ show node)-      Nothing        -> unexpected ("Invalid URI in NTriples parser URI validation: " ++ show t)--validateURI :: (CharParsing m, Monad m) => T.Text -> m T.Text-validateURI t = do-    UNode uri <- validateUNode t-    pure uri--isAbsoluteParser :: CharParsing m => T.Text -> m T.Text-isAbsoluteParser t =-    if isAbsoluteUri t-    then pure t-    else unexpected ("Only absolute IRIs allowed in NTriples format, which this isn't: " ++ show t)--absoluteURI :: CharParsing m => T.Text -> m T.Text-absoluteURI = isAbsoluteParser---- A URI reference is one or more nrab_character inside angle brackets.-nt_uriref :: (CharParsing m, Monad m) => m T.Text-nt_uriref = between (char '<') (char '>') $ do-              unvalidatedUri <- many (satisfy ( /= '>'))-              absoluteURI =<< validateURI (T.pack unvalidatedUri)+nt_object :: (CharParsing m, LookAheadParsing m, Monad m) => m Node+nt_object = unode <$> try nt_iriref+        <|> bnode <$> try nt_blank_node_label+        <|> LNode <$> nt_literal --- [141s] BLANK_NODE_LABEL-nt_blank_node_label :: (CharParsing m, Monad m) => m T.Text+-- [141s] BLANK_NODE_LABEL ::= '_:' (PN_CHARS_U | [0-9]) ((PN_CHARS | '.')* PN_CHARS)?+nt_blank_node_label :: (CharParsing m, LookAheadParsing m, Monad m) => m T.Text nt_blank_node_label = do-  void (char '_' *> char ':')-  s1 <- nt_pn_chars_u <|> satisfy isDigit-  s2 <- option "" $ try $ (++) <$> many (char '.') <*> some nt_pn_chars-  pure (T.pack ("_:" ++ s1:s2))+  void (string "_:")+  firstChar <- nt_pn_chars_u <|> satisfy isDigit+  otherChars <- option "" $ try $+    many (nt_pn_chars <|> try (char '.' <* lookAhead (try nt_pn_chars)))+  pure $ T.pack (firstChar : otherChars) --- [157s] PN_CHARS_BASE--- Not used. It used to be. What's happened?-{-+-- [157s] PN_CHARS_BASE ::= [A-Z] | [a-z] | [#x00C0-#x00D6] | [#x00D8-#x00F6] | [#x00F8-#x02FF] | [#x0370-#x037D] | [#x037F-#x1FFF] | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF] nt_pn_chars_base :: CharParsing m => m Char-nt_pn_chars_base = try $ satisfy isBaseChar c---}--isBaseChar :: Char -> Bool-isBaseChar c-    =  isAsciiUpper c-    || isAsciiLower c-    || (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')-+nt_pn_chars_base = try $ satisfy isBaseChar+  where 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')  -- [158s] PN_CHARS_U nt_pn_chars_u :: CharParsing m => m Char-nt_pn_chars_u = try $ satisfy $ \c -> c == '_' || c == ':' || isBaseChar c-+nt_pn_chars_u = nt_pn_chars_base <|> try (char '_') <|> try (char ':')  -- [160s] PN_CHARS nt_pn_chars :: CharParsing m => m Char nt_pn_chars = nt_pn_chars_u-  <|> try (satisfy $ \c ->-           c == '-' || c == '\x00B7'-           || isDigit c+          <|> try (char '-')+          <|> try (char '\x00B7')+          <|> try (satisfy f)+  where f c = isDigit c            || (c >= '\x0300' && c <= '\x036F')            || (c >= '\x203F' && c <= '\x2040')-    )  -- End-of-line consists of either lf or crlf. -- We also test for eof and consider that to match as well. nt_eoln :: CharParsing m => m ()-nt_eoln =  eof <|> void (nt_cr *> nt_lf) <|> void nt_lf---- Whitespace is either a space or tab character. We must avoid using the--- built-in space combinator here, because it includes newline.-nt_space :: CharParsing m => m Char-nt_space = char ' ' <|> nt_tab---- Carriage pure is \r.-nt_cr :: CharParsing m => m Char-nt_cr          =   char '\r'+nt_eoln =  try (void (string "\r\n")) <|> void (char '\n') --- Line feed is \n.-nt_lf :: CharParsing m => m Char-nt_lf          =   char '\n'+-- Whitespace is either a space or a tabulation.+-- The built-in space combinator must be avoided here, because it includes newline.+nt_space :: CharParsing m => m ()+nt_space = void (try (char ' ') <|> try (char '\t')) --- Tab is \t.-nt_tab :: CharParsing m => m Char-nt_tab         =   char '\t'+nt_comment :: CharParsing m => m ()+nt_comment = void (char '#' *> manyTill anyChar (try nt_eoln))  --------------------------------- -- parsec based parsers@@ -257,20 +216,22 @@ parseFileParsec :: (Rdf a) => String -> IO (Either ParseFailure (RDF a)) parseFileParsec path =   handleParsec mkRdf . runParser nt_ntripleDoc () path-  <$> TIO.readFile path+  <$> readFile path +readFile :: FilePath -> IO T.Text+readFile fpath = withFile fpath ReadMode $ \h -> do+  hSetNewlineMode h noNewlineTranslation+  hSetEncoding h utf8+  T.hGetContents h+ parseURLParsec :: (Rdf a) => String -> IO (Either ParseFailure (RDF a)) parseURLParsec = _parseURL parseStringParsec -handleParsec :: {-forall rdf. (RDF rdf) => -} (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF a) ->-                                        Either ParseError [Maybe Triple] ->-                                        Either ParseFailure (RDF a)-handleParsec _mkRdf result---  | T.length rem /= 0 = (Left $ ParseFailure $ "Invalid Document. Unparseable end of document: " ++ T.unpack rem)---  | otherwise          =-  = case result of-        Left err -> Left  $ ParseFailure $ "Parse failure: \n" ++ show err-        Right ts -> Right $ _mkRdf (catMaybes ts) Nothing (PrefixMappings Map.empty)+handleParsec :: (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF a) ->+                 Either ParseError [Triple] -> Either ParseFailure (RDF a)+handleParsec _mkRdf result = case result of+  Left err -> Left  $ ParseFailure $ "Parse failure: \n" <> show err+  Right ts -> Right $ _mkRdf ts Nothing (PrefixMappings mempty)  --------------------------------- @@ -278,7 +239,7 @@ -- attoparsec based parsers  parseFileAttoparsec :: (Rdf a) => String -> IO (Either ParseFailure (RDF a))-parseFileAttoparsec path = handleAttoparsec <$> TIO.readFile path+parseFileAttoparsec path = handleAttoparsec <$> readFile path  parseURLAttoparsec :: (Rdf a) => String -> IO (Either ParseFailure (RDF a)) parseURLAttoparsec = _parseURL handleAttoparsec@@ -295,7 +256,7 @@           -- "\nnot consumed: " ++ show i           -- ++ "\ncontexts: " ++ show contexts           -- ++ "\nerror: " ++ show err-        Partial f -> handleResult (f (T.encodeUtf8 T.empty))-        Done _ ts -> Right $ mkRdf (catMaybes ts) Nothing (PrefixMappings Map.empty)+        Partial f -> handleResult (f (T.encodeUtf8 mempty))+        Done _ ts -> Right $ mkRdf ts Nothing (PrefixMappings mempty)  ---------------------------------

@@ -1,11 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}+ -- |A serializer for RDF as N-Triples -- <http://www.w3.org/TR/rdf-testcases/#ntriples>. -module Text.RDF.RDF4H.NTriplesSerializer(-  NTriplesSerializer(NTriplesSerializer)-) where+module Text.RDF.RDF4H.NTriplesSerializer+  ( NTriplesSerializer(NTriplesSerializer)+  ) where -import Control.Monad (void) import Data.RDF.Types import Data.RDF.Query (expandTriples) import qualified Data.Text as T@@ -39,49 +40,31 @@   _writeNode h o >> hPutStrLn h " ."  _writeNode :: Handle -> Node -> IO ()-_writeNode h node =-  case node of-    (UNode bs)  -> hPutChar h '<' >>-                     T.hPutStr h bs >>-                     hPutChar h '>'-    (BNode gId) -> T.hPutStr h gId-    (BNodeGen i)-> putStr "_:genid" >> hPutStr h (show i)-    (LNode n)   -> _writeLValue h n+_writeNode h node = case node of+  (UNode s)  -> hPutChar h '<' >> T.hPutStr h s >> hPutChar h '>'+  (BNode gId) -> T.hPutStr h "_:" >> T.hPutStr h gId+  (BNodeGen i)-> T.hPutStr h "_:genid" >> hPutStr h (show i)+  (LNode n)   -> _writeLValue h n  _writeLValue :: Handle -> LValue -> IO ()-_writeLValue h lv =-  case lv of-    (PlainL lit)       -> _writeLiteralString h lit-    (PlainLL lit lang) -> _writeLiteralString h lit >>-                            hPutStr h "@" >>-                            T.hPutStr h lang-    (TypedL lit dtype) -> _writeLiteralString h lit >>-                            hPutStr h "^^<" >>-                            T.hPutStr h dtype >>-                            hPutStr h ">"+_writeLValue h lv = case lv of+  (PlainL lit)       -> _writeLiteralString h lit+  (PlainLL lit lang) -> _writeLiteralString h lit >>+                          hPutChar h '@' >>+                          T.hPutStr h lang+  (TypedL lit dtype) -> _writeLiteralString h lit >>+                          hPutStr h "^^<" >>+                          T.hPutStr h dtype >>+                          hPutChar h '>' --- TODO: this is REALLY slow. _writeLiteralString:: Handle -> T.Text -> IO ()-_writeLiteralString h bs =-  do hPutChar h '"'-     T.foldl' writeChar (return ()) bs-     hPutChar h '"'-  where-    -- the seq is necessary in writeChar to ensure all chars-    -- are written. without it, only the last is written.-    writeChar :: IO () -> Char -> IO ()-    writeChar b c = b >>= \b' -> b' `seq`-      case c of-        '\n' ->  void (hPutChar h '\\' >> hPutChar h 'n')-        '\t' ->  void (hPutChar h '\\' >> hPutChar h 't')-        '\r' ->  void (hPutChar h '\\' >> hPutChar h 'r')-        '"'  ->  void (hPutChar h '\\' >> hPutChar h '"')-        '\\' ->  void (hPutChar h '\\' >> hPutChar h '\\')-        _    ->  void (hPutChar h c)--_bs1, _bs2 :: T.Text-_bs1 = T.pack "\nthis \ris a \\U00015678long\t\nliteral\\uABCD\n"-_bs2 = T.pack "\nan \\U00015678 escape\n"--_w :: IO ()-_w = _writeLiteralString stdout _bs1+_writeLiteralString h ls = do+  hPutChar h '"'+  T.hPutStr h $ T.concatMap escapeChar ls+  hPutChar h '"'+  where escapeChar '\n' = "\\n"+        escapeChar '\t' = "\\t"+        escapeChar '\r' = "\\r"+        escapeChar '"'  = "\\\""+        escapeChar '\\' = "\\\\"+        escapeChar c    = T.singleton c

@@ -5,31 +5,27 @@ -- |An 'RdfParser' implementation for the Turtle format -- <http://www.w3.org/TeamSubmission/turtle/>. -module Text.RDF.RDF4H.TurtleParser(-  TurtleParser(TurtleParser),-  TurtleParserCustom(TurtleParserCustom)-)--where+module Text.RDF.RDF4H.TurtleParser+  ( TurtleParser(TurtleParser)+  , TurtleParserCustom(TurtleParserCustom)+  ) where -import Data.Attoparsec.ByteString (parse,IResult(..))-import Data.Char (isLetter,isAlphaNum,toLower,toUpper,isDigit,isHexDigit)+import Prelude hiding (readFile)+import Data.Attoparsec.Text (parse,IResult(..))+import Data.Char (toLower, toUpper, isDigit, isHexDigit) import qualified Data.Map as Map import Data.Map (Map) import Data.Maybe import Data.RDF.Types+import Data.RDF.IRI import Data.RDF.Namespace import Text.RDF.RDF4H.ParserUtils-import Text.Parsec (runParser,ParseError)--- import Text.Parsec.Text (GenParser)+import Text.RDF.RDF4H.NTriplesParser+import Text.Parsec (runParser, ParseError) import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as TIO-import Data.Sequence(Seq, (|>))-import qualified Data.Sequence as Seq+import Data.Sequence (Seq, (|>)) import qualified Data.Foldable as F import Control.Monad- import Text.Parser.Char import Text.Parser.Combinators import Text.Parser.LookAhead@@ -64,203 +60,190 @@   parseString (TurtleParserCustom bUrl dUrl Attoparsec)  = parseStringAttoparsec bUrl dUrl   parseFile   (TurtleParserCustom bUrl dUrl Parsec)      = parseFileParsec bUrl dUrl   parseFile   (TurtleParserCustom bUrl dUrl Attoparsec)  = parseFileAttoparsec bUrl dUrl-  parseURL    (TurtleParserCustom bUrl dUrl Parsec)      = parseURLParsec  bUrl dUrl+  parseURL    (TurtleParserCustom bUrl dUrl Parsec)      = parseURLParsec bUrl dUrl   parseURL    (TurtleParserCustom bUrl dUrl Attoparsec)  = parseURLAttoparsec  bUrl dUrl - 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.-   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-   [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-   Map String Int)+  ( 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.+  , Integer          -- 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+  , Maybe Subject    -- current subject node, if we have parsed a subject but not finished the triple+  , Maybe Predicate  -- current predicate node, if we have parsed a predicate but not finished the triple+  , Seq Triple       -- the triples encountered while parsing; always added to on the right side+  , Map String Integer ) -- map blank node names to generated id.  -- grammar rule: [1] turtleDoc--- t_turtleDoc :: (CharParsing m, Monad m) => m (Seq Triple, PrefixMappings)-t_turtleDoc :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m (Seq Triple, PrefixMappings)+t_turtleDoc :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m (Seq Triple, PrefixMappings) t_turtleDoc =-  many t_statement *> (eof <?> "eof") *> gets (\(_, _, _, pms, _, _, _, _, _, ts,_) -> (ts, pms))+  many t_statement *> (eof <?> "eof") *> gets (\(_, _, _, pms, _, _, ts,_) -> (ts, pms))  -- grammar rule: [2] statement-t_statement :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()-t_statement = d <|> t <|> void (some t_ws <?> "blankline-whitespace")+-- [2] statement ::= directive | triples '.'+t_statement :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()+t_statement = directive <|> triples <|> void (some t_ws <?> "blankline-whitespace")   where-    d = void+    directive = void       (try t_directive       *> (many t_ws <?> "directive-whitespace2"))-    t = void-      (t_triples+    triples = void+      (try t_triples       *> (many t_ws <?> "triple-whitespace1")       *> (char '.' <?> "end-of-triple-period")       *> (many t_ws <?> "triple-whitespace2"))  -- grammar rule: [6] triples -- subject predicateObjectList | blankNodePropertyList predicateObjectList?-t_triples :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()-t_triples =-  try (t_subject *> many t_ws *> t_predicateObjectList *> resetSubjectPredicate)-  <|> (setSubjBlankNodePropList-      *> t_blankNodePropertyList-      *> many t_ws+t_triples :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()+t_triples = try subjectWithPOL <|> blankNodePropertyListWithPOL+  where+    subjectWithPOL = t_subject *> many t_ws *> t_predicateObjectList *> resetSubjectPredicate+    blankNodePropertyListWithPOL = t_blankNodePropertyList >>= \bn+      -> many t_ws+      *> setSubjectPredicate (Just bn) Nothing       *> optional t_predicateObjectList       *> resetSubjectPredicate-      *> setNotSubjBlankNodePropList)  -- [14]	blankNodePropertyList ::= '[' predicateObjectList ']'-t_blankNodePropertyList :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()-t_blankNodePropertyList = between (char '[') (char ']') $ do-                            subjPropList <- isSubjPropList-                            blankNode <- BNodeGen <$> nextIdCounter-                            unless subjPropList $ addTripleForObject blankNode-                            pushSubj blankNode-                            many t_ws *> t_predicateObjectList *> void (many t_ws)-                            unless subjPropList $ void popSubj+t_blankNodePropertyList :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node+t_blankNodePropertyList = withConstantSubjectPredicate $+  between (char '[') (char ']') $ do+    bn <- nextBlankNode+    setSubjectPredicate (Just bn) Nothing+    void (many t_ws *> t_predicateObjectList *> many t_ws)+    return bn  -- grammar rule: [3] directive t_directive :: (CharParsing m, MonadState ParseState m) => m () t_directive = t_prefixID <|> t_base <|> t_sparql_prefix <|> t_sparql_base --- grammar rule: [135s] iri--- IRIREF | PrefixedName-t_iri :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m T.Text+-- grammar rule: [135s] iri ::= IRIREF | PrefixedName+t_iri :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m T.Text t_iri =  try t_iriref <|> t_prefixedName --- grammar rule: [136s] PrefixedName-t_prefixedName :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m T.Text-t_prefixedName = try t_pname_ln <|> try t_pname_ns+-- grammar rule: [136s] PrefixedName ::= PNAME_LN | PNAME_NS+t_prefixedName :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m T.Text+t_prefixedName = try t_pname_ln <|> t_pname_ns --- grammar rule: [4] prefixID+-- grammar rule: [4] prefixID ::= '@prefix' PNAME_NS IRIREF '.' t_prefixID :: (CharParsing m, MonadState ParseState m) => m ()-t_prefixID =-  do void (try (string "@prefix" <?> "@prefix-directive"))-     pre <- (some t_ws <?> "whitespace-after-@prefix") *> option T.empty t_pn_prefix-     void (char ':' *> (some t_ws <?> "whitespace-after-@prefix-colon"))-     uriFrag <- t_iriref-     void (many t_ws <?> "prefixID-whitespace")-     void (char '.' <?> "end-of-prefixID-period")-     (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _, _, _, _) <- get-     updatePMs $ Just (PrefixMappings $ Map.insert pre (absolutizeUrl bUrl dUrl uriFrag) pms)-     pure ()+t_prefixID = do+  void (try (string "@prefix" <?> "@prefix-directive"))+  void (some t_ws <?> "whitespace-after-@prefix")+  pre <- option mempty (try t_pn_prefix) <* char ':'+  void (some t_ws <?> "whitespace-after-@prefix-colon")+  iriFrag <- t_iriref+  void (many t_ws <?> "prefixID-whitespace")+  void (char '.' <?> "end-of-prefixID-period")+  (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _) <- get+  iri <- tryIriResolution bUrl dUrl iriFrag+  updatePMs $ Just (PrefixMappings $ Map.insert pre iri pms) --- grammar rule: [6s] sparqlPrefix+-- grammar rule: [6s] sparqlPrefix ::= "PREFIX" PNAME_NS IRIREF t_sparql_prefix :: (CharParsing m, MonadState ParseState m) => m ()-t_sparql_prefix =-  do void (try (caseInsensitiveString "PREFIX" <?> "@prefix-directive"))-     pre <- (some t_ws <?> "whitespace-after-@prefix") *> option T.empty t_pn_prefix-     void (char ':' *> (some t_ws <?> "whitespace-after-@prefix-colon"))-     uriFrag <- t_iriref-     (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _, _, _, _) <- get-     updatePMs $ Just (PrefixMappings $ Map.insert pre (absolutizeUrl bUrl dUrl uriFrag) pms)-     pure ()+t_sparql_prefix = do+  void (try (caseInsensitiveString "PREFIX" <?> "@prefix-directive"))+  void (some t_ws <?> "whitespace-after-PREFIX")+  pre <- option mempty (try t_pn_prefix) <* char ':'+  void (some t_ws <?> "whitespace-after-PREFIX-colon")+  iriFrag <- t_iriref+  (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _) <- get+  iri <- tryIriResolution bUrl dUrl iriFrag+  updatePMs $ Just (PrefixMappings $ Map.insert pre iri pms) --- grammar rule: [5] base+-- grammar rule: [5] base ::= '@base' IRIREF '.' t_base :: (CharParsing m, MonadState ParseState m) => m ()-t_base =-  do void (try (string "@base" <?> "@base-directive"))-     void (some t_ws <?> "whitespace-after-@base")-     urlFrag <- t_iriref-     void (many t_ws <?> "base-whitespace")-     void (char '.') <?> "end-of-base-period"-     bUrl <- currBaseUrl-     dUrl <- currDocUrl-     updateBaseUrl (Just $ Just $ newBaseUrl bUrl (absolutizeUrl bUrl dUrl urlFrag))+t_base = do+  void (try (string "@base" <?> "@base-directive"))+  void (some t_ws <?> "whitespace-after-@base")+  iriFrag <- t_iriref+  void (many t_ws <?> "base-whitespace")+  void (char '.') <?> "end-of-base-period"+  bUrl <- currBaseUrl+  dUrl <- currDocUrl+  newBaseIri <- BaseUrl <$> tryIriResolution bUrl dUrl iriFrag+  updateBaseUrl (Just $ Just newBaseIri) --- grammar rule: [5s] sparqlBase+-- grammar rule: [5s] sparqlBase ::= "BASE" IRIREF t_sparql_base :: (CharParsing m, MonadState ParseState m) => m ()-t_sparql_base =-  do void (try (caseInsensitiveString "BASE" <?> "@sparql-base-directive"))-     void (some t_ws <?> "whitespace-after-BASE")-     urlFrag <- t_iriref-     bUrl <- currBaseUrl-     dUrl <- currDocUrl-     updateBaseUrl (Just $ Just $ newBaseUrl bUrl (absolutizeUrl bUrl dUrl urlFrag))+t_sparql_base = do+  void (try (caseInsensitiveString "BASE" <?> "@sparql-base-directive"))+  void (some t_ws <?> "whitespace-after-BASE")+  iriFrag <- t_iriref+  bUrl <- currBaseUrl+  dUrl <- currDocUrl+  newBaseIri <- BaseUrl <$> tryIriResolution bUrl dUrl iriFrag+  updateBaseUrl (Just $ Just newBaseIri) -t_verb :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()--- [9]	verb ::= predicate | 'a'-t_verb = (try t_predicate <|> (char 'a' *> pure rdfTypeNode)) >>= pushPred+t_verb :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()+t_verb = try t_predicate <|> (char 'a' *> pure rdfTypeNode) >>= setPredicate --- grammar rule: [11] predicate-t_predicate :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m Node+-- grammar rule: [11] predicate ::= iri+t_predicate :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node t_predicate = UNode <$> (t_iri <?> "resource") --- grammar rules: [139s] PNAME_NS+-- grammar rules: [139s] PNAME_NS ::= PN_PREFIX? ':' t_pname_ns :: (CharParsing m, MonadState ParseState m) => m T.Text-t_pname_ns =do-  pre <- option T.empty (try t_pn_prefix) <* char ':'-  (bUrl, _, _, pms, _, _, _, _, _, _, _) <- get-  case resolveQName bUrl pre pms of+t_pname_ns = do+  pre <- option mempty (try t_pn_prefix) <* char ':'+  (_, _, _, pms, _, _, _, _) <- get+  case resolveQName pre pms of     Just n  -> pure 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 :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m T.Text+t_pn_local :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m T.Text t_pn_local = do   x <- t_pn_chars_u_str <|> string ":" <|> satisfy_str <|> t_plx   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 *> pure "."))-               concat <$> many recsve+    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 *> pure "."))+    concat <$> many recsve   pure (T.pack (x ++ xs))-    where-      satisfy_str      = pure <$> satisfy isDigit-      t_pn_chars_str   = pure <$> t_pn_chars-      t_pn_chars_u_str = pure <$> t_pn_chars_u+  where+    satisfy_str      = pure <$> satisfy isDigit+    t_pn_chars_str   = pure <$> t_pn_chars+    t_pn_chars_u_str = pure <$> t_pn_chars_u  -- PERCENT | PN_LOCAL_ESC -- grammar rules: [169s] PLX t_plx :: (CharParsing m, Monad m) => m String t_plx = t_percent <|> t_pn_local_esc_str-    where-      t_pn_local_esc_str = pure <$> t_pn_local_esc+  where t_pn_local_esc_str = pure <$> t_pn_local_esc  --        '%' HEX HEX -- grammar rules: [170s] PERCENT t_percent :: (CharParsing m, Monad m) => m String-t_percent = sequence [char '%',t_hex,t_hex]-+t_percent = sequence [char '%', t_hex, t_hex]  -- grammar rules: [172s] PN_LOCAL_ESC t_pn_local_esc :: CharParsing m => m Char t_pn_local_esc = char '\\' *> oneOf "_~.-!$&'()*+,;=/?#@%" --- grammar rules: [140s] PNAME_LN-t_pname_ln :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m T.Text+-- grammar rules: [140s] PNAME_LN ::= PNAME_NS PN_LOCAL+t_pname_ln :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m T.Text t_pname_ln = T.append <$> t_pname_ns <*> t_pn_local  -- grammar rule: [10] subject -- [10] subject	::= iri | BlankNode | collection-t_subject :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()-t_subject =-  iri <|>-  (t_blankNode >>= pushSubj) <|>-   (BNodeGen <$> nextIdCounter >>= \x -> pushSubj x-    *> pushPred rdfFirstNode-    *> pushSubjColl-    *> t_collection)-  where-    iri         = unode <$> (try t_iri <?> "subject resource") >>= pushSubj+t_subject :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()+t_subject = iri <|> t_blankNode <|> t_collection >>= setSubject+  where iri = unode <$> (try t_iri <?> "subject resource")  -- [137s] BlankNode ::= BLANK_NODE_LABEL | ANON t_blankNode :: (CharParsing m, MonadState ParseState m) => m Node t_blankNode = do-  genID <- try t_blank_node_label <|> (t_anon *> pure "")+  genID <- try t_blank_node_label <|> (t_anon *> pure mempty)   mp <- currGenIdLookup-  case Map.lookup genID mp of-    Nothing -> do+  maybe (newBN genID) getExistingBN (Map.lookup genID mp)+  where+    newBN genID = do       i <- nextIdCounter-      let node = BNodeGen i-      addGenIdLookup genID i-      pure node-    Just i ->-      pure $ BNodeGen i+      when (genID /= mempty) (addGenIdLookup genID i)+      return $ BNodeGen (fromIntegral i)+    getExistingBN = return . BNodeGen . fromIntegral  -- TODO replicate the recursion technique from [168s] for ((..)* something)? -- [141s] BLANK_NODE_LABEL ::= '_:' (PN_CHARS_U | [0-9]) ((PN_CHARS | '.')* PN_CHARS)?@@ -268,91 +251,67 @@ t_blank_node_label = do   void (string "_:")   firstChar <- t_pn_chars_u <|> satisfy isDigit---  optional $ try $ do-  try $ do-    ss <- option "" $ do-            xs <- many (t_pn_chars <|> char '.')-            if null xs-            then pure xs-            else if last xs == '.'-                 then unexpected "'.' at the end of a blank node label"-                 else pure xs-    pure (firstChar : ss)+  try $ (firstChar:) <$> otherChars+  where+    otherChars = option "" $ do+      xs <- many (t_pn_chars <|> char '.')+      if null xs+      then pure xs+      else if last xs == '.'+           then unexpected "'.' at the end of a blank node label"+           else pure xs  -- [162s] ANON ::= '[' WS* ']' t_anon :: CharParsing m => m ()-t_anon = between (char '[') (char ']') (skipMany t_ws)+t_anon = void (between (char '[') (char ']') (many t_ws))  -- [7] predicateObjectList ::= verb objectList (';' (verb objectList)?)*-t_predicateObjectList :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()-t_predicateObjectList =-  void (sepEndBy1-        (optional (try (do { t_verb-                           ; some t_ws-                           ; t_objectList-                           ; popPred})))-        (try (many t_ws *> char ';' *> many t_ws)))+t_predicateObjectList :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()+t_predicateObjectList = void $ sepEndBy1 (try verbObjectList) (try separator)+  where verbObjectList = t_verb *> some t_ws *> t_objectList+        separator = some (many t_ws *> char ';' *> many t_ws)  -- grammar rule: [8] objectlist -- [8] objectList ::= object (',' object)*-t_objectList :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()-t_objectList = -- t_object actually adds the triples-  () <$ ((t_object <?> "object")-     *> many (try (many t_ws *> char ',' *> many t_ws *> t_object)))+t_objectList :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m ()+t_objectList = do+  (t_object <?> "object") >>= addTripleForObject+  void $ many (try (many t_ws *> char ',' *> many t_ws *> t_object >>= addTripleForObject))  -- grammar rule: [12] object -- [12]	object ::= iri | BlankNode | collection | blankNodePropertyList | literal-t_object :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()-t_object = do-  inColl <- isInColl-  inSubjColl <- isInSubjColl-  onFirstItem <- onCollFirstItem-  let processObject =-           (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)  -> BNodeGen <$> nextIdCounter >>= \bSubj -> addTripleForObject bSubj-                          *> pushSubj bSubj *> pushPred rdfFirstNode *> processObject *> collFirstItemProcessed---    (True,True,True)  -> processObject *> collFirstItemProcessed-    (True,True,True)  -> processObject *> collFirstItemProcessed *> popColl-    (True,_,False) -> BNodeGen <$> nextIdCounter >>= \bSubj -> pushPred rdfRestNode *>-                      addTripleForObject bSubj *> popPred *> popSubj *>-                      pushSubj bSubj *> processObject+t_object :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node+t_object = try (UNode <$> t_iri)+       <|> try t_blankNode+       <|> try t_collection+       <|> try t_blankNodePropertyList+       <|> t_literal --- collection: '(' ws* itemList? ws* ')'--- itemList:      object (ws+ object)* -- grammar rule: [15] collection--- 15]	collection ::= '(' object* ')'-t_collection :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()-t_collection =+-- [15]	collection ::= '(' object* ')'+t_collection :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node+t_collection = withConstantSubjectPredicate $   between (char '(') (char ')') $ do-    beginColl-    try empty_list <|> non_empty_list     void (many t_ws)-    void finishColl-    -- popColl-      where-        non_empty_list = do-          some (many t_ws *> t_object *> many t_ws)--          _inSubjColl <- isInSubjColl--          popPred-          pushPred rdfRestNode-          addTripleForObject rdfNilNode-          void popSubj--          -- popPred-          -- if inSubjColl then trace "is sub" popColl else trace "not sub" $ void popSubj-          -- if inSubjColl then pure () else trace "not sub" $ void popSubj--        empty_list = do-          lookAhead (try (many t_ws *> char ')'))-          addTripleForObject rdfNilNode+    root <- try empty_list <|> non_empty_list+    void (many t_ws)+    return root+  where+    empty_list = lookAhead (char ')') *> return rdfNilNode+    non_empty_list = do+      ns <- sepEndBy1 element (some t_ws)+      addTripleForObject rdfNilNode+      return (head ns)+    element = do+      o <- t_object+      bn <- nextBlankNode+      s <- getSubject+      when (isJust s) (addTripleForObject bn)+      setSubjectPredicate (Just bn) (Just rdfFirstNode)+      addTripleForObject o+      setPredicate rdfRestNode+      return bn+    getSubject = get >>= \(_, _, _, _, s, _, _, _) -> pure s  rdfTypeNode, rdfNilNode, rdfFirstNode, rdfRestNode :: Node rdfTypeNode   = UNode $ mkUri rdf "type"@@ -366,7 +325,7 @@ xsdDecimalUri = mkUri xsd "decimal" xsdBooleanUri = mkUri xsd "boolean" -t_literal :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m Node+t_literal :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m Node t_literal =   LNode <$> try t_rdf_literal                 <|>   (`mkLNode` xsdDoubleUri)  <$> try t_double  <|>@@ -379,117 +338,87 @@  -- [128s] RDFLiteral -- String (LANGTAG | '^^' iri)?-t_rdf_literal :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m LValue+t_rdf_literal :: (MonadState ParseState m, CharParsing m, LookAheadParsing m) => m LValue t_rdf_literal = do-  str' <- t_string-  let str = escapeRDFSyntax str'-  option (plainL str) $-                  try (t_langtag >>= \lang -> pure (plainLL str lang)) <|>-                   (count 2 (char '^') *> t_iri >>= \iri -> pure (typedL str iri))+  str <- t_string+  option (plainL str) (langTag str <|> typeIRI str)+  where+    langTag str = plainLL str <$> try t_langtag+    typeIRI str = typedL str <$> try (count 2 (char '^') *> t_iri)  -- [17] String -- STRING_LITERAL_QUOTE | STRING_LITERAL_SINGLE_QUOTE | STRING_LITERAL_LONG_SINGLE_QUOTE | STRING_LITERAL_LONG_QUOTE t_string :: (CharParsing m, Monad m) => m T.Text-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_string = try t_string_literal_long_double_quote+       <|> try t_string_literal_long_single_quote+       <|> try t_string_literal_double_quote+       <|> t_string_literal_single_quote  -- [22]	STRING_LITERAL_QUOTE -- '"' ([^#x22#x5C#xA#xD] | ECHAR | UCHAR)* '"'-t_string_literal_quote :: (CharParsing m, Monad m) => m T.Text-t_string_literal_quote =-     between (char '"') (char '"') $-      T.concat <$> many (T.singleton <$> noneOf ['\x22','\x5C','\xA','\xD'] <|>-            t_echar <|>-            t_uchar)+t_string_literal_double_quote :: (CharParsing m, Monad m) => m T.Text+t_string_literal_double_quote = nt_string_literal_quote  -- [23] STRING_LITERAL_SINGLE_QUOTE -- "'" ([^#x27#x5C#xA#xD] | ECHAR | UCHAR)* "'" t_string_literal_single_quote :: (CharParsing m, Monad m) => m T.Text-t_string_literal_single_quote =-    between (char '\'') (char '\'') $-      T.concat <$>-       many (T.singleton <$> noneOf ['\x27','\x5C','\xA','\xD'] <|>-             t_echar <|>-             t_uchar)+t_string_literal_single_quote = string_literal_quote '\''  -- [24] STRING_LITERAL_LONG_SINGLE_QUOTE -- "'''" (("'" | "''")? ([^'\] | ECHAR | UCHAR))* "'''" t_string_literal_long_single_quote :: (CharParsing m, Monad m) => m 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-        pure (s1 `T.append` s2)-      pure (T.concat ss)+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)+    pure (s1 `T.append` s2)+  pure (T.concat ss)  -- [25] STRING_LITERAL_LONG_QUOTE -- '"""' (('"' | '""')? ([^"\] | ECHAR | UCHAR))* '"""'-t_string_literal_long_quote :: (CharParsing m, Monad m) => m 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-              pure (s1 `T.append` s2)-      pure (T.concat ss)+t_string_literal_long_double_quote :: (CharParsing m, Monad m) => m T.Text+t_string_literal_long_double_quote = between (string "\"\"\"") (string "\"\"\"") $ do+  ss <- many $ try $ do+    s1 <- T.pack <$> option "" (try (string "\"\"") <|> string "\"")+    s2 <- T.singleton <$> (noneOf ['"','\\'] <|> t_echar <|> t_uchar)+    pure (s1 `T.append` s2)+  pure (T.concat ss)  -- [144s] LANGTAG--- '@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)* t_langtag :: (CharParsing m, Monad m) => m T.Text-t_langtag = do-    ss   <- char '@' *> some (satisfy isLetter)-    rest <- concat <$> many (char '-' *> some (satisfy isAlphaNum) >>= \lang_str -> pure ('-':lang_str))-    pure (T.pack (ss ++ rest))+t_langtag = nt_langtag  -- [159s]	ECHAR--- '\' [tbnrf"'\]-t_echar :: (CharParsing m, Monad m) => m T.Text-t_echar = try $ do-    c2 <- char '\\' *> oneOf ['t','b','n','r','f','"','\'','\\']-    case c2 of-       't'  -> pure $ T.singleton '\t'-       'b'  -> pure $ T.singleton '\b'-       'n'  -> pure $ T.singleton '\n'-       'r'  -> pure $ T.singleton '\r'-       'f'  -> pure $ T.singleton '\f'-       '"'  -> pure $ T.singleton '\"'-       '\'' -> pure $ T.singleton '\''-       '\\' -> pure $ T.singleton '\\'-       _    -> fail "nt_echar: impossible error."+t_echar :: (CharParsing m, Monad m) => m Char+t_echar = nt_echar  -- [26]	UCHAR--- '\u' HEX HEX HEX HEX | '\U' HEX HEX HEX HEX HEX HEX HEX HEX-t_uchar :: (CharParsing m, Monad m) => m T.Text-t_uchar =-    (try (string "\\u" *> count 4 hexDigit) >>= \cs -> pure $ T.pack ('\\':'u':cs)) <|>-     (char '\\' *> char 'U' *> count 8 hexDigit >>= \cs -> pure $ T.pack ('\\':'U':cs))+t_uchar :: (CharParsing m, Monad m) => m Char+t_uchar = nt_uchar  -- [19] INTEGER ::= [+-]? [0-9]+ t_integer :: (CharParsing m, Monad m) => m T.Text-t_integer = try $-  do sign <- sign_parser <?> "+-"-     ds <- some (satisfy isDigit <?> "digit")-     pure $! ( T.pack sign `T.append` T.pack ds)+t_integer = try $ do+  sign <- sign_parser <?> "+-"+  ds <- some (satisfy isDigit <?> "digit")+  pure $! ( 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 :: (CharParsing m, Monad m) => m T.Text-t_double =-  do sign <- sign_parser <?> "+-"-     rest <- try (do { ds <- (some (satisfy isDigit) <?> "digit") <* char '.';-                      ds' <- many (satisfy isDigit) <?> "digit";-                      e <- t_exponent <?> "exponent";-                      pure ( T.pack ds `T.snoc` '.' `T.append`  T.pack ds' `T.append` e) }) <|>-             try (do { ds <- char '.' *> some (satisfy isDigit) <?> "digit";-                       e <- t_exponent <?> "exponent";-                       pure ('.' `T.cons`  T.pack ds `T.append` e) }) <|>-                 (do { ds <- some (satisfy isDigit) <?> "digit";-                       e <- t_exponent <?> "exponent";-                       pure ( T.pack ds `T.append` e) })-     pure $! T.pack sign `T.append` rest+t_double = do+  sign <- sign_parser <?> "+-"+  rest <- try (do { ds <- (some (satisfy isDigit) <?> "digit") <* char '.';+                  ds' <- many (satisfy isDigit) <?> "digit";+                  e <- t_exponent <?> "exponent";+                  pure ( T.pack ds `T.snoc` '.' `T.append`  T.pack ds' `T.append` e) }) <|>+         try (do { ds <- char '.' *> some (satisfy isDigit) <?> "digit";+                   e <- t_exponent <?> "exponent";+                   pure ('.' `T.cons`  T.pack ds `T.append` e) }) <|>+             (do { ds <- some (satisfy isDigit) <?> "digit";+                   e <- t_exponent <?> "exponent";+                   pure ( T.pack ds `T.append` e) })+  pure $! T.pack sign `T.append` rest  sign_parser :: CharParsing m => m String sign_parser = option "" (pure <$> oneOf "-+")@@ -497,246 +426,156 @@ -- [20]	DECIMAL ::= [+-]? [0-9]* '.' [0-9]+ t_decimal :: (CharParsing m, Monad m) => m T.Text t_decimal = try $ do-              sign <- sign_parser-              dig1 <- many (satisfy isDigit) <* char '.'-              dig2 <- some (satisfy isDigit)-              pure (T.pack sign `T.append`  T.pack dig1 `T.append` T.pack "." `T.append` T.pack dig2)+  sign <- sign_parser+  dig1 <- many (satisfy isDigit) <* char '.'+  dig2 <- some (satisfy isDigit)+  pure (T.pack sign `T.append`  T.pack dig1 `T.append` T.pack "." `T.append` T.pack dig2) +-- [154s] EXPONENT ::= [eE] [+-]? [0-9]+ t_exponent :: (CharParsing m, Monad m) => m T.Text t_exponent = do e <- oneOf "eE"                 s <- option "" (pure <$> oneOf "-+")                 ds <- some digit                 pure $! (e `T.cons` ( T.pack s `T.append` T.pack ds)) +-- [133s] BooleanLiteral ::= 'true' | 'false' t_boolean :: CharParsing m => m T.Text-t_boolean =-  T.pack <$> try (string "true" <|> string "false")+t_boolean = T.pack <$> try (string "true" <|> string "false")  t_comment :: CharParsing m => m ()-t_comment =-  void (char '#' *> many (noneOf "\n\r"))+t_comment = void (char '#' *> many (noneOf "\n\r"))+--[TODO] t_comment = nt_comment  -- [161s] WS ::= #x20 | #x9 | #xD | #xA t_ws :: CharParsing m => m ()-t_ws =-    (void (try (oneOf "\t\n\r "))) <|> try t_comment-    <?> "whitespace-or-comment"+t_ws = (void (try (oneOf "\t\n\r "))) <|> try t_comment+   <?> "whitespace-or-comment" --- grammar rule: [167s] PN_PREFIX+-- [167s] PN_PREFIX ::= PN_CHARS_BASE ((PN_CHARS | '.')* PN_CHARS)? t_pn_prefix :: (CharParsing m, MonadState ParseState m) => m T.Text t_pn_prefix = do   i <- try t_pn_chars_base   r <- option "" (many (try t_pn_chars <|> char '.')) -- TODO: ensure t_pn_chars is last char   pure (T.pack (i:r)) --- [18] IRIREF+-- [18] IRIREF ::= '<' ([^#x00-#x20<>"{}|^`\] | UCHAR)* '>' t_iriref :: (CharParsing m, MonadState ParseState m) => m T.Text-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 :: CharParsing m => m Char-t_pn_chars = t_pn_chars_u <|> char '-' <|> char '\x00B7' <|> satisfy f-  where-    f = flip in_range [('0', '9'), ('\x0300', '\x036F'), ('\x203F', '\x2040')]+t_iriref = between (char '<') (char '>') $ do+  iriFrag <- iriFragment+  bUrl <- currBaseUrl+  dUrl <- currDocUrl+  tryIriResolution bUrl dUrl iriFrag --- grammar rule: [163s] PN_CHARS_BASE+-- [163s] PN_CHARS_BASE t_pn_chars_base :: CharParsing m => m Char-t_pn_chars_base = try $ satisfy $ flip in_range blocks-  where-    blocks = [('A', 'Z'), ('a', 'z'), ('\x00C0', '\x00D6'),-              ('\x00D8', '\x00F6'), ('\x00F8', '\x02FF'),-              ('\x0370', '\x037D'), ('\x037F', '\x1FFF'),-              ('\x200C', '\x200D'), ('\x2070', '\x218F'),-              ('\x2C00', '\x2FEF'), ('\x3001', '\xD7FF'),-              ('\xF900', '\xFDCF'), ('\xFDF0', '\xFFFD'),-              ('\x10000', '\xEFFFF')]+t_pn_chars_base = nt_pn_chars_base --- grammar rule: [164s] PN_CHARS_U+-- [164s] PN_CHARS_U ::= PN_CHARS_BASE | '_' t_pn_chars_u :: CharParsing m => m Char t_pn_chars_u = t_pn_chars_base <|> char '_' +-- [166s] PN_CHARS ::= PN_CHARS_U | '-' | [0-9] | #x00B7 | [#x0300-#x036F] | [#x203F-#x2040]+t_pn_chars :: CharParsing m => m Char+t_pn_chars = t_pn_chars_u <|> char '-' <|> char '\x00B7' <|> satisfy f+  where f = flip in_range [('0', '9'), ('\x0300', '\x036F'), ('\x203F', '\x2040')]+ -- grammar rules: [171s] HEX--- TODO Should this support lowercase hex characters? if so, use Char.isHexDigit t_hex :: CharParsing m => m Char--- t_hex = satisfy (\c -> isDigit c || (c >= 'A' && c <= 'F')) <?> "hexadecimal digit" t_hex = satisfy isHexDigit <?> "hexadecimal digit"  {-# INLINE in_range #-} in_range :: Char -> [(Char, Char)] -> Bool in_range c = any (\(c1, c2) -> c >= c1 && c <= c2) -newBaseUrl :: Maybe BaseUrl -> T.Text -> BaseUrl-newBaseUrl Nothing               url = BaseUrl url-newBaseUrl (Just (BaseUrl bUrl)) url = BaseUrl $! mkAbsoluteUrl bUrl url--currGenIdLookup :: MonadState ParseState m => m (Map String Int)-currGenIdLookup = gets $ \(_, _, _, _, _, _, _, _, _, _,genMap) -> genMap+currGenIdLookup :: MonadState ParseState m => m (Map String Integer)+currGenIdLookup = gets $ \(_, _, _, _, _, _, _,genMap) -> genMap -addGenIdLookup :: MonadState ParseState m => String -> Int -> m ()+addGenIdLookup :: MonadState ParseState m => String -> Integer -> m () addGenIdLookup genId counter =-  modify $ \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->-            (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, Map.insert genId counter genMap)+  modify $ \(bUrl, dUrl, i, pms, s, p, ts, genMap) ->+            (bUrl, dUrl, i, pms, s, p, ts, Map.insert genId counter genMap)  currBaseUrl :: MonadState ParseState m => m (Maybe BaseUrl)-currBaseUrl = gets $ \(bUrl, _, _, _, _, _, _, _, _, _,_) -> bUrl+currBaseUrl = gets $ \(bUrl, _, _, _, _, _, _,_) -> bUrl  currDocUrl :: MonadState ParseState m => m (Maybe T.Text)-currDocUrl = gets $ \(_, dUrl, _, _, _, _, _, _, _, _,_) -> dUrl--pushSubj :: MonadState ParseState m => Subject -> m ()-pushSubj s = modify $ \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->-                       (bUrl, dUrl, i, pms, s:ss, ps, cs, subjC, subjBNodeList, ts, genMap)--popSubj :: (CharParsing m, MonadState ParseState m) => m Subject-popSubj = get >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->-                put (bUrl, dUrl, i, pms, tail ss, ps, cs, subjC, subjBNodeList, ts, genMap)-                  *> when (null ss) (fail "Cannot pop subject off empty stack.")-                  *> pure (head ss)--pushPred :: MonadState ParseState m => Predicate -> m ()-pushPred p = modify $ \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->-                       (bUrl, dUrl, i, pms, ss, p:ps, cs, subjC, subjBNodeList, ts, genMap)--popPred :: MonadState ParseState m => m Predicate-popPred = get >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->-                put (bUrl, dUrl, i, pms, ss, tail ps, cs, subjC, subjBNodeList, ts, genMap)-                  *> when (null ps) (fail "Cannot pop predicate off empty stack.")-                  *> pure (head ps)--isInColl :: MonadState ParseState m => m Bool-isInColl = gets $ \(_, _, _, _, _, _, cs, _, _, _, _) -> not . null $ cs--isInSubjColl :: MonadState ParseState m => m Bool-isInSubjColl = gets $ \(_, _, _, _, _, _, _, xs, _, _, _) ->-                   if null xs then False else (head xs)--{--isInObjColl :: (CharParsing m, MonadState ParseState m) => m Bool-isInObjColl = get >>= \(_, _, _, _, _, _, _, xs, _, _) -> do-               when (null xs) $ error "null in isInObjColl"-               pure (not (head xs))--}--pushSubjColl :: MonadState ParseState m => m ()-pushSubjColl = modify $ \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts, genMap) ->-                         (bUrl, dUrl, i, pms, s, p, cs, True:subjC, subjBNodeList, ts, genMap)--popColl :: (CharParsing m, MonadState ParseState m) => m ()-popColl = get >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts, genMap) -> do-                when (null subjC) $ fail "null in popColl"-                put (bUrl, dUrl, i, pms, s, p, cs, tail subjC, subjBNodeList, ts, genMap)--pushObjColl :: MonadState ParseState m => m ()-pushObjColl = modify $ \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->-                        (bUrl, dUrl, i, pms, s, p, cs, False:subjC, subjBNodeList, ts,genMap)--isSubjPropList :: MonadState ParseState m => m Bool-isSubjPropList = gets $ \(_, _, _, _, _, _, _, _, subjBNodeList, _,_) -> subjBNodeList--{--isObjPropList :: (CharParsing m, MonadState ParseState m) => m Bool-isObjPropList = get >>= \(_, _, _, _, _, _, _, _, subjBNodeList, _) -> do-                pure subjBNodeList--}--setSubjBlankNodePropList :: MonadState ParseState m => m ()-setSubjBlankNodePropList =-  modify $ \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts,genMap) ->-            (bUrl, dUrl, i, pms, s, p, cs, subjC, True, ts,genMap)--setNotSubjBlankNodePropList :: MonadState ParseState m => m ()-setNotSubjBlankNodePropList =-  modify $ \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts,genMap) ->-            (bUrl, dUrl, i, pms, s, p, cs, subjC, True, ts,genMap)---- setObjBlankNodePropList :: (CharParsing m, Monad m) => m ()--- setObjBlankNodePropList = get >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts) ->---                  put (bUrl, dUrl, i, pms, s, p, cs, subjC, False, ts)---- popBlankNodePropList :: (CharParsing m, Monad m) => m ()--- popBlankNodePropList = get >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _:subjBNodeList, ts) ->---                  when (null subjBNodeList) $ "no subj/obj flag to pop when exiting collection"---                  put (bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts)+currDocUrl = gets $ \(_, dUrl, _, _, _, _, _,_) -> dUrl  updateBaseUrl :: MonadState ParseState m => Maybe (Maybe BaseUrl) -> m () updateBaseUrl val = _modifyState val no no no no no  -- combines get_current and increment into a single function-nextIdCounter :: MonadState ParseState m => m Int-nextIdCounter = get >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->-                put (bUrl, dUrl, i+1, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) *> pure i+nextIdCounter :: MonadState ParseState m => m Integer+nextIdCounter = get >>= \(bUrl, dUrl, i, pms, s, p, ts, genMap) ->+                put (bUrl, dUrl, i+1, pms, s, p, ts, genMap) *> pure i +nextBlankNode :: MonadState ParseState m => m Node+nextBlankNode = BNodeGen . fromIntegral <$> nextIdCounter+ updatePMs :: MonadState ParseState m => Maybe PrefixMappings -> m () updatePMs val = _modifyState no no val no no no --- Register that we have begun processing a collection-beginColl :: MonadState ParseState m => m ()-beginColl = modify $ \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->-                      (bUrl, dUrl, i, pms, s, p, True:cs, subjC, subjBNodeList, ts,genMap)--onCollFirstItem :: MonadState ParseState m => m Bool-onCollFirstItem = gets $ \(_, _, _, _, _, _, cs, _, _, _,_) -> (not (null cs) && head cs)--collFirstItemProcessed :: MonadState ParseState m => m ()-collFirstItemProcessed =-  modify $ \(bUrl, dUrl, i, pms, s, p, _:cs, subjC, subjBNodeList, ts,genMap) ->-            (bUrl, dUrl, i, pms, s, p, False:cs, subjC, subjBNodeList, ts,genMap)---- Register that a collection is finished being processed; the bool value--- in the monad is *not* the value that was popped from the stack, but whether--- we are still processing a parent collection or have finished processing--- all collections and are no longer in a collection at all.-finishColl :: MonadState ParseState m => m Bool-finishColl = get >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->-             let cs' = drop 1 cs-             in put (bUrl, dUrl, i, pms, s, p, cs', subjC, subjBNodeList, ts,genMap) *> pure (not $ null cs')- -- Alias for Nothing for use with _modifyState calls, which can get very long with -- many Nothing values. no :: Maybe a no = Nothing +withConstantSubjectPredicate :: MonadState ParseState m => m a -> m a+withConstantSubjectPredicate a = do+  (_, _, _, _, s, p, _, _) <- get+  a' <- a+  (bUrl, dUrl, n, pms, _, _, ts, genMap) <- get+  put (bUrl, dUrl, n, pms, s, p, ts, genMap)+  return a'++-- Update the subject and predicate values of the ParseState+setSubjectPredicate :: MonadState ParseState m => Maybe Subject -> Maybe Predicate -> m ()+setSubjectPredicate s p =+  modify $ \(bUrl, dUrl, n, pms, _, _, ts, genMap) ->+            (bUrl, dUrl, n, pms, s, p, ts, genMap)++setSubject :: MonadState ParseState m => Subject -> m ()+setSubject s =+  modify $ \(bUrl, dUrl, n, pms, _, p, ts, genMap) ->+            (bUrl, dUrl, n, pms, Just s, p, ts, genMap)++setPredicate :: MonadState ParseState m => Predicate -> m ()+setPredicate p =+  modify $ \(bUrl, dUrl, n, pms, s, _, ts, genMap) ->+            (bUrl, dUrl, n, pms, s, Just p, ts, genMap)+ -- Update the subject and predicate values of the ParseState to Nothing. resetSubjectPredicate :: MonadState ParseState m => m ()-resetSubjectPredicate =-  modify $ \(bUrl, dUrl, n, pms, _, _, cs, subjC, subjBNodeList, ts,genMap) ->-            (bUrl, dUrl, n, pms, [], [], cs, subjC, subjBNodeList, ts,genMap)+resetSubjectPredicate = setSubjectPredicate Nothing Nothing  -- Modifies the current parser state by updating any state values among the parameters -- that have non-Nothing values. _modifyState :: MonadState ParseState m =>-                Maybe (Maybe BaseUrl) -> Maybe (Int -> Int) -> Maybe PrefixMappings ->-                Maybe Subject -> Maybe Predicate -> Maybe (Seq Triple) ->+                Maybe (Maybe BaseUrl) -> Maybe (Integer -> Integer) -> Maybe PrefixMappings ->+                Maybe (Maybe Subject) -> Maybe (Maybe Predicate) -> Maybe (Seq Triple) ->                 m ()-_modifyState mb_bUrl mb_n mb_pms mb_subj mb_pred mb_trps =-  do (_bUrl, _dUrl, _n, _pms, _s, _p, _cs, _subjC, _subjBNodeList, _ts,genMap) <- get-     put (fromMaybe _bUrl mb_bUrl,-              _dUrl,-              maybe _n (const _n) mb_n,-              fromMaybe _pms mb_pms,-              maybe _s (: _s) mb_subj,-              maybe _p (: _p) mb_pred,-              _cs,-              _subjC,-              _subjBNodeList,-              fromMaybe _ts mb_trps,genMap)+_modifyState mb_bUrl mb_n mb_pms mb_subj mb_pred mb_trps = do+  (_bUrl, _dUrl, _n, _pms, _s, _p, _ts, genMap) <- get+  put ( fromMaybe _bUrl mb_bUrl+      , _dUrl+      , maybe _n (const _n) mb_n+      , fromMaybe _pms mb_pms+      , maybe _s (const _s) mb_subj+      , maybe _p (const _p) mb_pred+      , fromMaybe _ts mb_trps, genMap )  addTripleForObject :: (CharParsing m, MonadState ParseState m) => Object -> m ()-addTripleForObject obj =-  do (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts,genMap) <- get-     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-     put (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts |> Triple (head ss) (head ps) obj,genMap)+addTripleForObject obj = do+  (bUrl, dUrl, i, pms, s, p, ts, genMap) <- get+  t <- getTriple s p+  put (bUrl, dUrl, i, pms, s, p, ts |> t, genMap)+  where+    getTriple Nothing   _         = unexpected $ "No Subject with which to create triple for: " ++ show obj+    getTriple _         Nothing   = unexpected $ "No Predicate with which to create triple for: " ++ show obj+    getTriple (Just s') (Just p') = pure $ Triple s' p' obj  + --------------------------------- -- parsec based parsers @@ -770,11 +609,12 @@ -- as 'parseURL', except that the last @String@ argument corresponds to a filesystem location rather -- than a location URI. --+-- Note: it does not relies on OS specificities (encoding, newline convention).+-- -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples. parseFileParsec :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure (RDF a)) parseFileParsec bUrl docUrl fpath =-  TIO.readFile fpath >>= \bs' -> pure $ handleResult bUrl (runParser (evalStateT t_turtleDoc (initialState bUrl docUrl)) () (maybe "" T.unpack docUrl) bs')-+  readFile fpath >>= \c -> pure $ handleResult bUrl (runParser (evalStateT t_turtleDoc (initialState bUrl docUrl)) () (maybe "" T.unpack docUrl) c)  -- |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@@ -787,16 +627,16 @@ -- attoparsec based parsers  parseStringAttoparsec :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> T.Text -> Either ParseFailure (RDF a)-parseStringAttoparsec bUrl docUrl bs = handleResult' $ parse (evalStateT t_turtleDoc (initialState bUrl docUrl)) (T.encodeUtf8 bs)+parseStringAttoparsec bUrl docUrl t = handleResult' $ parse (evalStateT t_turtleDoc (initialState bUrl docUrl)) t   where     handleResult' res = case res of         Fail _ _ err -> -- error err           Left $ ParseFailure $ "Parse failure: \n" ++ show err-        Partial f -> handleResult' (f (T.encodeUtf8 T.empty))+        Partial f -> handleResult' (f mempty)         Done _ (ts,pms) -> Right $! mkRdf (F.toList ts) bUrl pms  parseFileAttoparsec :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure (RDF a))-parseFileAttoparsec bUrl docUrl path = parseStringAttoparsec bUrl docUrl <$> TIO.readFile path+parseFileAttoparsec bUrl docUrl path = parseStringAttoparsec bUrl docUrl <$> readFile path  parseURLAttoparsec :: (Rdf a) =>                  Maybe BaseUrl       -- ^ The optional base URI of the document.@@ -810,27 +650,13 @@ ---------------------------------  initialState :: Maybe BaseUrl -> Maybe T.Text -> ParseState-initialState bUrl docUrl = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], [], False, Seq.empty,Map.empty)+initialState bUrl docUrl = (bUrl, docUrl, 1, PrefixMappings mempty, Nothing, Nothing, mempty, mempty)   handleResult :: Rdf a => Maybe BaseUrl -> Either ParseError (Seq Triple, PrefixMappings) -> Either ParseFailure (RDF a)-handleResult bUrl result =-  case result of-    (Left err)         -> Left (ParseFailure $ show err)-    (Right (ts, pms))  -> Right $! mkRdf (F.toList ts) bUrl pms--validateUNode :: CharParsing m => T.Text -> m Node-validateUNode t =-    case unodeValidate t of-      Nothing        -> unexpected ("Invalid URI in Turtle parser URI validation: " ++ show t)-      Just u@UNode{} -> pure u-      Just node      -> unexpected ("Unexpected node in Turtle parser URI validation: " ++ show node)--validateURI :: (CharParsing m, Monad m) => T.Text -> m T.Text-validateURI t = do-    UNode uri <- validateUNode t-    pure uri-+handleResult bUrl result = case result of+  (Left err)         -> Left (ParseFailure $ "Parse failure: \n" ++ show err)+  (Right (ts, pms))  -> Right $! mkRdf (F.toList ts) bUrl pms   --------------@@ -843,3 +669,11 @@ -- Match the string 's', accepting either lowercase or uppercase form of each character caseInsensitiveString :: (CharParsing m, Monad m) => String -> m String caseInsensitiveString s = try (mapM caseInsensitiveChar s) <?> "\"" ++ s ++ "\""++tryIriResolution :: (CharParsing m, Monad m) => Maybe BaseUrl -> Maybe T.Text -> T.Text -> m T.Text+tryIriResolution mbUrl mdUrl iriFrag = tryIriResolution' mbUrl mdUrl+  where+    tryIriResolution' (Just (BaseUrl bIri)) _ = either err pure (resolveIRI bIri iriFrag)+    tryIriResolution' _ (Just dIri)           = either err pure (resolveIRI dIri iriFrag)+    tryIriResolution' _ _                     = either err pure (resolveIRI mempty iriFrag)+    err m = unexpected $ "Cannot resolve IRI: " ++ m ++ " " ++ show (mbUrl, mdUrl, iriFrag)

@@ -0,0 +1,104 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.RDF.GraphImplTests (graphImplTests) where++import Data.RDF++import qualified Data.Map as Map+import Test.Tasty+import qualified Test.Tasty.HUnit as TU+++----------------------------------------------------+--  unit test cases         --+----------------------------------------------------++graphImplTests :: TestTree+graphImplTests =+  testGroup "graph-unit-tests"+  [+    testGroup "graph-impl-pred"+    [ testGroup "adjHashMap" [adjHashMap1,adjHashMap2]+    , testGroup "tlist" [tList1,tList2]+    ]+  ,+    testGroup "quickcheck-cases"+    [ testGroup "tlist" [tList3]+    ]+  ]++-- https://github.com/robstewart57/rdf4h/issues/49+adjHashMap1 :: TestTree+adjHashMap1 =+  let content = "PREFIX ex: <ex:> ex:s1  ex:p1 ex:o1 ;  ex:p2 ex:o2  ."+      Right g = parseString (TurtleParser Nothing Nothing) content :: Either ParseFailure (RDF AdjHashMap)+      res = query g Nothing (Just $ unode "ex:p1") Nothing+  in TU.testCase "adjHashMap1" $+     TU.assertBool+     "adjHashMap1 mkRdf test"+     (res+      ==+      [Triple (UNode "ex:s1") (UNode "ex:p1") (UNode "ex:o1")])++-- https://github.com/robstewart57/rdf4h/issues/49+adjHashMap2 :: TestTree+adjHashMap2 =+  let g = mkRdf+            [ Triple (unode "ex:s1") (unode "ex:p1") (unode "ex:o1")+            , Triple (unode "ex:s1") (unode "ex:p2") (unode "ex:o2")+            ]+            Nothing+            (PrefixMappings Map.empty) :: RDF AdjHashMap+      res = query g Nothing (Just $ unode "ex:p1") Nothing+  in TU.testCase "adjHashMap2" $+     TU.assertBool+     "adjHashMap1 mkRdf test"+     (res+      ==+      [Triple (UNode "ex:s1") (UNode "ex:p1") (UNode "ex:o1")])++-- https://github.com/robstewart57/rdf4h/issues/49+tList1 :: TestTree+tList1 =+  let content = "PREFIX ex: <ex:> ex:s1  ex:p1 ex:o1 ;  ex:p2 ex:o2  ."+      Right g = parseString (TurtleParser Nothing Nothing) content :: Either ParseFailure (RDF TList)+      res = query g Nothing (Just $ unode "ex:p1") Nothing+  in TU.testCase "tList1" $+     TU.assertBool+     "tList1 mkRdf test"+     (res+      ==+      [Triple (UNode "ex:s1") (UNode "ex:p1") (UNode "ex:o1")])++-- https://github.com/robstewart57/rdf4h/issues/49+tList2 :: TestTree+tList2 =+  let g = mkRdf+            [ Triple (unode "ex:s1") (unode "ex:p1") (unode "ex:o1")+            , Triple (unode "ex:s1") (unode "ex:p2") (unode "ex:o2")+            ]+            Nothing+            (PrefixMappings Map.empty) :: RDF AdjHashMap+      res = query g Nothing (Just $ unode "ex:p1") Nothing+  in TU.testCase "tList1" $+     TU.assertBool+     "tList1 mkRdf test"+     (res+      ==+      [Triple (UNode "ex:s1") (UNode "ex:p1") (UNode "ex:o1")])++tList3 :: TestTree+tList3 =+  let ts =+        [ Triple (BNode ":_genid2") (UNode "http://www.example.org/bar1") (LNode (PlainLL "haskell" "en"))+        , Triple (UNode "ex:s1") (UNode "ex:o2") (LNode (TypedL "haskell" "http://www.w3.org/2001/XMLSchema#int"))+        , Triple (UNode "ex:p2") (UNode "http://www.example.org/bar1") (LNode (PlainLL "earth" "fr"))+        , Triple (UNode "ex:p3") (UNode "ex:s3") (LNode (PlainLL "earth" "fr"))+        , Triple (UNode "ex:p2") (UNode "http://www.example.org/bar1") (LNode (PlainLL "earth" "fr"))+        ]+      gr = mkRdf ts Nothing (PrefixMappings Map.empty) :: RDF TList+      res = query gr (Just (unode "ex:p2")) (Just (unode "http://www.example.org/bar1")) (Just (lnode (plainLL "earth" "fr")))+  in TU.testCase "tList2" $+     TU.assertBool+     "tList2"+     (res == [Triple (UNode "ex:p2") (UNode "http://www.example.org/bar1") (LNode (PlainLL "earth" "fr"))])

@@ -0,0 +1,177 @@+--{-# LANGUAGE DeriveGeneric #-}+--{-# LANGUAGE TypeFamilies #-}+--{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.RDF.IRITests+  ( iriTests+  ) where
++import Data.Either+import Data.Text ()+import Data.RDF.IRI
+
+import Test.Tasty+import Test.Tasty.HUnit++iriTests :: TestTree+iriTests =+  testGroup "iri-unit-tests"+  [ testCase "No scheme 01" $+      assertEqual ""+        (Right (IRIRef Nothing authority02 mempty Nothing Nothing))+        (parseRelIRI "//duckduckgo.com")+  , testCase "No scheme 02" $+      assertBool "" (isRight (parseRelIRI "duckduckgo.com"))+  , testCase "No path" $+      assertEqual ""+      (Right (IRIRef https authority01 mempty Nothing Nothing))+      (parseIRI "https://en.wikipedia.org")+  , testCase "Scheme case" $+      assertEqual ""+      (Right (IRIRef https authority01 mempty Nothing Nothing))+      (parseIRI "htTpS://en.wikipedia.org")+  , testCase "Empty query" $+    assertEqual ""+      (Right (IRIRef https authority02 mempty (Just mempty) Nothing))+      (parseIRI "https://duckduckgo.com?")+  , testCase "Empty fragment" $+    assertEqual ""+      (Right (IRIRef https authority02 mempty Nothing (Just mempty)))+      (parseIRI "https://duckduckgo.com#")+  , testCase "Empty query & fragment" $+    assertEqual ""+      (Right (IRIRef https authority02 mempty (Just mempty) (Just mempty)))+      (parseIRI "https://duckduckgo.com?#")+  , testCase "Simple query without path" $+    assertEqual ""+      (Right (IRIRef https authority02 mempty query01 Nothing))+      (parseIRI "https://duckduckgo.com?q=Uniform+Resource+Identifier")+  , testCase "Simple query with path" $+    assertEqual ""+      (Right (IRIRef https authority02 (Path "/") query01 Nothing))+      (parseIRI "https://duckduckgo.com/?q=Uniform+Resource+Identifier")+  , testCase "Japanese characters 01" $+    assertEqual ""+      (Right (IRIRef https authority03 mempty Nothing Nothing))+      (parseIRI "https://www.ほんとうにながいわけのわからないどめいんめいのらべるまだながくしないとたりない.w3.mag.keio.ac.jp")+  , testCase "Empty Filepath" $+    assertEqual ""+      (Right (IRIRef file emptyAuthority mempty Nothing Nothing))+      (parseIRI "file://")+  , testCase "Simple Filepath 01" $+    assertEqual ""+      (Right (IRIRef file emptyAuthority (Path "/") Nothing Nothing))+      (parseIRI "file:///")+  , testCase "Simple Filepath 02" $+    assertEqual ""+      (Right (IRIRef file emptyAuthority (Path "/temp") Nothing Nothing))+      (parseIRI "file:///temp")+  , testCase "Simple Filepath 03" $+    assertEqual ""+      (Right (IRIRef file emptyAuthority (Path "/temp/test.txt") Nothing Nothing))+      (parseIRI "file:///temp/test.txt")+  , testCase "Example for IRI resolution 1" $+    assertEqual ""+      (Right (IRIRef http authority04 (Path "/bb/ccc/d;p") (Just $ Query "q") Nothing))+      (parseIRI "http://a/bb/ccc/d;p?q")+  , testCase "Example for IRI resolution 2" $+    assertEqual ""+      (Right (IRIRef (Just $ Scheme "g") Nothing (Path "h") Nothing Nothing))+      (parseIRI "g:h")+  , testCase "Example for IRI resolution 3a" $+    assertBool "" (isLeft (parseIRI "g"))+  , testCase "Example for IRI resolution 3b" $+    assertEqual ""+      (Right (IRIRef Nothing Nothing (Path "g") Nothing Nothing))+      (parseRelIRI "g")+  , testCase "Example for IRI resolution 4" $+    assertEqual ""+      (Right (IRIRef Nothing Nothing (Path "..") Nothing Nothing))+      (parseRelIRI "..")+  , testCase "IRI resolution 0" $+    assertEqual ""+      (Right "http://a/bb/ccc/d;p?q")+      (resolveIRI "http://a/bb/ccc/d;p?q" "")+  , testCase "IRI resolution 1" $+    assertEqual ""+      (Right "g:h")+      (resolveIRI "http://a/bb/ccc/d;p?q" "g:h")+  , testCase "IRI resolution 2" $+    assertEqual ""+      (Right "http://a/bb/ccc/g")+      (resolveIRI "http://a/bb/ccc/d;p?q" "g")+  , testCase "IRI resolution 3" $+    assertEqual ""+      (Right "http://a/bb/ccc/g")+      (resolveIRI "http://a/bb/ccc/d;p?q" "./g")+  , testCase "IRI resolution 4" $+    assertEqual ""+      (Right "http://a/bb/ccc/g/")+      (resolveIRI "http://a/bb/ccc/d;p?q" "g/")+  , testCase "IRI resolution 5" $+    assertEqual ""+      (Right "http://a/g")+      (resolveIRI "http://a/bb/ccc/d;p?q" "/g")+  , testCase "IRI resolution 6" $+    assertEqual ""+      (Right "http://a/bb/ccc/g/")+      (resolveIRI "http://a/bb/ccc/d;p?q" "./g/.")+  , testCase "IRI resolution 7" $+    assertEqual ""+      (Right "http://a/bb/")+      (resolveIRI "http://a/bb/ccc/d;p?q" "..")+  , testCase "IRI resolution 8" $+    assertEqual ""+      (Right "http://a/g")+      (resolveIRI "http://a/bb/ccc/d;p?q" "../../../g")+  , testCase "IRI resolution 9" $+    assertEqual ""+      (Right "http://a.com/bb/ccc/test.ttl#")+      (resolveIRI "http://a.com/bb/ccc/test.ttl" "#")+  , testCase "IRI resolution 10" $+    assertEqual ""+      (Right "http://a/bb/ccc/d;p?q#")+      (resolveIRI "http://a/bb/ccc/d;p?q" "#")+  ]++http :: Maybe Scheme+http = Just $ Scheme "http"++https :: Maybe Scheme+https = Just $ Scheme "https"++file :: Maybe Scheme+file = Just $ Scheme "file"++emptyAuthority :: Maybe Authority+emptyAuthority = Just $ Authority Nothing (Host mempty) Nothing++authority01 :: Maybe Authority+authority01 = Just $ Authority Nothing host01 Nothing++authority02 :: Maybe Authority+authority02 = Just $ Authority Nothing host02 Nothing++authority03 :: Maybe Authority+authority03 = Just $ Authority Nothing host03 Nothing++authority04 :: Maybe Authority+authority04 = Just $ Authority Nothing (Host "a") Nothing++host01 :: Host+host01 = Host "en.wikipedia.org"++host02 :: Host+host02 = Host "duckduckgo.com"++host03 :: Host+host03 = Host "www.ほんとうにながいわけのわからないどめいんめいのらべるまだながくしないとたりない.w3.mag.keio.ac.jp"++query01 :: Maybe Query+query01 = Just $ Query "q=Uniform+Resource+Identifier"++{-+fragment01 :: Maybe Fragment+fragment01 = Just $ Fragment "top"+-}

@@ -3,16 +3,18 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -module Data.RDF.PropertyTests (graphTests,arbitraryTs) where+module Data.RDF.PropertyTests (graphTests) where -import Data.RDF-import Data.RDF.Namespace+import qualified Data.Text.IO as T+import Data.RDF hiding (empty)+import Data.RDF.Namespace hiding (rdf) import qualified Data.Text as T import Test.QuickCheck import Data.List import qualified Data.Set as Set import qualified Data.Map as Map import Control.Monad+import Control.Exception (bracket) import GHC.Generics () import System.Directory (removeFile) import System.IO@@ -26,36 +28,36 @@ ----------------------------------------------------  graphTests-  :: (Arbitrary (RDF rdf), Rdf rdf)+  :: (Rdf rdf)   => TestName   -> RDF rdf -- ^ empty-  -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -- ^ mkRdf+  -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -- ^ _mkRdf   -> TestTree-graphTests testGroupName _empty _mkRdf =+graphTests testGroupName empty _mkRdf =   testGroup     testGroupName-    [ testProperty "empty" (p_empty _empty)+    [ testProperty "empty" (p_empty empty)     , testProperty "mkRdf_triplesOf" (p_mkRdf_triplesOf _mkRdf)     , testProperty "mkRdf_no_dupes" (p_mkRdf_no_dupes _mkRdf)     , testProperty "query_match_none" (p_query_match_none _mkRdf)-    , testProperty "query_matched_spo" (p_query_matched_spo _empty)       -- see comment above p_query_matched_spo_no_dupes for why this is disabled       -- , testProperty "query_matched_spo_no_dupes" (p_query_matched_spo_no_dupes _triplesOf _mkRdf)-    , testProperty "query_unmatched_spo" (p_query_unmatched_spo _empty)-    , testProperty "query_match_s" (p_query_match_s _empty)-    , testProperty "query_match_p" (p_query_match_p _empty)-    , testProperty "query_match_o" (p_query_match_o _empty)-    , testProperty "query_match_sp" (p_query_match_sp _empty)-    , testProperty "query_match_so" (p_query_match_so _empty)-    , testProperty "query_match_po" (p_query_match_po _empty)-    , testProperty "select_match_none" (p_select_match_none _empty)-    , testProperty "select_match_s" (p_select_match_s _empty)-    , testProperty "select_match_p" (p_select_match_p _empty)-    , testProperty "select_match_o" (p_select_match_o _empty)-    , testProperty "select_match_sp" (p_select_match_sp _empty)-    , testProperty "select_match_so" (p_select_match_so _empty)-    , testProperty "select_match_po" (p_select_match_po _empty)-    , testProperty "select_match_spo" (p_select_match_spo _empty)+    , testProperty "query_match_s" (p_query_match_s empty)+    , testProperty "query_match_p" (p_query_match_p empty)+    , testProperty "query_match_o" (p_query_match_o empty)+    , testProperty "query_match_sp" (p_query_match_sp empty)+    , testProperty "query_match_so" (p_query_match_so empty)+    , testProperty "query_match_po" (p_query_match_po empty)+    , testProperty "query_match_spo" (p_query_match_spo empty)+    , testProperty "query_unmatched_spo" (p_query_unmatched_spo empty)+    , testProperty "select_match_none" (p_select_match_none empty)+    , testProperty "select_match_s" (p_select_match_s empty)+    , testProperty "select_match_p" (p_select_match_p empty)+    , testProperty "select_match_o" (p_select_match_o empty)+    , testProperty "select_match_sp" (p_select_match_sp empty)+    , testProperty "select_match_so" (p_select_match_so empty)+    , testProperty "select_match_po" (p_select_match_po empty)+    , testProperty "select_match_spo" (p_select_match_spo empty)     , testProperty "reversed RDF handle write" (p_reverseRdfTest _mkRdf)       -- adding and removing triples from a graph.     , testProperty "add_triple" (p_add_triple _mkRdf)@@ -65,16 +67,16 @@         (p_remove_triple_from_graph _mkRdf)     , testProperty         "remove_triple_from_singleton_graph_query_s"-        (p_remove_triple_from_singleton_graph_query_s _empty)+        (p_remove_triple_from_singleton_graph_query_s empty)     , testProperty         "remove_triple_from_singleton_graph_query_p"-        (p_remove_triple_from_singleton_graph_query_p _empty)+        (p_remove_triple_from_singleton_graph_query_p empty)     , testProperty         "remove_triple_from_singleton_graph_query_o"-        (p_remove_triple_from_singleton_graph_query_o _empty)+        (p_remove_triple_from_singleton_graph_query_o empty)     , testProperty         "p_add_then_remove_triples"-        (p_add_then_remove_triples _empty)+        (p_add_then_remove_triples empty)     ]  newtype SingletonGraph rdf = SingletonGraph@@ -105,7 +107,7 @@   oneof $   map     (return . BaseUrl . T.pack)-    ["http://example.com/a", "http://asdf.org/b", "http://asdf.org/c"]+    ["http://example.org/", "http://example.com/a", "http://asdf.org/b", "http://asdf.org/c"]  arbitraryPrefixMappings :: Gen PrefixMappings arbitraryPrefixMappings =@@ -114,9 +116,10 @@     , return $       PrefixMappings $       Map.fromAscList-        [ (T.pack "eg1", T.pack "http://example.com/1")-        , (T.pack "eg2", T.pack "http://example.com/2")-        , (T.pack "eg3", T.pack "http://example.com/3")+        [ (T.pack "ex", T.pack "ex:")+        , (T.pack "eg1", T.pack "http://example.org/1")+        , (T.pack "eg2", T.pack "http://example.org/2")+        , (T.pack "eg3", T.pack "http://example.org/3")         ]     ] @@ -128,7 +131,7 @@ p_empty   :: Rdf rdf   => RDF rdf -> Bool-p_empty _empty = triplesOf _empty == []+p_empty empty = triplesOf empty == []  -- triplesOf any RDF should return unique triples used to create it p_mkRdf_triplesOf@@ -173,10 +176,12 @@  -- query with no wildcard and a triple in the RDF should yield -- a singleton list with just the triple.-p_query_matched_spo+p_query_match_spo   :: Rdf rdf-  => RDF rdf -> RDF rdf -> Property-p_query_matched_spo _unused rdf =+  => RDF rdf+  -> RDF rdf+  -> Property+p_query_match_spo _unused rdf =   classify (null ts) "trivial" $ forAll (tripleFromGen triplesOf rdf) f   where     ts = triplesOf rdf@@ -217,13 +222,13 @@ -- should yield all triple with unequal subjects. p_query_match_s   :: Rdf rdf-  => RDF rdf -> RDF rdf -> Property-p_query_match_s _unused = mk_query_match_fn sameSubj f+  => RDF rdf -> Property+p_query_match_s = mk_query_match_fn sameSubj f   where     f t = (Just (subjectOf t), Nothing, Nothing) --- query w/ fixed predicate and wildcards for subj and obj should yield--- a list with all triples having predicate, and RDFgraph minus result triples+-- query with fixed predicate and wildcards for subj and obj should yield+-- a list with all triples having predicate, and a RDF graph minus result triples -- should yield all triple with unequal predicates. p_query_match_p   :: Rdf rdf@@ -267,6 +272,21 @@     same t1 t2 = samePred t1 t2 && sameObj t1 t2     f t = (Nothing, Just $ predicateOf t, Just $ objectOf t) +{-+ This function:++ 1) creates a random RDF graph.+ 2) extracts a random triple from the graph.+ 3) queries the graph for that triple (according to the+    (Maybe Node, Maybe Node, Maybe Node) pattern specified+    by the mkPatternFn function.+ 4) extracts all triples in the graph that was not returned by+    the query above.+ 5) checks that all triples returned by the query match the triple+    comparison function (sameSubj, samePred, sameObj).+ 6) checks that all triples not returned by the query do not+    match the tripl comparison function.+-} mk_query_match_fn   :: Rdf rdf   => (Triple -> Triple -> Bool)@@ -462,9 +482,9 @@ p_add_then_remove_triples _empty genTriples =   let emptyGraph = _empty       populatedGraph =-        foldr (\triple gr -> addTriple gr triple) emptyGraph genTriples+        foldr (\t gr -> addTriple gr t) emptyGraph genTriples       emptiedGraph =-        foldr (\triple gr -> removeTriple gr triple) populatedGraph genTriples+        foldr (\t gr -> removeTriple gr t) populatedGraph genTriples   in triplesOf emptiedGraph == []  equivNode :: (Node -> Node -> Bool)@@ -543,7 +563,9 @@ datatypes = map (mkUri xsd . T.pack) ["string", "int", "token"]  uris :: [T.Text]-uris = map (mkUri ex) [T.pack n `T.append` T.pack (show (i::Int)) | n <- ["foo", "bar", "quz", "zak"], i <- [0..9]]+uris =+  map (mkUri ex) [T.pack n `T.append` T.pack (show (i::Int)) | n <- ["foo", "bar", "quz", "zak"], i <- [0..2]]+  ++ [T.pack "ex:" `T.append` T.pack n `T.append` T.pack (show (i::Int)) | n <- ["s", "p", "o"], i <- [1..3]]  plainliterals :: [LValue] plainliterals = [plainLL lit lang | lit <- litvalues, lang <- languages]@@ -563,19 +585,24 @@ lnodes :: [Node] lnodes = [LNode lit | lit <- plainliterals ++ typedliterals] -test_triples :: [Triple]-test_triples =-  [ triple s p o-  | s <- unodes ++ bnodes-  , p <- unodes-  , o <- unodes ++ bnodes ++ lnodes-  ]-+-- maximum number of triples maxN :: Int-maxN = min 100 (length test_triples - 1)+maxN = 10 +instance (Rdf rdf) => Arbitrary (RDF rdf) where+  arbitrary = do+    prefix <- arbitraryPrefixMappings+    baseU' <- arbitraryBaseUrl+    baseU <- oneof [return (Just baseU'), return Nothing]+    ts <- arbitraryTs+    return $ mkRdf ts baseU prefix+ instance Arbitrary Triple where-  arbitrary = liftM3 triple arbitraryS arbitraryP arbitraryO+  arbitrary = do+    s <- arbitraryS+    p <- arbitraryP+    o <- arbitraryO+    return (triple s p o)  instance Arbitrary Node where   arbitrary = oneof $ map return unodes@@ -585,15 +612,6 @@   n <- sized (\_ -> choose (0, maxN))   sequence [arbitrary | _ <- [1 .. n]] --- arbitraryTriple :: Gen Triple--- arbitraryTriple = elements test_triples---- arbitraryN :: Gen Int--- arbitraryN = choose (0, maxN - 1)---- arbitraryTNum :: Gen Int--- arbitraryTNum = choose (0, maxN - 1)- arbitraryS, arbitraryP, arbitraryO :: Gen Node arbitraryS = oneof $ map return $ unodes ++ bnodes arbitraryP = oneof $ map return unodes@@ -611,23 +629,24 @@   => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF a) -> Property p_reverseRdfTest _mkRdf =   monadicIO $ do-    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"+    fileContents <- Test.QuickCheck.Monadic.run $ bracket+      (openTempFile "." "tmp")+      (\(path, h) -> hClose h >> removeFile path)+      (\(_, h) -> do+        hSetEncoding h utf8+        hWriteRdf NTriplesSerializer h rdf+        hSeek h AbsoluteSeek 0+        T.hGetContents h)     assert $ expected == fileContents   where-    rdfGraph = _mkRdf ts (Just $ BaseUrl "file://") (ns_mappings [])+    rdf = _mkRdf ts (Just $ BaseUrl "file://") (ns_mappings mempty)     ts :: [Triple]     ts =       [ Triple           (unode "file:///this/is/not/a/palindrome")           (unode "file:///this/is/not/a/palindrome")-          (LNode . PlainL . T.pack $ "literal string")+          (LNode . PlainL $ "literal string")       ]+    expected = "<file:///this/is/not/a/palindrome> \+               \<file:///this/is/not/a/palindrome> \+               \\"literal string\" .\n"

@@ -3,13 +3,14 @@  module Main where -import Control.Monad-import qualified Data.Map as Map+import Data.Maybe (fromJust) import Data.RDF+import           Data.RDF.GraphImplTests import           Data.RDF.PropertyTests+import           Data.RDF.IRITests import qualified Data.Text as T+import System.FilePath ((</>)) import System.Directory (getCurrentDirectory)-import Test.QuickCheck.Arbitrary import Test.Tasty (defaultMain,testGroup) import W3C.Manifest import qualified W3C.NTripleTest as W3CNTripleTest@@ -33,30 +34,13 @@ mfBaseURIXml      = BaseUrl "http://www.w3.org/2013/RDFXMLTests/" mfBaseURINTriples = BaseUrl "http://www.w3.org/2013/N-TriplesTests/" -instance Arbitrary (RDF TList) where-  arbitrary =-    liftM3-      mkRdf-      arbitraryTs-      (return Nothing)-      (return $ PrefixMappings Map.empty)--instance Arbitrary (RDF AdjHashMap) where-  arbitrary =-    liftM3-      mkRdf-      arbitraryTs-      (return Nothing)-      (return $ PrefixMappings Map.empty)- main :: IO ()-main--- obtain manifest files for W3C tests before running tests--- justification for separation: http://stackoverflow.com/a/33046723- = do+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)+        fromJust . filePathToUri $ (dir </> T.unpack suitesDir)   turtleManifest <-     loadManifest mfPathTurtle (fileSchemeUri suiteFilesDirTurtle)   xmlManifest <- loadManifest mfPathXml (fileSchemeUri suiteFilesDirXml)@@ -79,12 +63,24 @@            (empty :: RDF AdjHashMap)            (mkRdf :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF AdjHashMap))]        ,+         testGroup+         "graph-impl-unit-tests"+         [ graphImplTests ]+       ,+         testGroup+         "iri"+         [ iriTests ]+       ,++       -- RDF parser unit tests        testGroup "parser-unit-tests-turtle"        TurtleUnitTest.tests        ,        testGroup "parser-unit-tests-xml"        XmlUnitTest.tests        ,++       -- RDF parser W3C tests        testGroup        "parser-w3c-tests-ntriples"        [ testGroup

@@ -1,6 +1,7 @@+{-# LANGUAGE OverloadedStrings #-}+ module Text.RDF.RDF4H.TurtleParser_ConformanceTest-  (-    tests+  ( tests   ) where  -- Testing imports@@ -8,50 +9,49 @@ 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.Graph.TList import Data.RDF.Types-import qualified Data.Text as T-import qualified Data.Text.IO as TIO+import Data.String (fromString)+import Data.Text (Text) import Text.Printf import Text.RDF.RDF4H.TurtleParser+import Control.Applicative ((<|>))  -- 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)]-otherTestFiles = [("data/ttl", "example1"),-                  ("data/ttl", "example2"),-                  ("data/ttl", "example3"),-                  ("data/ttl", "example5"),-                  ("data/ttl", "example6"),---                  ("data/ttl", "example7"), -- rdf4h URIs support RFC3986, not unicode IRIs in RFC3987-                  ("data/ttl", "example8"),-                  ("data/ttl", "example9"),-                  ("data/ttl", "example10"),-                  ("data/ttl", "example11"),-                  ("data/ttl", "fawlty1")-                 ]+otherTestFiles = [ ("data/ttl", "example1")+                 , ("data/ttl", "example2")+                 , ("data/ttl", "example3")+                 , ("data/ttl", "example5")+                 , ("data/ttl", "example6")+                 , ("data/ttl", "example7")+                 , ("data/ttl", "example8")+                 , ("data/ttl", "example9")+                 , ("data/ttl", "example10")+                 , ("data/ttl", "example11")+                 , ("data/ttl", "example12")+                 , ("data/ttl", "fawlty1") ] + -- The Base URI to be used for all conformance tests:-testBaseUri :: String-testBaseUri  = "http://www.w3.org/2001/sw/DataAccess/df1/tests/"+testBaseUri :: Text+testBaseUri = "http://www.w3.org/2001/sw/DataAccess/df1/tests/"  mtestBaseUri :: Maybe BaseUrl-mtestBaseUri = Just $ BaseUrl $ T.pack testBaseUri+mtestBaseUri = Just . BaseUrl $ testBaseUri  fpath :: String -> Int -> String -> String fpath name i ext = printf "data/ttl/conformance/%s-%02d.%s" name i ext :: String  tests :: [TestTree] tests = ts1 ++ ts2 ++ ts3-   where-        ts1 = map (checkGoodConformanceTest) [0..30]-        ts2 = map (checkBadConformanceTest) [0..14]-        ts3 = map (uncurry checkGoodOtherTest) otherTestFiles+   where ts1 = fmap checkGoodConformanceTest [0..29]+         ts2 = fmap checkBadConformanceTest [0..15]+         ts3 = fmap (uncurry checkGoodOtherTest) otherTestFiles  checkGoodConformanceTest :: Int -> TestTree checkGoodConformanceTest i =@@ -82,27 +82,21 @@ -- Determines if graphs are equivalent, returning Nothing if so or else a diagnostic message. -- First graph is expected graph, second graph is actual. equivalent :: Rdf a => Either ParseFailure (RDF a) -> Either ParseFailure (RDF a) -> Maybe String-equivalent (Left _) _                = Nothing-equivalent _        (Left _)         = Nothing-equivalent (Right gr1) (Right gr2)   = test $! zip gr1ts gr2ts+equivalent (Left e)    _           = Just $ "Parse failure of the expected graph: " ++ show e+equivalent _           (Left e)    = Just $ "Parse failure of the input graph: " ++ show e+equivalent (Right gr1) (Right gr2) = checkSize <|> (test $! zip gr1ts gr2ts)   where     gr1ts = uordered $ triplesOf gr1     gr2ts = uordered $ triplesOf gr2+    length1 = length gr1ts+    length2 = length gr2ts+    checkSize = if (length1 == length2) then Nothing else (Just $ "Size different. Expected: " ++ (show length1) ++ ", got: " ++ (show length2))     test []           = Nothing-    test ((t1,t2):ts) =-      case compareTriple t1 t2 of-        Nothing -> test ts-        err     -> err-    compareTriple t1 t2 =+    test ((t1,t2):ts) = maybe (test ts) pure (compareTriple t1 t2)+    compareTriple t1@(Triple s1 p1 o1) t2@(Triple s2 p2 o2) =       if equalNodes s1 s2 && equalNodes p1 p2 && equalNodes o1 o2         then Nothing         else Just ("Expected:\n  " ++ show t1 ++ "\nFound:\n  " ++ show t2 ++ "\n")-      where-        (s1, p1, o1) = f t1-        (s2, p2, o2) = f t2-        f t = (subjectOf t, predicateOf t, objectOf t)-    -- equalNodes (BNode fs1) (BNodeGen i) = T.reverse fs1 == T.pack ("_:genid" ++ show i)-    -- equalNodes (BNode fs1) (BNodeGen i) = fs1 == T.pack ("_:genid" ++ show i)      -- I'm not sure it's right to compare blank nodes with generated     -- blank nodes. This is because parsing an already generated blank@@ -117,44 +111,30 @@     --     -- which just so happens to be what Apache Jena just created when     -- [] was parsed.-    equalNodes (BNode _) (BNodeGen _) = True-    equalNodes (BNodeGen _) (BNode _) = True+    equalNodes (BNode _)    (BNodeGen _) = True+    equalNodes (BNodeGen _) (BNode _)    = True     equalNodes (BNodeGen _) (BNodeGen _) = True-    equalNodes (BNode _) (BNode _) = True-    equalNodes n1          n2           = n1 == n2+    equalNodes (BNode _)    (BNode _)    = True+    equalNodes n1           n2           = n1 == n2  -- 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 (RDF TList))-loadInputGraph name n =-  TIO.readFile (fpath name n "ttl") >>=-  return . parseString (TurtleParser mtestBaseUri (mkDocUrl testBaseUri name n)) >>= return . handleLoad+loadInputGraph name n = parseFile parserConfig path+  where path = fpath name n "ttl"+        parserConfig = TurtleParser mtestBaseUri (mkDocUrl testBaseUri name n)  loadInputGraph1 :: String -> String -> IO (Either ParseFailure (RDF TList))-loadInputGraph1 dir fname =-  TIO.readFile (printf "%s/%s.ttl" dir fname :: String) >>=-  return . parseString (TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname)) >>= return . handleLoad--handleLoad :: Either ParseFailure (RDF TList) -> Either ParseFailure (RDF TList)-handleLoad res =-  case res of-    l@(Left _)  -> l-    (Right gr)  -> Right $ mkRdf (map normalize (triplesOf gr)) (baseUrl gr) (prefixMappings gr)--normalize :: Triple -> Triple-normalize t = let s' = normalizeN $ subjectOf t-                  p' = normalizeN $ predicateOf t-                  o' = normalizeN $ objectOf t-              in  triple s' p' o'-normalizeN :: Node -> Node-normalizeN (BNodeGen i) = BNode (T.pack $ "_:genid" ++ show i)-normalizeN n            = n+loadInputGraph1 dir fname = parseFile parserConfig path+  where path = printf "%s/%s.ttl" dir fname :: String+        parserConfig = TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname)  loadExpectedGraph :: String -> Int -> IO (Either ParseFailure (RDF TList)) loadExpectedGraph name n = loadExpectedGraph1 (fpath name n "out")+ loadExpectedGraph1 :: String -> IO (Either ParseFailure (RDF TList)) loadExpectedGraph1 fname =-  liftM (parseString (TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname))) (TIO.readFile fname)+  parseFile (TurtleParser mtestBaseUri (mkDocUrl1 testBaseUri fname)) fname  assertLoadSuccess, assertLoadFailure :: String -> IO (Either ParseFailure (RDF TList)) -> TU.Assertion assertLoadSuccess idStr exprGr = do@@ -174,11 +154,11 @@   gr1 <- r1   gr2 <- r2   case equivalent gr1 gr2 of-    Nothing    -> TU.assert True+    Nothing    -> return ()     (Just msg) -> fail $ "Graph " ++ testname ++ " not equivalent to expected:\n" ++ msg -mkDocUrl :: String -> String -> Int -> Maybe T.Text-mkDocUrl baseDocUrl fname testNum = Just $ T.pack $ printf "%s%s-%02d.ttl" baseDocUrl fname testNum+mkDocUrl :: Text -> String -> Int -> Maybe Text+mkDocUrl baseDocUrl fname testNum = Just . fromString $ printf "%s%s-%02d.ttl" baseDocUrl fname testNum -mkDocUrl1 :: String -> String -> Maybe T.Text-mkDocUrl1 baseDocUrl fname        = Just $ T.pack $ printf "%s%s.ttl" baseDocUrl fname+mkDocUrl1 :: Text -> String -> Maybe Text+mkDocUrl1 baseDocUrl fname        = Just . fromString $ printf "%s%s.ttl" baseDocUrl fname

@@ -22,7 +22,7 @@ import Text.RDF.RDF4H.XmlParser import Text.RDF.RDF4H.NTriplesParser import Text.Printf- + tests :: [TestTree] tests =  [ testCase "simpleStriping1" test_simpleStriping1@@ -52,7 +52,7 @@                  , ("data/xml", "example18")                  , ("data/xml", "example19")                  , ("data/xml", "example20")-                 +                  -- https://github.com/robstewart57/rdf4h/issues/48                  , ("data/xml", "example22")                  ]@@ -125,7 +125,7 @@     \</rdf:RDF>"     ( mkRdf [ Triple (unode "http://www.w3.org/TR/rdf-syntax-grammar")                      (unode "dc:title")-                     (mkTextNode "RDF/XML Syntax Specification (Revised)") +                     (mkTextNode "RDF/XML Syntax Specification (Revised)")             , Triple (unode "http://example.org/buecher/baum")                      (unode "dc:title")                      (mkTextNode "Der Baum")@@ -352,7 +352,7 @@   gr1 <- r1   gr2 <- r2   case equivalent gr1 gr2 of-    Nothing    -> TU.assert True+    Nothing    -> return ()     (Just msg) -> fail $ "Graph " ++ testname ++ " not equivalent to expected:\n" ++ msg  -- Determines if graphs are equivalent, returning Nothing if so or else a diagnostic message.

@@ -10,7 +10,8 @@ import Data.RDF.Graph.TList import Data.RDF.Query import Data.RDF.Types-import Data.RDF.Namespace+import Data.RDF.Namespace (mkUri, rdfs)+import qualified Data.RDF.Namespace as NS import Safe import Text.RDF.RDF4H.TurtleParser @@ -105,7 +106,7 @@ rdfType,rdfsComment,rdfsLabel,rdftApproval,rdfsApproval,mfName,mfManifest,mfAction,   mfResult,mfEntries,mfEntailmentRegime,mfRecognizedDatatypes,mfUnrecognizedDatatypes :: Node -rdfType = unode $ mkUri rdf "type"+rdfType = unode $ mkUri NS.rdf "type" rdfsComment = unode $ mkUri rdfs "comment" rdfsLabel = unode $ mkUri rdfs "label" -- rdftTestTurtleEval = unode "http://www.w3.org/ns/rdftest#TestTurtleEval"

@@ -1,4 +1,7 @@-module W3C.NTripleTest where+module W3C.NTripleTest+  ( testsParsec+  , testsAttoparsec+  ) where  import Data.Maybe (fromJust) import Test.Tasty

@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -module W3C.RdfXmlTest where+module W3C.RdfXmlTest+  ( tests+  ) where  import Data.Maybe (fromJust) import Test.Tasty

@@ -1,6 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} -module W3C.TurtleTest where+module W3C.TurtleTest+  ( testsParsec+  , testsAttoparsec+  ) where  import Test.Tasty import qualified Test.Tasty.HUnit as TU

@@ -1,4 +1,10 @@-module W3C.W3CAssertions where+module W3C.W3CAssertions+  ( runManifestTests+  , assertIsIsomorphic+  , assertIsParsed+  , assertIsNotParsed+  , nodeURI+  ) where  import qualified Data.Text as T import           Data.RDF@@ -15,23 +21,22 @@   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+  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 :: IO (Either ParseFailure (RDF TList)) -> TU.Assertion assertIsParsed r1 = do