packages feed

rdf4h 3.0.1 → 3.0.2

raw patch · 17 files changed

+1420/−1285 lines, 17 filesdep +attoparsecdep +mtldep +parsersdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: attoparsec, mtl, parsers

Dependency ranges changed: base

API changes (from Hackage documentation)

+ Text.RDF.RDF4H.NTriplesParser: NTriplesParserCustom :: Parser -> NTriplesParserCustom
+ Text.RDF.RDF4H.NTriplesParser: data NTriplesParserCustom
+ Text.RDF.RDF4H.NTriplesParser: instance Data.RDF.Types.RdfParser Text.RDF.RDF4H.NTriplesParser.NTriplesParserCustom
+ Text.RDF.RDF4H.ParserUtils: Attoparsec :: Parser
+ Text.RDF.RDF4H.ParserUtils: Parsec :: Parser
+ Text.RDF.RDF4H.ParserUtils: _parseURL :: (Text -> Either ParseFailure (RDF rdfImpl)) -> String -> IO (Either ParseFailure (RDF rdfImpl))
+ Text.RDF.RDF4H.ParserUtils: data Parser
+ Text.RDF.RDF4H.ParserUtils: justTriples :: [Maybe Triple] -> [Triple]
+ Text.RDF.RDF4H.TurtleParser: TurtleParserCustom :: (Maybe BaseUrl) -> (Maybe Text) -> Parser -> TurtleParserCustom
+ Text.RDF.RDF4H.TurtleParser: data TurtleParserCustom
+ Text.RDF.RDF4H.TurtleParser: instance Data.RDF.Types.RdfParser Text.RDF.RDF4H.TurtleParser.TurtleParserCustom
- Data.RDF: hWriteH :: (RdfSerializer s, Rdf a) => s -> Handle -> RDF a -> IO ()
+ Data.RDF: hWriteH :: (RdfSerializer s, (Rdf a)) => s -> Handle -> RDF a -> IO ()
- Data.RDF: hWriteRdf :: (RdfSerializer s, Rdf a) => s -> Handle -> RDF a -> IO ()
+ Data.RDF: hWriteRdf :: (RdfSerializer s, (Rdf a)) => s -> Handle -> RDF a -> IO ()
- Data.RDF: parseFile :: (RdfParser p, Rdf a) => p -> String -> IO (Either ParseFailure (RDF a))
+ Data.RDF: parseFile :: (RdfParser p, (Rdf a)) => p -> String -> IO (Either ParseFailure (RDF a))
- Data.RDF: parseString :: (RdfParser p, Rdf a) => p -> Text -> Either ParseFailure (RDF a)
+ Data.RDF: parseString :: (RdfParser p, (Rdf a)) => p -> Text -> Either ParseFailure (RDF a)
- Data.RDF: parseURL :: (RdfParser p, Rdf a) => p -> String -> IO (Either ParseFailure (RDF a))
+ Data.RDF: parseURL :: (RdfParser p, (Rdf a)) => p -> String -> IO (Either ParseFailure (RDF a))
- Data.RDF: writeH :: (RdfSerializer s, Rdf a) => s -> RDF a -> IO ()
+ Data.RDF: writeH :: (RdfSerializer s, (Rdf a)) => s -> RDF a -> IO ()
- Data.RDF: writeRdf :: (RdfSerializer s, Rdf a) => s -> RDF a -> IO ()
+ Data.RDF: writeRdf :: (RdfSerializer s, (Rdf a)) => s -> RDF a -> IO ()
- Data.RDF.Types: hWriteH :: (RdfSerializer s, Rdf a) => s -> Handle -> RDF a -> IO ()
+ Data.RDF.Types: hWriteH :: (RdfSerializer s, (Rdf a)) => s -> Handle -> RDF a -> IO ()
- Data.RDF.Types: hWriteRdf :: (RdfSerializer s, Rdf a) => s -> Handle -> RDF a -> IO ()
+ Data.RDF.Types: hWriteRdf :: (RdfSerializer s, (Rdf a)) => s -> Handle -> RDF a -> IO ()
- Data.RDF.Types: parseFile :: (RdfParser p, Rdf a) => p -> String -> IO (Either ParseFailure (RDF a))
+ Data.RDF.Types: parseFile :: (RdfParser p, (Rdf a)) => p -> String -> IO (Either ParseFailure (RDF a))
- Data.RDF.Types: parseString :: (RdfParser p, Rdf a) => p -> Text -> Either ParseFailure (RDF a)
+ Data.RDF.Types: parseString :: (RdfParser p, (Rdf a)) => p -> Text -> Either ParseFailure (RDF a)
- Data.RDF.Types: parseURL :: (RdfParser p, Rdf a) => p -> String -> IO (Either ParseFailure (RDF a))
+ Data.RDF.Types: parseURL :: (RdfParser p, (Rdf a)) => p -> String -> IO (Either ParseFailure (RDF a))
- Data.RDF.Types: writeH :: (RdfSerializer s, Rdf a) => s -> RDF a -> IO ()
+ Data.RDF.Types: writeH :: (RdfSerializer s, (Rdf a)) => s -> RDF a -> IO ()
- Data.RDF.Types: writeRdf :: (RdfSerializer s, Rdf a) => s -> RDF a -> IO ()
+ Data.RDF.Types: writeRdf :: (RdfSerializer s, (Rdf a)) => s -> RDF a -> IO ()

Files

bench/MainCriterion.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings, LambdaCase, RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}  module Main where @@ -6,7 +7,9 @@ import Criterion.Types import Criterion.Main import Data.RDF+import Text.RDF.RDF4H.ParserUtils import qualified Data.Text as T+import Control.DeepSeq (NFData)  -- The `bills.102.rdf` XML file is needed to run this benchmark suite --@@ -42,12 +45,14 @@   defaultMainWith     (defaultConfig {resamples = 100})     [ env-      -- fawltyContent <- T.pack <$> readFile "data/ttl/fawlty1.ttl"         (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+                triples = triplesOf rdf1             -- let (Right rdf3) =             --       parseString (XmlParser Nothing Nothing) rdfContent             -- let (Right rdf4) =@@ -55,21 +60,45 @@             return               ( rdf1 :: RDF TList               , rdf2 :: RDF AdjHashMap-              )) $ \ ~(triplesList, adjMap) ->+              , triples :: Triples+              , fawltyContentNTriples :: T.Text+              , fawltyContentTurtle :: T.Text+              )) $ \ ~(triplesList, adjMap, triples, fawltyContentNTriples, fawltyContentTurtle) ->         bgroup           "rdf4h"-          --  bgroup-          --     "parsers"-          --     [ bench "AdjHashMap" $-          --       nf (parseTtlRDF :: T.Text -> RDF AdjHashMap) fawlty_towers-          --     , bench "HashSP" $-          --       nf (parseTtlRDF :: T.Text -> RDF HashSP) fawlty_towers-          --     , bench "SP" $ nf (parseTtlRDF :: T.Text -> RDF SP) fawlty_towers-          --     , bench "TList" $-          --       nf (parseTtlRDF :: T.Text -> RDF TList) fawlty_towers-          --     ]-          -- ,-          [ bgroup+           [ bgroup+              "parsers"+              [ 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+                   ) 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+                   ) 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+                   ) 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+                   ) fawltyContentTurtle+              ]+          ,+            bgroup               "query"               (queryBench "TList" triplesList ++                queryBench "AdjHashMap" adjMap@@ -82,6 +111,11 @@                -- selectBench "SP" mapSP ++ selectBench "HashSP" hashMapSP               )           , bgroup+              "add-remove-triples"+              (addRemoveTriples "TList" triples (empty :: RDF TList) triplesList+              ++ addRemoveTriples "AdjHashMap" triples (empty :: RDF AdjHashMap) adjMap+              )+          , bgroup             "count_triples"             [ bench "TList" (nf (length . triplesOf) triplesList)             , bench "AdjHashMap" (nf (length . triplesOf) adjMap)@@ -89,8 +123,6 @@           ]     ] -        - selectBench :: Rdf a => String -> RDF a -> [Benchmark] selectBench label gr =    [ bench (label ++ " SPO") $ nf selectGr (subjSelect,predSelect,objSelect,gr)@@ -124,3 +156,17 @@    , bench (label ++ " P")   $ nf queryGr (queryNothing,predQuery,queryNothing,gr)    , bench (label ++ " O")   $ nf queryGr (queryNothing,queryNothing,objQuery,gr)    ]++addRemoveTriples :: (NFData a,NFData (RDF a), Rdf a) => String -> Triples -> RDF a -> RDF a -> [Benchmark]+addRemoveTriples lbl triples emptyGr populatedGr =+   [ bench (lbl ++ "-add-triples") $ nf addTriples (triples,emptyGr)+   , bench (lbl ++ "-remove-triples") $ nf removeTriples (triples,populatedGr)+   ]++addTriples ::  Rdf a => (Triples,RDF a) -> RDF a+addTriples (triples,emptyGr) =+  foldr (\t g -> addTriple g t) emptyGr triples++removeTriples ::  Rdf a => (Triples,RDF a) -> RDF a+removeTriples (triples,populatedGr) =+  foldr (\t g -> removeTriple g t) populatedGr triples
examples/ParseURLs.hs view
@@ -9,7 +9,7 @@ --   returns a single String element: [\"Designing the Web for an Open Society\"]. timBernersLee :: IO () timBernersLee = do-    Right (rdf::TriplesList) <- parseURL (XmlParser Nothing Nothing) "http://www.w3.org/People/Berners-Lee/card.rdf"+    Right (rdf::RDF TList) <- parseURL (XmlParser Nothing Nothing) "http://www.w3.org/People/Berners-Lee/card.rdf"     let ts = query rdf (Just (UNode "http://www.w3.org/2011/Talks/0331-hyderabad-tbl/data#talk")) (Just (UNode "dct:title")) Nothing     let talks = map (\(Triple _ _ (LNode (PlainL s))) -> s) ts     print talks
rdf4h.cabal view
@@ -1,5 +1,5 @@ name:            rdf4h-version:         3.0.1+version:         3.0.2 synopsis:        A library for RDF processing in Haskell description:   'RDF for Haskell' is a library for working with RDF in Haskell.@@ -10,7 +10,7 @@  author:          Calvin Smith, Rob Stewart, Slava Kravchenko copyright:       (c) Calvin Smith, Rob Stewart, Slava Kravchenko-maintainer:      Rob Stewart <robstewart@gmail.com>, Slava Kravchenko+maintainer:      Rob Stewart <robstewart@gmail.com> homepage:        https://github.com/robstewart57/rdf4h bug-reports:     https://github.com/robstewart57/rdf4h/issues license:         BSD3@@ -34,24 +34,19 @@                  , Data.RDF.Types                  , Data.RDF.Query                  , Data.RDF.Graph.AdjHashMap-                 -- , Data.RDF.Graph.HashMapSP-                 -- , Data.RDF.Graph.MapSP-                 -- this is very slow-                 -- , Data.RDF.Graph.TPatriciaTree                  , Data.RDF.Graph.TList                  , Text.RDF.RDF4H.TurtleParser                  , Text.RDF.RDF4H.TurtleSerializer                  , Text.RDF.RDF4H.NTriplesParser                  , Text.RDF.RDF4H.NTriplesSerializer                  , Text.RDF.RDF4H.XmlParser-  build-depends:   base >= 3+                 , Text.RDF.RDF4H.ParserUtils+  build-depends:   attoparsec >= 0.13.1.0+                 , base >= 4.8.0.0                  , bytestring                  , directory                  , containers                  , parsec >= 3-                 -- was needed for the patricia tree RDF implementation,-                 -- which was too slow.-                 -- , fgl >= 5.5.2.0                  , HTTP >= 4000.0.0                  , hxt >= 9.3.1.2                  , text >= 1.2.1.0@@ -62,6 +57,8 @@                  , text-binary                  , utf8-string                  , hgal+                 , parsers+                 , mtl   if impl(ghc < 7.6)     build-depends: ghc-prim @@ -70,15 +67,14 @@   else     build-depends: network-uri < 2.6, network < 2.6 -  other-modules:   Text.RDF.RDF4H.ParserUtils-                 , Text.RDF.RDF4H.Interact+  other-modules:   Text.RDF.RDF4H.Interact   hs-source-dirs:  src   extensions:      BangPatterns RankNTypes MultiParamTypeClasses Arrows FlexibleContexts OverloadedStrings DoAndIfThenElse   ghc-options:     -Wall -fno-warn-unused-do-bind -funbox-strict-fields  executable rdf4h   main-is:         src/Rdf4hParseMain.hs-  build-depends:   base >= 4 && < 6+  build-depends:   base >= 4.8.0.0 && < 6                  , rdf4h                  , containers                  , text >= 1.2.1.0@@ -97,12 +93,7 @@ test-suite test-rdf4h   type:          exitcode-stdio-1.0   main-is:       Test.hs-  other-modules: Data.RDF.GraphTestUtils-                 Data.RDF.Graph.AdjHashMap_Test-                 -- Data.RDF.Graph.HashSP_Test-                 -- Data.RDF.Graph.SP_Test-                 -- Data.RDF.Graph.TriplesPatriciaTree_Test-                 Data.RDF.Graph.TList_Test+  other-modules: Data.RDF.PropertyTests                  Text.RDF.RDF4H.TurtleParser_ConformanceTest                  Text.RDF.RDF4H.XmlParser_Test                  W3C.Manifest@@ -111,7 +102,7 @@                  W3C.W3CAssertions   ghc-options:   -Wall -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-name-shadowing -funbox-strict-fields   extensions:    RankNTypes MultiParamTypeClasses Arrows FlexibleContexts OverloadedStrings-  build-depends: base >= 4 && < 6+  build-depends: base >= 4.8.0.0 && < 6                , rdf4h                , tasty                , tasty-hunit@@ -139,7 +130,8 @@   type:             exitcode-stdio-1.0   hs-source-dirs:   bench   main-is:          MainCriterion.hs-  build-depends:    base,+  build-depends:    base >= 4.8.0.0,+                    deepseq,                     criterion,                     rdf4h,                     text >= 1.2.1.0
src/Data/RDF/Types.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Data.RDF.Types ( @@ -48,7 +46,6 @@ import System.IO import Text.Printf import Data.Binary-import Control.Monad (guard) import Data.Map(Map) import Data.Maybe (fromJust) import GHC.Generics (Generic)@@ -57,11 +54,14 @@ import qualified Data.Map as Map import qualified Network.URI as Network (uriPath,parseURI) import Control.DeepSeq (NFData,rnf)-import Text.Parsec-import Text.Parsec.Text+import Text.Parsec(ParseError,parse) import Network.URI import Codec.Binary.UTF8.String +import Text.Parser.Char+import Text.Parser.Combinators+import Control.Applicative+ ------------------- -- LValue and constructor functions @@ -177,19 +177,17 @@ isRdfURI t = parse (isRdfURIParser  <* eof) ("Invalid URI: " ++ T.unpack t) t  -- [18]	IRIREF from Turtle spec-isRdfURIParser :: GenParser () T.Text-isRdfURIParser = T.concat <$> many (T.singleton <$> noneOf (['\x00'..'\x20'] ++ [' ','<','>','"','{','}','|','^','`','\\']) <|> nt_uchar)+isRdfURIParser :: CharParsing m => m T.Text+isRdfURIParser = T.concat <$> many (T.singleton <$> noneOf (['\x00'..'\x20'] ++ " <>\"{}|^`\\") <|> nt_uchar)  -- [10] UCHAR-nt_uchar :: GenParser () T.Text+nt_uchar :: CharParsing m => m T.Text nt_uchar =-    (try (char '\\' >> char 'u' >> count 4 hexDigit >>= \cs -> return $ T.pack (uEscapedToXEscaped cs)) <|>-     try (char '\\' >> char 'U' >> count 8 hexDigit >>= \cs -> return $ T.pack (uEscapedToXEscaped cs)))+    try (T.pack . uEscapedToXEscaped <$> (string "\\u" *> count 4 hexDigit)) <|>+    try (T.pack . uEscapedToXEscaped <$> (string "\\U" *> count 8 hexDigit))  uEscapedToXEscaped :: String -> String-uEscapedToXEscaped ss =-    let str = ['\\','x'] ++ ss-    in read ("\"" ++ str ++ "\"")+uEscapedToXEscaped ss = read ("\"\\x" ++ ss ++ "\"")  -- |Validate a Text URI and return it in a @Just Text@ if it is --  valid, otherwise @Nothing@ is returned. See 'unodeValidate'.@@ -207,13 +205,12 @@     isRdfURIString = parse (isRdfURIParserS  <* eof) ("Invalid URI: " ++ t) t     isRdfURIParserS = many (validUriChar <|> nt_ucharS)     nt_ucharS =-        (try (char '\\' >> char 'u' >> count 4 hexDigit >>= return . head . uEscapedToXEscaped) <|>-         try (char '\\' >> char 'U' >> count 8 hexDigit >>= return . head . uEscapedToXEscaped))+        try (head . uEscapedToXEscaped <$> (string "\\u" *> count 4 hexDigit)) <|>+        try (head . uEscapedToXEscaped <$> (string "\\U" *> count 8 hexDigit))     -- [18]	IRIREF from Turtle spec-    validUriChar = try $ do-        c <- anyChar-        guard $ not (c >= '\x00' && c <= '\x20') && c `notElem` [' ','<','>','"','{','}','|','^','`','\\']-        return c+    validUriChar = try $ satisfy $ \c ->+      not (c >= '\x00' && c <= '\x20')+      && c `notElem` [' ','<','>','"','{','}','|','^','`','\\']  -- | Escapes @\Uxxxxxxxx@ and @\uxxxx@ character sequences according --   to the RDF specification.@@ -221,33 +218,16 @@ escapeRDFSyntax t = T.pack uri     where       Right uri = parse unicodeEscParser "" (T.unpack t)-      unicodeEscParser :: Stream s m Char => ParsecT s u m String-      unicodeEscParser = do-                ss <- many (-                    try (do { _ <- char '\\'-                            ; _ <- char 'U'-                            ; pos1 <- hexDigit-                            ; pos2 <- hexDigit-                            ; pos3 <- hexDigit-                            ; pos4 <- hexDigit-                            ; pos5 <- hexDigit-                            ; pos6 <- hexDigit-                            ; pos7 <- hexDigit-                            ; pos8 <- hexDigit-                            ; let str = ['\\','x',pos1,pos2,pos3,pos4,pos5,pos6,pos7,pos8]-                            ; return (read ("\"" ++ str ++ "\"") :: String)})-                   <|>-                    try (do { _ <- char '\\'-                            ; _ <- char 'u'-                            ; pos1 <- hexDigit-                            ; pos2 <- hexDigit-                            ; pos3 <- hexDigit-                            ; pos4 <- hexDigit-                            ; let str = ['\\','x',pos1,pos2,pos3,pos4]-                            ; return (read ("\"" ++ str ++ "\"") :: String)})+      unicodeEscParser :: (CharParsing m, Monad m) => m String+      unicodeEscParser =+                concat <$> many (+                    try (do { str <- ("\\x"++) <$> (string "\\U" *> count 8 hexDigit)+                            ; pure (read ("\"" ++ str ++ "\"") :: String)})                    <|>-                    (anyChar >>= \c -> return [c]))-                return (concat ss :: String)+                    try (do { str <- ("\\x"++) <$> (string "\\u" *> count 4 hexDigit)+                            ; pure (read ("\"" ++ str ++ "\"") :: String)})+                   <|> (pure <$> anyChar)+                   )   -- |Return a blank node using the given string identifier.@@ -336,9 +316,6 @@ -- the following: <http://www.w3.org/TR/rdf-concepts/#section-rdf-graph>. class (Generic rdfImpl, NFData rdfImpl) => Rdf rdfImpl where -  -- -- |RDF type family-  -- data RDF rdfImpl-     -- |Return the base URL of this RDF, if any.   baseUrl :: RDF rdfImpl -> Maybe BaseUrl @@ -414,7 +391,7 @@   showGraph     :: RDF rdfImpl -> String  instance (Rdf a) => Show (RDF a) where-  show a = showGraph a+  show = showGraph  -- |An RdfParser is a parser that knows how to parse 1 format of RDF and -- can parse an RDF document of that type from a string, a file, or a URL.@@ -735,7 +712,10 @@     doubleUri  =  "http://www.w3.org/2001/XMLSchema#double"  _integerStr, _decimalStr, _doubleStr :: T.Text -> T.Text-_integerStr = T.dropWhile (== '0')+_integerStr t =+  if T.length t == 1+  then t+  else T.dropWhile (== '0') t  -- exponent: [eE] ('-' | '+')? [0-9]+ -- ('-' | '+') ? ( [0-9]+ '.' [0-9]* exponent | '.' ([0-9])+ exponent | ([0-9])+ exponent )@@ -750,10 +730,9 @@  -- | Removes "file://" schema from URIs in 'UNode' nodes fileSchemeToFilePath :: Node -> Maybe T.Text-fileSchemeToFilePath (UNode fileScheme) =-    if T.pack "file://" `T.isPrefixOf` fileScheme-    then fmap (T.pack . Network.uriPath) (Network.parseURI (T.unpack fileScheme))-    else if T.pack "http://" `T.isPrefixOf` fileScheme-         then fmap (T.pack . Network.uriPath) (Network.parseURI (T.unpack fileScheme))-         else Nothing+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)) fileSchemeToFilePath _ = Nothing
src/Text/RDF/RDF4H/Interact.hs view
@@ -70,7 +70,7 @@ -- 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 :: (RdfParser p, Rdf a) => +_load :: (Rdf a) =>              (p -> String -> IO (Either ParseFailure (RDF a))) ->               p -> String -> IO (RDF a) _load parseFunc parser location = parseFunc parser location >>= _handle
src/Text/RDF/RDF4H/NTriplesParser.hs view
@@ -2,20 +2,26 @@ -- <http://www.w3.org/TR/rdf-testcases/#ntriples>.  module Text.RDF.RDF4H.NTriplesParser-  (NTriplesParser(NTriplesParser), ParseFailure)+  (NTriplesParser(NTriplesParser), NTriplesParserCustom(NTriplesParserCustom),ParseFailure)   where  import Prelude hiding (init,pred) import Data.RDF.Types import Text.RDF.RDF4H.ParserUtils-import Data.Char (isLetter, isDigit,isAlphaNum)+import Data.Attoparsec.ByteString (parse,IResult(..))+import Data.Char (isLetter, isDigit,isAlphaNum, isAsciiUpper, isAsciiLower) import Data.Map as Map (empty)-import Text.Parsec-import Text.Parsec.Text+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 Control.Monad (liftM,void,guard)+import Control.Monad (void) +import Text.Parser.Char+import Text.Parser.Combinators+import Control.Applicative+import Data.Maybe (catMaybes)+ -- |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@@ -23,31 +29,42 @@ -- class. data NTriplesParser = NTriplesParser --- |'NTriplesParser' is an instance of 'RdfParser'.+data NTriplesParserCustom = NTriplesParserCustom Parser++-- |'NTriplesParser' is an instance of 'RdfParser' using parsec based parsers. instance RdfParser NTriplesParser where-  parseString _  = parseString'-  parseFile   _  = parseFile'-  parseURL    _  = parseURL'+  parseString _  = parseStringParsec+  parseFile   _  = parseFileParsec+  parseURL    _  = parseURLParsec +-- |'NTriplesParser' is an instance of 'RdfParser'.+instance RdfParser NTriplesParserCustom where+  parseString (NTriplesParserCustom Parsec) = parseStringParsec+  parseString (NTriplesParserCustom Attoparsec) = parseStringAttoparsec+  parseFile   (NTriplesParserCustom Parsec) = parseFileParsec+  parseFile   (NTriplesParserCustom Attoparsec) = parseFileAttoparsec+  parseURL    (NTriplesParserCustom Parsec) = parseURLParsec+  parseURL    (NTriplesParserCustom Attoparsec) = parseURLAttoparsec+ -- We define or redefine all here using same names as the spec, but with an -- 'nt_' prefix in order to avoid name clashes (e.g., ntripleDoc becomes -- nt_ntripleDoc).  -- |nt_ntripleDoc is simply zero or more lines.-nt_ntripleDoc :: GenParser () [Maybe Triple]+nt_ntripleDoc :: (CharParsing m, Monad m) => m [Maybe Triple] nt_ntripleDoc = manyTill nt_line eof -nt_line :: GenParser () (Maybe Triple)+nt_line :: (CharParsing m, Monad m) => m (Maybe Triple) nt_line =-    skipMany nt_space >>-     ((nt_comment >>= \res -> return res)-      <|> try (nt_triple >>= \res -> nt_eoln >> return res)-      <|> try (nt_triple >>= \res -> char '#' >> manyTill anyChar nt_eoln >> return res)-      <|> (nt_empty >>= \res -> nt_eoln >> return res))-     >>= \res -> return res+    skipMany nt_space *>+     (nt_comment+      <|> try (nt_triple <* nt_eoln)+      <|> try (nt_triple <* char '#' <* manyTill anyChar nt_eoln)+      <|> (nt_empty <* nt_eoln)+      ) -nt_comment :: GenParser () (Maybe Triple)-nt_comment   = char '#' >> manyTill anyChar nt_eoln >> return Nothing+nt_comment :: CharParsing m => m (Maybe Triple)+nt_comment   = char '#' *> manyTill anyChar nt_eoln *> pure Nothing  -- A triple consists of whitespace-delimited subject, predicate, and object, -- followed by optional whitespace and a period, and possibly more@@ -60,147 +77,126 @@ -- -- `optional` lets this nt_triple parser succeed even if there is not -- a space or tab character between resources or the object and the '.'.-nt_triple :: GenParser () (Maybe Triple)+nt_triple :: (CharParsing m, Monad m) => m (Maybe Triple) nt_triple    =   do-    subj <- nt_subject-    optional (skipMany1 nt_space)-    pred <- nt_predicate-    optional (skipMany1 nt_space)-    obj <- nt_object-    optional (skipMany1 nt_space)-    void (char '.')-    void (many nt_space)-    return $ Just (Triple subj pred obj)-+    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-nt_literal :: GenParser () LValue+nt_literal :: (CharParsing m, Monad m) => m LValue nt_literal = do-  s' <- nt_string_literal_quote-  let s = escapeRDFSyntax s'-  option (plainL s) $ do-               ((count 2 (char '^') >> nt_iriref >>= validateURI >>= isAbsoluteParser >>= \iri -> return (typedL s iri))-                <|> (nt_langtag >>= \lang -> return (plainLL s lang)))+  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)  -- [9] STRING_LITERAL_QUOTE-nt_string_literal_quote :: GenParser () T.Text+nt_string_literal_quote :: CharParsing m => m T.Text nt_string_literal_quote =-    between (char '"') (char '"') $ do-      T.concat <$> (many ((T.singleton <$> noneOf ['\x22','\x5C','\xA','\xD']) <|>+    between (char '"') (char '"') $+      T.concat <$> many ((T.singleton <$> noneOf ['\x22','\x5C','\xA','\xD']) <|>                           nt_echar <|>-                          nt_uchar))+                          nt_uchar)  -- [144s] LANGTAG-nt_langtag :: GenParser () T.Text+nt_langtag :: (CharParsing m, Monad m) => m T.Text nt_langtag = do-  void (char '@')-  ss   <- many1 (satisfy (\ c -> isLetter c))-  rest <- concat <$> many (char '-' >> many1 (satisfy (\ c -> isAlphaNum c)) >>= \lang_str -> return ('-':lang_str))-  return (T.pack (ss ++ rest))+  ss   <- char '@' *> some (satisfy isLetter)+  rest <- concat <$> many ((:) <$> char '-' <*> some (satisfy isAlphaNum))+  pure (T.pack (ss ++ rest))  -- [8] IRIREF-nt_iriref :: GenParser () T.Text-nt_iriref = do-  between (char '<') (char '>') $ do-              T.concat <$> many ( T.singleton <$> noneOf (['\x00'..'\x20'] ++ ['<','>','"','{','}','|','^','`','\\']) <|>-                                  nt_uchar )+nt_iriref :: CharParsing m => m T.Text+nt_iriref =+  between (char '<') (char '>') $+              T.concat <$> many ( T.singleton <$> noneOf (['\x00'..'\x20'] ++ "<>\"{}|^`\\") <|> nt_uchar )  -- [153s] ECHAR-nt_echar :: GenParser () T.Text-nt_echar = try $ do-  void (char '\\')-  c2 <- anyChar-  guard $ isEchar c2-  return (T.pack [c2])+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 :: GenParser () T.Text+nt_uchar :: CharParsing m => m T.Text nt_uchar =-    (try (char '\\' >> char 'u' >> count 4 hexDigit >>= \cs -> return $ T.pack ('\\':'u':cs)) <|>-     try (char '\\' >> char 'U' >> count 8 hexDigit >>= \cs -> return $ T.pack ('\\':'U':cs)))+    try (T.pack <$> ((++) <$> string "\\u" <*> count 4 hexDigit)) <|>+    try (T.pack <$> ((++) <$> string "\\U" <*> count 8 hexDigit))  -- nt_empty is a line that isn't a comment or a triple. They appear in the -- parsed output as Nothing, whereas a real triple appears as (Just triple).-nt_empty :: GenParser () (Maybe Triple)-nt_empty     = skipMany nt_space >> return Nothing+nt_empty :: CharParsing m => m (Maybe Triple)+nt_empty     = skipMany nt_space *> pure Nothing  -- A subject is either a URI reference for a resource or a node id for a -- blank node.-nt_subject :: GenParser () Node+nt_subject :: (CharParsing m, Monad m) => m Node nt_subject   =-  liftM unode nt_uriref <|>-  liftM bnode nt_blank_node_label+  unode <$> nt_uriref <|>+  bnode <$> nt_blank_node_label  -- A predicate may only be a URI reference to a resource.-nt_predicate :: GenParser () Node-nt_predicate = liftM unode nt_uriref+nt_predicate :: (CharParsing m, Monad m) => m Node+nt_predicate = unode <$> nt_uriref  -- 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 :: GenParser () Node+nt_object :: (CharParsing m, Monad m) => m Node nt_object =-  liftM unode nt_uriref <|>-  liftM bnode nt_blank_node_label <|>-  liftM LNode nt_literal+  unode <$> nt_uriref <|>+  bnode <$> nt_blank_node_label <|>+  LNode <$> nt_literal -validateUNode :: T.Text -> GenParser () Node+validateUNode :: CharParsing m => T.Text -> m Node validateUNode t =     case unodeValidate t of-      Nothing        -> unexpected ("Invalid URI in NTriples parser URI validation: " ++ show t)-      Just u@(UNode{}) -> return u+      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 :: T.Text -> GenParser () T.Text+validateURI :: (CharParsing m, Monad m) => T.Text -> m T.Text validateURI t = do     UNode uri <- validateUNode t-    return uri+    pure uri -isAbsoluteParser :: T.Text -> GenParser () T.Text+isAbsoluteParser :: CharParsing m => T.Text -> m T.Text isAbsoluteParser t =     if isAbsoluteUri t-    then return t+    then pure t     else unexpected ("Only absolute IRIs allowed in NTriples format, which this isn't: " ++ show t) -absoluteURI :: T.Text -> GenParser () T.Text-absoluteURI t = do-    uri <- isAbsoluteParser t-    return uri+absoluteURI :: CharParsing m => T.Text -> m T.Text+absoluteURI = isAbsoluteParser  -- A URI reference is one or more nrab_character inside angle brackets.-nt_uriref :: GenParser () T.Text+nt_uriref :: (CharParsing m, Monad m) => m T.Text nt_uriref = between (char '<') (char '>') $ do               unvalidatedUri <- many (satisfy ( /= '>'))-              t <- validateURI (T.pack unvalidatedUri)-              absoluteURI t+              absoluteURI =<< validateURI (T.pack unvalidatedUri)  -- [141s] BLANK_NODE_LABEL-nt_blank_node_label :: GenParser () T.Text+nt_blank_node_label :: (CharParsing m, Monad m) => m T.Text nt_blank_node_label = do-  void (char '_' >> char ':')-  s1 <- (nt_pn_chars_u <|> satisfy isDigit)-  s2 <- option "" $ try $ do-          sub_dots <- many (char '.')-          sub_s1   <- many1 nt_pn_chars-          return (sub_dots ++ sub_s1)-  return (T.pack ("_:" ++ [s1] ++ s2))+  void (char '_' *> char ':')+  s1 <- nt_pn_chars_u <|> satisfy isDigit+  s2 <- option "" $ try $ (++) <$> many (char '.') <*> some nt_pn_chars+  pure (T.pack ("_:" ++ s1:s2))  -- [157s] PN_CHARS_BASE -- Not used. It used to be. What's happened? {--nt_pn_chars_base :: GenParser () Char-nt_pn_chars_base = try $ do-    c <- anyChar-    guard $ isBaseChar c-    return c+nt_pn_chars_base :: CharParsing m => m Char+nt_pn_chars_base = try $ satisfy isBaseChar c+ -}  isBaseChar :: Char -> Bool isBaseChar c-    =  (c >= 'A' && c <= 'Z')-    || (c >= 'a' && c <= 'z')+    =  isAsciiUpper c+    || isAsciiLower c     || (c >= '\x00C0' && c <= '\x00D6')     || (c >= '\x00D8' && c <= '\x00F6')     || (c >= '\x00F8' && c <= '\x02FF')@@ -216,66 +212,84 @@   -- [158s] PN_CHARS_U-nt_pn_chars_u :: GenParser () Char-nt_pn_chars_u = try $ do-    c <- anyChar-    guard $ c == '_' || c == ':' || isBaseChar c-    return c+nt_pn_chars_u :: CharParsing m => m Char+nt_pn_chars_u = try $ satisfy $ \c -> c == '_' || c == ':' || isBaseChar c   -- [160s] PN_CHARS-nt_pn_chars :: GenParser () Char-nt_pn_chars = nt_pn_chars_u <|> try (do-    c <- anyChar-    guard $ c == '-' || c == '\x00B7'+nt_pn_chars :: CharParsing m => m Char+nt_pn_chars = nt_pn_chars_u+  <|> try (satisfy $ \c ->+           c == '-' || c == '\x00B7'            || isDigit c            || (c >= '\x0300' && c <= '\x036F')            || (c >= '\x203F' && c <= '\x2040')-    return c     )  -- End-of-line consists of either lf or crlf. -- We also test for eof and consider that to match as well.-nt_eoln :: GenParser () ()-nt_eoln =  eof <|> void (nt_cr >> nt_lf) <|> void nt_lf+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 :: GenParser () Char+nt_space :: CharParsing m => m Char nt_space = char ' ' <|> nt_tab --- Carriage return is \r.-nt_cr :: GenParser () Char+-- Carriage pure is \r.+nt_cr :: CharParsing m => m Char nt_cr          =   char '\r'  -- Line feed is \n.-nt_lf :: GenParser () Char+nt_lf :: CharParsing m => m Char nt_lf          =   char '\n'  -- Tab is \t.-nt_tab :: GenParser () Char+nt_tab :: CharParsing m => m Char nt_tab         =   char '\t' -parseString' :: (Rdf a) => T.Text -> Either ParseFailure (RDF a)-parseString' bs = handleParse mkRdf (runParser nt_ntripleDoc () "" bs)+---------------------------------+-- parsec based parsers -parseURL' :: (Rdf a) => String -> IO (Either ParseFailure (RDF a))-parseURL' = _parseURL parseString'+parseStringParsec :: (Rdf a) => T.Text -> Either ParseFailure (RDF a)+parseStringParsec bs = handleParse mkRdf (runParser nt_ntripleDoc () "" bs) -parseFile' :: (Rdf a) => String -> IO (Either ParseFailure (RDF a))-parseFile' path = liftM (handleParse mkRdf . runParser nt_ntripleDoc () path)-                   (TIO.readFile path)+parseFileParsec :: (Rdf a) => String -> IO (Either ParseFailure (RDF a))+parseFileParsec path =+  handleParse mkRdf . runParser nt_ntripleDoc () path+  <$> TIO.readFile path -handleParse :: {-forall rdf. (RDF rdf) => -} (Triples -> Maybe BaseUrl -> PrefixMappings -> (RDF a)) ->+parseURLParsec :: (Rdf a) => String -> IO (Either ParseFailure (RDF a))+parseURLParsec = _parseURL parseStringParsec++---------------------------------++---------------------------------+-- attoparsec based parsers++parseStringAttoparsec :: (Rdf a) => T.Text -> Either ParseFailure (RDF a)+parseStringAttoparsec bs = handleResult $ parse nt_ntripleDoc (T.encodeUtf8 bs)+  where+    handleResult res = case res of+        Fail _ _ err -> error err+        Partial f -> handleResult (f (T.encodeUtf8 T.empty))+        Done _ ts -> Right $ mkRdf (catMaybes ts) Nothing (PrefixMappings Map.empty)++parseFileAttoparsec :: (Rdf a) => String -> IO (Either ParseFailure (RDF a))+parseFileAttoparsec path = parseStringAttoparsec <$> TIO.readFile path++parseURLAttoparsec :: (Rdf a) => String -> IO (Either ParseFailure (RDF a))+parseURLAttoparsec = _parseURL parseStringAttoparsec++---------------------------------+++handleParse :: {-forall rdf. (RDF rdf) => -} (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF a) ->                                         Either ParseError [Maybe Triple] ->                                         Either ParseFailure (RDF a) handleParse _mkRdf result --  | T.length rem /= 0 = (Left $ ParseFailure $ "Invalid Document. Unparseable end of document: " ++ T.unpack rem)-  | otherwise          =-      case result of+--  | otherwise          =+  = case result of         Left err -> Left  $ ParseFailure $ "Parse failure: \n" ++ show err-        Right ts -> Right $ _mkRdf (conv ts) Nothing (PrefixMappings Map.empty)-  where-    conv []            = []-    conv (Nothing:ts)  = conv ts-    conv (Just t:ts) = t : conv ts+        Right ts -> Right $ _mkRdf (catMaybes ts) Nothing (PrefixMappings Map.empty)
src/Text/RDF/RDF4H/ParserUtils.hs view
@@ -1,5 +1,6 @@ module Text.RDF.RDF4H.ParserUtils(-  _parseURL, justTriples+  _parseURL, justTriples,+  Parser(..) ) where  import Data.RDF.Types@@ -12,6 +13,8 @@ import qualified Data.Text as T -- import qualified Data.Map as Map import Data.Maybe (fromMaybe)++data Parser = Parsec | Attoparsec  -- | A convenience function for terminating a parse with a parse failure, using -- the given error message as the message for the failure.
src/Text/RDF/RDF4H/TurtleParser.hs view
@@ -2,28 +2,37 @@ -- <http://www.w3.org/TeamSubmission/turtle/>.  module Text.RDF.RDF4H.TurtleParser(-  TurtleParser(TurtleParser)+  TurtleParser(TurtleParser),+  TurtleParserCustom(TurtleParserCustom) )  where -import Data.Char (isLetter,isAlphaNum,toLower,toUpper)+import Data.Attoparsec.ByteString (parse,IResult(..))+import Data.Char (isLetter,isAlphaNum,toLower,toUpper,isDigit,isHexDigit) import qualified Data.Map as Map import Data.Map (Map) import Data.Maybe import Data.RDF.Types import Data.RDF.Namespace import Text.RDF.RDF4H.ParserUtils-import Text.Parsec-import Text.Parsec.Text+import Text.Parsec (runParser,ParseError)+-- import Text.Parsec.Text (GenParser) 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 qualified Data.Foldable as F-import Data.Char (isDigit) import Control.Monad +import Text.Parser.Char+import Text.Parser.Combinators+import Text.Parser.LookAhead+import Control.Applicative+import Control.Monad.State.Class+import Control.Monad.State.Strict+ -- |An 'RdfParser' implementation for parsing RDF in the -- Turtle format. It is an implementation of W3C Turtle grammar rules at -- http://www.w3.org/TR/turtle/#sec-grammar-grammar .@@ -36,12 +45,25 @@ -- class. data TurtleParser = TurtleParser (Maybe BaseUrl) (Maybe T.Text) --- |'TurtleParser' is an instance of 'RdfParser'.+data TurtleParserCustom = TurtleParserCustom (Maybe BaseUrl) (Maybe T.Text) Parser++-- |'TurtleParser' is an instance of 'RdfParser' using a parsec based parser. instance RdfParser TurtleParser where-  parseString (TurtleParser bUrl dUrl)  = parseString' bUrl dUrl-  parseFile   (TurtleParser bUrl dUrl)  = parseFile' bUrl dUrl-  parseURL    (TurtleParser bUrl dUrl)  = parseURL'  bUrl dUrl+  parseString (TurtleParser bUrl dUrl)  = parseStringParsec bUrl dUrl+  parseFile   (TurtleParser bUrl dUrl)  = parseFileParsec bUrl dUrl+  parseURL    (TurtleParser bUrl dUrl)  = parseURLParsec  bUrl dUrl +-- |'TurtleParser' is an instance of 'RdfParser' using either a+-- parsec or an attoparsec based parser.+instance RdfParser TurtleParserCustom where+  parseString (TurtleParserCustom bUrl dUrl Parsec)      = parseStringParsec bUrl dUrl+  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 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.@@ -56,280 +78,276 @@    Map String Int)  -- grammar rule: [1] turtleDoc-t_turtleDoc :: GenParser ParseState (Seq Triple, PrefixMappings)+-- 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 =-  many t_statement >> (eof <?> "eof") >> getState >>= \(_, _, _, pms, _, _, _, _, _, ts,_) -> return (ts, pms)+  many t_statement *> (eof <?> "eof") *> gets (\(_, _, _, pms, _, _, _, _, _, ts,_) -> (ts, pms))  -- grammar rule: [2] statement-t_statement :: GenParser ParseState ()-t_statement = d <|> t <|> void (many1 t_ws <?> "blankline-whitespace")+t_statement :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()+t_statement = d <|> t <|> void (some t_ws <?> "blankline-whitespace")   where     d = void-      (try t_directive >>-      (many t_ws <?> "directive-whitespace2"))+      (try t_directive+      *> (many t_ws <?> "directive-whitespace2"))     t = void-      (t_triples >> (many t_ws <?> "triple-whitespace1") >>-      (char '.' <?> "end-of-triple-period") >>-      (many t_ws <?> "triple-whitespace2"))+      (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 :: GenParser ParseState ()-t_triples = do-  try (t_subject >> many t_ws >> t_predicateObjectList >> resetSubjectPredicate) <|> (setSubjBlankNodePropList >> t_blankNodePropertyList >> many t_ws >> optional (t_predicateObjectList) >> resetSubjectPredicate >> setNotSubjBlankNodePropList)+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+      *> optional t_predicateObjectList+      *> resetSubjectPredicate+      *> setNotSubjBlankNodePropList)  -- [14]	blankNodePropertyList ::= '[' predicateObjectList ']'-t_blankNodePropertyList :: GenParser ParseState ()+t_blankNodePropertyList :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m () t_blankNodePropertyList = between (char '[') (char ']') $ do                             subjPropList <- isSubjPropList-                            blankNode <- liftM BNodeGen nextIdCounter+                            blankNode <- BNodeGen <$> nextIdCounter                             unless subjPropList $ addTripleForObject blankNode                             pushSubj blankNode-                            (many t_ws >> t_predicateObjectList >> void (many t_ws))+                            many t_ws *> t_predicateObjectList *> void (many t_ws)                             unless subjPropList $ void popSubj  -- grammar rule: [3] directive-t_directive :: GenParser ParseState ()+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 :: GenParser ParseState T.Text+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 :: GenParser ParseState T.Text-t_prefixedName = do-  t <- try t_pname_ln <|> try t_pname_ns-  return t+t_prefixedName :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m T.Text+t_prefixedName = try t_pname_ln <|> try t_pname_ns  -- grammar rule: [4] prefixID-t_prefixID :: GenParser ParseState ()+t_prefixID :: (CharParsing m, MonadState ParseState m) => m () t_prefixID =   do void (try (string "@prefix" <?> "@prefix-directive"))-     pre <- (many1 t_ws <?> "whitespace-after-@prefix") >> option T.empty t_pn_prefix-     void (char ':' >> (many1 t_ws <?> "whitespace-after-@prefix-colon"))+     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, _, _, _, _, _, _, _) <- getState+     (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _, _, _, _) <- get      updatePMs $ Just (PrefixMappings $ Map.insert pre (absolutizeUrl bUrl dUrl uriFrag) pms)-     return ()+     pure ()  -- grammar rule: [6s] sparqlPrefix-t_sparql_prefix :: GenParser ParseState ()+t_sparql_prefix :: (CharParsing m, MonadState ParseState m) => m () t_sparql_prefix =   do void (try (caseInsensitiveString "PREFIX" <?> "@prefix-directive"))-     pre <- (many1 t_ws <?> "whitespace-after-@prefix") >> option T.empty t_pn_prefix-     void (char ':' >> (many1 t_ws <?> "whitespace-after-@prefix-colon"))+     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, _, _, _, _, _, _, _) <- getState+     (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _, _, _, _) <- get      updatePMs $ Just (PrefixMappings $ Map.insert pre (absolutizeUrl bUrl dUrl uriFrag) pms)-     return ()+     pure ()  -- grammar rule: [5] base-t_base :: GenParser ParseState ()+t_base :: (CharParsing m, MonadState ParseState m) => m () t_base =   do void (try (string "@base" <?> "@base-directive"))-     void (many1 t_ws <?> "whitespace-after-@base")+     void (some t_ws <?> "whitespace-after-@base")      urlFrag <- t_iriref      void (many t_ws <?> "base-whitespace")-     (void (char '.') <?> "end-of-base-period")+     void (char '.') <?> "end-of-base-period"      bUrl <- currBaseUrl      dUrl <- currDocUrl      updateBaseUrl (Just $ Just $ newBaseUrl bUrl (absolutizeUrl bUrl dUrl urlFrag))  -- grammar rule: [5s] sparqlBase-t_sparql_base :: GenParser ParseState ()+t_sparql_base :: (CharParsing m, MonadState ParseState m) => m () t_sparql_base =   do void (try (caseInsensitiveString "BASE" <?> "@sparql-base-directive"))-     void (many1 t_ws <?> "whitespace-after-BASE")+     void (some t_ws <?> "whitespace-after-BASE")      urlFrag <- t_iriref      bUrl <- currBaseUrl      dUrl <- currDocUrl      updateBaseUrl (Just $ Just $ newBaseUrl bUrl (absolutizeUrl bUrl dUrl urlFrag)) -t_verb :: GenParser ParseState ()+t_verb :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m () -- [9]	verb ::= predicate | 'a'-t_verb = (try t_predicate <|> (char 'a' >> return rdfTypeNode)) >>= pushPred+t_verb = (try t_predicate <|> (char 'a' *> pure rdfTypeNode)) >>= pushPred  -- grammar rule: [11] predicate-t_predicate :: GenParser ParseState Node-t_predicate = liftM UNode (t_iri <?> "resource")+t_predicate :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m Node+t_predicate = UNode <$> (t_iri <?> "resource")  -- grammar rules: [139s] PNAME_NS-t_pname_ns :: GenParser ParseState T.Text+t_pname_ns :: (CharParsing m, MonadState ParseState m) => m T.Text t_pname_ns =do-  pre <- option T.empty (try t_pn_prefix)-  void (char ':')-  (bUrl, _, _, pms, _, _, _, _, _, _, _) <- getState+  pre <- option T.empty (try t_pn_prefix) <* char ':'+  (bUrl, _, _, pms, _, _, _, _, _, _, _) <- get   case resolveQName bUrl pre pms of-    Just n  -> return n+    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 :: GenParser ParseState 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 >> return "."))+                            (t_pn_chars_str <|> string ":" <|> t_plx <|> try (string "." *> notFollowedBy t_ws *> pure "."))                concat <$> many recsve-  return (T.pack (x ++ xs))+  pure (T.pack (x ++ xs))     where-      satisfy_str = satisfy (flip in_range [('0', '9')]) >>= \c -> return [c]-      t_pn_chars_str = t_pn_chars >>= \c -> return [c]-      t_pn_chars_u_str = t_pn_chars_u >>= \c -> return [c]+      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 :: GenParser ParseState String+t_plx :: (CharParsing m, Monad m) => m String t_plx = t_percent <|> t_pn_local_esc_str     where-      t_pn_local_esc_str = do-        c <- t_pn_local_esc-        return ([c])+      t_pn_local_esc_str = pure <$> t_pn_local_esc  --        '%' HEX HEX -- grammar rules: [170s] PERCENT-t_percent :: GenParser ParseState String-t_percent = do-  void (char '%')-  h1 <- t_hex-  h2 <- t_hex-  return (['%',h1,h2])+t_percent :: (CharParsing m, Monad m) => m String+t_percent = sequence [char '%',t_hex,t_hex] + -- grammar rules: [172s] PN_LOCAL_ESC-t_pn_local_esc :: GenParser ParseState Char-t_pn_local_esc = char '\\' >> oneOf "_~.-!$&'()*+,;=/?#@%"+t_pn_local_esc :: CharParsing m => m Char+t_pn_local_esc = char '\\' *> oneOf "_~.-!$&'()*+,;=/?#@%"  -- grammar rules: [140s] PNAME_LN-t_pname_ln :: GenParser ParseState T.Text-t_pname_ln =-  do pre <- t_pname_ns-     name <- t_pn_local-     return (pre `T.append` name)+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 :: GenParser ParseState ()+t_subject :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m () t_subject =   iri <|>   (t_blankNode >>= pushSubj) <|>-   (liftM BNodeGen nextIdCounter >>= pushSubj-    >> pushPred rdfFirstNode-    >> pushSubjColl-    >> t_collection)+   (BNodeGen <$> nextIdCounter >>= \x -> pushSubj x+    *> pushPred rdfFirstNode+    *> pushSubjColl+    *> t_collection)   where-    iri         = liftM unode (try t_iri <?> "subject resource") >>= \s -> pushSubj s+    iri         = unode <$> (try t_iri <?> "subject resource") >>= pushSubj  -- [137s] BlankNode ::= BLANK_NODE_LABEL | ANON-t_blankNode :: GenParser ParseState Node+t_blankNode :: (CharParsing m, MonadState ParseState m) => m Node t_blankNode = do-  genID <- (try t_blank_node_label <|> (t_anon >> return ""))+  genID <- try t_blank_node_label <|> (t_anon *> pure "")   mp <- currGenIdLookup-  node <--    case Map.lookup genID mp of-      Nothing -> do-        i <- nextIdCounter-        let node = BNodeGen i-        addGenIdLookup genID i-        return node-      Just i ->-        return $ BNodeGen i-  return node+  case Map.lookup genID mp of+    Nothing -> do+      i <- nextIdCounter+      let node = BNodeGen i+      addGenIdLookup genID i+      pure node+    Just i ->+      pure $ BNodeGen i  -- TODO replicate the recursion technique from [168s] for ((..)* something)? -- [141s] BLANK_NODE_LABEL ::= '_:' (PN_CHARS_U | [0-9]) ((PN_CHARS | '.')* PN_CHARS)?-t_blank_node_label :: GenParser ParseState [Char]+t_blank_node_label :: (CharParsing m, MonadState ParseState m) => m String t_blank_node_label = do   void (string "_:")-  firstChar <- (t_pn_chars_u <|> oneOf ['0'..'9'])+  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 return xs+            then pure xs             else if last xs == '.'                  then unexpected "'.' at the end of a blank node label"-                 else return xs-    return (firstChar : ss)+                 else pure xs+    pure (firstChar : ss)  -- [162s] ANON ::= '[' WS* ']'-t_anon :: GenParser ParseState ()-t_anon = between (char '[') (char ']') (void (many t_ws))+t_anon :: CharParsing m => m ()+t_anon = between (char '[') (char ']') (skipMany t_ws)  -- [7] predicateObjectList ::= verb objectList (';' (verb objectList)?)*-t_predicateObjectList :: GenParser ParseState ()-t_predicateObjectList = do+t_predicateObjectList :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m ()+t_predicateObjectList =   void (sepEndBy1         (optional (try (do { t_verb-                           ; many1 t_ws+                           ; some t_ws                            ; t_objectList-                           ; void popPred})))-        (try (many t_ws >> char ';' >> many t_ws)))+                           ; popPred})))+        (try (many t_ws *> char ';' *> many t_ws)))  -- grammar rule: [8] objectlist -- [8] objectList ::= object (',' object)*-t_objectList :: GenParser ParseState ()+t_objectList :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m () t_objectList = -- t_object actually adds the triples-  void-  ((t_object <?> "object") >>-  many (try (many t_ws >> char ',' >> many t_ws >> t_object)))+  () <$ ((t_object <?> "object")+     *> many (try (many t_ws *> char ',' *> many t_ws *> t_object)))  -- grammar rule: [12] object -- [12]	object ::= iri | BlankNode | collection | blankNodePropertyList | literal-t_object :: GenParser ParseState ()+t_object :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m () t_object = do   inColl <- isInColl   inSubjColl <- isInSubjColl   onFirstItem <- onCollFirstItem   let processObject =-           (liftM UNode t_iri >>= addTripleForObject) <|>+           (UNode <$> t_iri >>= addTripleForObject) <|>            (try t_blankNode >>= addTripleForObject) <|>-           (try t_collection >> pushObjColl) <|>-           (try t_blankNodePropertyList) <|>+           (try t_collection *> pushObjColl) <|>+           try t_blankNodePropertyList <|>            (t_literal >>= addTripleForObject)   case (inColl,inSubjColl,onFirstItem) of     (False,_,_)    -> processObject-    (True,False,True)  -> liftM BNodeGen nextIdCounter >>= \bSubj -> addTripleForObject bSubj-                          >> pushSubj bSubj >> pushPred rdfFirstNode >> processObject >> collFirstItemProcessed---    (True,True,True)  -> processObject >> collFirstItemProcessed-    (True,True,True)  -> processObject >> collFirstItemProcessed >> popColl-    (True,_,False) -> liftM BNodeGen nextIdCounter >>= \bSubj -> pushPred rdfRestNode >>-                      addTripleForObject bSubj >> popPred >> popSubj >>-                      pushSubj bSubj >> processObject+    (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  -- collection: '(' ws* itemList? ws* ')' -- itemList:      object (ws+ object)* -- grammar rule: [15] collection -- 15]	collection ::= '(' object* ')'-t_collection :: GenParser ParseState ()+t_collection :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m () t_collection =   between (char '(') (char ')') $ do     beginColl-    (try empty_list <|> non_empty_list)+    try empty_list <|> non_empty_list+    void (many t_ws)     void finishColl     -- popColl       where         non_empty_list = do-          many1 (many t_ws >> t_object >> many t_ws)+          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 return () 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 ')'))+          lookAhead (try (many t_ws *> char ')'))           addTripleForObject rdfNilNode  rdfTypeNode, rdfNilNode, rdfFirstNode, rdfRestNode :: Node@@ -344,30 +362,30 @@ xsdDecimalUri = mkUri xsd "decimal" xsdBooleanUri = mkUri xsd "boolean" -t_literal :: GenParser ParseState Node+t_literal :: (MonadState ParseState m,CharParsing m, LookAheadParsing m) => m Node t_literal =-  (try t_rdf_literal >>= \l -> return (LNode l))   <|>-  liftM (`mkLNode` xsdDoubleUri) (try t_double)    <|>-  liftM (`mkLNode` xsdDecimalUri) (try t_decimal)  <|>-  liftM (`mkLNode` xsdIntUri) (try t_integer)      <|>-  liftM (`mkLNode` xsdBooleanUri) t_boolean-   where+  LNode <$> try t_rdf_literal                 <|>+  (`mkLNode` xsdDoubleUri)  <$> try t_double  <|>+  (`mkLNode` xsdDecimalUri) <$> try t_decimal <|>+  (`mkLNode` xsdIntUri)     <$> try t_integer <|>+  (`mkLNode` xsdBooleanUri) <$> t_boolean+  where     mkLNode :: T.Text -> T.Text -> Node     mkLNode bsType bs' = LNode (typedL bsType bs')  -- [128s] RDFLiteral -- String (LANGTAG | '^^' iri)?-t_rdf_literal :: GenParser ParseState 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) $ do-                  (try (t_langtag >>= \lang -> return (plainLL str lang)) <|>-                   ((count 2 (char '^') >> t_iri >>= \iri -> return (typedL str iri))))+  option (plainL str) $+                  try (t_langtag >>= \lang -> pure (plainLL str lang)) <|>+                   (count 2 (char '^') *> t_iri >>= \iri -> pure (typedL str iri))  -- [17] String -- STRING_LITERAL_QUOTE | STRING_LITERAL_SINGLE_QUOTE | STRING_LITERAL_LONG_SINGLE_QUOTE | STRING_LITERAL_LONG_QUOTE-t_string :: GenParser ParseState T.Text+t_string :: (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 <|>@@ -375,18 +393,18 @@  -- [22]	STRING_LITERAL_QUOTE -- '"' ([^#x22#x5C#xA#xD] | ECHAR | UCHAR)* '"'-t_string_literal_quote :: GenParser ParseState T.Text+t_string_literal_quote :: (CharParsing m, Monad m) => m T.Text t_string_literal_quote =-     between (char '"') (char '"') $ do+     between (char '"') (char '"') $       T.concat <$> many (T.singleton <$> noneOf ['\x22','\x5C','\xA','\xD'] <|>             t_echar <|>             t_uchar)  -- [23] STRING_LITERAL_SINGLE_QUOTE -- "'" ([^#x27#x5C#xA#xD] | ECHAR | UCHAR)* "'"-t_string_literal_single_quote :: GenParser ParseState T.Text+t_string_literal_single_quote :: (CharParsing m, Monad m) => m T.Text t_string_literal_single_quote =-    between (char '\'') (char '\'') $ do+    between (char '\'') (char '\'') $       T.concat <$>        many (T.singleton <$> noneOf ['\x27','\x5C','\xA','\xD'] <|>              t_echar <|>@@ -394,128 +412,121 @@  -- [24] STRING_LITERAL_LONG_SINGLE_QUOTE -- "'''" (("'" | "''")? ([^'\] | ECHAR | UCHAR))* "'''"-t_string_literal_long_single_quote :: GenParser ParseState T.Text+t_string_literal_long_single_quote :: (CharParsing m, Monad m) => m T.Text t_string_literal_long_single_quote =-    between ((string "'''")) ((string "'''")) $ do+    between (string "'''") (string "'''") $ do       ss <- many $ try $ do         s1 <- T.pack <$> option "" (try (string "''") <|> string "'")         s2 <- T.singleton <$> noneOf ['\'','\\'] <|> t_echar <|> t_uchar-        return (s1 `T.append` s2)-      return (T.concat ss)+        pure (s1 `T.append` s2)+      pure (T.concat ss)  -- [25] STRING_LITERAL_LONG_QUOTE -- '"""' (('"' | '""')? ([^"\] | ECHAR | UCHAR))* '"""'-t_string_literal_long_quote :: GenParser ParseState T.Text+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-              return (s1 `T.append` s2)-      return (T.concat ss)+              pure (s1 `T.append` s2)+      pure (T.concat ss)  -- [144s] LANGTAG -- '@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)*-t_langtag :: GenParser ParseState T.Text+t_langtag :: (CharParsing m, Monad m) => m T.Text t_langtag = do-    void (char '@')-    ss   <- many1 (satisfy (\ c -> isLetter c))-    rest <- concat <$> many (char '-' >> many1 (satisfy (\ c -> isAlphaNum c)) >>= \lang_str -> return ('-':lang_str))-    return (T.pack (ss ++ rest))+    ss   <- char '@' *> some (satisfy isLetter)+    rest <- concat <$> many (char '-' *> some (satisfy isAlphaNum) >>= \lang_str -> pure ('-':lang_str))+    pure (T.pack (ss ++ rest))  -- [159s]	ECHAR -- '\' [tbnrf"'\]-t_echar :: GenParser ParseState T.Text+t_echar :: (CharParsing m, Monad m) => m T.Text t_echar = try $ do-    void (char '\\')-    c2 <- oneOf ['t','b','n','r','f','"','\'','\\']-    return $ case c2 of-               't'  -> T.singleton '\t'-               'b'  -> T.singleton '\b'-               'n'  -> T.singleton '\n'-               'r'  -> T.singleton '\r'-               'f'  -> T.singleton '\f'-               '"'  -> T.singleton '\"'-               '\'' -> T.singleton '\''-               '\\' -> T.singleton '\\'-               _    -> error "nt_echar: impossible error."+    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."  -- [26]	UCHAR -- '\u' HEX HEX HEX HEX | '\U' HEX HEX HEX HEX HEX HEX HEX HEX-t_uchar :: GenParser ParseState T.Text+t_uchar :: (CharParsing m, Monad m) => m T.Text t_uchar =-    (try (string "\\u" >> count 4 hexDigit) >>= \cs -> return $ T.pack ('\\':'u':cs)) <|>-     (char '\\' >> char 'U' >> count 8 hexDigit >>= \cs -> return $ T.pack ('\\':'U':cs))+    (try (string "\\u" *> count 4 hexDigit) >>= \cs -> pure $ T.pack ('\\':'u':cs)) <|>+     (char '\\' *> char 'U' *> count 8 hexDigit >>= \cs -> pure $ T.pack ('\\':'U':cs))  -- [19] INTEGER ::= [+-]? [0-9]+-t_integer :: GenParser ParseState T.Text+t_integer :: (CharParsing m, Monad m) => m T.Text t_integer = try $   do sign <- sign_parser <?> "+-"-     ds <- many1 (oneOf ['0'..'9'] <?> "digit")-     return $! ( T.pack sign `T.append` T.pack ds)+     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 :: GenParser ParseState T.Text+t_double :: (CharParsing m, Monad m) => m T.Text t_double =   do sign <- sign_parser <?> "+-"-     rest <- try (do { ds <- many1 (oneOf ['0'..'9']) <?> "digit";-                      void (char '.');-                      ds' <- many (oneOf ['0'..'9']) <?> "digit";+     rest <- try (do { ds <- (some (satisfy isDigit) <?> "digit") <* char '.';+                      ds' <- many (satisfy isDigit) <?> "digit";                       e <- t_exponent <?> "exponent";-                      return ( T.pack ds `T.snoc` '.' `T.append`  T.pack ds' `T.append` e) }) <|>-             try (do { void (char '.');-                       ds <- many1 (oneOf ['0'..'9']) <?> "digit";+                      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";-                       return ('.' `T.cons`  T.pack ds `T.append` e) }) <|>-                 (do { ds <- many1 (oneOf ['0'..'9']) <?> "digit";+                       pure ('.' `T.cons`  T.pack ds `T.append` e) }) <|>+                 (do { ds <- some (satisfy isDigit) <?> "digit";                        e <- t_exponent <?> "exponent";-                       return ( T.pack ds `T.append` e) })-     return $! T.pack sign `T.append` rest+                       pure ( T.pack ds `T.append` e) })+     pure $! T.pack sign `T.append` rest -sign_parser :: GenParser ParseState String-sign_parser = option "" (oneOf "-+" >>= (\c -> return [c]))+sign_parser :: CharParsing m => m String+sign_parser = option "" (pure <$> oneOf "-+")  -- [20]	DECIMAL ::= [+-]? [0-9]* '.' [0-9]+-t_decimal :: GenParser ParseState T.Text+t_decimal :: (CharParsing m, Monad m) => m T.Text t_decimal = try $ do               sign <- sign_parser-              dig1 <- many (oneOf ['0'..'9'])-              void (char '.')-              dig2 <- many1 (oneOf ['0'..'9'])-              return (T.pack sign `T.append`  T.pack dig1 `T.append` T.pack "." `T.append` T.pack dig2)+              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) -t_exponent :: GenParser ParseState T.Text+t_exponent :: (CharParsing m, Monad m) => m T.Text t_exponent = do e <- oneOf "eE"-                s <- option "" (oneOf "-+" >>= \c -> return [c])-                ds <- many1 digit;-                return $! (e `T.cons` ( T.pack s `T.append` T.pack ds))+                s <- option "" (pure <$> oneOf "-+")+                ds <- some digit+                pure $! (e `T.cons` ( T.pack s `T.append` T.pack ds)) -t_boolean :: GenParser ParseState T.Text+t_boolean :: CharParsing m => m T.Text t_boolean =-  try (liftM T.pack (string "true") <|>-  liftM T.pack (string "false"))+  T.pack <$> try (string "true" <|> string "false") -t_comment :: GenParser ParseState ()+t_comment :: CharParsing m => m () t_comment =-  void (char '#' >> many (satisfy (\ c -> c /= '\n' && c /= '\r')))+  void (char '#' *> many (noneOf "\n\r"))  -- [161s] WS ::= #x20 | #x9 | #xD | #xA-t_ws :: GenParser ParseState ()+t_ws :: CharParsing m => m () t_ws =-    (void (try (char '\t' <|> char '\n' <|> char '\r' <|> char ' '))-     <|> try t_comment)+    (void (try (oneOf "\t\n\r "))) <|> try t_comment     <?> "whitespace-or-comment"  -- grammar rule: [167s] PN_PREFIX-t_pn_prefix :: GenParser ParseState T.Text+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-  return (T.pack (i:r))+  pure (T.pack (i:r))  -- [18] IRIREF-t_iriref :: GenParser ParseState T.Text+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'] ++ ['<','>','"','{','}','|','^','`','\\']) <|>@@ -525,13 +536,13 @@     let iri' = escapeRDFSyntax iri     validateURI (absolutizeUrl bUrl dUrl iri') -t_pn_chars :: GenParser ParseState Char+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 rule: [163s] PN_CHARS_BASE-t_pn_chars_base :: GenParser ParseState Char+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'),@@ -543,12 +554,14 @@               ('\x10000', '\xEFFFF')]  -- grammar rule: [164s] PN_CHARS_U-t_pn_chars_u :: GenParser ParseState Char+t_pn_chars_u :: CharParsing m => m Char t_pn_chars_u = t_pn_chars_base <|> char '_'  -- grammar rules: [171s] HEX-t_hex :: GenParser ParseState Char-t_hex = satisfy (\c -> isDigit c || (c >= 'A' && c <= 'F')) <?> "hexadecimal digit"+-- 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@@ -558,124 +571,127 @@ newBaseUrl Nothing               url = BaseUrl url newBaseUrl (Just (BaseUrl bUrl)) url = BaseUrl $! mkAbsoluteUrl bUrl url -currGenIdLookup :: GenParser ParseState (Map String Int)-currGenIdLookup = getState >>= \(_, _, _, _, _, _, _, _, _, _,genMap) -> return genMap+currGenIdLookup :: MonadState ParseState m => m (Map String Int)+currGenIdLookup = gets $ \(_, _, _, _, _, _, _, _, _, _,genMap) -> genMap -addGenIdLookup :: String -> Int -> GenParser ParseState ()-addGenIdLookup genId counter = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->-                  setState (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, Map.insert genId counter genMap)+addGenIdLookup :: MonadState ParseState m => String -> Int -> 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) -currBaseUrl :: GenParser ParseState (Maybe BaseUrl)-currBaseUrl = getState >>= \(bUrl, _, _, _, _, _, _, _, _, _,_) -> return bUrl+currBaseUrl :: MonadState ParseState m => m (Maybe BaseUrl)+currBaseUrl = gets $ \(bUrl, _, _, _, _, _, _, _, _, _,_) -> bUrl -currDocUrl :: GenParser ParseState (Maybe T.Text)-currDocUrl = getState >>= \(_, dUrl, _, _, _, _, _, _, _, _,_) -> return dUrl+currDocUrl :: MonadState ParseState m => m (Maybe T.Text)+currDocUrl = gets $ \(_, dUrl, _, _, _, _, _, _, _, _,_) -> dUrl -pushSubj :: Subject -> GenParser ParseState ()-pushSubj s = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->-                  setState (bUrl, dUrl, i, pms, s:ss, ps, cs, subjC, subjBNodeList, ts, genMap)+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 :: GenParser ParseState Subject-popSubj = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->-                setState (bUrl, dUrl, i, pms, tail ss, ps, cs, subjC, subjBNodeList, ts, genMap) >>-                  when (null ss) (error "Cannot pop subject off empty stack.") >>-                  return (head ss)+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 :: Predicate -> GenParser ParseState ()-pushPred p = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->-                  setState (bUrl, dUrl, i, pms, ss, p:ps, cs, subjC, subjBNodeList, ts, genMap)+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 :: GenParser ParseState Predicate-popPred = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts, genMap) ->-                setState (bUrl, dUrl, i, pms, ss, tail ps, cs, subjC, subjBNodeList, ts, genMap) >>-                  when (null ps) (error "Cannot pop predicate off empty stack.") >>-                  return (head ps)+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 :: GenParser ParseState Bool-isInColl = getState >>= \(_, _, _, _, _, _, cs, _, _, _, _) -> return . not . null $ cs+isInColl :: MonadState ParseState m => m Bool+isInColl = gets $ \(_, _, _, _, _, _, cs, _, _, _, _) -> not . null $ cs -isInSubjColl :: GenParser ParseState Bool-isInSubjColl = getState >>= \(_, _, _, _, _, _, _, xs, _, _, _) -> do-               if null xs then return False else return (head xs)+isInSubjColl :: MonadState ParseState m => m Bool+isInSubjColl = gets $ \(_, _, _, _, _, _, _, xs, _, _, _) ->+                   if null xs then False else (head xs)  {--isInObjColl :: GenParser ParseState Bool-isInObjColl = getState >>= \(_, _, _, _, _, _, _, xs, _, _) -> do+isInObjColl :: (CharParsing m, MonadState ParseState m) => m Bool+isInObjColl = get >>= \(_, _, _, _, _, _, _, xs, _, _) -> do                when (null xs) $ error "null in isInObjColl"-               return (not (head xs))+               pure (not (head xs)) -} -pushSubjColl :: GenParser ParseState ()-pushSubjColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts, genMap) ->-                 setState (bUrl, dUrl, i, pms, s, p, cs, True:subjC, subjBNodeList, ts, genMap)+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 :: GenParser ParseState ()-popColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts, genMap) -> do-                when (null subjC) $ error "null in popColl"-                setState (bUrl, dUrl, i, pms, s, p, cs, tail subjC, subjBNodeList, ts, 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 :: GenParser ParseState ()-pushObjColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->-                 setState (bUrl, dUrl, i, pms, s, p, cs, False:subjC, subjBNodeList, ts,genMap)+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 :: GenParser ParseState Bool-isSubjPropList = getState >>= \(_, _, _, _, _, _, _, _, subjBNodeList, _,_) -> do-                return subjBNodeList+isSubjPropList :: MonadState ParseState m => m Bool+isSubjPropList = gets $ \(_, _, _, _, _, _, _, _, subjBNodeList, _,_) -> subjBNodeList  {--isObjPropList :: GenParser ParseState Bool-isObjPropList = getState >>= \(_, _, _, _, _, _, _, _, subjBNodeList, _) -> do-                return subjBNodeList+isObjPropList :: (CharParsing m, MonadState ParseState m) => m Bool+isObjPropList = get >>= \(_, _, _, _, _, _, _, _, subjBNodeList, _) -> do+                pure subjBNodeList -} -setSubjBlankNodePropList :: GenParser ParseState ()-setSubjBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts,genMap) ->-                 setState (bUrl, dUrl, i, pms, s, p, cs, subjC, True, ts,genMap)+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 :: GenParser ParseState ()-setNotSubjBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts,genMap) ->-                 setState (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 :: GenParser ParseState ()--- setObjBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _, ts) ->---                  setState (bUrl, dUrl, i, pms, s, p, cs, subjC, False, ts)+-- 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 :: GenParser ParseState ()--- popBlankNodePropList = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, _:subjBNodeList, 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"---                  setState (bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts)+--                  put (bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts) -updateBaseUrl :: Maybe (Maybe BaseUrl) -> GenParser ParseState ()+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 :: GenParser ParseState Int-nextIdCounter = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->-                setState (bUrl, dUrl, i+1, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) >> return i+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 -updatePMs :: Maybe PrefixMappings -> GenParser ParseState ()+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 :: GenParser ParseState ()-beginColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->-            setState (bUrl, dUrl, i, pms, s, p, True:cs, subjC, subjBNodeList, ts,genMap)+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 :: GenParser ParseState Bool-onCollFirstItem = getState >>= \(_, _, _, _, _, _, cs, _, _, _,_) -> return (not (null cs) && head cs)+onCollFirstItem :: MonadState ParseState m => m Bool+onCollFirstItem = gets $ \(_, _, _, _, _, _, cs, _, _, _,_) -> (not (null cs) && head cs) -collFirstItemProcessed :: GenParser ParseState ()-collFirstItemProcessed = getState >>= \(bUrl, dUrl, i, pms, s, p, _:cs, subjC, subjBNodeList, ts,genMap) ->-                         setState (bUrl, dUrl, i, pms, s, p, False:cs, subjC, subjBNodeList, ts,genMap)+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 :: GenParser ParseState Bool-finishColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, subjC, subjBNodeList, ts,genMap) ->+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 setState (bUrl, dUrl, i, pms, s, p, cs', subjC, subjBNodeList, ts,genMap) >> return (not $ null 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.@@ -683,19 +699,20 @@ no = Nothing  -- Update the subject and predicate values of the ParseState to Nothing.-resetSubjectPredicate :: GenParser ParseState ()+resetSubjectPredicate :: MonadState ParseState m => m () resetSubjectPredicate =-  getState >>= \(bUrl, dUrl, n, pms, _, _, cs, subjC, subjBNodeList, ts,genMap) ->-  setState (bUrl, dUrl, n, pms, [], [], cs, subjC, subjBNodeList, ts,genMap)+  modify $ \(bUrl, dUrl, n, pms, _, _, cs, subjC, subjBNodeList, ts,genMap) ->+            (bUrl, dUrl, n, pms, [], [], cs, subjC, subjBNodeList, ts,genMap)  -- Modifies the current parser state by updating any state values among the parameters -- that have non-Nothing values.-_modifyState :: Maybe (Maybe BaseUrl) -> Maybe (Int -> Int) -> Maybe PrefixMappings ->+_modifyState :: MonadState ParseState m =>+                Maybe (Maybe BaseUrl) -> Maybe (Int -> Int) -> Maybe PrefixMappings ->                 Maybe Subject -> Maybe Predicate -> Maybe (Seq Triple) ->-                GenParser ParseState ()+                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) <- getState-     setState (fromMaybe _bUrl mb_bUrl,+  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,@@ -706,15 +723,19 @@               _subjBNodeList,               fromMaybe _ts mb_trps,genMap) -addTripleForObject :: Object -> GenParser ParseState ()+addTripleForObject :: (CharParsing m, MonadState ParseState m) => Object -> m () addTripleForObject obj =-  do (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts,genMap) <- getState+  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-     setState (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts |> Triple (head ss) (head ps) obj,genMap)+     put (bUrl, dUrl, i, pms, ss, ps, cs, subjC, subjBNodeList, ts |> Triple (head ss) (head ps) obj,genMap) ++---------------------------------+-- parsec based parsers+ -- |Parse the document at the given location URL as a Turtle document, using an optional @BaseUrl@ -- as the base URI, and using the given document URL as the URI of the Turtle document itself. --@@ -732,57 +753,88 @@ -- base URI against which the relative URI is resolved. -- -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples.-parseURL' :: (Rdf a) =>+parseURLParsec :: (Rdf a) =>                  Maybe BaseUrl       -- ^ The optional base URI of the document.                  -> Maybe T.Text     -- ^ The document URI (i.e., the URI of the document itself); if Nothing, use location URI.                  -> String           -- ^ The location URI from which to retrieve the Turtle document.                  -> IO (Either ParseFailure (RDF a))                                      -- ^ The parse result, which is either a @ParseFailure@ or the RDF                                      --   corresponding to the Turtle document.-parseURL' bUrl docUrl = _parseURL (parseString' bUrl docUrl)+parseURLParsec bUrl docUrl = _parseURL (parseStringParsec bUrl docUrl)  -- |Parse the given file as a Turtle document. The arguments and return type have the same semantics -- as 'parseURL', except that the last @String@ argument corresponds to a filesystem location rather -- than a location URI. -- -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples.-parseFile' :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> String -> IO (Either ParseFailure (RDF a))-parseFile' bUrl docUrl fpath = do-  TIO.readFile fpath >>= \bs' -> return $ handleResult bUrl (runParser t_turtleDoc initialState (maybe "" T.unpack docUrl) bs')-  where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], [], False, Seq.empty,Map.empty)+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') + -- |Parse the given string as a Turtle document. The arguments and return type have the same semantics -- as <parseURL>, except that the last @String@ argument corresponds to the Turtle document itself as -- a string rather than a location URI.-parseString' :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> T.Text -> Either ParseFailure (RDF a)-parseString' bUrl docUrl ttlStr = handleResult bUrl (runParser t_turtleDoc initialState "" ttlStr)-  where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], [], False, Seq.empty,Map.empty)+parseStringParsec :: (Rdf a) => Maybe BaseUrl -> Maybe T.Text -> T.Text -> Either ParseFailure (RDF a)+parseStringParsec bUrl docUrl ttlStr = handleResult bUrl (runParser (evalStateT t_turtleDoc (initialState bUrl docUrl)) () "" ttlStr) ++---------------------------------+-- 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)+  where+    handleResult' res = case res of+        Fail _ _ err -> error err+        Partial f -> handleResult' (f (T.encodeUtf8 T.empty))+        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++parseURLAttoparsec :: (Rdf a) =>+                 Maybe BaseUrl       -- ^ The optional base URI of the document.+                 -> Maybe T.Text     -- ^ The document URI (i.e., the URI of the document itself); if Nothing, use location URI.+                 -> String           -- ^ The location URI from which to retrieve the Turtle document.+                 -> IO (Either ParseFailure (RDF a))+                                     -- ^ The parse result, which is either a @ParseFailure@ or the RDF+                                     --   corresponding to the Turtle document.+parseURLAttoparsec bUrl docUrl = _parseURL (parseStringAttoparsec bUrl docUrl)++---------------------------------++initialState :: Maybe BaseUrl -> Maybe T.Text -> ParseState+initialState bUrl docUrl = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], [], False, Seq.empty,Map.empty)++ handleResult :: Rdf a => Maybe BaseUrl -> Either ParseError (Seq Triple, PrefixMappings) -> Either ParseFailure (RDF a) handleResult bUrl result =   case result of     (Left err)         -> Left (ParseFailure $ show err)     (Right (ts, pms))  -> Right $! mkRdf (F.toList ts) bUrl pms -validateUNode :: T.Text -> GenParser ParseState Node+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{}) -> return u+      Just u@UNode{} -> pure u       Just node      -> unexpected ("Unexpected node in Turtle parser URI validation: " ++ show node) -validateURI :: T.Text -> GenParser ParseState T.Text+validateURI :: (CharParsing m, Monad m) => T.Text -> m T.Text validateURI t = do     UNode uri <- validateUNode t-    return uri+    pure uri ++ -------------- -- auxiliary parsing functions  -- Match the lowercase or uppercase form of 'c'-caseInsensitiveChar :: Char -> GenParser ParseState Char+caseInsensitiveChar :: CharParsing m => Char -> m Char caseInsensitiveChar c = char (toLower c) <|> char (toUpper c)  -- Match the string 's', accepting either lowercase or uppercase form of each character-caseInsensitiveString :: String -> GenParser ParseState String+caseInsensitiveString :: (CharParsing m, Monad m) => String -> m String caseInsensitiveString s = try (mapM caseInsensitiveChar s) <?> "\"" ++ s ++ "\""
src/Text/RDF/RDF4H/XmlParser.hs view
@@ -7,7 +7,7 @@   XmlParser(XmlParser) ) where -import Control.Arrow (Arrow,(>>>),(<<<),(&&&),(***),arr,returnA)+import Control.Arrow ((>>>),(<<<),(&&&),(***),arr,returnA) import Control.Arrow.ArrowState (ArrowState,nextState) import Control.Exception import Data.List (isPrefixOf)@@ -139,7 +139,7 @@                    <+> (second (getChildren >>> isElem) >>> parsePredicatesFromChildren)                    <+> (second (neg (hasName "rdf:Description") >>> neg (hasName "Description")) >>> arr2A readTypeTriple))                >>. replaceLiElems [] (1 :: Int)-  where readTypeTriple :: (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple+  where readTypeTriple :: (ArrowXml a) => LParseState -> a XmlTree Triple         readTypeTriple state = getName >>> arr (Triple (stateSubject state) rdfType . unode . T.pack)         replaceLiElems acc n (Triple s p o : rest) | p == (unode . T.pack) "rdf:li" =             replaceLiElems (Triple s ((unode . T.pack) ("rdf:_" ++ show n)) o : acc) (n + 1) rest@@ -154,13 +154,13 @@         <+> (arr (\s -> s { stateSubject = n }) *** (getChildren >>> isElem) >>> parsePredicatesFromChildren))  -- |Read the attributes of an rdf:Description element.  These correspond to the Predicate Object pairs of the Triple-parsePredicatesFromAttr :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple+parsePredicatesFromAttr :: forall a. (ArrowXml a) => LParseState -> a XmlTree Triple parsePredicatesFromAttr state = getAttrl     >>> (getName >>> neg isMetaAttr >>> mkUNode) &&& (getChildren >>> getText >>> arr (mkLiteralNode state))     >>> arr (attachSubject (stateSubject state))  -- | Arrow to determine if special processing is required for an attribute-isMetaAttr :: forall a. (ArrowXml a, ArrowState GParseState a) => a String String+isMetaAttr :: forall a. (ArrowXml a) => a String String isMetaAttr = isA (== "rdf:about")          <+> isA (== "rdf:nodeID")          <+> isA (== "rdf:ID")@@ -196,7 +196,7 @@ --  _:a <rdf:foo> "foo" . -- -- And hence the use of `hasNamePrefix "rdf"`-isValidPropElemName :: (ArrowXml a, ArrowState GParseState a) => a XmlTree XmlTree+isValidPropElemName :: (ArrowXml a) => a XmlTree XmlTree isValidPropElemName = hasNamePrefix "rdf"   -- hasName "rdf:Seq"   -- <+> hasName "rdf:Bag"@@ -254,7 +254,7 @@  -- See https://www.w3.org/2000/03/rdf-tracking/ -- Section "Issue rdfms-rdf-names-use: Illegal or unusual use of names from the RDF namespace"-validPropElementName :: (ArrowXml a, ArrowState GParseState a) => a (LParseState,XmlTree) (LParseState,XmlTree)+validPropElementName :: (ArrowXml a) => a (LParseState,XmlTree) (LParseState,XmlTree) validPropElementName = proc (state,predXml) -> do   neg (hasName "rdf:Description") -< predXml   neg (hasName "rdf:RDF") -< predXml@@ -285,7 +285,7 @@ attachSubject :: Subject -> (Predicate, Object) -> Triple attachSubject s (p, o) = Triple s p o -reifyTriple :: forall a. (ArrowXml a, ArrowState GParseState a) => Subject -> a Triple Triples+reifyTriple :: forall a. (ArrowXml a) => Subject -> a Triple Triples reifyTriple node = arr (\(Triple s p o) -> [ Triple s p o                                            , Triple node rdfType rdfStatement                                            , Triple node rdfSubject s@@ -294,7 +294,7 @@                                            ])  -- |Updates the local state at a given node-updateState :: forall a. (ArrowXml a, ArrowState GParseState a)+updateState :: forall a. (ArrowXml a)             => a (LParseState, XmlTree) (LParseState, XmlTree) updateState = ifA (second (hasAttr "xml:lang")) (arr2A readLang) (arr id)           >>> ifA (second (hasAttr "xml:base")) (arr2A readBase) (arr id)@@ -302,11 +302,11 @@         readBase state = (getAttrValue0 "xml:base" >>> arr (\base -> state { stateBaseUrl = (BaseUrl . T.pack) base } ) ) &&& arr id  -- |Read a Triple with an rdf:parseType of Literal-parseAsLiteralTriple :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple+parseAsLiteralTriple :: forall a. (ArrowXml a) => LParseState -> a XmlTree Triple parseAsLiteralTriple state = (nameToUNode &&& (xshow getChildren >>> arr (mkTypedLiteralNode rdfXmlLiteral)))     >>> arr (attachSubject (stateSubject state)) -mkCollectionTriples :: forall a. (ArrowXml a, ArrowState GParseState a) => a [(Triple, Node)] Triples+mkCollectionTriples :: forall a. (ArrowXml a) => a [(Triple, Node)] Triples mkCollectionTriples = arr (mkCollectionTriples' [])   where mkCollectionTriples' [] ((Triple s1 p1 o1, n1):rest) =             mkCollectionTriples' [Triple s1 p1 n1] ((Triple s1 p1 o1, n1):rest)@@ -317,16 +317,16 @@         mkCollectionTriples' _ [] = []  -- |Read a Triple and it's type when rdf:datatype is available-getTypedTriple :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple+getTypedTriple :: forall a. (ArrowXml a) => LParseState -> a XmlTree Triple getTypedTriple state = nameToUNode &&& (attrExpandURI state "rdf:datatype" &&& xshow getChildren >>> arr (\(t, v) -> mkTypedLiteralNode (T.pack t) v))     >>> arr (attachSubject (stateSubject state)) -getResourceTriple :: forall a. (ArrowXml a, ArrowState GParseState a)+getResourceTriple :: forall a. (ArrowXml a)                   => LParseState -> a XmlTree Triple getResourceTriple state = nameToUNode &&& (attrExpandURI state "rdf:resource" >>> mkUNode)     >>> arr (attachSubject (stateSubject state)) -getNodeIdTriple :: forall a. (ArrowXml a, ArrowState GParseState a)+getNodeIdTriple :: forall a. (ArrowXml a)                 => LParseState -> a XmlTree Triple getNodeIdTriple state = nameToUNode &&& (getAttrValue "rdf:nodeID" >>> arr (bnode . T.pack))     >>> arr (attachSubject (stateSubject state))@@ -342,7 +342,7 @@  -- See https://www.w3.org/2000/03/rdf-tracking/ -- Section "Issue rdfms-rdf-names-use: Illegal or unusual use of names from the RDF namespace"-validNodeElementName :: (ArrowXml a, ArrowState GParseState a) => a XmlTree XmlTree+validNodeElementName :: (ArrowXml a) => a XmlTree XmlTree validNodeElementName = neg (hasName "rdf:RDF")                        >>> neg (hasName "rdf:ID")                        >>> neg (hasName "rdf:about")@@ -375,13 +375,13 @@   where baseUrl = constA (case stateBaseUrl state of BaseUrl b -> T.unpack b)  -- |Make a UNode from an absolute string-mkUNode :: forall a. (Arrow a, ArrowIf a) => a String Node+mkUNode :: forall a. (ArrowIf a) => a String Node mkUNode = choiceA [ (arr (isJust . unodeValidate . T.pack)) :-> (arr (fromJust . unodeValidate . T.pack))                   , arr (\_ -> True) :-> arr (\uri -> throw (ParserException ("Invalid URI: " ++ uri)))                   ]  -- |Make a UNode from a rdf:ID element, expanding relative URIs-mkRelativeNode :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Node+mkRelativeNode :: forall a. (ArrowXml a) => LParseState -> a XmlTree Node mkRelativeNode s = (getAttrValue "rdf:ID" >>> arr (\x -> '#':x)) &&& baseUrl     >>> expandURI >>> arr (unode . T.pack)   where baseUrl = constA (case stateBaseUrl s of BaseUrl b -> T.unpack b)
− testsuite/tests/Data/RDF/Graph/AdjHashMap_Test.hs
@@ -1,33 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module Data.RDF.Graph.AdjHashMap_Test (triplesOf',uniqTriplesOf',empty',mkRdf',addTriple',removeTriple') where--import Data.RDF.Types-import Data.RDF.Graph.AdjHashMap (AdjHashMap)-import Data.RDF.GraphTestUtils-import qualified Data.Map as Map-import Control.Monad--import Test.QuickCheck--instance Arbitrary (RDF AdjHashMap) where-  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)-  --coarbitrary = undefined--empty' :: RDF AdjHashMap-empty' = empty--mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF AdjHashMap-mkRdf' = mkRdf--triplesOf' :: RDF AdjHashMap -> Triples-triplesOf' = triplesOf--uniqTriplesOf' :: RDF AdjHashMap -> Triples-uniqTriplesOf' = uniqTriplesOf--addTriple' :: RDF AdjHashMap -> Triple -> RDF AdjHashMap-addTriple' = addTriple--removeTriple' :: RDF AdjHashMap -> Triple -> RDF AdjHashMap-removeTriple' = removeTriple
− testsuite/tests/Data/RDF/Graph/TList_Test.hs
@@ -1,33 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}--module Data.RDF.Graph.TList_Test (empty',triplesOf',uniqTriplesOf',mkRdf',addTriple',removeTriple') where--import Control.Monad-import qualified Data.Map as Map-import Data.RDF.GraphTestUtils-import Data.RDF.Namespace-import Data.RDF.Graph.TList-import Data.RDF.Types-import Test.QuickCheck.Arbitrary--instance Arbitrary (RDF TList) where-  arbitrary = liftM3 mkRdf arbitraryTs (return Nothing) (return $ PrefixMappings Map.empty)-  --coarbitrary = undefined--empty' :: RDF TList-empty' = empty--mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF TList-mkRdf' = mkRdf--triplesOf' :: RDF TList -> Triples-triplesOf' = triplesOf--uniqTriplesOf' :: RDF TList -> Triples-uniqTriplesOf' = uniqTriplesOf--addTriple' :: RDF TList -> Triple -> RDF TList-addTriple' = addTriple--removeTriple' :: RDF TList -> Triple -> RDF TList-removeTriple' = removeTriple
− testsuite/tests/Data/RDF/GraphTestUtils.hs
@@ -1,561 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Data.RDF.GraphTestUtils (graphTests,arbitraryTs) where--import Data.RDF.Types-import Data.RDF.Query-import Data.RDF.Namespace-import Text.RDF.RDF4H.NTriplesSerializer-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 GHC.Generics ()-import System.Directory (removeFile)-import System.IO--import Test.Tasty-import Test.Tasty.QuickCheck-import Test.QuickCheck.Monadic (assert, monadicIO,run)---------------------------------------------------------  property based quick check test cases         ---------------------------------------------------------graphTests-  :: (Arbitrary (RDF rdf), Rdf rdf)-  => TestName-  -> (RDF rdf -> Triples) -- ^ triplesOf-  -> (RDF rdf -> Triples) -- ^ uniqTriplesOf-  -> RDF rdf -- ^ empty-  -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -- ^ mkRdf-  -> (RDF rdf -> Triple -> RDF rdf) -- ^ addTriple-  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple-  -> TestTree-graphTests testGroupName _triplesOf _uniqTriplesOf _empty _mkRdf _addTriple _removeTriple =-  testGroup testGroupName-            [-              testProperty "empty"                      (p_empty _triplesOf _empty)-            , testProperty "mkRdf_triplesOf"            (p_mkRdf_triplesOf _triplesOf _mkRdf)-            , testProperty "mkRdf_no_dupes"             (p_mkRdf_no_dupes _uniqTriplesOf _mkRdf)-            , testProperty "query_match_none"           (p_query_match_none _mkRdf)-            , testProperty "query_matched_spo"          (p_query_matched_spo _triplesOf)-            -- 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 _triplesOf)-            , testProperty "query_match_s"              (p_query_match_s _triplesOf)-            , testProperty "query_match_p"              (p_query_match_p _triplesOf)-            , testProperty "query_match_o"              (p_query_match_o _triplesOf)-            , testProperty "query_match_sp"             (p_query_match_sp _triplesOf)-            , testProperty "query_match_so"             (p_query_match_so _triplesOf)-            , testProperty "query_match_po"             (p_query_match_po _triplesOf)-            , testProperty "select_match_none"          (p_select_match_none _triplesOf)-            , testProperty "select_match_s"             (p_select_match_s _triplesOf)-            , testProperty "select_match_p"             (p_select_match_p _triplesOf)-            , testProperty "select_match_o"             (p_select_match_o _triplesOf)-            , testProperty "select_match_sp"            (p_select_match_sp _triplesOf)-            , testProperty "select_match_so"            (p_select_match_so _triplesOf)-            , testProperty "select_match_po"            (p_select_match_po _triplesOf)-            , testProperty "select_match_spo"           (p_select_match_spo _triplesOf)-            , testProperty "reversed RDF handle write"  (p_reverseRdfTest _mkRdf)--            -- adding and removing triples from a graph.-            , testProperty "add_triple" (p_add_triple _mkRdf _triplesOf _addTriple)-            , testProperty "remove_triple" (p_remove_triple _mkRdf _triplesOf _removeTriple)-            , testProperty "remove_triple_from_graph" (p_remove_triple_from_graph _mkRdf _triplesOf _removeTriple)-            , testProperty "remove_triple_from_singleton_graph_query_s" (p_remove_triple_from_singleton_graph_query_s _triplesOf _removeTriple)-            , testProperty "remove_triple_from_singleton_graph_query_p" (p_remove_triple_from_singleton_graph_query_p _triplesOf _removeTriple)-            , testProperty "remove_triple_from_singleton_graph_query_o" (p_remove_triple_from_singleton_graph_query_o _triplesOf _removeTriple)-            ]--newtype SingletonGraph rdf = SingletonGraph { rdfGraph :: (RDF rdf) }--instance (Rdf rdf) => Arbitrary (SingletonGraph rdf) where-  arbitrary = do-    pref <- arbitraryPrefixMappings-    baseU' <- arbitraryBaseUrl-    baseU <- oneof [return (Just baseU'), return Nothing]-    t <- liftM3 triple arbitraryS arbitraryP arbitraryO-    return SingletonGraph { rdfGraph = (mkRdf [t] baseU pref) }--instance (Rdf rdf) => Show (SingletonGraph rdf) where-  show singletonGraph = showGraph (rdfGraph singletonGraph)--instance Arbitrary BaseUrl where-  arbitrary = arbitraryBaseUrl--instance Arbitrary PrefixMappings where-  arbitrary = arbitraryPrefixMappings--arbitraryBaseUrl :: Gen BaseUrl-arbitraryBaseUrl = oneof $ map (return . BaseUrl . T.pack) ["http://example.com/a","http://asdf.org/b","http://asdf.org/c"]--arbitraryPrefixMappings :: Gen PrefixMappings-arbitraryPrefixMappings = oneof [return $ PrefixMappings Map.empty, return $ PrefixMappings $-                          Map.fromAscList [(T.pack "eg1", T.pack "http://example.com/1"),-                                           (T.pack "eg2", T.pack "http://example.com/2"),-                                           (T.pack "eg3", T.pack "http://example.com/3")]]----- Test stubs, which just require the appropriate RDF impl function--- passed in to determine the implementation to be tested.---- empty RDF should have no triples-p_empty :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Bool-p_empty _triplesOf _empty = _triplesOf _empty == []---- triplesOf any RDF should return unique triples used to create it-p_mkRdf_triplesOf :: Rdf rdf => (RDF rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool-p_mkRdf_triplesOf _triplesOf _mkRdf ts bUrl pms =-  uordered (_triplesOf (_mkRdf ts bUrl pms)) == uordered ts---- duplicate input triples should not be returned when--- uniqTriplesof is used-p_mkRdf_no_dupes :: Rdf rdf => (RDF rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool-p_mkRdf_no_dupes _uniqtriplesOf _mkRdf ts bUrl pms =-  null ts || (sort result == uordered ts)-   where-    tsWithDupe = head ts : ts-    result = _uniqtriplesOf $ _mkRdf tsWithDupe bUrl pms---- Note: in TriplesGraph and PatriciaTreeGraph `query` expands triples---       but `ts` here is not  necessarily expanded. What is the correct---       property this test should check?------ query with all 3 wildcards should yield all triples in RDF-p_query_match_none :: Rdf rdf => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool-p_query_match_none  _mkRdf ts bUrl pms = uordered ts == uordered result-  where-    result = query (_mkRdf ts bUrl pms) Nothing Nothing Nothing---- query with no wildcard and a triple in the RDF should yield--- a singleton list with just the triple.-p_query_matched_spo :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_query_matched_spo _triplesOf rdf =-  classify (null ts) "trivial" $-    forAll (tripleFromGen _triplesOf rdf) f-  where-    ts = _triplesOf rdf-    f t = case t of-            Nothing   ->  True-            (Just t') ->  [t'] == queryT rdf t'--{- disabled:--- removing duplicates from `query` (and `select`) is deprecated, see---  https://github.com/cordawyn/rdf4h/commit/9dd4729908db8d2f80088706592adac81a0f3016------ query as in p_query_matched_spo after duplicating a triple in the--- RDF, so that we can verify that the results just have 1, even--- if the RDF itself doesn't ensure that there are no dupes internally.-p_query_matched_spo_no_dupes :: RDF rdf => (RDF rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> rdf -> Property-p_query_matched_spo_no_dupes _triplesOf _mkRdf rdf =-  classify (null ts) "trivial" $-    forAll (tripleFromGen _triplesOf rdf) f-  where-    ts = _triplesOf rdf-    f t = case t of-            Nothing   -> True-            Just t'   -> [t'] == queryT (mkRdfWithDupe _triplesOf _mkRdf rdf t') t'--}---- query with no wildcard and a triple no in the RDF should yield []-p_query_unmatched_spo :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Triple -> Property-p_query_unmatched_spo _triplesOf rdf t =-  classify (t `elem` ts) "ignored" $-    notElem t ts ==> [] == queryT rdf t-  where-    ts = _triplesOf rdf---- query with fixed subject and wildcards for pred and obj should yield--- a list with all triples having subject, and RDF minus result triples--- should yield all triple with unequal subjects.-p_query_match_s :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_query_match_s = mk_query_match_fn sameSubj f-  where f t = (Just (subjectOf t), Nothing, Nothing)---- query w/ fixed predicate and wildcards for subj and obj should yield--- a list with all triples having predicate, and RDFgraph minus result triples--- should yield all triple with unequal predicates.-p_query_match_p :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_query_match_p = mk_query_match_fn samePred f-  where f t = (Nothing, Just (predicateOf t), Nothing)---- likewise for fixed subject and predicate with object wildcard-p_query_match_o :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_query_match_o = mk_query_match_fn sameObj f-  where f t = (Nothing, Nothing, Just (objectOf t))---- verify likewise for fixed subject and predicate with wildcard object-p_query_match_sp :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_query_match_sp = mk_query_match_fn same f-  where same t1 t2 = sameSubj t1 t2 && samePred t1 t2-        f t = (Just $ subjectOf t, Just $ predicateOf t, Nothing)---- fixed subject and object with wildcard predicate-p_query_match_so :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_query_match_so = mk_query_match_fn same f-  where same t1 t2 = sameSubj t1 t2 && sameObj t1 t2-        f t = (Just $ subjectOf t, Nothing, Just $ objectOf t)---- fixed predicate and object with wildcard subject-p_query_match_po :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_query_match_po = mk_query_match_fn same f-  where same t1 t2 = samePred t1 t2 && sameObj t1 t2-        f t = (Nothing, Just $ predicateOf t, Just $ objectOf t)--mk_query_match_fn :: Rdf rdf => (Triple -> Triple -> Bool)-  -> (Triple -> (Maybe Node, Maybe Node, Maybe Node))-  -> (RDF rdf -> Triples) -> RDF rdf -> Property-mk_query_match_fn tripleCompareFn  mkPatternFn _triplesOf rdf =-  forAll (tripleFromGen _triplesOf rdf) f-  where-    f :: Maybe Triple -> Bool-    f Nothing   = True-    f (Just t)  =-      let-        all_ts = _triplesOf rdf-        all_ts_sorted = uordered all_ts-        results = uordered $ queryC rdf (mkPatternFn t)-        -- `notResults` is the difference of the two sets of triples-        notResults = ldiff all_ts_sorted results-      in-        all (tripleCompareFn t) results &&-        all (not . tripleCompareFn t) notResults--p_select_match_none :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Bool-p_select_match_none _triplesOf_not_used rdf = sort ts1 == sort ts2-    where-      ts1 = select rdf Nothing Nothing Nothing-      -- ts2 = (nub . triplesOf) rdf--      -- may have duplicates, see comments in-      --   https://github.com/cordawyn/rdf4h/commit/9dd4729908db8d2f80088706592adac81a0f3016-      ts2 = triplesOf rdf--p_select_match_s :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_select_match_s =-  p_select_match_fn same mkPattern-  where-    same = equivNode (==) subjectOf-    mkPattern t = (Just (\n -> n == subjectOf t), Nothing, Nothing)--p_select_match_p :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_select_match_p =-  p_select_match_fn same mkPattern-  where-    same = equivNode equiv predicateOf-    equiv (UNode u1) (UNode u2) = T.last u1 == T.last u2-    equiv _          _          = error "GraphTestUtils.p_select_match_p.equiv"-    mkPattern t = (Nothing, Just (\n -> lastChar n == lastChar (predicateOf t)) , Nothing)-    lastChar (UNode uri) = T.last uri-    lastChar _           = error "GraphTestUtils.p_select_match_p.lastChar"---p_select_match_o :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_select_match_o =-  p_select_match_fn same mkPattern-  where-    same = equivNode (/=) objectOf-    mkPattern t = (Nothing, Nothing, Just (\n -> n /= objectOf t))--p_select_match_sp :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_select_match_sp =-  p_select_match_fn same mkPattern-  where-    same t1 t2 = subjectOf t1 == subjectOf t2 && predicateOf t1 /= predicateOf t2-    mkPattern t = (Just (\n -> n == subjectOf t), Just (\n -> n /= predicateOf t), Nothing)--p_select_match_so :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_select_match_so =-  p_select_match_fn same mkPattern-  where-    same t1 t2 = subjectOf t1 /= subjectOf t2 && objectOf t1 == objectOf t2-    mkPattern t = (Just (\n -> n /= subjectOf t), Nothing, Just (\n -> n == objectOf t))--p_select_match_po :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_select_match_po =-  p_select_match_fn same mkPattern-  where-    same t1 t2 = predicateOf t1 == predicateOf t2 && objectOf t1 == objectOf t2-    mkPattern t = (Nothing, Just (\n -> n == predicateOf t), Just (\n -> n == objectOf t))--p_select_match_spo :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Property-p_select_match_spo =-  p_select_match_fn same mkPattern-  where-    same t1 t2 = subjectOf t1 == subjectOf t2 && predicateOf t1 == predicateOf t2 &&-                 objectOf t1 /= objectOf t2-    mkPattern t = (Just (\n -> n == subjectOf t),-                   Just (\n -> n == predicateOf t),-                   Just (\n -> n /= objectOf t))---- |adding a triple to a graph.-p_add_triple-  :: (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)-  -> (RDF rdf -> Triples) -- ^ triplesOf-  -> (RDF rdf -> Triple -> RDF rdf) -- ^ addTriple-  -> Triples-  -> Maybe BaseUrl-  -> PrefixMappings-  -> Triple -- ^ new triple to be added-  -> Bool-p_add_triple _mkRdf _triplesOf _addTriple ts bUrl pms newTriple =-  uordered (newTriple : _triplesOf oldGr)-  == uordered (_triplesOf newGr) -  where-    oldGr = _mkRdf ts bUrl pms-    newGr =  _addTriple oldGr newTriple---- |removing a triple that may or may not be in a graph. If it is not,---  this operation is silently ignored.-p_remove_triple-  :: (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)-  -> (RDF rdf -> Triples) -- ^ triplesOf-  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple-  -> Triples-  -> Maybe BaseUrl-  -> PrefixMappings-  -> Triple -- ^ triple to be removed-  -> Bool-p_remove_triple _mkRdf _triplesOf _removeTriple ts bUrl pms tripleToBeRemoved =-  uordered (filter (/= tripleToBeRemoved) oldTriples)-  == uordered newTriples-  where-    oldGr      = _mkRdf ts bUrl pms-    newGr      = _removeTriple oldGr tripleToBeRemoved-    oldTriples = _triplesOf oldGr-    newTriples = _triplesOf newGr---- |removing a triple from a graph. The new graph should not contain--- any instances of the triple.-p_remove_triple_from_graph-  :: (Rdf rdf)-  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)-  -> (RDF rdf -> Triples) -- ^ triplesOf-  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple-  -> Triples-  -> Maybe BaseUrl-  -> PrefixMappings-  -> Property-p_remove_triple_from_graph  _mkRdf _triplesOf _removeTriple ts bUrl pms =-  classify (null ts) "p_remove_triple_from_graph tests were trivial" $-  forAll (tripleFromGen _triplesOf (_mkRdf ts bUrl pms)) f-  where-    f :: Maybe Triple -> Bool-    f Nothing = True-    f (Just tripleToBeRemoved) =-      p_remove_triple _mkRdf _triplesOf _removeTriple ts bUrl pms tripleToBeRemoved---- TODO: refactor the following 3 functions.---- |removing a triple from a graph that contained only that triple.--- Performing a ((Just s) Nothing Nothing) query should return an--- empty list.-p_remove_triple_from_singleton_graph_query_s-  :: (Rdf rdf)-  => (RDF rdf -> Triples) -- ^ triplesOf-  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple-  -> SingletonGraph rdf-  -> Bool-p_remove_triple_from_singleton_graph_query_s _tripleOf _removeTriple singletonGraph =-  query newGr (Just s) Nothing Nothing == []-  where-    tripleInGraph@(Triple s _p _o) = head (_tripleOf (rdfGraph singletonGraph))-    newGr = _removeTriple (rdfGraph singletonGraph) tripleInGraph---- |removing a triple from a graph that contained only that triple.--- Performing a (Nothing (Just p) Nothing) query should return an--- empty list.-p_remove_triple_from_singleton_graph_query_p-  :: (Rdf rdf)-  => (RDF rdf -> Triples) -- ^ triplesOf-  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple-  -> SingletonGraph rdf-  -> Bool-p_remove_triple_from_singleton_graph_query_p _tripleOf _removeTriple singletonGraph =-  query newGr Nothing (Just p) Nothing == []-  where-    tripleInGraph@(Triple _s p _o) = head (_tripleOf (rdfGraph singletonGraph))-    newGr = _removeTriple (rdfGraph singletonGraph) tripleInGraph---- |removing a triple from a graph that contained only that triple.--- Performing a (Nothing Nothing (Just o)) query should return an--- empty list.-p_remove_triple_from_singleton_graph_query_o-  :: (Rdf rdf)-  => (RDF rdf -> Triples) -- ^ triplesOf-  -> (RDF rdf -> Triple -> RDF rdf) -- ^ removeTriple-  -> SingletonGraph rdf-  -> Bool-p_remove_triple_from_singleton_graph_query_o _tripleOf _removeTriple singletonGraph =-  query newGr Nothing Nothing (Just o) == []-  where-    tripleInGraph@(Triple _s _p o) = head (_tripleOf (rdfGraph singletonGraph))-    newGr = _removeTriple (rdfGraph singletonGraph) tripleInGraph--  --- p_query_match_none :: Rdf rdf => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -> Triples -> Maybe BaseUrl -> PrefixMappings -> Bool--- p_query_match_none  _mkRdf ts bUrl pms = uordered ts == uordered result-  -- where-  --   result = query (_mkRdf ts bUrl pms) Nothing Nothing Nothing---equivNode :: (Node -> Node -> Bool) -> (Triple -> Node) -> Triple -> Triple -> Bool-equivNode eqFn exFn t1 t2 = exFn t1 `eqFn` exFn t2--p_select_match_fn :: Rdf rdf => (Triple -> Triple -> Bool)-  -> (Triple -> (NodeSelector, NodeSelector, NodeSelector))-  -> (RDF rdf -> Triples) -> RDF rdf -> Property-p_select_match_fn tripleCompareFn mkPatternFn _triplesOf rdf =-  forAll (tripleFromGen _triplesOf rdf) f-  where-    f :: Maybe Triple -> Bool-    f Nothing = True-    f (Just t) =-      let-        all_ts = triplesOf rdf-        all_ts_sorted = uordered all_ts-        results = uordered $ selectC rdf (mkPatternFn t)-        notResults = ldiff all_ts_sorted results-      in-        all (tripleCompareFn t) results &&-        all (not . tripleCompareFn t) notResults---- mkRdfWithDupe :: Rdf rdf => (RDF rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -> RDF rdf -> Triple -> RDF rdf--- mkRdfWithDupe _triplesOf _mkRdf rdf t = _mkRdf ts (baseUrl rdf) (prefixMappings rdf)---   where ts = t : _triplesOf rdf----- Utility functions and test data ... ------ a curried version of query that delegates to the actual query after unpacking--- curried maybe node pattern.-queryC :: Rdf rdf => RDF rdf -> (Maybe Node, Maybe Node, Maybe Node) -> Triples-queryC rdf (s, p, o) = query rdf s p o--selectC :: Rdf rdf => RDF rdf -> (NodeSelector, NodeSelector, NodeSelector) -> Triples-selectC rdf (s, p, o) = select rdf s p o---- uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d--- uncurry3 fn (x, y, z) = fn x y z---- curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d--- curry3 fn x y z = fn (x, y, z)---- debug :: String -> Triples -> Bool--- debug msg ts =---   unsafePerformIO $---     putStrLn msg >> mapM print ts >> return True--ldiff :: Triples -> Triples -> Triples-ldiff l1 l2 = Set.toList $(Set.fromList l1) `Set.difference` Set.fromList l2--sameSubj :: Triple -> Triple -> Bool-sameSubj t1 t2 = subjectOf t1 == subjectOf t2--samePred :: Triple -> Triple -> Bool-samePred t1 t2 = predicateOf t1 == predicateOf t2--sameObj :: Triple -> Triple -> Bool-sameObj  t1 t2 = objectOf t1 == objectOf t2---- |pick a random triple from an RDF graph if the graph is not empty.-tripleFromGen :: Rdf rdf => (RDF rdf -> Triples) -> RDF rdf -> Gen (Maybe Triple)-tripleFromGen _triplesOf rdf =-  if null ts-  then return Nothing-  else oneof $ map (return . Just) ts-   where ts = _triplesOf rdf--queryT :: Rdf rdf => RDF rdf -> Triple -> Triples-queryT rdf t = query rdf (Just $ subjectOf t) (Just $ predicateOf t) (Just $ objectOf t)--languages :: [T.Text]-languages = [T.pack "fr", T.pack "en"]--datatypes :: [T.Text]-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]]--plainliterals :: [LValue]-plainliterals = [plainLL lit lang | lit <- litvalues, lang <- languages]--typedliterals :: [LValue]-typedliterals = [typedL lit dtype | lit <- litvalues, dtype <- datatypes]--litvalues :: [T.Text]-litvalues = map T.pack ["hello", "world", "peace", "earth", "", "haskell"]--unodes :: [Node]-unodes = map UNode uris--bnodes :: [ Node]-bnodes = map (BNode . \i -> T.pack ":_genid" `T.append` T.pack (show (i::Int))) [1..5]--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]--maxN :: Int-maxN = min 100 (length test_triples - 1)--instance Arbitrary Triple where-  arbitrary = liftM3 triple arbitraryS arbitraryP arbitraryO-  --coarbitrary = undefined--instance Arbitrary Node where-  arbitrary = oneof $ map return unodes-  --coarbitrary = undefined---- arbitraryTNum :: Gen Int--- arbitraryTNum = choose (0, maxN - 1)--arbitraryTs :: Gen Triples-arbitraryTs = do-  n <- sized (\_ -> choose (0, maxN))-  sequence [arbitrary | _ <- [1..n]]---- arbitraryTriple :: Gen Triple--- arbitraryTriple = elements test_triples---- arbitraryN :: Gen Int--- arbitraryN = choose (0, maxN - 1)--arbitraryS, arbitraryP, arbitraryO :: Gen Node-arbitraryS = oneof $ map return $ unodes ++ bnodes-arbitraryP = oneof $ map return unodes-arbitraryO = oneof $ map return $ unodes ++ bnodes ++ lnodes---------------------------------------------------------  Unit test cases                               ----------------------------------------------------------- Reported by Daniel Bergey:---   https://github.com/robstewart57/rdf4h/issues/4--p_reverseRdfTest :: Rdf a => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF a) -> Property-p_reverseRdfTest _mkRdf = monadicIO $ do-    fileContents <- Test.QuickCheck.Monadic.run $ do-      (pathFile,hFile) <- openTempFile "." "tmp."-      hWriteRdf NTriplesSerializer hFile rdfGraph-      hClose hFile-      contents <- readFile pathFile-      removeFile pathFile-      return contents-    let expected = "<file:///this/is/not/a/palindrome> <file:///this/is/not/a/palindrome> \"literal string\" .\n"-    assert $ expected == fileContents--  where-    rdfGraph = _mkRdf ts (Just $ BaseUrl "file://") (ns_mappings [])--    ts :: [Triple]-    ts = [Triple-           (unode "file:///this/is/not/a/palindrome")-           (unode "file:///this/is/not/a/palindrome")-           (LNode . PlainL . T.pack $ "literal string")]
+ testsuite/tests/Data/RDF/PropertyTests.hs view
@@ -0,0 +1,631 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeFamilies #-}++module Data.RDF.PropertyTests (graphTests,arbitraryTs) where++import Data.RDF+import Data.RDF.Namespace+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 GHC.Generics ()+import System.Directory (removeFile)+import System.IO++import Test.Tasty+import Test.Tasty.QuickCheck+import Test.QuickCheck.Monadic (assert, monadicIO,run)++----------------------------------------------------+--  property based quick check test cases         --+----------------------------------------------------++graphTests+  :: (Arbitrary (RDF rdf), Rdf rdf)+  => TestName+  -> RDF rdf -- ^ empty+  -> (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf) -- ^ mkRdf+  -> TestTree+graphTests testGroupName _empty _mkRdf =+  testGroup+    testGroupName+    [ 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 "reversed RDF handle write" (p_reverseRdfTest _mkRdf)+      -- adding and removing triples from a graph.+    , testProperty "add_triple" (p_add_triple _mkRdf)+    , testProperty "remove_triple" (p_remove_triple _mkRdf)+    , testProperty+        "remove_triple_from_graph"+        (p_remove_triple_from_graph _mkRdf)+    , testProperty+        "remove_triple_from_singleton_graph_query_s"+        (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)+    , testProperty+        "remove_triple_from_singleton_graph_query_o"+        (p_remove_triple_from_singleton_graph_query_o _empty)+    , testProperty+        "p_add_then_remove_triples"+        (p_add_then_remove_triples _empty)+    ]++newtype SingletonGraph rdf = SingletonGraph+  { rdfGraph :: (RDF rdf)+  }++instance (Rdf rdf) =>+         Arbitrary (SingletonGraph rdf) where+  arbitrary = do+    pref <- arbitraryPrefixMappings+    baseU' <- arbitraryBaseUrl+    baseU <- oneof [return (Just baseU'), return Nothing]+    t <- liftM3 triple arbitraryS arbitraryP arbitraryO+    return SingletonGraph {rdfGraph = (mkRdf [t] baseU pref)}++instance (Rdf rdf) =>+         Show (SingletonGraph rdf) where+  show singletonGraph = showGraph (rdfGraph singletonGraph)++instance Arbitrary BaseUrl where+  arbitrary = arbitraryBaseUrl++instance Arbitrary PrefixMappings where+  arbitrary = arbitraryPrefixMappings++arbitraryBaseUrl :: Gen BaseUrl+arbitraryBaseUrl =+  oneof $+  map+    (return . BaseUrl . T.pack)+    ["http://example.com/a", "http://asdf.org/b", "http://asdf.org/c"]++arbitraryPrefixMappings :: Gen PrefixMappings+arbitraryPrefixMappings =+  oneof+    [ return $ PrefixMappings Map.empty+    , return $+      PrefixMappings $+      Map.fromAscList+        [ (T.pack "eg1", T.pack "http://example.com/1")+        , (T.pack "eg2", T.pack "http://example.com/2")+        , (T.pack "eg3", T.pack "http://example.com/3")+        ]+    ]+++-- Test stubs, which just require the appropriate RDF impl function+-- passed in to determine the implementation to be tested.++-- empty RDF should have no triples+p_empty+  :: Rdf rdf+  => RDF rdf -> Bool+p_empty _empty = triplesOf _empty == []++-- triplesOf any RDF should return unique triples used to create it+p_mkRdf_triplesOf+  :: Rdf rdf+  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)+  -> Triples+  -> Maybe BaseUrl+  -> PrefixMappings+  -> Bool+p_mkRdf_triplesOf _mkRdf ts bUrl pms =+  uordered (triplesOf (_mkRdf ts bUrl pms)) == uordered ts++-- duplicate input triples should not be returned when+-- uniqTriplesof is used+p_mkRdf_no_dupes+  :: Rdf rdf+  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)+  -> Triples+  -> Maybe BaseUrl+  -> PrefixMappings+  -> Bool+p_mkRdf_no_dupes _mkRdf ts bUrl pms = null ts || (sort result == uordered ts)+  where+    tsWithDupe = head ts : ts+    result = uniqTriplesOf $ _mkRdf tsWithDupe bUrl pms++-- Note: in TriplesGraph and PatriciaTreeGraph `query` expands triples+--       but `ts` here is not  necessarily expanded. What is the correct+--       property this test should check?+--+-- query with all 3 wildcards should yield all triples in RDF+p_query_match_none+  :: Rdf rdf+  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)+  -> Triples+  -> Maybe BaseUrl+  -> PrefixMappings+  -> Bool+p_query_match_none _mkRdf ts bUrl pms = uordered ts == uordered result+  where+    result = query (_mkRdf ts bUrl pms) Nothing Nothing Nothing++-- query with no wildcard and a triple in the RDF should yield+-- a singleton list with just the triple.+p_query_matched_spo+  :: Rdf rdf+  => RDF rdf -> RDF rdf -> Property+p_query_matched_spo _unused rdf =+  classify (null ts) "trivial" $ forAll (tripleFromGen triplesOf rdf) f+  where+    ts = triplesOf rdf+    f t =+      case t of+        Nothing -> True+        (Just t') -> [t'] == queryT rdf t'++{- disabled:+-- removing duplicates from `query` (and `select`) is deprecated, see+--  https://github.com/cordawyn/rdf4h/commit/9dd4729908db8d2f80088706592adac81a0f3016+--+-- query as in p_query_matched_spo after duplicating a triple in the+-- RDF, so that we can verify that the results just have 1, even+-- if the RDF itself doesn't ensure that there are no dupes internally.+p_query_matched_spo_no_dupes :: RDF rdf => (RDF rdf -> Triples) -> (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) -> rdf -> Property+p_query_matched_spo_no_dupes _triplesOf _mkRdf rdf =+  classify (null ts) "trivial" $+    forAll (tripleFromGen _triplesOf rdf) f+  where+    ts = _triplesOf rdf+    f t = case t of+            Nothing   -> True+            Just t'   -> [t'] == queryT (mkRdfWithDupe _triplesOf _mkRdf rdf t') t'+-}++-- query with no wildcard and a triple no in the RDF should yield []+p_query_unmatched_spo+  :: Rdf rdf+  => RDF rdf -> Triple -> Property+p_query_unmatched_spo rdf t =+  classify (t `elem` ts) "ignored" $ notElem t ts ==> [] == queryT rdf t+  where+    ts = triplesOf rdf++-- query with fixed subject and wildcards for pred and obj should yield+-- a list with all triples having subject, and RDF minus result triples+-- should yield all triple with unequal subjects.+p_query_match_s+  :: Rdf rdf+  => RDF rdf -> RDF rdf -> Property+p_query_match_s _unused = mk_query_match_fn sameSubj f+  where+    f t = (Just (subjectOf t), Nothing, Nothing)++-- query w/ fixed predicate and wildcards for subj and obj should yield+-- a list with all triples having predicate, and RDFgraph minus result triples+-- should yield all triple with unequal predicates.+p_query_match_p+  :: Rdf rdf+  => RDF rdf -> RDF rdf -> Property+p_query_match_p _unused = mk_query_match_fn samePred f+  where+    f t = (Nothing, Just (predicateOf t), Nothing)++-- likewise for fixed subject and predicate with object wildcard+p_query_match_o+  :: Rdf rdf+  => RDF rdf -> RDF rdf -> Property+p_query_match_o _unused = mk_query_match_fn sameObj f+  where+    f t = (Nothing, Nothing, Just (objectOf t))++-- verify likewise for fixed subject and predicate with wildcard object+p_query_match_sp+  :: Rdf rdf+  => RDF rdf -> RDF rdf -> Property+p_query_match_sp _unsed = mk_query_match_fn same f+  where+    same t1 t2 = sameSubj t1 t2 && samePred t1 t2+    f t = (Just $ subjectOf t, Just $ predicateOf t, Nothing)++-- fixed subject and object with wildcard predicate+p_query_match_so+  :: Rdf rdf+  => RDF rdf -> RDF rdf -> Property+p_query_match_so _unused = mk_query_match_fn same f+  where+    same t1 t2 = sameSubj t1 t2 && sameObj t1 t2+    f t = (Just $ subjectOf t, Nothing, Just $ objectOf t)++-- fixed predicate and object with wildcard subject+p_query_match_po+  :: Rdf rdf+  => RDF rdf -> RDF rdf -> Property+p_query_match_po _unused = mk_query_match_fn same f+  where+    same t1 t2 = samePred t1 t2 && sameObj t1 t2+    f t = (Nothing, Just $ predicateOf t, Just $ objectOf t)++mk_query_match_fn+  :: Rdf rdf+  => (Triple -> Triple -> Bool)+  -> (Triple -> (Maybe Node, Maybe Node, Maybe Node))+  -> RDF rdf+  -> Property+mk_query_match_fn tripleCompareFn mkPatternFn rdf =+  forAll (tripleFromGen triplesOf rdf) f+  where+    f :: Maybe Triple -> Bool+    f Nothing = True+    f (Just t) =+      let all_ts = triplesOf rdf+          all_ts_sorted = uordered all_ts+          results = uordered $ queryC rdf (mkPatternFn t)+          -- `notResults` is the difference of the two sets of triples+          notResults = ldiff all_ts_sorted results+      in all (tripleCompareFn t) results &&+         all (not . tripleCompareFn t) notResults++p_select_match_none+  :: Rdf rdf+  => RDF rdf -> Bool+p_select_match_none rdf = sort ts1 == sort ts2+  where+    ts1 = select rdf Nothing Nothing Nothing+    -- ts2 = (nub . triplesOf) rdf+    -- may have duplicates, see comments in+    --   https://github.com/cordawyn/rdf4h/commit/9dd4729908db8d2f80088706592adac81a0f3016+    ts2 = triplesOf rdf++p_select_match_s+  :: Rdf rdf+  => RDF rdf -> Property+p_select_match_s = p_select_match_fn same mkPattern triplesOf+  where+    same = equivNode (==) subjectOf+    mkPattern t = (Just (\n -> n == subjectOf t), Nothing, Nothing)++p_select_match_p+  :: Rdf rdf+  => RDF rdf -> Property+p_select_match_p = p_select_match_fn same mkPattern triplesOf+  where+    same = equivNode equiv predicateOf+    equiv (UNode u1) (UNode u2) = T.last u1 == T.last u2+    equiv _ _ = error "GraphTestUtils.p_select_match_p.equiv"+    mkPattern t =+      (Nothing, Just (\n -> lastChar n == lastChar (predicateOf t)), Nothing)+    lastChar (UNode uri) = T.last uri+    lastChar _ = error "GraphTestUtils.p_select_match_p.lastChar"+++p_select_match_o :: Rdf rdf => RDF rdf -> Property+p_select_match_o =+  p_select_match_fn same mkPattern triplesOf+  where+    same = equivNode (/=) objectOf+    mkPattern t = (Nothing, Nothing, Just (\n -> n /= objectOf t))++p_select_match_sp :: Rdf rdf => RDF rdf -> Property+p_select_match_sp =+  p_select_match_fn same mkPattern triplesOf+  where+    same t1 t2 = subjectOf t1 == subjectOf t2 && predicateOf t1 /= predicateOf t2+    mkPattern t = (Just (\n -> n == subjectOf t), Just (\n -> n /= predicateOf t), Nothing)++p_select_match_so+  :: Rdf rdf+  => RDF rdf -> Property+p_select_match_so = p_select_match_fn same mkPattern triplesOf+  where+    same t1 t2 = subjectOf t1 /= subjectOf t2 && objectOf t1 == objectOf t2+    mkPattern t =+      (Just (\n -> n /= subjectOf t), Nothing, Just (\n -> n == objectOf t))++p_select_match_po+  :: Rdf rdf+  => RDF rdf -> RDF rdf -> Property+p_select_match_po _unsed = p_select_match_fn same mkPattern triplesOf+  where+    same t1 t2 = predicateOf t1 == predicateOf t2 && objectOf t1 == objectOf t2+    mkPattern t =+      (Nothing, Just (\n -> n == predicateOf t), Just (\n -> n == objectOf t))++p_select_match_spo+  :: (Rdf rdf)+  => RDF rdf -> RDF rdf -> Property+p_select_match_spo _unused = p_select_match_fn same mkPattern triplesOf+  where+    same t1 t2 =+      subjectOf t1 == subjectOf t2 &&+      predicateOf t1 == predicateOf t2 && objectOf t1 /= objectOf t2+    mkPattern t =+      ( Just (\n -> n == subjectOf t)+      , Just (\n -> n == predicateOf t)+      , Just (\n -> n /= objectOf t))++-- |adding a triple to a graph.+p_add_triple+  :: (Rdf rdf)+  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)+  -> Triples+  -> Maybe BaseUrl+  -> PrefixMappings+  -> Triple -- ^ new triple to be added+  -> Bool+p_add_triple _mkRdf ts bUrl pms newTriple =+  uordered (newTriple : triplesOf oldGr) == uordered (triplesOf newGr)+  where+    oldGr = _mkRdf ts bUrl pms+    newGr = addTriple oldGr newTriple++-- |removing a triple that may or may not be in a graph. If it is not,+--  this operation is silently ignored.+p_remove_triple+  :: (Rdf rdf)+  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)+  -> Triples+  -> Maybe BaseUrl+  -> PrefixMappings+  -> Triple -- ^ triple to be removed+  -> Bool+p_remove_triple _mkRdf ts bUrl pms tripleToBeRemoved =+  uordered (filter (/= tripleToBeRemoved) oldTriples) == uordered newTriples+  where+    oldGr = _mkRdf ts bUrl pms+    newGr = removeTriple oldGr tripleToBeRemoved+    oldTriples = triplesOf oldGr+    newTriples = triplesOf newGr++-- |removing a triple from a graph. The new graph should not contain+-- any instances of the triple.+p_remove_triple_from_graph+  :: (Rdf rdf)+  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF rdf)+  -> Triples+  -> Maybe BaseUrl+  -> PrefixMappings+  -> Property+p_remove_triple_from_graph _mkRdf ts bUrl pms =+  classify (null ts) "p_remove_triple_from_graph tests were trivial" $+  forAll (tripleFromGen triplesOf (_mkRdf ts bUrl pms)) f+  where+    f :: Maybe Triple -> Bool+    f Nothing = True+    f (Just tripleToBeRemoved) =+      p_remove_triple _mkRdf ts bUrl pms tripleToBeRemoved++-- TODO: refactor the following 3 functions.++-- |removing a triple from a graph that contained only that triple.+-- Performing a ((Just s) Nothing Nothing) query should return an+-- empty list.+p_remove_triple_from_singleton_graph_query_s+  :: (Rdf rdf)+  => RDF rdf -> SingletonGraph rdf -> Bool+p_remove_triple_from_singleton_graph_query_s _unused singletonGraph =+  query newGr (Just s) Nothing Nothing == []+  where+    tripleInGraph@(Triple s _p _o) = head (triplesOf (rdfGraph singletonGraph))+    newGr = removeTriple (rdfGraph singletonGraph) tripleInGraph++-- |removing a triple from a graph that contained only that triple.+-- Performing a (Nothing (Just p) Nothing) query should return an+-- empty list.+p_remove_triple_from_singleton_graph_query_p+  :: (Rdf rdf)+  => RDF rdf -> SingletonGraph rdf -> Bool+p_remove_triple_from_singleton_graph_query_p _unused singletonGraph =+  query newGr Nothing (Just p) Nothing == []+  where+    tripleInGraph@(Triple _s p _o) = head (triplesOf (rdfGraph singletonGraph))+    newGr = removeTriple (rdfGraph singletonGraph) tripleInGraph++-- |removing a triple from a graph that contained only that triple.+-- Performing a (Nothing Nothing (Just o)) query should return an+-- empty list.+p_remove_triple_from_singleton_graph_query_o+  :: (Rdf rdf)+  => RDF rdf -> SingletonGraph rdf -> Bool+p_remove_triple_from_singleton_graph_query_o _unused singletonGraph =+  query newGr Nothing Nothing (Just o) == []+  where+    tripleInGraph@(Triple _s _p o) = head (triplesOf (rdfGraph singletonGraph))+    newGr = removeTriple (rdfGraph singletonGraph) tripleInGraph++p_add_then_remove_triples+  :: (Rdf rdf)+  => RDF rdf -- ^ empty+  -> Triples -- ^ triples to add then remove+  -> Bool+p_add_then_remove_triples _empty genTriples =+  let emptyGraph = _empty+      populatedGraph =+        foldr (\triple gr -> addTriple gr triple) emptyGraph genTriples+      emptiedGraph =+        foldr (\triple gr -> removeTriple gr triple) populatedGraph genTriples+  in triplesOf emptiedGraph == []++equivNode :: (Node -> Node -> Bool)+          -> (Triple -> Node)+          -> Triple+          -> Triple+          -> Bool+equivNode eqFn exFn t1 t2 = exFn t1 `eqFn` exFn t2++p_select_match_fn+  :: Rdf rdf+  => (Triple -> Triple -> Bool)+  -> (Triple -> (NodeSelector, NodeSelector, NodeSelector))+  -> (RDF rdf -> Triples)+  -> RDF rdf+  -> Property+p_select_match_fn tripleCompareFn mkPatternFn _triplesOf rdf =+  forAll (tripleFromGen _triplesOf rdf) f+  where+    f :: Maybe Triple -> Bool+    f Nothing = True+    f (Just t) =+      let all_ts = triplesOf rdf+          all_ts_sorted = uordered all_ts+          results = uordered $ selectC rdf (mkPatternFn t)+          notResults = ldiff all_ts_sorted results+      in all (tripleCompareFn t) results &&+         all (not . tripleCompareFn t) notResults++-- Utility functions and test data ... --++-- a curried version of query that delegates to the actual query after unpacking+-- curried maybe node pattern.+queryC+  :: Rdf rdf+  => RDF rdf -> (Maybe Node, Maybe Node, Maybe Node) -> Triples+queryC rdf (s, p, o) = query rdf s p o++selectC+  :: Rdf rdf+  => RDF rdf -> (NodeSelector, NodeSelector, NodeSelector) -> Triples+selectC rdf (s, p, o) = select rdf s p o++ldiff :: Triples -> Triples -> Triples+ldiff l1 l2 = Set.toList $(Set.fromList l1) `Set.difference` Set.fromList l2++sameSubj :: Triple -> Triple -> Bool+sameSubj t1 t2 = subjectOf t1 == subjectOf t2++samePred :: Triple -> Triple -> Bool+samePred t1 t2 = predicateOf t1 == predicateOf t2++sameObj :: Triple -> Triple -> Bool+sameObj  t1 t2 = objectOf t1 == objectOf t2++-- |pick a random triple from an RDF graph if the graph is not empty.+tripleFromGen+  :: (RDF rdf -> Triples) -> RDF rdf -> Gen (Maybe Triple)+tripleFromGen _triplesOf rdf =+  if null ts+    then return Nothing+    else oneof $ map (return . Just) ts+  where+    ts = _triplesOf rdf++queryT+  :: Rdf rdf+  => RDF rdf -> Triple -> Triples+queryT rdf t =+  query rdf (Just $ subjectOf t) (Just $ predicateOf t) (Just $ objectOf t)++languages :: [T.Text]+languages = [T.pack "fr", T.pack "en"]++datatypes :: [T.Text]+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]]++plainliterals :: [LValue]+plainliterals = [plainLL lit lang | lit <- litvalues, lang <- languages]++typedliterals :: [LValue]+typedliterals = [typedL lit dtype | lit <- litvalues, dtype <- datatypes]++litvalues :: [T.Text]+litvalues = map T.pack ["hello", "world", "peace", "earth", "", "haskell"]++unodes :: [Node]+unodes = map UNode uris++bnodes :: [ Node]+bnodes = map (BNode . \i -> T.pack ":_genid" `T.append` T.pack (show (i::Int))) [1..5]++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+  ]++maxN :: Int+maxN = min 100 (length test_triples - 1)++instance Arbitrary Triple where+  arbitrary = liftM3 triple arbitraryS arbitraryP arbitraryO++instance Arbitrary Node where+  arbitrary = oneof $ map return unodes++arbitraryTs :: Gen Triples+arbitraryTs = do+  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+arbitraryO = oneof $ map return $ unodes ++ bnodes ++ lnodes++----------------------------------------------------+--  Unit test cases                               --+----------------------------------------------------++-- Reported by Daniel Bergey:+--   https://github.com/robstewart57/rdf4h/issues/4++p_reverseRdfTest+  :: Rdf a+  => (Triples -> Maybe BaseUrl -> PrefixMappings -> RDF a) -> Property+p_reverseRdfTest _mkRdf =+  monadicIO $ do+    fileContents <-+      Test.QuickCheck.Monadic.run $ do+        (pathFile, hFile) <- openTempFile "." "tmp."+        hWriteRdf NTriplesSerializer hFile rdfGraph+        hClose hFile+        contents <- readFile pathFile+        removeFile pathFile+        return contents+    let expected =+          "<file:///this/is/not/a/palindrome> <file:///this/is/not/a/palindrome> \"literal string\" .\n"+    assert $ expected == fileContents+  where+    rdfGraph = _mkRdf ts (Just $ BaseUrl "file://") (ns_mappings [])+    ts :: [Triple]+    ts =+      [ Triple+          (unode "file:///this/is/not/a/palindrome")+          (unode "file:///this/is/not/a/palindrome")+          (LNode . PlainL . T.pack $ "literal string")+      ]
testsuite/tests/Test.hs view
@@ -1,24 +1,20 @@-module Main where--import Test.Tasty (defaultMain,testGroup)+{-# LANGUAGE FlexibleInstances #-} -import qualified Data.RDF.Graph.TList_Test as TList-import qualified Data.RDF.Graph.AdjHashMap_Test as AdjHashMap--- import qualified Data.RDF.Graph.HashSP_Test as HashSP--- import qualified Data.RDF.Graph.SP_Test as SP--- very slow implementation, disabled for now.--- import qualified Data.RDF.Graph.TriplesPatriciaTree_Test as TriplesPatriciaTree-import           Data.RDF.Types-import qualified Text.RDF.RDF4H.XmlParser_Test as XmlParser-import qualified Text.RDF.RDF4H.TurtleParser_ConformanceTest as TurtleParser-import qualified W3C.TurtleTest as W3CTurtleTest-import qualified W3C.RdfXmlTest as W3CRdfXmlTest-import qualified W3C.NTripleTest as W3CNTripleTest-import           Data.RDF.GraphTestUtils+module Main where +import Control.Monad+import qualified Data.Map as Map+import Data.RDF+import           Data.RDF.PropertyTests import qualified Data.Text as T import System.Directory (getCurrentDirectory)+import Test.QuickCheck.Arbitrary+import Test.Tasty (defaultMain,testGroup) import W3C.Manifest+import qualified W3C.NTripleTest as W3CNTripleTest+import qualified W3C.RdfXmlTest as W3CRdfXmlTest+import qualified W3C.TurtleTest as W3CTurtleTest+import qualified Text.RDF.RDF4H.TurtleParser_ConformanceTest as TurtleUnitTest  suiteFilesDirTurtle,suiteFilesDirXml,suiteFilesDirNTriples :: T.Text suiteFilesDirTurtle = "rdf-tests/turtle/"@@ -35,66 +31,78 @@ 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 = do-  -- obtain manifest files for W3C tests before running tests-  -- justification for separation: http://stackoverflow.com/a/33046723+main+-- obtain manifest files for W3C tests before running tests+-- justification for separation: http://stackoverflow.com/a/33046723+ = do   dir <- getCurrentDirectory-  let fileSchemeUri suitesDir = T.pack ("file://" ++ dir ++ "/" ++ T.unpack suitesDir)+  let fileSchemeUri suitesDir =+        T.pack ("file://" ++ dir ++ "/" ++ T.unpack suitesDir)   turtleManifest <--         loadManifest mfPathTurtle   (fileSchemeUri suiteFilesDirTurtle)--  xmlManifest <--         loadManifest mfPathXml      (fileSchemeUri suiteFilesDirXml)-+    loadManifest mfPathTurtle (fileSchemeUri suiteFilesDirTurtle)+  xmlManifest <- loadManifest mfPathXml (fileSchemeUri suiteFilesDirXml)   nTriplesManifest <--         loadManifest mfPathNTriples (fileSchemeUri suiteFilesDirNTriples)-+    loadManifest mfPathNTriples (fileSchemeUri suiteFilesDirNTriples)   -- run tests   defaultMain-       (testGroup "rdf4h tests"-        [ -- RDF graph API tests-          graphTests "TList"-          TList.triplesOf'-          TList.uniqTriplesOf'-          TList.empty'-          TList.mkRdf'-          TList.addTriple'-          TList.removeTriple'--        , graphTests "AdjHashMap"-          AdjHashMap.triplesOf'-          AdjHashMap.uniqTriplesOf'-          AdjHashMap.empty'-          AdjHashMap.mkRdf'-          AdjHashMap.addTriple'-          AdjHashMap.removeTriple'--        -- , graphTests "HashSP"-        --   HashSP.triplesOf'-        --   HashSP.uniqTriplesOf'-        --   HashSP.empty'-        --   HashSP.mkRdf'--        -- , graphTests "SP"-        --   SP.triplesOf'-        --   SP.uniqTriplesOf'-        --   SP.empty'-        --   SP.mkRdf'--        -- , graphTests "TriplesPatriciaTree"-        --   TriplesPatriciaTree.triplesOf'-        --   TriplesPatriciaTree.uniqTriplesOf'-        --   TriplesPatriciaTree.empty'-        --   TriplesPatriciaTree.mkRdf'--          -- rdf4h unit tests-        , TurtleParser.tests-        , XmlParser.tests--          -- W3C tests-        , W3CTurtleTest.tests   turtleManifest-        , W3CRdfXmlTest.tests   xmlManifest-        , W3CNTripleTest.tests  nTriplesManifest-        ])+    (testGroup+       "rdf4h tests"+       -- RDF graph API tests+       [ testGroup+         "property-tests"+         [(graphTests+           "TList"+           (empty :: RDF TList)+           (mkRdf :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF TList))+         ,+         (graphTests+           "AdjHashMap"+           (empty :: RDF AdjHashMap)+           (mkRdf :: Triples -> Maybe BaseUrl -> PrefixMappings -> RDF AdjHashMap))]+       ,+       testGroup "parser-unit-tests-turtle"+       TurtleUnitTest.allCTests+       ,+       testGroup+       "parser-w3c-tests-ntriples"+       [ testGroup+         "parser-w3c-tests-ntriples-parsec"+         [W3CNTripleTest.testsParsec nTriplesManifest]+       , testGroup+         "parser-w3c-tests-ntriples-attoparsec"+         [W3CNTripleTest.testsAttoparsec nTriplesManifest]+       ]+       ,+       testGroup+       "parser-w3c-tests-turtle"+       [ testGroup+         "parser-w3c-tests-turtle-parsec"+         [W3CTurtleTest.testsParsec turtleManifest]+       , testGroup+         "parser-w3c-tests-turtle-attoparsec"+         [W3CTurtleTest.testsAttoparsec turtleManifest]+       ]+       ,+       testGroup+       "parser-w3c-tests-xml"+       [ W3CRdfXmlTest.tests xmlManifest+       ]+       ]+    )
testsuite/tests/Text/RDF/RDF4H/TurtleParser_ConformanceTest.hs view
@@ -27,6 +27,9 @@                   ("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")                  ] @@ -51,27 +54,27 @@ checkGoodConformanceTest i =   let expGr = loadExpectedGraph "test" i       inGr  = loadInputGraph    "test" i-  in doGoodConformanceTest expGr inGr (printf "test %d" i :: String)+  in doGoodConformanceTest expGr inGr (printf "test-%d" i :: String)  checkGoodOtherTest :: String -> String -> TestTree checkGoodOtherTest dir fname =     let expGr = loadExpectedGraph1 (printf "%s/%s.out" dir fname :: String)         inGr  = loadInputGraph1 dir fname-    in doGoodConformanceTest expGr inGr $ printf "test using file \"%s\"" fname+    in doGoodConformanceTest expGr inGr $ printf "turtle-%s" fname -doGoodConformanceTest   :: IO (Either ParseFailure (RDF TList)) -> -                           IO (Either ParseFailure (RDF TList)) -> +doGoodConformanceTest   :: IO (Either ParseFailure (RDF TList)) ->+                           IO (Either ParseFailure (RDF TList)) ->                            String -> TestTree doGoodConformanceTest expGr inGr testname =     let t1 = assertLoadSuccess (printf "expected (%s): " testname) expGr         t2 = assertLoadSuccess (printf "   input (%s): " testname) inGr         t3 = assertEquivalent testname expGr inGr-    in testGroup (printf "Conformance %s" testname) $ map (uncurry testCase) [("Loading expected graph data", t1), ("Loading input graph data", t2), ("Comparing graphs", t3)]+    in testGroup (printf "conformance-%s" testname) $ map (uncurry testCase) [("loading-expected-graph-data", t1), ("loading-input-graph-data", t2), ("comparing-graphs", t3)]  checkBadConformanceTest :: Int -> TestTree checkBadConformanceTest i =   let t = assertLoadFailure (show i) (loadInputGraph "bad" i)-  in testCase (printf "Loading test %d (negative)" i) t+  in testCase (printf "loading-test-%d-negative" i) t  -- Determines if graphs are equivalent, returning Nothing if so or else a diagnostic message. -- First graph is expected graph, second graph is actual.@@ -96,7 +99,23 @@         (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)+    -- 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+    -- node is parsed as a blank node. Moreover, a parser is free to+    -- generate the blank node how ever they wish. E.g. parsing [] could be:+    --+    -- _:genid1+    --+    -- or+    --+    -- _:Bb71dd4e4b81c097db8d7f79078bbc7c0+    --+    -- which just so happens to be what Apache Jena just created when+    -- [] was parsed.+    equalNodes (BNode _) (BNodeGen _) = True+    equalNodes (BNodeGen _) (BNode _) = True     equalNodes n1          n2           = n1 == n2  -- Returns a graph for a good ttl test that is intended to pass, and normalizes
testsuite/tests/W3C/NTripleTest.hs view
@@ -10,26 +10,34 @@  import Data.RDF.Types import Text.RDF.RDF4H.NTriplesParser+import Text.RDF.RDF4H.ParserUtils import Data.RDF.Graph.TList -tests :: Manifest -> TestTree-tests = runManifestTests mfEntryToTest+testsParsec :: Manifest -> TestTree+testsParsec = runManifestTests (mfEntryToTest testParserParsec) +testsAttoparsec :: Manifest -> TestTree+testsAttoparsec = runManifestTests (mfEntryToTest testParserAttoparsec)+ -- Functions to map manifest test entries to unit tests. -- They are defined here to avoid cluttering W3C.Manifest -- with functions that may not be needed to those who -- just want to parse Manifest files. -- TODO: They should probably be moved to W3C.Manifest after all.-mfEntryToTest :: TestEntry -> TestTree-mfEntryToTest (TestNTriplesPositiveSyntax nm _ _ act') =+mfEntryToTest :: NTriplesParserCustom -> TestEntry -> TestTree+mfEntryToTest testParser (TestNTriplesPositiveSyntax nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'       rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList))   in TU.testCase (T.unpack nm) $ assertIsParsed rdf-mfEntryToTest (TestNTriplesNegativeSyntax nm _ _ act') =+mfEntryToTest testParser (TestNTriplesNegativeSyntax nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'       rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList))   in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf-mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x+mfEntryToTest _ x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x -testParser :: NTriplesParser-testParser = NTriplesParser+testParserParsec :: NTriplesParserCustom+testParserParsec = NTriplesParserCustom Parsec++testParserAttoparsec :: NTriplesParserCustom+testParserAttoparsec = NTriplesParserCustom Attoparsec+
testsuite/tests/W3C/TurtleTest.hs view
@@ -13,34 +13,44 @@ import Data.RDF.Query import Text.RDF.RDF4H.TurtleParser import Text.RDF.RDF4H.NTriplesParser+import Text.RDF.RDF4H.ParserUtils import Data.RDF.Graph.TList -tests :: Manifest -> TestTree-tests = runManifestTests mfEntryToTest+testsParsec :: Manifest -> TestTree+testsParsec = runManifestTests (mfEntryToTest testParserParsec) -mfEntryToTest :: TestEntry -> TestTree-mfEntryToTest (TestTurtleEval nm _ _ act' res') =+testsAttoparsec :: Manifest -> TestTree+testsAttoparsec = runManifestTests (mfEntryToTest testParserAttoparsec)++mfEntryToTest :: TurtleParserCustom -> TestEntry -> TestTree+mfEntryToTest parser (TestTurtleEval nm _ _ act' res') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'       res = (UNode . fromJust . fileSchemeToFilePath) res'-      parsedRDF   = parseFile testParser (nodeURI act) >>= return . fromEither :: IO (RDF TList)+      parsedRDF   = parseFile parser (nodeURI act) >>= return . fromEither :: IO (RDF TList)       expectedRDF = parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO (RDF TList)   in TU.testCase (T.unpack nm) $ assertIsIsomorphic parsedRDF expectedRDF-mfEntryToTest (TestTurtleNegativeEval nm _ _ act') =+mfEntryToTest parser (TestTurtleNegativeEval nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-      rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList))+      rdf = parseFile parser (nodeURI act) :: IO (Either ParseFailure (RDF TList))   in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf-mfEntryToTest (TestTurtlePositiveSyntax nm _ _ act') =+mfEntryToTest parser (TestTurtlePositiveSyntax nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-      rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList))+      rdf = parseFile parser (nodeURI act) :: IO (Either ParseFailure (RDF TList))   in TU.testCase (T.unpack nm) $ assertIsParsed rdf-mfEntryToTest (TestTurtleNegativeSyntax nm _ _ act') =+mfEntryToTest parser (TestTurtleNegativeSyntax nm _ _ act') =   let act = (UNode . fromJust . fileSchemeToFilePath) act'-      rdf = parseFile testParser (nodeURI act) :: IO (Either ParseFailure (RDF TList))+      rdf = parseFile parser (nodeURI act) :: IO (Either ParseFailure (RDF TList))   in TU.testCase (T.unpack nm) $ assertIsNotParsed rdf-mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x+mfEntryToTest _ x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x  mfBaseURITurtle :: BaseUrl mfBaseURITurtle   = BaseUrl "http://www.w3.org/2013/TurtleTests/" -testParser :: TurtleParser-testParser = TurtleParser (Just mfBaseURITurtle) Nothing+-- testParser :: TurtleParser+-- testParser = TurtleParser (Just mfBaseURITurtle) Nothing++testParserParsec :: TurtleParserCustom+testParserParsec = TurtleParserCustom (Just mfBaseURITurtle) Nothing Parsec++testParserAttoparsec :: TurtleParserCustom+testParserAttoparsec = TurtleParserCustom (Just mfBaseURITurtle) Nothing Attoparsec