packages feed

rdf4h 1.3.3 → 1.3.4

raw patch · 15 files changed

+185/−81 lines, 15 filesdep +safePVP ok

version bump matches the API change (PVP)

Dependencies added: safe

API changes (from Hackage documentation)

+ Data.RDF.Types: fileSchemeToFilePath :: Node -> Maybe Text
+ Data.RDF.Types: unodeValidate :: Text -> Maybe Node
+ Text.RDF.RDF4H.XmlParser: instance GHC.Exception.Exception Text.RDF.RDF4H.XmlParser.ParserException
+ Text.RDF.RDF4H.XmlParser: instance GHC.Show.Show Text.RDF.RDF4H.XmlParser.ParserException

Files

LICENSE.txt view
@@ -1,28 +1,32 @@ Copyright 2007-2012 Calvin Smith.-Copyright 2012-2014 Rob Stewart <robstewart57@gmail.com>+Copyright 2012-2015 Rob Stewart <robstewart57@gmail.com>.  All rights reserved.  Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:-1. Redistributions of source code must retain the above copyright-   notice, this list of conditions and the following disclaimer.-2. Redistributions in binary form must reproduce the above copyright-   notice, this list of conditions and the following disclaimer in the-   documentation and/or other materials provided with the distribution.-3. Neither the name of the author nor the names of his contributors-   may be used to endorse or promote products derived from this software-   without specific prior written permission.+modification, are permitted provided that the following conditions are+met: -THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF-SUCH DAMAGE.+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alan Zimmerman nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
bench/MainCriterion.hs view
@@ -5,7 +5,7 @@ import Criterion import Criterion.Main import Data.RDF-import qualified Data.Text.Lazy as T+import qualified Data.Text as T  -- The `bills.102.rdf` XML file is needed to run this benchmark suite --
rdf4h.cabal view
@@ -1,5 +1,5 @@ name:            rdf4h-version:         1.3.3+version:         1.3.4 synopsis:        A library for RDF processing in Haskell description:   'RDF for Haskell' is a library for working with RDF in Haskell.@@ -109,6 +109,8 @@                , containers                , text >= 1.2.1.0                , knob+               , directory+               , safe    if impl(ghc < 7.6)     build-depends: ghc-prim
src/Data/RDF/Namespace.hs view
@@ -14,7 +14,7 @@   standard_ns_mappings, ns_mappings ) where -import qualified Data.Text.Lazy as T+import qualified Data.Text as T import Data.RDF.Types import qualified Data.Map as Map 
src/Data/RDF/Query.hs view
@@ -20,7 +20,7 @@ import Data.List import Data.RDF.Types import qualified Data.RDF.Namespace as NS (toPMList, uriOf, rdf)-import qualified Data.Text.Lazy as T+import qualified Data.Text as T import Data.Maybe (catMaybes)  
src/Data/RDF/Types.hs view
@@ -9,13 +9,13 @@    -- * Constructor functions   plainL,plainLL,typedL,-  unode,bnode,lnode,triple,+  unode,bnode,lnode,triple,unodeValidate,    -- * Node query function   isUNode,isLNode,isBNode,    -- * Miscellaneous-  resolveQName, absolutizeUrl, isAbsoluteUri, mkAbsoluteUrl,+  resolveQName, absolutizeUrl, isAbsoluteUri, mkAbsoluteUrl,fileSchemeToFilePath,    -- * RDF Type   RDF(baseUrl,prefixMappings,addPrefixMappings,empty,mkRdf,triplesOf,uniqTriplesOf,select,query),@@ -36,7 +36,7 @@ ) where  import Prelude hiding (pred)-import qualified Data.Text.Lazy as T+import qualified Data.Text as T import System.IO import Text.Printf import Data.Binary@@ -45,10 +45,9 @@ import Data.Hashable(Hashable) import qualified Data.List as List import qualified Data.Map as Map-import qualified Network.URI as Network (isURI)+import qualified Network.URI as Network (isURI,uriPath,parseURI) import Control.DeepSeq (NFData,rnf)-import GHC.Generics ()-+import Text.Parsec  ------------------- -- LValue and constructor functions@@ -138,11 +137,76 @@ -- |An alias for 'Node', defined for convenience and readability purposes. type Object = Node --- |Return a URIRef node for the given bytetring URI.+-- |Return a URIRef node for the given URI. {-# INLINE unode #-} unode :: T.Text -> Node unode = UNode +-- For background on 'unodeValidate', see:+-- http://stackoverflow.com/questions/33250184/unescaping-unicode-literals-found-in-haskell-strings++-- |Validate a URI and return it in a @Just UNode@ if it is+--  valid, otherwise @Nothing@ is returned. Performs the following:+--  +--  1. unescape unicode RDF literals+--  2. checks validity of this unescaped URI using 'isURI' from 'Network.URI'+--  3. if the unescaped URI is valid then 'Node' constructed with 'UNode'+unodeValidate :: T.Text -> Maybe Node+unodeValidate t = if Network.isURI uri+                  then Just (UNode (T.pack uri))+                  else Nothing+    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 <- digit+                            ; pos2 <- digit+                            ; pos3 <- digit+                            ; pos4 <- digit+                            ; pos5 <- digit+                            ; pos6 <- digit+                            ; pos7 <- digit+                            ; pos8 <- digit+                            ; let str = ['\\','x',pos1,pos2,pos3,pos4,pos5,pos6,pos7,pos8]+                            ; return (read ("\"" ++ str ++ "\"") :: String)})+                   <|>+                    try (do { _ <- char '\\'+                            ; _ <- char 'U'+                            ; pos1 <- digit+                            ; pos2 <- digit+                            ; pos3 <- digit+                            ; pos4 <- digit+                            ; pos5 <- digit+                            ; pos6 <- digit+                            ; pos7 <- digit+                            ; pos8 <- digit+                            ; let str = ['\\','x',pos1,pos2,pos3,pos4,pos5,pos6,pos7,pos8]+                            ; return (read ("\"" ++ str ++ "\"") :: String)})+                   <|>+                    try (do { _ <- char '\\'+                            ; _ <- char 'u'+                            ; pos1 <- digit+                            ; pos2 <- digit+                            ; pos3 <- digit+                            ; pos4 <- digit+                            ; let str = ['\\','x',pos1,pos2,pos3,pos4]+                            ; return (read ("\"" ++ str ++ "\"") :: String)})+                   <|>+                    try (do { _ <- char '\\'+                            ; _ <- char 'U'+                            ; pos1 <- digit+                            ; pos2 <- digit+                            ; pos3 <- digit+                            ; pos4 <- digit+                            ; let str = ['\\','x',pos1,pos2,pos3,pos4]+                            ; return (read ("\"" ++ str ++ "\"") :: String)})+                   <|>+                    (anyChar >>= \c -> return [c]))+        return (concat ss :: String)+         -- |Return a blank node using the given string identifier. {-# INLINE bnode #-} bnode :: T.Text ->  Node@@ -635,3 +699,12 @@     '.' -> f (s `T.snoc` '0')     _   -> f s   where f s' = T.pack $ show (read $ T.unpack s' :: Double)++-- | Removes "file://" schema from URIs in 'UNode' nodes+fileSchemeToFilePath :: Node -> Maybe T.Text+fileSchemeToFilePath (UNode fileScheme) =+    if T.pack "file://" `T.isPrefixOf` fileScheme+    then fmap (T.pack . Network.uriPath) (Network.parseURI (T.unpack fileScheme))+    else Nothing+fileSchemeToFilePath _ = Nothing+
src/Rdf4hParseMain.hs view
@@ -12,8 +12,8 @@ import Text.RDF.RDF4H.TurtleParser import Text.RDF.RDF4H.TurtleSerializer -import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as TIO+import qualified Data.Text as T+import qualified Data.Text.IO as TIO  import System.Environment import System.IO
src/Text/RDF/RDF4H/Interact.hs view
@@ -14,7 +14,7 @@  module Text.RDF.RDF4H.Interact where -import qualified Data.Text.Lazy as T+import qualified Data.Text as T  import Data.RDF.Types hiding (baseUrl) import Data.RDF.TriplesGraph()
src/Text/RDF/RDF4H/NTriplesParser.hs view
@@ -11,9 +11,9 @@ import Data.Char(isLetter, isDigit, isLower) import qualified Data.Map as Map import Text.Parsec-import Text.Parsec.Text.Lazy-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as TIO+import Text.Parsec.Text+import qualified Data.Text as T+import qualified Data.Text.IO as TIO import Control.Monad (liftM,void)  -- |NTriplesParser is an 'RdfParser' implementation for parsing RDF in the
src/Text/RDF/RDF4H/NTriplesSerializer.hs view
@@ -8,8 +8,8 @@ import Control.Monad (void) import Data.RDF.Types import Data.RDF.Query (expandTriples)-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as T+import qualified Data.Text as T+import qualified Data.Text.IO as T import System.IO  data NTriplesSerializer = NTriplesSerializer
src/Text/RDF/RDF4H/ParserUtils.hs view
@@ -7,9 +7,9 @@ import Network.URI import Network.HTTP import Data.Char (intToDigit)-import Data.Text.Lazy.Encoding (decodeUtf8)-import qualified Data.ByteString.Lazy.Char8 as B-import qualified Data.Text.Lazy as T+import Data.Text.Encoding (decodeUtf8)+import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T -- import qualified Data.Map as Map import Data.Maybe (fromMaybe) 
src/Text/RDF/RDF4H/TurtleParser.hs view
@@ -8,14 +8,15 @@ where  import Data.Char (toLower,toUpper)+import Data.Maybe import Data.RDF.Types import Data.RDF.Namespace import Text.RDF.RDF4H.ParserUtils import Text.Parsec-import Text.Parsec.Text.Lazy+import Text.Parsec.Text import qualified Data.Map as Map-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as TIO+import qualified Data.Text 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@@ -189,7 +190,7 @@      (bUrl, _, _, pms, _, _, _, _) <- getState      case resolveQName bUrl pre pms of        Just n -> return $ n `T.append` name-       Nothing -> error ("Cannot resolve QName prefix: " ++ T.unpack pre)+       Nothing -> unexpected ("Cannot resolve QName prefix: " ++ T.unpack pre)  -- grammar rule: [10] subject t_subject :: GenParser ParseState ()@@ -199,21 +200,21 @@   nodeId <|>   between (char '[') (char ']') poList   where-    iri         = liftM UNode (try t_iri <?> "subject resource") >>= pushSubj+    iri         = liftM unode (try t_iri <?> "subject resource") >>= pushSubj     nodeId      = liftM BNode (try t_nodeID <?> "subject nodeID") >>= pushSubj     simpleBNode = try (string "[]") >> nextIdCounter >>=  pushSubj . BNodeGen     poList      = void                 (nextIdCounter >>= pushSubj . BNodeGen >> many t_ws >>                 t_predicateObjectList >>                 many t_ws)-+     -- verb objectList (';' (verb objectList)?)* -- -- verb ws+ objectList ( ws* ';' ws* verb ws+ objectList )* (ws* ';')? -- grammar rule: [7] predicateObjectlist t_predicateObjectList :: GenParser ParseState () t_predicateObjectList =-  do sepEndBy1 (try (t_verb >> many1 t_ws >> t_objectList >> popPred)) (try (many t_ws >> char ';' >> many t_ws))+  do sepEndBy1 (try (t_verb >> many1 t_ws >> t_objectList >> popPred)) (try (many t_ws >> char ';' >> optional (char ';') >> many t_ws))      return ()  -- grammar rule: [8] objectlist@@ -293,8 +294,8 @@ t_literal :: GenParser ParseState Node t_literal =   try str_literal <|>-  liftM (`mkLNode` xsdIntUri) (try t_integer)   <|>   liftM (`mkLNode` xsdDoubleUri) (try t_double)  <|>+  liftM (`mkLNode` xsdIntUri) (try t_integer)   <|>   liftM (`mkLNode` xsdDecimalUri) (try t_decimal) <|>   liftM (`mkLNode` xsdBooleanUri) t_boolean   where@@ -416,7 +417,9 @@   do frag <- liftM (T.pack . concat) (many t_ucharacter)      bUrl <- currBaseUrl      dUrl <- currDocUrl-     return $ absolutizeUrl bUrl dUrl frag+     case unodeValidate (absolutizeUrl bUrl dUrl frag) of+       Nothing -> unexpected ("Invalid URI in Turtle parser: " ++ show (absolutizeUrl bUrl dUrl frag))+       Just (UNode t) -> return t  -- We make this String rather than T.Text because we want -- t_relativeURI (the only place it's used) to have chars so that@@ -614,9 +617,9 @@ addTripleForObject obj =   do (bUrl, dUrl, i, pms, ss, ps, cs, ts) <- getState      when (null ss) $-       error $ "No Subject with which to create triple for: " ++ show obj+       unexpected $ "No Subject with which to create triple for: " ++ show obj      when (null ps) $-       error $ "No Predicate with which to create triple for: " ++ show obj+       unexpected $ "No Predicate with which to create triple for: " ++ show obj      setState (bUrl, dUrl, i, pms, ss, ps, cs, ts |> Triple (head ss) (head ps) obj)  -- |Parse the document at the given location URL as a Turtle document, using an optional @BaseUrl@
src/Text/RDF/RDF4H/TurtleSerializer.hs view
@@ -10,8 +10,8 @@ import Data.RDF.Types import Data.RDF.Query import Data.RDF.Namespace hiding (rdf)-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as T+import qualified Data.Text as T+import qualified Data.Text.IO as T import Data.Map(Map) import qualified Data.Map as Map import Data.List
src/Text/RDF/RDF4H/XmlParser.hs view
@@ -1,6 +1,6 @@-{-# Language Arrows,OverloadedStrings #-}+{-# Language Arrows,OverloadedStrings,DoAndIfThenElse #-} --- |An parser for the RDF/XML format +-- |An parser for the RDF/XML format -- <http://www.w3.org/TR/REC-rdf-syntax/>.  module Text.RDF.RDF4H.XmlParser(@@ -9,21 +9,24 @@  import Control.Arrow (Arrow,(>>>),(<<<),(&&&),(***),arr,returnA) import Control.Arrow.ArrowState (ArrowState,nextState)+import Control.Exception import Data.List (isPrefixOf) import qualified Data.Map as Map (fromList)+import Data.Maybe+import Data.Typeable import Text.RDF.RDF4H.ParserUtils-import Data.RDF.Types (RDF,RdfParser(..),Node(BNodeGen),BaseUrl(..),Triple(..),Triples,Subject,Predicate,Object,PrefixMappings(..),ParseFailure(ParseFailure),mkRdf,lnode,plainL,plainLL,typedL,unode,bnode)-import qualified Data.Text.Lazy as T (Text,pack,unpack)-import qualified Data.Text.Lazy.IO as TIO-import Text.XML.HXT.Core (ArrowXml,XmlTree,IfThen((:->)),(>.),(>>.),first,neg,(<+>),expandURI,getName,getAttrValue,getAttrValue0,getAttrl,hasAttrValue,hasAttr,constA,choiceA,getChildren,ifA,arr2A,second,hasName,isElem,isWhiteSpace,xshow,listA,isA,isText,getText,this,unlistA,orElse,sattr,mkelem,xreadDoc,runSLA)-+import Data.RDF.Types (RDF,RdfParser(..),Node(BNodeGen),BaseUrl(..),Triple(..),Triples,Subject,Predicate,Object,PrefixMappings(..),ParseFailure(ParseFailure),mkRdf,lnode,plainL,plainLL,typedL,unode,bnode,unodeValidate)+import qualified Data.Text as T (Text,pack,unpack)+import qualified Data.Text.IO as TIO+import Text.XML.HXT.Core (ArrowXml,ArrowIf,ArrowChoice,XmlTree,IfThen((:->)),(>.),(>>.),first,neg,(<+>),expandURI,getName,getAttrValue,getAttrValue0,getAttrl,hasAttrValue,hasAttr,constA,choiceA,getChildren,ifA,arr2A,second,hasName,isElem,isWhiteSpace,xshow,listA,isA,isText,getText,this,unlistA,orElse,sattr,mkelem,xreadDoc,runSLA,fatal,canonicalizeAllNodes)+     -- TODO: write QuickCheck tests for XmlParser instance for RdfParser.  data XmlParser = XmlParser (Maybe BaseUrl) (Maybe T.Text)  -- |'XmlParser' is an instance of 'RdfParser'. instance RdfParser XmlParser where-  parseString (XmlParser bUrl dUrl)  = parseXmlRDF bUrl dUrl +  parseString (XmlParser bUrl dUrl)  = parseXmlRDF bUrl dUrl   parseFile   (XmlParser bUrl dUrl)  = parseFile' bUrl dUrl   parseURL    (XmlParser bUrl dUrl)  = parseURL'  bUrl dUrl @@ -40,6 +43,10 @@                                }   deriving(Show) +data ParserException = ParserException String+                     deriving (Show,Typeable)+instance Exception ParserException+ -- |Parse the given file as a XML 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.@@ -54,19 +61,19 @@ -- -- The @BaseUrl@ is used as the base URI within the document for resolving any relative URI references. -- It may be changed within the document using the @\@base@ directive. At any given point, the current--- base URI is the most recent @\@base@ directive, or if none, the @BaseUrl@ given to @parseURL@, or +-- base URI is the most recent @\@base@ directive, or if none, the @BaseUrl@ given to @parseURL@, or -- if none given, the document URL given to @parseURL@. For example, if the @BaseUrl@ were--- @http:\/\/example.org\/@ and a relative URI of @\<b>@ were encountered (with no preceding @\@base@ +-- @http:\/\/example.org\/@ and a relative URI of @\<b>@ were encountered (with no preceding @\@base@ -- directive), then the relative URI would expand to @http:\/\/example.org\/b@. -- -- The document URL is for the purpose of resolving references to 'this document' within the document, -- and may be different than the actual location URL from which the document is retrieved. Any reference--- to @\<>@ within the document is expanded to the value given here. Additionally, if no @BaseUrl@ is +-- to @\<>@ within the document is expanded to the value given here. Additionally, if no @BaseUrl@ is -- given and no @\@base@ directive has appeared before a relative URI occurs, this value is used as the -- base URI against which the relative URI is resolved. --p -- Returns either a @ParseFailure@ or a new RDF containing the parsed triples.-parseURL' :: forall rdf. (RDF rdf) => +parseURL' :: forall rdf. (RDF rdf) =>                  Maybe BaseUrl       -- ^ The optional base URI of the document.                  -> Maybe T.Text -- ^ The document URI (i.e., the URI of the document itself); if Nothing, use location URI.                  -> String           -- ^ The location URI from which to retrieve the XML document.@@ -104,7 +111,8 @@ -- |Arrow that translates HXT XmlTree to an RDF representation getRDF :: forall rdf a. (RDF rdf, ArrowXml a, ArrowState GParseState a) => a XmlTree rdf getRDF = proc xml -> do-            rdf <- hasName "rdf:RDF" <<< isElem <<< getChildren         -< xml+--            rdf <- hasName "rdf:RDF" `orElse` hasName "RDF" <<< isElem <<< getChildren         -< xml+            rdf <- isElem <<< getChildren -< xml             bUrl <- arr (BaseUrl . T.pack) <<< ((getAttrValue0 "xml:base" <<< isElem <<< getChildren) `orElse` getAttrValue "transfer-URI") -< xml             prefixMap <- arr toPrefixMap <<< toAttrMap                  -< rdf             triples <- parseDescription' >. id -< (bUrl, rdf)@@ -125,7 +133,7 @@ parseDescription = updateState                >>> (arr2A parsePredicatesFromAttr                    <+> (second (getChildren >>> isElem) >>> parsePredicatesFromChildren)-                   <+> (second (neg (hasName "rdf:Description")) >>> arr2A readTypeTriple))+                   <+> (second (neg (hasName "rdf:Description") >>> neg (hasName "Description")) >>> arr2A readTypeTriple))                >>. replaceLiElems [] (1 :: Int)   where readTypeTriple :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple         readTypeTriple state = getName >>> arr (Triple (stateSubject state) rdfType . unode . T.pack)@@ -144,7 +152,7 @@ -- |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 state = getAttrl-    >>> (getName >>> neg isMetaAttr >>> mkUNode) &&& (getChildren >>> getText >>> arr (lnode . plainL . T.pack))+    >>> (getName >>> neg isMetaAttr >>> mkUNode) &&& (getChildren >>> getText >>> arr (mkLiteralNode state))     >>> arr (attachSubject (stateSubject state))  -- | Arrow to determine if special processing is required for an attribute@@ -166,6 +174,7 @@         , second (hasAttrValue "rdf:parseType" (== "Collection")) :-> (listA (defaultA >>> arr id &&& mkBlankNode) >>> mkCollectionTriples >>> unlistA)         , second (hasAttr "rdf:datatype") :-> arr2A getTypedTriple         , second (hasAttr "rdf:resource") :-> arr2A getResourceTriple+--        , second (hasAttr "rdf:nodeID") >>> hasAttr "rdf:ID" :-> ERROR.         , second (hasAttr "rdf:nodeID") :-> arr2A getNodeIdTriple         , second (hasAttr "rdf:ID") :-> (arr2A mkRelativeNode &&& defaultA >>> arr2A reifyTriple >>> unlistA)         , second hasPredicateAttr :-> (defaultA <+> (mkBlankNode &&& arr id >>> arr2A parsePredicateAttr))@@ -270,8 +279,10 @@   where baseUrl = constA (case stateBaseUrl state of BaseUrl b -> T.unpack b)  -- |Make a UNode from an absolute string-mkUNode :: forall a. (Arrow a) => a String Node-mkUNode = arr (unode . T.pack)+mkUNode :: forall a. (Arrow 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@@ -292,4 +303,3 @@ mkBlankNode :: forall a b. (ArrowState GParseState a) => a b Node mkBlankNode = nextState (\gState -> gState { stateGenId = stateGenId gState + 1 })     >>> arr (BNodeGen . stateGenId)-
testsuite/tests/W3C/TurtleTest.hs view
@@ -3,7 +3,10 @@ import Test.Framework.Providers.API import Test.Framework.Providers.HUnit import qualified Test.HUnit as TU-import qualified Data.Text.Lazy as T+import Data.Maybe (fromJust)+import qualified Data.Text as T+import Network.URI (parseURI,uriPath)+import System.Directory (getCurrentDirectory)  import W3C.Manifest @@ -13,6 +16,7 @@ import Text.RDF.RDF4H.NTriplesParser import Data.RDF.TriplesGraph +suiteFilesDir :: T.Text suiteFilesDir = "data/w3c/turtle/TurtleTests/"  mfPath = T.concat [suiteFilesDir, "manifest.ttl"]@@ -23,26 +27,34 @@  allTurtleTests :: IO Test allTurtleTests = do-  m <- loadManifest mfPath suiteFilesDir+  dir <- getCurrentDirectory+  let fileSchemeURI = T.pack ("file://" ++ dir ++ "/" ++ T.unpack suiteFilesDir)+  m <- loadManifest mfPath fileSchemeURI   return $ testGroup (T.unpack $ description m) $ map (buildTest . mfEntryToTest) $ entries m + -- Functions to map manifest test entries to unit tests. -- They are defined here to avoid cluttering W3C.Manifest -- with functions that may not be needed to those who -- just want to parse Manifest files. -- TODO: They should probably be moved to W3C.Manifest after all. mfEntryToTest :: TestEntry -> IO Test-mfEntryToTest (TestTurtleEval nm _ _ act res) = do+mfEntryToTest (TestTurtleEval nm _ _ act' res') = do+  let act = (UNode . fromJust . fileSchemeToFilePath) act'+  let res = (UNode . fromJust . fileSchemeToFilePath) res'   parsedRDF <- parseFile testParser (nodeURI act) >>= return . fromEither :: IO TriplesGraph   expectedRDF <- parseFile NTriplesParser (nodeURI res) >>= return . fromEither :: IO TriplesGraph   return $ testCase (T.unpack nm) $ TU.assert $ isIsomorphic parsedRDF expectedRDF-mfEntryToTest (TestTurtleNegativeEval nm _ _ act) = do+mfEntryToTest (TestTurtleNegativeEval nm _ _ act') = do+  let act = (UNode . fromJust . fileSchemeToFilePath) act'   rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph)   return $ testCase (T.unpack nm) $ TU.assert $ isNotParsed rdf-mfEntryToTest (TestTurtlePositiveSyntax nm _ _ act) = do+mfEntryToTest (TestTurtlePositiveSyntax nm _ _ act') = do+  let act = (UNode . fromJust . fileSchemeToFilePath) act'   rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph)   return $ testCase (T.unpack nm) $ TU.assert $ isParsed rdf-mfEntryToTest (TestTurtleNegativeSyntax nm _ _ act) = do+mfEntryToTest (TestTurtleNegativeSyntax nm _ _ act') = do+  let act = (UNode . fromJust . fileSchemeToFilePath) act'   rdf <- parseFile testParser (nodeURI act) :: IO (Either ParseFailure TriplesGraph)   return $ testCase (T.unpack nm) $ TU.assert $ isNotParsed rdf mfEntryToTest x = error $ "unknown TestEntry pattern in mfEntryToTest: " ++ show x