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 +26/−22
- bench/MainCriterion.hs +1/−1
- rdf4h.cabal +3/−1
- src/Data/RDF/Namespace.hs +1/−1
- src/Data/RDF/Query.hs +1/−1
- src/Data/RDF/Types.hs +80/−7
- src/Rdf4hParseMain.hs +2/−2
- src/Text/RDF/RDF4H/Interact.hs +1/−1
- src/Text/RDF/RDF4H/NTriplesParser.hs +3/−3
- src/Text/RDF/RDF4H/NTriplesSerializer.hs +2/−2
- src/Text/RDF/RDF4H/ParserUtils.hs +3/−3
- src/Text/RDF/RDF4H/TurtleParser.hs +14/−11
- src/Text/RDF/RDF4H/TurtleSerializer.hs +2/−2
- src/Text/RDF/RDF4H/XmlParser.hs +28/−18
- testsuite/tests/W3C/TurtleTest.hs +18/−6
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