diff --git a/app/RunW3CTests.hs b/app/RunW3CTests.hs new file mode 100644 --- /dev/null +++ b/app/RunW3CTests.hs @@ -0,0 +1,322 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-------------------------------------------------------------------------------- +-- See end of this file for licence information. +-------------------------------------------------------------------------------- +-- | +-- Module : RunW3CTests +-- Copyright : (c) 2013 Douglas Burke +-- License : GPL V2 +-- +-- Maintainer : Douglas Burke +-- Stability : experimental +-- Portability : OverloadedStrings, RecordWildCards +-- +-- Run the W3C Turtle tests using the supplied manifest file (Turtle format). +-- It requires that the tests are installed locally (i.e. it will /not/ +-- download from the Turtle test suite at ). +-- +-- Possible improvements: +-- +-- - create an EARL report (), for +-- . +-- See also . +-- +-- - option to download the tests from the W3C site. +-- +-------------------------------------------------------------------------------- + +module Main where + +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Text.Lazy as L +import qualified Data.Text.Lazy.IO as L + +import qualified Swish.RDF.Parser.Turtle as TTL +import qualified Swish.RDF.Parser.NTriples as NT + +import Control.Monad (forM_) + +import Data.Maybe (catMaybes) + +import Network.URI (URI, parseURI, parseURIReference, relativeTo, uriPath, uriScheme) + +import Swish.RDF.Graph +import Swish.Namespace (ScopedName, getScopeURI) +import Swish.RDF.Query +import Swish.RDF.Vocabulary.RDF (rdfType) +import Swish.RDF.Vocabulary.XSD (xsdString) + +import System.Directory (canonicalizePath) +import System.Environment +import System.Exit (exitFailure, exitSuccess) +import System.FilePath (splitFileName) +import System.IO (hFlush, hPutStr, hPutStrLn, stderr, stdout) + +-- | The base URI for the tests. +base :: Maybe URI +base = parseURI "http://www.w3.org/2013/TurtleTests/" + +-- Could include the language type for the Parse version. + +-- | I have decided to treat @rdf:type rdft:TestTurtleNegativeEval@ +-- tests the same as @rdf:TestTurtleNegativeSyntax@. +data TestType = + NTriplesParse Bool -- ^ Should the NTriples file parse successfully? + | TurtleParse Bool -- ^ Should the Turtle file parse successfully? + | TurtleCompare -- ^ The Turtle and NTriples files should match. + +_showBool :: Bool -> String +_showBool True = "pass" +_showBool _ = "fail" + +instance Show TestType where + show (NTriplesParse a) = "" + show (TurtleParse a) = "" + show TurtleCompare = "" + +data Test = + Test + { + _tName :: String + , _tAction :: IO (Maybe String) + -- ^ If the test fails a string reporting the error is returned. + } + +-- | Returns the name of the test if it failed. +runTest :: Test -> IO (Maybe String) +runTest Test {..} = _tAction >>= \r -> hFlush stdout >> return r + +runTests :: [Test] -> IO () +runTests ts = do + putStrLn $ "Running " ++ show (length ts) ++ " tests" + hFlush stdout + fails <- catMaybes `fmap` mapM runTest ts + putStrLn "" + case fails of + [] -> putStrLn "All tests passed." >> exitSuccess + [f] -> hPutStrLn stderr ("One test failed: " ++ f) >> exitFailure + _ -> do + let nf = show $ length fails + hPutStrLn stderr $ "There were " ++ nf ++ " failures:" + forM_ (zip [(1::Int)..] fails) $ \(n,m) -> do + hPutStr stderr $ "# [" ++ show n ++ "/" ++ nf ++ "] " + hPutStrLn stderr m + exitFailure + +mfEntries, mfName :: ScopedName +mfEntries = "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#entries" +mfName = "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#name" + +mfAction, mfResult :: ScopedName +mfAction = "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#action" +mfResult = "http://www.w3.org/2001/sw/DataAccess/tests/test-manifest#result" + +rdftTestTurtleEval, rdftTestTurtleNegativeEval, rdftTestTurtlePositiveSyntax, rdftTestTurtleNegativeSyntax :: ScopedName +rdftTestTurtleEval = "http://www.w3.org/ns/rdftest#TestTurtleEval" +rdftTestTurtleNegativeEval = "http://www.w3.org/ns/rdftest#TestTurtleNegativeEval" + +rdftTestTurtlePositiveSyntax ="http://www.w3.org/ns/rdftest#TestTurtlePositiveSyntax" +rdftTestTurtleNegativeSyntax = "http://www.w3.org/ns/rdftest#TestTurtleNegativeSyntax" + +rdftTestNTriplesPositiveSyntax, rdftTestNTriplesNegativeSyntax :: ScopedName +rdftTestNTriplesPositiveSyntax = "http://www.w3.org/ns/rdftest#rdftTestNTriplesPositiveSyntax" +rdftTestNTriplesNegativeSyntax = "http://www.w3.org/ns/rdftest#rdftTestNTriplesNegativeSyntax" + +{- +rdftApproval :: RDFLabel +rdftApproval = u2L + "http://www.w3.org/ns/rdftest#approval" +-} + +-- | Extract out the object from the list of triples, +-- erroring out if there is not a single match. +getVal :: + ScopedName -- ^ predicate to search for + -> [RDFTriple] + -> Either String RDFLabel -- ^ object, if found +getVal p ts = + let ns = filter ((== Res p) . arcPred) ts + in case ns of + [n] -> Right $ arcObj n + + [] -> Left $ "No " ++ show p ++ " predicate found" + _ -> Left $ "Found multiple " ++ show p ++ " attributes" + +-- | Note: assuming that the literals are untyped at the moment. +toString :: RDFLabel -> Either String String +toString (Lit s) = Right $ T.unpack s +toString (LangLit s _) = Right $ T.unpack s +toString (TypedLit s dt) | dt == xsdString = Right $ T.unpack s + | otherwise = Left $ "Not a string, but " ++ show dt +toString v = Left $ "Not a string literal, but " ++ show v + +toTestType :: RDFLabel -> Either String TestType +toTestType (Res r) | r == rdftTestTurtleEval = Right TurtleCompare + | r == rdftTestTurtlePositiveSyntax = Right $ TurtleParse True + | r == rdftTestTurtleNegativeSyntax = Right $ TurtleParse False + | r == rdftTestTurtleNegativeEval = Right $ TurtleParse False + | r == rdftTestNTriplesPositiveSyntax = Right $ NTriplesParse True + | r == rdftTestNTriplesNegativeSyntax = Right $ NTriplesParse False + | otherwise = Left $ "Unrecognized test type: " ++ show r +toTestType x = Left $ "Not a resource, but " ++ show x + +getScheme, getPath :: ScopedName -> String +getScheme = uriScheme . getScopeURI +getPath = uriPath . getScopeURI + +toFilePath :: RDFLabel -> Either String FilePath +toFilePath (Res r) | getScheme r == "file:" = Right $ getPath r + | otherwise = Left $ "Not a file URL: " ++ show r +toFilePath x = Left $ "Not a resource, but " ++ show x + +-- | Indicates that the details of the test in the manifest graph +-- do not contain the required details. +failedAction :: String -> IO (Maybe String) +failedAction = return . Just + +pass :: IO (Maybe String) +pass = putStrLn "[PASS]" >> return Nothing + +nopass :: String -> IO (Maybe String) +nopass e = putStrLn "[FAIL]" >> failedAction e + +ljust :: String -> IO () +ljust m = + putStr $ m ++ replicate (60 - length m) ' ' + +-- | Compare the two files. +evalAction :: + String -- ^ test name + -> FilePath -- ^ turtle file (to test) + -> FilePath -- ^ NTriples file (to compare against) + -> IO (Maybe String) + -- ^ If the test fpasses return @Nothing@, otherwise + -- a string descibing the error +evalAction name tFile nFile = do + ljust $ "*** " ++ name + cts1 <- L.readFile tFile + cts2 <- L.readFile nFile + let filename = snd $ splitFileName tFile + Just frag = parseURIReference filename + nbase = (frag `relativeTo`) `fmap` base + let res = do + tgr <- TTL.parseTurtle cts1 nbase + ngr <- NT.parseNT cts2 + return $ if tgr == ngr + then Nothing + else + -- should look at Swish.Commands.swishOutputDiffs + -- but that is quite involved, so just dump the + -- two graphs, which should be small + let f = concatMap show . S.toList . getArcs + in Just $ name ++ "\nDoes not compare equal.\nExpected:\n" ++ + f ngr ++ "\nTurtle:\n" ++ f tgr + + case res of + Left e -> nopass (name ++ "\nParse failure:\n" ++ e) + Right Nothing -> pass + Right (Just e) -> nopass e + +-- | Does the file parse? +-- +-- TODO: should we ensure the graph is evaluated to make sure +-- that laziness does not catch us out here? +evalSyntaxPass :: + (L.Text -> Either String a) -- ^ parser to test + -> String -- ^ test name + -> FilePath -- ^ turtle file (to test) + -> IO (Maybe String) +evalSyntaxPass parser name tFile = do + ljust $ "*** " ++ name + cts <- L.readFile tFile + case parser cts of + Left e -> nopass (name ++ "\n" ++ e) + Right _ -> pass + +-- | Does the file fail to parse? +-- +-- TODO: should we ensure the graph is evaluated to make sure +-- that laziness does not catch us out here? +evalSyntaxFail :: + (L.Text -> Either String a) -- ^ parser to test + -> String -- ^ test name + -> FilePath -- ^ turtle file (to test) + -> IO (Maybe String) +evalSyntaxFail parser name tFile = do + ljust $ "*** " ++ name + cts <- L.readFile tFile + case parser cts of + Left _ -> pass + Right _ -> nopass (name ++ "\nShould not have parsed, but it did!") + +-- | Create a test for the given label. For now ignore the +-- approved field. +makeTest :: RDFGraph -> RDFLabel -> Test +makeTest gr lbl = + let arcs = rdfFindArcs (rdfSubjEq lbl) gr + + getMetaData = do + testName <- getVal mfName arcs >>= toString + testType <- getVal rdfType arcs >>= toTestType + return (testName, testType) + + getAction name (NTriplesParse b) = do + inFile <- getVal mfAction arcs >>= toFilePath + return $ if b + then evalSyntaxPass NT.parseNT name inFile + else evalSyntaxFail NT.parseNT name inFile + + getAction name (TurtleParse b) = do + inFile <- getVal mfAction arcs >>= toFilePath + return $ if b + then evalSyntaxPass TTL.parseTurtlefromText name inFile + else evalSyntaxFail TTL.parseTurtlefromText name inFile + + getAction name TurtleCompare = do + inFile <- getVal mfAction arcs >>= toFilePath + outFile <- getVal mfResult arcs >>= toFilePath + return $ evalAction name inFile outFile + + in case getMetaData of + Left e -> Test "Failed to build test" $ failedAction $ "No test data found: " ++ e + Right (n,t) -> case getAction n t of + Left e -> Test n $ failedAction $ "Failed to build test " ++ n ++ ": " ++ e + Right a -> Test n a + +makeTests :: RDFGraph -> [Test] +makeTests gr = + let [Arc _ _ ehead] = rdfFindArcs (rdfPredEq (Res mfEntries)) gr + in map (makeTest gr) $ rdfFindList gr ehead + +readManifest :: FilePath -> IO [Test] +readManifest fname = do + putStrLn $ "Reading manifest: " ++ fname + cts <- L.readFile fname + path <- canonicalizePath fname + let (dName, _) = splitFileName path + baseName = parseURI $ "file://" ++ dName + case baseName of + Just bn -> putStrLn $ "Using as base: " ++ show bn + _ -> hPutStrLn stderr ("Unable to convert " ++ dName ++ " to a base URI!") + >> exitFailure + case TTL.parseTurtle cts baseName of + Left e -> hPutStrLn stderr ("Error parsing " ++ fname) + >> hPutStrLn stderr ("--> " ++ e) + >> exitFailure + Right gr -> return $ makeTests gr + + +main :: IO () +main = do + args <- getArgs + case args of + [fname] -> readManifest fname >>= runTests + _ -> do + pName <- getProgName + hPutStrLn stderr $ "Usage: " ++ pName ++ " " + exitFailure + + diff --git a/src/Swish/QName.hs b/src/Swish/QName.hs --- a/src/Swish/QName.hs +++ b/src/Swish/QName.hs @@ -5,7 +5,7 @@ -------------------------------------------------------------------------------- -- | -- Module : QName --- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke +-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke @@ -16,8 +16,9 @@ -- which represents a 'URI' as the combination of a namespace 'URI' -- and a local component ('LName'), which can be empty. -- --- Although RDF supports using IRIs, the use of 'URI' here precludes this. --- There is currently no attempt to convert from an IRI into a URI. +-- Although RDF supports using IRIs, the use of 'URI' here precludes this, +-- which means that, for instance, 'LName' only accepts a subset of valid +-- characters. There is currently no attempt to convert from an IRI into a URI. -- -------------------------------------------------------------------------------- @@ -68,11 +69,13 @@ {-| A local name, which can be empty. -At present, the local name can not -contain spaces or the \'#\', \':\', or \'/\' characters. This restriction is -experimental. +At present, the local name can not contain a space character and can only +contain ascii characters (those that match 'Data.Char.isAscii'). -The additional restriction of 'Data.Char.isAscii' was added in version @0.7.0.2@. +In version @0.9.0.3@ and earlier, the following characters were not +allowed in local names: \'#\', \':\', or \'/\' characters. + +This is all rather experimental. -} newtype LName = LName T.Text deriving (Eq, Ord) @@ -93,8 +96,9 @@ -- | Create a local name. newLName :: T.Text -> Maybe LName --- newLName l = if T.any (`elem` " #:/") l then Nothing else Just (LName l) -newLName l = if T.any (\c -> c `elem` " #:/" || not (isAscii c)) l then Nothing else Just (LName l) +-- newLName l = if T.any (`elem` " #:/") l then Nothing else Just (LName l) -- 0.7.0.1 and earlier +-- newLName l = if T.any (\c -> c `elem` " #:/" || not (isAscii c)) l then Nothing else Just (LName l) -- 0.9.0.3 and earlier +newLName l = if T.any (\c -> c == ' ' || not (isAscii c)) l then Nothing else Just (LName l) -- | Extract the local name. getLName :: LName -> T.Text @@ -114,12 +118,13 @@ > swish> let qn2 = "http://example.com/bob" :: QName > swish> let qn3 = "http://example.com/bob/fred" :: QName > swish> let qn4 = "http://example.com/bob/fred#x" :: QName -> swish> map getLocalName [qn1, qn2, qn3, qn4] -> ["","bob","fred","x"] +> swish> let qn5 = "http://example.com/bob/fred:joe" :: QName +> swish> map getLocalName [qn1, qn2, qn3, qn4, qn5] +> ["","bob","fred","x","fred:joe"] > swish> getNamespace qn1 -> http://example.com +> http://example.com/ > swish> getNamespace qn2 -> http://example.com +> http://example.com/ > swish> getNamespace qn3 > http://example.com/bob/ > swish> getNamespace qn4 @@ -155,7 +160,7 @@ compare = comparing getQNameURI -- | The format used to display the URI is @\@, and does not --- include the password if using baccess access authorization. +-- include the password if using basic access authorization. instance Show QName where show (QName u _ _) = "<" ++ show u ++ ">" @@ -271,7 +276,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, --- 2011, 2012 Douglas Burke +-- 2011, 2012, 2013 Douglas Burke -- All rights reserved. -- -- This file is part of Swish. diff --git a/src/Swish/RDF/Formatter/Internal.hs b/src/Swish/RDF/Formatter/Internal.hs --- a/src/Swish/RDF/Formatter/Internal.hs +++ b/src/Swish/RDF/Formatter/Internal.hs @@ -7,7 +7,7 @@ -- | -- Module : Internal -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, --- 2011, 2012 Douglas Burke +-- 2011, 2012, 2013 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke @@ -56,6 +56,11 @@ ) where +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Text.Lazy.Builder as B + import Swish.GraphClass (Arc(..), ArcSet) import Swish.Namespace (ScopedName, getScopeLocal, getScopeURI) import Swish.QName (getLName) @@ -72,18 +77,13 @@ import Control.Monad (liftM) import Control.Monad.State (State, get, gets, modify, put) -import Data.List (delete, foldl', groupBy, intersperse, partition) +import Data.List (foldl', groupBy, isInfixOf, intersperse, partition) import Data.Monoid (Monoid(..), mconcat) import Data.Word import Network.URI (URI) import Network.URI.Ord () -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Text.Lazy.Builder as B - #if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 701) import Data.Tuple (swap) #else @@ -232,6 +232,9 @@ -- Graph-related helper functions ---------------------------------------------------------------------- +-- partiton up the graph; should this be replaced by Swish.GraphPartition? +-- Also extracts a list of bnodes in the graph +-- processArcs :: RDFGraph -> (SubjTree RDFLabel, [RDFLabel]) processArcs gr = let arcs = sortArcs $ getArcs gr @@ -304,40 +307,53 @@ {- -Find all blank nodes that occur - - any number of times as a subject - - 0 or 1 times as an object +Return a list of blank nodes that can not be converted to "[]" +format by Turtle/N3: -Such nodes can be output using the "[..]" syntax. To make it simpler -to check we actually store those nodes that can not be expanded. + - any blank node that is a predicate + - any blank node that is an object position multiple times + - any blank node that is both a subject and object -Note that we do not try and expand any bNode that is used in -a predicate position. +Note, really need to partition the graph since the last check +means that we can not convert -Should probably be using the SubjTree RDFLabel structure but this -is easier for now. + _:a :knows _:b . _:b :knows _:a . +to + + _:a :knows [ :knows _:a ] . + -} countBnodes :: SortedArcs RDFLabel -> [RDFLabel] -countBnodes (SA as) = snd (foldl' ctr ([],[]) as) - where - -- first element of tuple are those blank nodes only seen once, - -- second element those blank nodes seen multiple times +countBnodes (SA as) = + let -- This is only ever used if a label already exists, + -- so we know that in this case the value to store is True + upd _ _ = True + + -- Only want to process the subject after processing all the + -- arcs that it is the subject of. It could be included into + -- procPO by passing around the previous subject and processing + -- it when it changes, but separate out for now. + procPO oMap (Arc _ p o) = + addNode False o $ addNode True p oMap + + procS oMap s = addNode False s oMap + + -- Take advantage of the fact that the arcs are sorted -- - inc b@(b1s,bms) l@(Blank _) | l `elem` bms = b - | l `elem` b1s = (delete l b1s, l:bms) - | otherwise = (l:b1s, bms) - inc b _ = b + isBlank (Blank _) = True + isBlank _ = False + subjects = S.filter isBlank $ S.fromList $ map arcSubj as - -- if the bNode appears as a predicate we instantly add it to the - -- list of nodes not to expand, even if only used once - incP b@(b1s,bms) l@(Blank _) | l `elem` bms = b - | l `elem` b1s = (delete l b1s, l:bms) - | otherwise = (b1s, l:bms) - incP b _ = b + -- not bothering about lazy/strict insert here + addNode f l@(Blank _) m = M.insertWith upd l f m + addNode _ _ m = m - ctr orig (Arc _ p o) = inc (incP orig p) o + map1 = foldl' procPO M.empty as + map2 = S.foldl' procS map1 subjects + + in M.keys $ M.filter id map2 -- N3-like output @@ -350,13 +366,49 @@ is to use one double quote unless three are needed, and to handle adding necessary @\\@ characters, or conversion for Unicode characters. + +Turtle supports 4 ways of quoting text, + + (1) @\'...\'@ + + (2) @\'\'\'...\'\'\'@ + + (3) @\"...\"@ + + (4) @\"\"\"...\"\"\"@ + +where there are slightly-different +constraints on @...@ for each one. At present +we assume that the string is to be quoted as 3 or 4; this +could be extended to allow for 1 or 2 as well. + +For now option 4 is only used when the contents contain a +@\n@ character and does not contain @\"\"\"@. -} + +-- The original thinking was that a scan of the string is worthwhile +-- if it avoids having to quote characters, but we always need to +-- go through and do this anyway, eg for @\t@ or @\@. +-- +-- Swish.RDF.Graph.quote, used by quoteB, does not handle +-- strings with three or more consecutive @"@ characters, so +-- we explicitly check for this and fall back to the single-" +-- version, which protects each quote. +-- quoteText :: T.Text -> B.Builder quoteText txt = - let st = T.unpack txt -- TODO: fix - qst = quoteB (n==1) st - n = if '\n' `elem` st || '"' `elem` st then 3 else 1 + let st = T.unpack txt -- TODO: fix to use Text + + -- assume the magical ghc pixie will fuse all these loops + hasNL = '\n' `elem` st + hasSQ = '"' `elem` st + has3Q = "\"\"\"" `isInfixOf` st + + n = if has3Q || (not hasNL && not hasSQ) then 1 else 3 + qch = B.fromString (replicate n '"') + qst = quoteB (n==1) st + in mconcat [qch, qst, qch] -- TODO: need to be a bit more clever with this than we did in NTriples @@ -386,10 +438,17 @@ -- does not match the syntax used in N3, so we need to convert here. -- Rather than converting back to a Double and then displaying that -- we just convert E to e for now. --- -formatTypedLit :: T.Text -> ScopedName -> B.Builder -formatTypedLit lit dtype - | dtype == xsdDouble = B.fromText $ T.toLower lit +-- +-- However, I am moving away from storing a canonical representation +-- of a datatyped literal in the resource since it is messy and makes +-- some comparisons difficult (unless equality of RDFLabels is made +-- dependent on types, and then it gets messy). I am also not as +-- concerned about issues in the N3 parser/formatter as in the Turtle +-- one. +-- +formatTypedLit :: Bool -> T.Text -> ScopedName -> B.Builder +formatTypedLit n3flag lit dtype + | dtype == xsdDouble = B.fromText $ if n3flag then T.toLower lit else lit | dtype `elem` [xsdBoolean, xsdDecimal, xsdInteger] = B.fromText lit | otherwise = mconcat [quoteText lit, "^^", showScopedName dtype] @@ -645,7 +704,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, --- 2011, 2012 Douglas Burke +-- 2011, 2012, 2013 Douglas Burke -- All rights reserved. -- -- This file is part of Swish. diff --git a/src/Swish/RDF/Formatter/N3.hs b/src/Swish/RDF/Formatter/N3.hs --- a/src/Swish/RDF/Formatter/N3.hs +++ b/src/Swish/RDF/Formatter/N3.hs @@ -461,7 +461,7 @@ formatLabel _ (Lit lit) = return $ formatPlainLit lit formatLabel _ (LangLit lit lcode) = return $ formatLangLit lit lcode -formatLabel _ (TypedLit lit dtype) = return $ formatTypedLit lit dtype +formatLabel _ (TypedLit lit dtype) = return $ formatTypedLit True lit dtype formatLabel _ lab = return $ B.fromString $ show lab diff --git a/src/Swish/RDF/Formatter/NTriples.hs b/src/Swish/RDF/Formatter/NTriples.hs --- a/src/Swish/RDF/Formatter/NTriples.hs +++ b/src/Swish/RDF/Formatter/NTriples.hs @@ -12,13 +12,19 @@ -- Stability : experimental -- Portability : OverloadedStrings -- --- This Module implements a NTriples formatter for an 'RDFGraph'. +-- This Module implements a NTriples formatter for a 'RDFGraph'. -- -- REFERENCES: -- -- - \"RDF Test Cases\", -- W3C Recommendation 10 February 2004, -- +-- +-- NOTES: +-- +-- - Update to the document \"N-Triples. A line-based syntax for an RDF graph\" +-- W3C Working Group Note 09 April 2013, +-- -- -------------------------------------------------------------------------------- diff --git a/src/Swish/RDF/Formatter/Turtle.hs b/src/Swish/RDF/Formatter/Turtle.hs --- a/src/Swish/RDF/Formatter/Turtle.hs +++ b/src/Swish/RDF/Formatter/Turtle.hs @@ -6,7 +6,7 @@ -- | -- Module : Turtle -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, --- 2011, 2012 Douglas Burke +-- 2011, 2012, 2013 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke @@ -22,6 +22,17 @@ -- W3C Working Draft 09 August 2011 () -- -- +-- NOTES: +-- +-- - The formatter needs to be updated to the W3C +-- Candidate Recommendation (19 February 2013, +-- ). +-- +-- - Should literal strings (@Lit@) be written out as @xsd:string@, or +-- should @TypedLit@ strings with a type of @xsd:string@ be written +-- out with no type? (e.g. see +-- ). +-- -------------------------------------------------------------------------------- {- @@ -311,16 +322,12 @@ -- (b) URI nodes: if possible, replace URI with qname, -- else display as -- (c) formula nodes (containing graphs). --- (d) use the "special-case" formats for integer/float/double +-- (d) use the "special-case" formats for integer/float/double/string -- literals. -- --- [[[TODO:]]] --- (d) generate multi-line literals when appropriate --- -- This is being updated to produce inline formula, lists and -- blank nodes. The code is not efficient. -- --- -- Note: There is a lot less customisation possible in Turtle than N3. -- @@ -329,7 +336,7 @@ {- The "[..]" conversion is done last, after "()" and "{}" checks. -TODO: look at the (_:_) check on the blank string; why is this needed? +TODO: why is there a (_:_) check on the blank node? -} formatLabel lctxt lab@(Blank (_:_)) = do mlst <- extractList lctxt lab @@ -354,7 +361,7 @@ formatLabel _ (Lit lit) = return $ formatPlainLit lit formatLabel _ (LangLit lit lcode) = return $ formatLangLit lit lcode -formatLabel _ (TypedLit lit dtype) = return $ formatTypedLit lit dtype +formatLabel _ (TypedLit lit dtype) = return $ formatTypedLit False lit dtype formatLabel _ lab = return $ B.fromString $ show lab @@ -369,7 +376,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, --- 2011, 2012 Douglas Burke +-- 2011, 2012, 2013 Douglas Burke -- All rights reserved. -- -- This file is part of Swish. diff --git a/src/Swish/RDF/Graph.hs b/src/Swish/RDF/Graph.hs --- a/src/Swish/RDF/Graph.hs +++ b/src/Swish/RDF/Graph.hs @@ -8,15 +8,25 @@ -- | -- Module : Graph -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, --- 2011, 2012 Douglas Burke +-- 2011, 2012, 2013 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental -- Portability : FlexibleInstances, MultiParamTypeClasses, OverloadedStrings -- --- This module defines a memory-based RDF graph instance. +-- This module defines a memory-based RDF graph instance. At present only +-- RDF 1.0 is explicitly supported; I have not gone through the RDF 1.1 +-- changes to see how the code needs to be updated. This means that you +-- can have untyped strings in your graph that do not match the same content +-- but with an explicit @xsd:string@ datatype. -- +-- Note that the identifiers for blank nodes may /not/ be propogated when +-- a graph is written out using one of the formatters, such as +-- 'Swish.RDF.Formatter.Turtle'. There is limited support for +-- generating new blank nodes from an existing set of triples; e.g. +-- 'newNode' and 'newNodes'. +-- -------------------------------------------------------------------------------- ------------------------------------------------------------ @@ -213,7 +223,7 @@ -- | RDF graph node values -- --- cf. +-- cf. version 1.0 -- -- This is extended from the RDF abstract graph syntax in the -- following ways: @@ -668,12 +678,12 @@ -- | See `quote`. quoteT :: Bool -> T.Text -> T.Text -quoteT f = T.pack . quote f . T.unpack +quoteT f = T.pack . quote f . T.unpack -- TODO: avoid conversion to string {-| N3-style quoting rules for a string. -TODO: when flag is `False` need to worry about multiple quotes (> 2) -in a row. +WARNING: the output is /incorrect/ if the flag is @False@ and +the text contains 3 or more consecutive @\"@ characters. -} quote :: @@ -1377,14 +1387,15 @@ mapbn' = (dn,dnmap):mapbn allbn' = dnmap:allbn +-- TODO: optimize this for common case @nnn@ and @_nnn@: +-- always generate @_nnn@ and keep track of last allocated +-- + -- |Given a node and a list of existing nodes, find a new node for -- the supplied node that does not clash with any existing node. -- (Generates an non-terminating list of possible replacements, and -- picks the first one that isn't already in use.) -- --- TODO: optimize this for common case @nnn@ and @_nnn@: --- always generate @_nnn@ and keep track of last allocated --- newNode :: (Label lb) => lb -> [lb] -> lb newNode dn existnodes = head $ newNodes dn existnodes @@ -1474,7 +1485,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, --- 2011, 2012 Douglas Burke +-- 2011, 2012, 2013 Douglas Burke -- All rights reserved. -- -- This file is part of Swish. diff --git a/src/Swish/RDF/Parser/NTriples.hs b/src/Swish/RDF/Parser/NTriples.hs --- a/src/Swish/RDF/Parser/NTriples.hs +++ b/src/Swish/RDF/Parser/NTriples.hs @@ -4,7 +4,7 @@ -- | -- Module : NTriples --- Copyright : (c) 2011, 2012 Douglas Burke +-- Copyright : (c) 2011, 2012, 2013 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke @@ -25,7 +25,13 @@ -- -- - If the URI is actually an IRI (Internationalized Resource Identifiers) -- then the parser will fail since 'Network.URI.parseURI' fails. --- +-- +-- - The case of language tags is retained. +-- +-- - Update to the document \"N-Triples. A line-based syntax for an RDF graph\" +-- W3C Working Group Note 09 April 2013, +-- +-- -------------------------------------------------------------------------------- module Swish.RDF.Parser.NTriples @@ -208,9 +214,13 @@ isAZ = isAsciiUpper is09 = isDigit +isaZ, isaZ09 :: Char -> Bool +isaZ c = isaz c || isAZ c +isaZ09 c = isaZ c || is09 c + isHeadChar, isBodyChar :: Char -> Bool -isHeadChar c = isaz c || isAZ c -isBodyChar c = isHeadChar c || is09 c +isHeadChar = isaZ +isBodyChar = isaZ09 name :: NTParser L.Text name = L.cons <$> satisfy isHeadChar <*> manySatisfy isBodyChar @@ -297,8 +307,8 @@ dtlang :: NTParser (Either LanguageTag ScopedName) dtlang = - (char '@' *> (Left <$> language)) - <|> (string "^^" *> (Right <$> uriref)) + (char '@' *> commit (Left <$> language)) + <|> (string "^^" *> commit (Right <$> uriref)) -- Note that toLangTag may fail since it does some extra -- validation not done by the parser (mainly on the length of the @@ -307,10 +317,14 @@ -- NOTE: This parser does not accept multiple secondary tags which RFC3066 -- does. -- +-- Although the EBNF only lists [a-z] we also support upper case values, +-- since the W3C Turtle test case includes a NTriples file with +-- "...@en-UK" in it. +-- language :: NTParser LanguageTag language = do - h <- many1Satisfy isaz - mt <- optional ( L.cons <$> char '-' <*> many1Satisfy (\c -> isaz c || is09 c) ) + h <- many1Satisfy isaZ + mt <- optional $ L.cons <$> char '-' <*> many1Satisfy isaZ09 let lbl = L.toStrict $ L.append h $ fromMaybe L.empty mt case toLangTag lbl of Just lt -> return lt @@ -380,7 +394,7 @@ -------------------------------------------------------------------------------- -- --- Copyright (c) 2011, 2012 Douglas Burke +-- Copyright (c) 2011, 2012, 2013 Douglas Burke -- All rights reserved. -- -- This file is part of Swish. diff --git a/src/Swish/RDF/Parser/Turtle.hs b/src/Swish/RDF/Parser/Turtle.hs --- a/src/Swish/RDF/Parser/Turtle.hs +++ b/src/Swish/RDF/Parser/Turtle.hs @@ -1,11 +1,11 @@ -{-# LANGUAGE OverloadedStrings #-} -- only used in 'fromMaybe "" mbase' line of parseN3 +{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : Turtle --- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke +-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke @@ -19,47 +19,40 @@ -- REFERENCES: -- -- - \"Turtle, Terse RDF Triple Language\", --- W3C Working Draft 09 August 2011 (), +-- W3C Candidate Recommendation 19 February 2013 ( -- -- NOTES: -- --- - At present there is a lot of overlap with the N3 Parser. --- --- - The parser needs to be updated to the latest working draft (10 July 2012, --- ). --- +-- - Prior to version @0.9.0.4@, the parser followed the +-- W3C Working Draft 09 August 2011 () +-- -- - Strings with no language tag are converted to a 'LitTag' not a -- 'TypedLitTag' with a type of @xsd:string@ (e.g. see -- ). -- -- - If the URI is actually an IRI (Internationalized Resource Identifiers) -- then the parser will fail since 'Network.URI.parseURI' fails. +-- +-- - The current (August 2013) Turtle test suite from +-- passes except for the four +-- tests with non-ASCII local names, namely: +-- @localName_with_assigned_nfc_bmp_PN_CHARS_BASE_character_boundaries@, +-- @localName_with_assigned_nfc_PN_CHARS_BASE_character_boundaries@, +-- @localName_with_nfc_PN_CHARS_BASE_character_boundaries@, +-- and +-- @localName_with_non_leading_extras@. -- -------------------------------------------------------------------------------- +-- TODO: +-- - should the productions moved to an Internal module for use by +-- others - e.g. Sparql or the N3 parser? + module Swish.RDF.Parser.Turtle ( ParseResult , parseTurtle , parseTurtlefromText - {- - , parseAnyfromText - , parseTextFromText, parseAltFromText - , parseNameFromText -- , parsePrefixFromText - , parseAbsURIrefFromText, parseLexURIrefFromText, parseURIref2FromText - -} - - {- - -- * Exports for parsers that embed Turtle in a bigger syntax - , TurtleParser, TurtleState(..), SpecialMap - - , getPrefix -- a combination of the old defaultPrefix and namedPrefix productions - , n3symbol -- replacement for uriRef2 -- TODO: check this is semantically correct - , quickVariable -- was varid - , lexUriRef - , document, subgraph - , newBlankNode - -} ) where @@ -72,7 +65,6 @@ import Swish.RDF.Graph ( RDFGraph, RDFLabel(..) - , ToRDFLabel(..) , NamespaceMap , addArc , setNamespaces @@ -99,7 +91,7 @@ , ichar , string , stringT - , symbol + , sepEndBy1 , isymbol , lexeme , whiteSpace @@ -111,8 +103,8 @@ import Control.Applicative import Control.Monad (foldM) -import Data.Char (chr, ord, isAsciiLower, isAsciiUpper, isDigit) -import Data.Maybe (fromMaybe, fromJust) +import Data.Char (chr, isAsciiLower, isAsciiUpper, isDigit, isHexDigit, ord, toLower) +import Data.Maybe (fromMaybe) import Data.Word (Word32) import Network.URI (URI(..), parseURIReference) @@ -198,14 +190,19 @@ -> ParseResult parseTurtle txt mbase = parseAnyfromText turtleDoc mbase txt +{- hashURI :: URI hashURI = fromJust $ parseURIReference "#" +-} +-- | The W3C turtle tests - e.g. - +-- point out there's no default prefix mapping. +-- emptyState :: Maybe URI -- ^ starting base for the graph -> TurtleState emptyState mbase = - let pmap = M.singleton Nothing hashURI + let pmap = M.empty -- M.singleton Nothing hashURI buri = fromMaybe (getScopedNameURI defaultBase) mbase in TurtleState { graphState = emptyRDFGraph @@ -258,14 +255,29 @@ match :: (Ord a) => a -> [(a,a)] -> Bool match v = any (\(l,h) -> v >= l && v <= h) --- a specialization of bracket -br :: String -> String -> TurtleParser a -> TurtleParser a -br lsym rsym = bracket (symbol lsym) (symbol rsym) +-- a specialization of bracket that ensures white space after +-- the bracket symbol is parsed. +br :: Char -> Char -> TurtleParser a -> TurtleParser a +br lsym rsym = + let f = lexeme . char + in bracket (f lsym) (f rsym) -- this is a lot simpler than N3 atWord :: T.Text -> TurtleParser () atWord s = char '@' *> lexeme (stringT s) *> pure () +-- | Case insensitive match. +charI :: + Char -- ^ must be upper case + -> TurtleParser Char +charI c = satisfy (`elem` c : [ toLower c ]) + +-- | Case insensitive match. +stringI :: + String -- ^ must be upper case + -> TurtleParser String +stringI = mapM charI + {- Add statement to graph in the parser state; there is a special case for the special-case literals in the grammar since we need to ensure @@ -292,19 +304,6 @@ isaZ09 c = isaZ c || is09 c {- -Convert a string representing a double into canonical -XSD form. The input string is assumed to be syntactically -valid so we use read rather than reads. We use the String read -rather than Text one because of issues I have had in some tests -with the accuracy of the Text one. --} -d2s :: L.Text -> RDFLabel -d2s = - let conv :: String -> Double - conv = read - in toRDFLabel . conv . L.unpack - -{- Since operatorLabel can be used to add a label with an unknown namespace, we need to ensure that the namespace is added if not known. If the namespace prefix is already @@ -346,11 +345,28 @@ Just uri -> return $ makeNamespace (Just pre) uri Nothing -> failBad $ "Undefined prefix '" ++ T.unpack pre ++ ":'." +-- | Add the message to the start of the error message if the +-- parser fails (a minor specialization of 'adjustErr'). + {- +addErr :: Parser s a -> String -> Parser s a +addErr p m = adjustErr p (m++) +-} -Syntax productions; the Turtle NBF grammar elements are from -http://www.w3.org/TR/turtle/turtle.bnf +( String -- ^ Error message to add (a new line is added after the message) + -> Parser s a +( infixl 3 +infixl 4 (whiteSpace *> many statement *> eof *> stGet) @@ -369,158 +384,140 @@ mkGr s = setNamespaces (prefixUris s) (graphState s) {- -[2] statement ::= directive "." - | triples "." +[2] statement ::= directive | triples '.' -} statement :: TurtleParser () -statement = (directive <|> triples) *> fullStop +statement = directive <|> (triples *> fullStop) {- -[3] directive ::= prefixID - | base +[3] directive ::= prefixID | base | sparqlPrefix | sparqlBase + +With the addition of sparqlPrefix/sparqlBase (so '.' handling moved +into prefixID/base) may need to adjust use of lexeme. -} directive :: TurtleParser () -directive = lexeme (prefixID <|> base) +directive = + lexeme + (prefixID base sparqlPrefix sparqlBase > _iriRef >>= stUpdate . setBase +base = do + atWord "base" + b <- commit $ lexeme _iriRef + fullStop + stUpdate $ setBase b {- -[6] triples ::= subject predicateObjectList +[5s] sparqlBase ::= "BASE" IRIREF -} +sparqlBase :: TurtleParser () +sparqlBase = lexeme (stringI "BASE") >> commit _iriRef >>= stUpdate . setBase +{- +[6s] sparqlPrefix ::= "PREFIX" PNAME_NS IRIREF +-} +sparqlPrefix :: TurtleParser () +sparqlPrefix = do + ignore $ lexeme $ stringI "PREFIX" + p <- commit $ lexeme _pnameNS + u <- lexeme _iriRef + stUpdate $ setPrefix (fmap L.toStrict p) u + +{- +[6] triples ::= subject predicateObjectList | blankNodePropertyList predicateObjectList? +-} + triples :: TurtleParser () -triples = subject >>= predicateObjectList +triples = + (subject >>= predicateObjectList) + <|> + (blankNodePropertyList >>= ignore . optional . predicateObjectList) {- -[7] predicateObjectList ::= verb objectList ( ";" verb objectList )* (";")? +[7] predicateObjectList ::= verb objectList (';' (verb objectList)?)* -} predicateObjectList :: RDFLabel -> TurtleParser () predicateObjectList subj = let term = verb >>= objectList subj - in sepBy1 term semiColon *> ignore (optional semiColon) - -- in sepBy1 (lexeme term) semiColon *> ignore (optional semiColon) - + in ignore $ sepEndBy1 term (many1 semiColon) + {- -[8] objectList ::= object ( "," object )* +[8] objectList ::= object (',' object)* -} objectList :: RDFLabel -> RDFLabel -> TurtleParser () objectList subj prd = sepBy1 object comma >>= mapM_ (addStatement subj prd) {- -[9] verb ::= predicate - | "a" +[9] verb ::= predicate | 'a' -} verb :: TurtleParser RDFLabel verb = predicate <|> (lexeme (char 'a') *> operatorLabel rdfType) {- -[10] subject ::= IRIref - | blank +[10] subject ::= iri | BlankNode | collection -} subject :: TurtleParser RDFLabel -subject = (Res <$> iriref) <|> blank +subject = (Res <$> iri) <|> blankNode <|> collection {- -[11] predicate ::= IRIref +[11] predicate ::= iri -} predicate :: TurtleParser RDFLabel -predicate = Res <$> iriref +predicate = Res <$> iri {- -[12] object ::= IRIref - | blank - | literal +[12] object ::= iri | BlankNode | collection | blankNodePropertyList | literal -} object :: TurtleParser RDFLabel -object = (Res <$> iriref) <|> blank <|> literal +object = (Res <$> iri) <|> blankNode <|> collection <|> + blankNodePropertyList <|> literal {- -[13] literal ::= RDFLiteral - | NumericLiteral - | BooleanLiteral +[13] literal ::= RDFLiteral | NumericLiteral | BooleanLiteral -} literal :: TurtleParser RDFLabel literal = lexeme $ rdfLiteral <|> numericLiteral <|> booleanLiteral {- -[14] blank ::= BlankNode - | blankNodePropertyList - | collection - -Since both BlankNode and blankNodePropertyList can match '[ ... ]' we pull -that out and treat this as - - blank ::= BLANK_NODE_LABEL - | "[" (predicateObjectList | WS*) "]" - | collection - -blank :: TurtleParser RDFLabel -blank = lexeme (blankNode <|> blankNodePropertyList <|> collection) - +[14] blankNodePropertyList ::= '[' predicateObjectList ']' -} -blank :: TurtleParser RDFLabel -blank = lexeme (_blankNodeLabel - <|> - bracket (char '[') (char ']') handleBlankNode - <|> - collection - ) - -{- -[15] blankNodePropertyList ::= "[" predicateObjectList "]" - -We now match the brackets in the parent rule. - blankNodePropertyList :: TurtleParser RDFLabel blankNodePropertyList = do bNode <- newBlankNode - -- br "[" "]" (predicateObjectList bNode) - bracket (satisfy (=='[')) - (satisfy (==']')) - (_manyws *> predicateObjectList bNode *> _manyws) - -- ignore (optional _manyws) -- TODO: this is a hack - return bNode - --} - -handleBlankNode :: TurtleParser RDFLabel -handleBlankNode = do - bNode <- newBlankNode - _manyws - ignore $ optional $ predicateObjectList bNode - _manyws + br '[' ']' $ lexeme (predicateObjectList bNode) return bNode - {- -[16] collection ::= "(" object* ")" +[15] collection ::= '(' object* ')' -} - collection :: TurtleParser RDFLabel collection = do - os <- br "(" ")" (many object) + os <- br '(' ')' $ many object eNode <- operatorLabel rdfNil case os of [] -> return eNode @@ -544,157 +541,93 @@ return bNode {- -[17] ::= "@base" --} +[16] NumericLiteral ::= INTEGER | DECIMAL | DOUBLE -_base :: TurtleParser () -_base = atWord "base" +NOTE: We swap the order from this production -{- -[18] ::= "@prefix" +I have removed the conversion to a canonical form for +the double production, since it makes running the W3C +tests for Turtle harder (since it assumes that "1E0" +is passed through as is). It is also funny to +create a "canonical" form for only certain data types. -} - -_prefix :: TurtleParser () -_prefix = atWord "prefix" +numericLiteral :: TurtleParser RDFLabel +numericLiteral = + let f t v = makeDatatypedLiteral t (L.toStrict v) + in (f xsdDouble <$> _double) + <|> + (f xsdDecimal <$> _decimal) + <|> + (f xsdInteger <$> _integer) {- -[19] ::= ( "\\u" [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] ) - | ( "\\U" [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] - [0-9a-fA-F] [0-9a-fA-F] [0-9a-fA-F] ) - --} - -_uchar :: TurtleParser Char -_uchar = char '\\' *> _uchar' - -_uchar' :: TurtleParser Char -_uchar' = (char 'u' *> hex4) <|> (char 'U' *> hex8) +[128s] RDFLiteral ::= String (LANGTAG | '^^' iri)? -{- -[60s] RDFLiteral ::= String ( LANGTAG | ( "^^" IRIref ) )? +TODO: remove 'Lit lbl' form, since dtype=xsd:string in this case. -} - rdfLiteral :: TurtleParser RDFLabel rdfLiteral = do lbl <- L.toStrict <$> turtleString - opt <- optional ((Left <$> _langTag) <|> (string "^^" *> (Right <$> iriref))) + opt <- optional ((Left <$> _langTag) + <|> + (string "^^" *> (Right <$> commit iri))) + ignore $ optional whiteSpace return $ case opt of Just (Left lcode) -> LangLit lbl lcode Just (Right dtype) -> TypedLit lbl dtype _ -> Lit lbl {- -[61s] NumericLiteral ::= NumericLiteralUnsigned - | NumericLiteralPositive - | NumericLiteralNegative --} - -numericLiteral :: TurtleParser RDFLabel -numericLiteral = numericLiteralNegative <|> numericLiteralPositive <|> numericLiteralUnsigned - -{- -[62s] NumericLiteralUnsigned ::= INTEGER - | DECIMAL - | DOUBLE --} - -numericLiteralUnsigned :: TurtleParser RDFLabel -numericLiteralUnsigned = - d2s <$> _double - <|> - (makeDatatypedLiteral xsdDecimal . L.toStrict <$> _decimal) - <|> - (makeDatatypedLiteral xsdInteger . L.toStrict <$> _integer) - -{- -[63s] NumericLiteralPositive ::= INTEGER_POSITIVE - | DECIMAL_POSITIVE - | DOUBLE_POSITIVE --} - -numericLiteralPositive :: TurtleParser RDFLabel -numericLiteralPositive = - d2s <$> _doublePositive - <|> - (makeDatatypedLiteral xsdDecimal . L.toStrict <$> _decimalPositive) - <|> - (makeDatatypedLiteral xsdInteger . L.toStrict <$> _integerPositive) - -{- -[64s] NumericLiteralNegative ::= INTEGER_NEGATIVE - | DECIMAL_NEGATIVE - | DOUBLE_NEGATIVE --} - -numericLiteralNegative :: TurtleParser RDFLabel -numericLiteralNegative = - d2s <$> _doubleNegative - <|> - (makeDatatypedLiteral xsdDecimal . L.toStrict <$> _decimalNegative) - <|> - (makeDatatypedLiteral xsdInteger . L.toStrict <$> _integerNegative) - -{- -[65s] BooleanLiteral ::= "true" - | "false" +[133s] BooleanLiteral ::= 'true' | 'false' -} - booleanLiteral :: TurtleParser RDFLabel -booleanLiteral = makeDatatypedLiteral xsdBoolean . T.pack <$> (string "true" <|> string "false") +booleanLiteral = makeDatatypedLiteral xsdBoolean . T.pack <$> lexeme (string "true" <|> string "false") {- -[66s] String ::= STRING_LITERAL1 - | STRING_LITERAL2 - | STRING_LITERAL_LONG1 - | STRING_LITERAL_LONG2 +[17] String ::= STRING_LITERAL_QUOTE | STRING_LITERAL_SINGLE_QUOTE | STRING_LITERAL_LONG_SINGLE_QUOTE | STRING_LITERAL_LONG_QUOTE -} - turtleString :: TurtleParser L.Text turtleString = lexeme ( - _stringLiteralLong1 <|> _stringLiteral1 <|> - _stringLiteralLong2 <|> _stringLiteral2) + _stringLiteralLongQuote <|> _stringLiteralQuote <|> + _stringLiteralLongSingleQuote <|> _stringLiteralSingleQuote + ) {- -[67s] IRIref ::= IRI_REF - | PrefixedName +[135s] iri ::= IRIREF | PrefixedName -} - -iriref :: TurtleParser ScopedName -iriref = lexeme ((makeURIScopedName <$> _iriRef) <|> prefixedName) +iri :: TurtleParser ScopedName +iri = lexeme ( + (makeURIScopedName <$> _iriRef) + <|> + prefixedName) {- -[68s] PrefixedName ::= PNAME_LN - | PNAME_NS +[136s] PrefixedName ::= PNAME_LN | PNAME_NS -} - prefixedName :: TurtleParser ScopedName prefixedName = _pnameLN <|> flip makeNSScopedName emptyLName <$> (_pnameNS >>= findPrefixNamespace) {- -[69s] BlankNode ::= BLANK_NODE_LABEL - | ANON - +[137s] BlankNode ::= BLANK_NODE_LABEL | ANON +-} blankNode :: TurtleParser RDFLabel blankNode = lexeme (_blankNodeLabel <|> _anon) --} +{--- Productions for terminals ---} {- -[70s] ::= "<" ( [^<>\"{}|^`\\] - [#0000- ] | UCHAR )* ">" - -Read [#0000- ] as [#x00-#x20] from -http://lists.w3.org/Archives/Public/public-rdf-comments/2011Aug/0011.html - -Unlike N3, whitespace is significant within the surrounding <>. +[18] IRIREF ::= '<' ([^#x00-#x20<>\"{}|^`\] | UCHAR)* '>' -} - _iriRef :: TurtleParser URI _iriRef = do - ignore $ char '<' - ustr <- manyFinally' iriRefChar (char '>') + -- ignore $ char '<' + -- why a, I using manyFinally' here? '>' shouldn't overlap + -- with iriRefChar. + -- ustr <- manyFinally' iriRefChar (char '>') + ustr <- bracket (char '<') (commit (char '>')) (many iriRefChar) case parseURIReference ustr of Nothing -> failBad $ "Invalid URI: <" ++ ustr ++ ">" Just uref -> do @@ -702,24 +635,23 @@ either fail return $ appendURIs (baseUri s) uref iriRefChar :: TurtleParser Char -iriRefChar = satisfy notIRIChar <|> _uchar +iriRefChar = satisfy isIRIChar <|> _uchar -notIRIChar :: Char -> Bool -notIRIChar c = c >= chr 0x20 - && - c `notElem` "^<>\"{}|^`\\" +isIRIChar :: Char -> Bool +isIRIChar c = + c > chr 0x20 + && + c `notElem` "<>\"{}|^`\\" {- -[71s] ::= (PN_PREFIX)? ":" +[139s] PNAME_NS ::= PN_PREFIX? ':' -} - _pnameNS :: TurtleParser (Maybe L.Text) _pnameNS = optional _pnPrefix <* char ':' {- -[72s] ::= PNAME_NS PN_LOCAL +[140s] PNAME_LN ::= PNAME_NS PN_LOCAL -} - _pnameLN :: TurtleParser ScopedName _pnameLN = do ns <- _pnameNS >>= findPrefixNamespace @@ -729,133 +661,223 @@ _ -> fail $ "Invalid local name: '" ++ T.unpack l ++ "'" {- -[73s] ::= "_:" PN_LOCAL +[141s] BLANK_NODE_LABEL ::= '_:' (PN_CHARS_U | [0-9]) ((PN_CHARS | '.')* PN_CHARS)? -} - _blankNodeLabel :: TurtleParser RDFLabel -_blankNodeLabel = (Blank . L.unpack) <$> (string "_:" *> _pnLocal) +_blankNodeLabel = do + ignore $ string "_:" + fChar <- _pnCharsU <|> satisfy is09 + rest <- _pnRest + return $ Blank $ fChar : L.unpack rest {- +Extracted from BLANK_NODE_LABEL and PN_PREFIX -These are unused in the grammar. + :== ( ( PN_CHARS | '.' )* PN_CHARS )? -[74s] ::= "?" VARNAME -[75s] ::= "$" VARNAME +We assume below that the match is only ever done for small strings, so +the cost isn't likely to be large. Let's see how well this assumption +holds up. + -} +_pnRest :: TurtleParser L.Text +_pnRest = noTrailingDot _pnChars + {- -[76s] ::= BASE - | PREFIX - | "@" [a-zA-Z]+ ( "-" [a-zA-Z0-9]+ )* +There are two productions which look like -I am ignoring the BASE and PREFIX lines here as they don't make sense to me. + ( (parser | '.')* parser )? + +Unfortunately one of them has parser returning a Char and the +other has the parser returning multiple characters, so separate +out for now; hopefully can combine + +Have decided to try replacing this with sepEndBy1, treating the '.' +as a separator, since this is closer to the EBNF. However, this +then eats up multiple '.' characters. + +noTrailingDot :: + TurtleParser Char -- ^ This *should not* match '.' + -> TurtleParser L.Text +noTrailingDot p = do + terms <- sepEndBy1 (many p) (char '.') + return $ L.pack $ intercalate "." terms + +noTrailingDotM :: + TurtleParser L.Text -- ^ This *should not* match '.' + -> TurtleParser L.Text +noTrailingDotM p = do + terms <- sepEndBy1 (many p) (char '.') + return $ L.intercalate "." $ map L.concat terms + -} --- Note that toLangTag may fail since it does some extra --- validation not done by the parser (mainly on the length of the --- primary and secondary tags). --- --- NOTE: This parser does not accept multiple secondary tags which RFC3066 --- does. --- +noTrailing :: + TurtleParser a -- ^ parser for '.' + -> ([a] -> String) -- ^ Collect fragments into a string + -> TurtleParser a -- ^ This *should not* match '.' + -> TurtleParser L.Text +noTrailing dotParser conv parser = do + lbl <- many (parser <|> dotParser) + let (nret, lclean) = clean $ conv lbl + + -- a simple difference list implementation + edl = id + snocdl x xs = xs . (x:) + appenddl = (.) + replicatedl n x = (replicate n x ++) + + -- this started out as a simple automaton/transducer from + -- http://www.haskell.org/pipermail/haskell-cafe/2011-September/095347.html + -- but then I decided to complicate it + -- + clean :: String -> (Int, String) + clean = go 0 edl + where + go n acc [] = (n, acc []) + go n acc ('.':xs) = go (n+1) acc xs + go 0 acc (x:xs) = go 0 (snocdl x acc) xs + go n acc (x:xs) = go 0 (appenddl acc (snocdl x (replicatedl n '.'))) xs + + reparse $ L.replicate (fromIntegral nret) "." + return $ L.pack lclean + +noTrailingDot :: + TurtleParser Char -- ^ This *should not* match '.' + -> TurtleParser L.Text +noTrailingDot = noTrailing (char '.') id + +noTrailingDotM :: + TurtleParser L.Text -- ^ This *should not* match '.' + -> TurtleParser L.Text +noTrailingDotM = noTrailing (char '.' *> pure ".") (L.unpack . L.concat) + +{- +[144s] LANGTAG ::= '@' [a-zA-Z]+ ('-' [a-zA-Z0-9]+)* + +Note that toLangTag may fail since it does some extra +validation not done by the parser (mainly on the length of the +primary and secondary tags). + +NOTE: This parser does not accept multiple secondary tags which RFC3066 +does. + +-} _langTag :: TurtleParser LanguageTag _langTag = do ichar '@' - h <- many1Satisfy isaZ + h <- commit $ many1Satisfy isaZ mt <- optional (L.cons <$> char '-' <*> many1Satisfy isaZ09) let lbl = L.toStrict $ L.append h $ fromMaybe L.empty mt case toLangTag lbl of Just lt -> return lt _ -> fail ("Invalid language tag: " ++ T.unpack lbl) -- should this be failBad? - + +-- Returns True for + and False for -. +_leadingSign :: TurtleParser (Maybe Bool) +_leadingSign = do + ms <- optional (satisfy (`elem` "+-")) + return $ (=='+') `fmap` ms + {- -[77s] ::= [0-9]+ +For when we tried to create a canonical representation. +addSign :: Maybe Bool -> L.Text -> L.Text +addSign (Just False) t = L.cons '-' t +addSign _ t = t -} -_integer :: TurtleParser L.Text -_integer = many1Satisfy is09 +addSign :: Maybe Bool -> L.Text -> L.Text +addSign (Just True) t = L.cons '+' t +addSign (Just _) t = L.cons '-' t +addSign _ t = t {- -[78s] ::= [0-9]+ "." [0-9]* - | "." [0-9]+ +[19] INTEGER ::= [+-]? [0-9]+ We try to produce a canonical form for the numbers. -} -_decimal :: TurtleParser L.Text -_decimal = - let dpart = L.cons <$> char '.' <*> (fromMaybe "0" <$> optional _integer) - in - (L.append <$> _integer <*> dpart) - <|> - (L.append "0." <$> (char '.' *> _integer)) +_integer :: TurtleParser L.Text +_integer = do + ms <- _leadingSign + rest <- many1Satisfy is09 + return $ addSign ms rest {- -[79s] ::= [0-9]+ "." [0-9]* EXPONENT - | "." ( [0-9] )+ EXPONENT - | ( [0-9] )+ EXPONENT - -Unlike _decimal, the canonical form is enforced -later on, although it could be done here. +[20] DECIMAL ::= [+-]? [0-9]* '.' [0-9]+ -} -_double :: TurtleParser L.Text -_double = - (L.append <$> _decimal <*> _exponent) - <|> - (L.append <$> _integer <*> _exponent) +_decimal :: TurtleParser L.Text +_decimal = do + ms <- _leadingSign + leading <- manySatisfy is09 + ichar '.' + trailing <- many1Satisfy is09 + let ans2 = L.cons '.' trailing + ans = if L.null leading + -- then L.cons '0' ans2 -- create a 'canonical' version + then ans2 + else L.append leading ans2 + return $ addSign ms ans {- -[80s] ::= "+" INTEGER -[81s] ::= "+" DECIMAL -[82s] ::= "+" DOUBLE +[21] DOUBLE ::= [+-]? ([0-9]+ '.' [0-9]* EXPONENT | '.' [0-9]+ EXPONENT | [0-9]+ EXPONENT) + -} +_d1 :: TurtleParser L.Text +_d1 = do + a <- many1Satisfy is09 + ichar '.' + b <- manySatisfy is09 + return $ a `L.append` ('.' `L.cons` b) -_integerPositive, _decimalPositive, _doublePositive :: TurtleParser L.Text -_integerPositive = char '+' *> _integer -_decimalPositive = char '+' *> _decimal -_doublePositive = char '+' *> _double +_d2 :: TurtleParser L.Text +_d2 = do + ichar '.' + b <- many1Satisfy is09 + return $ '.' `L.cons` b -{- -[83s] ::= "-" INTEGER -[84s] ::= "-" DECIMAL -[85s] ::= "-" DOUBLE --} +_d3 :: TurtleParser L.Text +_d3 = many1Satisfy is09 -_integerNegative, _decimalNegative, _doubleNegative :: TurtleParser L.Text -_integerNegative = L.cons <$> char '-' <*> _integer -_decimalNegative = L.cons <$> char '-' <*> _decimal -_doubleNegative = L.cons <$> char '-' <*> _double +_double :: TurtleParser L.Text +_double = do + ms <- _leadingSign + leading <- _d1 <|> _d2 <|> _d3 + e <- _exponent + return $ addSign ms $ leading `L.append` e {- -[86s] ::= [eE] [+-]? [0-9]+ +[154s] EXPONENT ::= [eE] [+-]? [0-9]+ -} - _exponent :: TurtleParser L.Text _exponent = do - ignore $ satisfy (`elem` "eE") - ms <- optional (satisfy (`elem` "+-")) - e <- _integer - case ms of - Just '-' -> return $ L.append "E-" e - _ -> return $ L.cons 'E' e - + e <- char 'e' <|> char 'E' + ms <- _leadingSign + ep <- _integer + return $ L.cons e $ addSign ms ep + {- -[87s] ::= "'" ( ( [^'\\\n\r] ) | ECHAR | UCHAR )* "'" -[88s] ::= '"' ( ( [^\"\\\n\r] ) | ECHAR | UCHAR )* '"' -[89s] ::= "'''" ( ( "'" | "''" )? ( [^'\\] | ECHAR | UCHAR ) )* "'''" -[90s] ::= '"""' ( ( '"' | '""' )? ( [^\"\\] | ECHAR | UCHAR ) )* '"""' +[22] STRING_LITERAL_QUOTE ::= '"' ([^#x22#x5C#xA#xD] | ECHAR | UCHAR)* '"' +[23] STRING_LITERAL_SINGLE_QUOTE ::= "'" ([^#x27#x5C#xA#xD] | ECHAR | UCHAR)* "'" +[24] STRING_LITERAL_LONG_SINGLE_QUOTE ::= "'''" (("'" | "''")? [^'\] | ECHAR | UCHAR)* "'''" +[25] STRING_LITERAL_LONG_QUOTE ::= '"""' (('"' | '""')? [^"\] | ECHAR | UCHAR)* '"""' -} -_stringLiteral1, _stringLiteral2 :: TurtleParser L.Text -_stringLiteral1 = _stringIt sQuot (_tChars "'\\\n\r") -_stringLiteral2 = _stringIt dQuot (_tChars "\"\\\n\r") +_exclSLQ, _exclSLSQ :: String +_exclSLQ = map chr [0x22, 0x5c, 0x0a, 0x0d] +_exclSLSQ = map chr [0x27, 0x5c, 0x0a, 0x0d] -_stringLiteralLong1, _stringLiteralLong2 :: TurtleParser L.Text -_stringLiteralLong1 = _stringItLong sQuot3 (_tCharsLong '\'' "'\\") -_stringLiteralLong2 = _stringItLong dQuot3 (_tCharsLong '"' "\"\\") +_stringLiteralQuote, _stringLiteralSingleQuote :: TurtleParser L.Text +_stringLiteralQuote = _stringIt dQuot (_tChars _exclSLQ) +_stringLiteralSingleQuote = _stringIt sQuot (_tChars _exclSLSQ) +_stringLiteralLongQuote, _stringLiteralLongSingleQuote :: TurtleParser L.Text +_stringLiteralLongQuote = _stringItLong dQuot3 (_tCharsLong '"') +_stringLiteralLongSingleQuote = _stringItLong sQuot3 (_tCharsLong '\'') + _stringIt :: TurtleParser a -> TurtleParser Char -> TurtleParser L.Text _stringIt sep chars = L.pack <$> bracket sep sep (many chars) @@ -866,12 +888,6 @@ _tChars excl = (char '\\' *> (_echar' <|> _uchar')) <|> noneOf excl -_tCharsLong :: Char -> String -> TurtleParser L.Text -_tCharsLong c excl = do - mq <- optional $ oneOrTwo c - r <- _tChars excl - return $ L.append (fromMaybe L.empty mq) (L.singleton r) - oneOrTwo :: Char -> TurtleParser L.Text oneOrTwo c = do a <- char c @@ -880,10 +896,29 @@ Just b -> return $ L.pack [a,b] _ -> return $ L.singleton a +_multiQuote :: Char -> TurtleParser L.Text +_multiQuote c = do + mq <- optional (oneOrTwo c) + r <- noneOf (c : "\\") + return $ fromMaybe L.empty mq `L.snoc` r + +_tCharsLong :: Char -> TurtleParser L.Text +_tCharsLong c = + let conv = (L.singleton `fmap`) + in _multiQuote c <|> conv (_echar <|> _uchar) + {- -[91s] ::= "\\" [tbnrf\\\"'] +[26] UCHAR ::= '\u' HEX HEX HEX HEX | '\U' HEX HEX HEX HEX HEX HEX HEX HEX -} +_uchar :: TurtleParser Char +_uchar = char '\\' >> _uchar' +_uchar' :: TurtleParser Char +_uchar' = (char 'u' *> hex4) <|> (char 'U' *> hex8) + +{- +[159s] ECHAR ::= '\' [tbnrf\"'] +-} _echar :: TurtleParser Char _echar = char '\\' *> _echar' @@ -893,59 +928,31 @@ (char 'b' *> pure '\b') <|> (char 'n' *> pure '\n') <|> (char 'r' *> pure '\r') <|> + (char 'f' *> pure '\f') <|> (char '\\' *> pure '\\') <|> (char '"' *> pure '"') <|> (char '\'' *> pure '\'') - {- - -Unused. - -[92s] ::= "(" (WS)* ")" +[161s] WS ::= #x20 | #x9 | #xD | #xA -} -{- -[93s] ::= " " - | "\t" - | "\r" - | "\n" - _ws :: TurtleParser () -_ws = ignore $ satisfy (`elem` " \t\r\n") - --} +_ws = ignore $ satisfy (`elem` _wsChars) -_manyws :: TurtleParser () -_manyws = ignore $ manySatisfy (`elem` " \t\r\n") +_wsChars :: String +_wsChars = map chr [0x20, 0x09, 0x0d, 0x0a] {- -[94s] ::= "[" (WS)* "]" - -Unused as we do not support the use of ANON in the BlankNode -terminal. +[162s] ANON ::= '[' WS* ']' +-} _anon :: TurtleParser RDFLabel -_anon = br "[" "]" _manyws *> newBlankNode - --} +_anon = + br '[' ']' (many _ws) >> newBlankNode {- -[95s] ::= [A-Z] - | [a-z] - | [#00C0-#00D6] - | [#00D8-#00F6] - | [#00F8-#02FF] - | [#0370-#037D] - | [#037F-#1FFF] - | [#200C-#200D] - | [#2070-#218F] - | [#2C00-#2FEF] - | [#3001-#D7FF] - | [#F900-#FDCF] - | [#FDF0-#FFFD] - | [#10000-#EFFFF] - | UCHAR +[163s] PN_CHARS_BASE ::= [A-Z] | [a-z] | [#x00C0-#x00D6] | [#x00D8-#x00F6] | [#x00F8-#x02FF] | [#x0370-#x037D] | [#x037F-#x1FFF] | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF] TODO: may want to make this a Char -> Bool selector for use with manySatisfy rather than a combinator. @@ -959,116 +966,67 @@ (0x370, 0x37d), (0x37f, 0x1fff), (0x200c, 0x200d), (0x2070, 0x218f), (0x2c00, 0x2fef), (0x3001, 0xd7ff), (0xf900, 0xfdcf), (0xfdf0, 0xfffd), (0x10000, 0xeffff)] - in satisfy f <|> _uchar + in satisfy f {- -[96s] ::= PN_CHARS_BASE - | "_" +[164s] PN_CHARS_U ::= PN_CHARS_BASE | '_' +[166s] PN_CHARS ::= PN_CHARS_U | '-' | [0-9] | #x00B7 | [#x0300-#x036F] | [#x203F-#x2040] -} -_pnCharsU :: TurtleParser Char +_pnCharsU, _pnChars :: TurtleParser Char _pnCharsU = _pnCharsBase <|> char '_' - -{- - -Only used in VAR1/2 rules which are themselves unused. - -Unused in the grammar (other than -[97s] ::= ( PN_CHARS_U | [0-9] ) ( PN_CHARS_U | [0-9] | #00B7 | [#0300-#036F] | [# - 203F-#2040] )* --} - -{- -[98s] ::= PN_CHARS_U - | "-" - | [0-9] - | #00B7 - | [#0300-#036F] - | [#203F-#2040] --} - -_pnChars :: TurtleParser Char -_pnChars = - _pnCharsU - <|> - satisfy (\c -> let i = ord c - in c == '-' || isDigit c || i == 0xb7 || - match i [(0x0300, 0x036f), (0x203f, 0x2040)]) +_pnChars = + let f c = let i = ord c + in match i [(0x300, 0x36f), (0x203f, 0x2040)] + in _pnCharsU <|> char '-' <|> satisfy is09 <|> + char (chr 0xb7) <|> satisfy f {- -[99s] ::= PN_CHARS_BASE ( ( PN_CHARS | "." )* PN_CHARS )? +[167s] PN_PREFIX ::= PN_CHARS_BASE ((PN_CHARS | '.')* PN_CHARS)? +[168s] PN_LOCAL ::= (PN_CHARS_U | ':' | [0-9] | PLX) ((PN_CHARS | '.' | ':' | PLX)* (PN_CHARS | ':' | PLX))? -} _pnPrefix :: TurtleParser L.Text _pnPrefix = L.cons <$> _pnCharsBase <*> _pnRest - -{- -[100s] ::= ( PN_CHARS_U | [0-9] ) ( ( PN_CHARS | "." )* PN_CHARS )? --} _pnLocal :: TurtleParser L.Text -_pnLocal = L.cons <$> (_pnCharsU <|> satisfy is09) - <*> _pnRest +_pnLocal = do + s <- L.singleton <$> (_pnCharsU <|> char ':' <|> satisfy is09) + <|> _plx + e <- noTrailingDotM (L.singleton <$> (_pnChars <|> char ':') <|> _plx) + return $ s `L.append` e {- -Extracted from PN_PREFIX and PN_LOCAL is - - :== ( ( PN_CHARS | "." )* PN_CHARS )? - -We assume below that the match is only ever done for small strings, so -the cost of the foldr isn't likely to be large. Let's see how well -this assumption holds up. +[169s] PLX ::= PERCENT | PN_LOCAL_ESC +[170s] PERCENT ::= '%' HEX HEX +[171s] HEX ::= [0-9] | [A-F] | [a-f] +[172s] PN_LOCAL_ESC ::= '\' ('_' | '~' | '.' | '-' | '!' | '$' | '&' | "'" | '(' | ')' | '*' | '+' | ',' | ';' | '=' | '/' | '?' | '#' | '@' | '%') +We do not convert hex-encoded values into the characters, which +means we have to deal with Text rather than Char for these +parsers, which is annoying. -} -_pnRest :: TurtleParser L.Text -_pnRest = do - lbl <- many (_pnChars <|> char '.') - let (nret, lclean) = clean lbl - - -- a simple difference list implementation - edl = id - snocdl x xs = xs . (x:) - appenddl = (.) - replicatedl n x = (replicate n x ++) - - -- this started out as a simple automaton/transducer from - -- http://www.haskell.org/pipermail/haskell-cafe/2011-September/095347.html - -- but then I decided to complicate it - -- - clean :: String -> (Int, String) - clean = go 0 edl - where - go n acc [] = (n, acc []) - go n acc ('.':xs) = go (n+1) acc xs - go 0 acc (x:xs) = go 0 (snocdl x acc) xs - go n acc (x:xs) = go 0 (appenddl acc (snocdl x (replicatedl n '.'))) xs - - reparse $ L.replicate (fromIntegral nret) (L.singleton '.') - return $ L.pack lclean - -{- -Original from - - chop = go 0 [] - where - -- go :: State -> Stack -> String -> String - go 0 _ [] = [] - go 0 _ (x:xs) - | isSpace x = go 1 [x] xs - | otherwise = x : go 0 xs +_plx, _percent :: TurtleParser L.Text +_plx = _percent <|> (L.singleton <$> _pnLocalEsc) - go 1 ss [] = [] - go 1 ss (x:xs) - | isSpace c = go 1 (x:ss) xs - | otherwise = reverse ss ++ x : go 0 xs +_percent = do + ichar '%' + a <- _hex + b <- _hex + return $ L.cons '%' $ L.cons a $ L.singleton b --} +_hex, _pnLocalEsc :: TurtleParser Char +_hex = satisfy isHexDigit +_pnLocalEsc = char '\\' *> satisfy (`elem` _pnLocalEscChars) + +_pnLocalEscChars :: String +_pnLocalEscChars = "_~.-!$&'()*+,;=/?#@%" -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, --- 2011, 2012 Douglas Burke +-- 2011, 2012, 2013 Douglas Burke -- All rights reserved. -- -- This file is part of Swish. diff --git a/swish.cabal b/swish.cabal --- a/swish.cabal +++ b/swish.cabal @@ -1,5 +1,5 @@ Name: swish -Version: 0.9.0.3 +Version: 0.9.0.4 Stability: experimental License: LGPL License-file: LICENSE @@ -44,6 +44,31 @@ . * Complete, ready-to-run, command-line and script-driven programs. . + Changes in version @0.9.0.4@: + . + * Turtle parser: updated to the Candidate Recommendation (19 February 2013) + specification; added minor improvements to error messages when + given invalid syntax. As part of the upgrade, there is no longer a + default namespace set up for the empty prefix and numeric literals + are no-longer converted into a canonical form. + . + * Turtle/N3 output: improved string formatting (better handling of + string literals with three or more consecutive @\"@ characters); blank + node handling has been improved but the output may not be as elegant. + . + * NTriples parser: now accepts upper-case language tags such as + @en-UK@ (case is preserved). + . + * @Swish.QName.LName@ names can now contain @#@, @:@ and @/@ characters. + . + * Added tests for the Turtle parser and formatter. + . + * The new @w3ctests@ flag will build the @runw3ctests@ executable, + which will run the W3C Turtle tests (if downloaded from + ). + . + * Minor fixes and additions to the documentation. + . Changes in version @0.9.0.3@: . * Minor Haddock fix to @Swish.RDF.Parser.Utils.appendURIs@. @@ -88,16 +113,17 @@ Description: Turn on developer flags Default: False --- Flag hpc --- Description: Use Hpc for the tests --- Default: False +Flag w3ctests + Description: Build the RunW3CTests application + Default: False Library Build-Depends: base >=3 && < 5, containers >= 0.4 && < 0.6, filepath >= 1.1 && < 1.4, - hashable >= 1.1 && < 1.3, + -- Early versions of hashable 1.2 are problematic + hashable (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3), mtl >= 2 && < 3, network >= 2.2 && < 2.5, old-locale == 1.0.*, @@ -245,6 +271,23 @@ swish, text +Test-Suite test-turtle + type: exitcode-stdio-1.0 + Hs-Source-Dirs: tests/ + Main-Is: TurtleTest.hs + Other-Modules: TestHelpers + + ghc-options: + -Wall -fno-warn-orphans + + Build-Depends: + base, + containers, + HUnit, + network, + swish, + text + Test-Suite test-n3parser type: exitcode-stdio-1.0 Hs-Source-Dirs: tests/ @@ -450,3 +493,27 @@ Build-Depends: base, swish + +Executable runw3ctests + Main-Is: RunW3CTests.hs + Hs-Source-Dirs: app/ + -- Other-Modules: Paths_swish + + ghc-options: + -Wall -fno-warn-orphans + + if flag(developer) + ghc-options: -Werror + ghc-prof-options: -auto-all + + if flag(w3ctests) + Build-Depends: + base, + containers, + directory, + filepath, + network, + swish, + text + else + Buildable: False diff --git a/tests/N3FormatterTest.hs b/tests/N3FormatterTest.hs --- a/tests/N3FormatterTest.hs +++ b/tests/N3FormatterTest.hs @@ -838,9 +838,14 @@ {- Simple troublesome case --} - -simpleN3Graph_x13a :: B.Builder + + +Changed Aug 15 2013 to support rendering + + _:a :knows _:b . _:b :knows _:a . + +which, as currently implemented, loses the ability to make the simplification below. + simpleN3Graph_x13a = mconcat [ commonPrefixes @@ -854,6 +859,24 @@ b2s = "[\n base1:p1 base2:o2\n]" b3s = "[\n base1:p1 base3:o3\n]" +-} + +simpleN3Graph_x13a :: B.Builder +simpleN3Graph_x13a = + mconcat + [ commonPrefixes + , "base1:s1 " + , b1n + , " ;\n ( ", b2n, " ", b3n, " ) .\n" + , b1n, " base1:p1 base1:o1 .\n" + , b2n, " base1:p1 base2:o2 .\n" + , b3n, " base1:p1 base3:o3 .\n" + ] + where + b1n = "_:swish1" + b2n = "_:swish2" + b3n = "_:swish3" + {- Simple collection tests; may replicate some of the previous tests. @@ -913,23 +936,44 @@ commonPrefixesN [0] `mappend` "[\n base1:p1 base1:o1\n] .\n" -simpleN3Graph_b2 :: B.Builder +{- +See discussion of simpleN3Graph_x13a for why this has been changed simpleN3Graph_b2 = commonPrefixesN [0,1,2] `mappend` "base1:s1 base1:p1 [\n base2:o2 base3:o3 ;\n base2:p2 \"l1\"\n] .\n" +-} +simpleN3Graph_b2 :: B.Builder +simpleN3Graph_b2 = + commonPrefixesN [0,1,2] `mappend` + "base1:s1 base1:p1 _:b1 .\n_:b1 base2:o2 base3:o3 ;\n base2:p2 \"l1\" .\n" + simpleN3Graph_b2rev :: B.Builder simpleN3Graph_b2rev = commonPrefixesN [0,1,2] `mappend` "[\n base1:p1 base1:o1 ;\n base2:o2 base3:o3 ;\n base2:p2 \"l1\"\n] .\n" -simpleN3Graph_b3 :: B.Builder +{- +See discussion of simpleN3Graph_x13a for why this has been changed + simpleN3Graph_b3 = mconcat [ commonPrefixesN [0,1,2] , "base1:s1 base1:p1 [\n base2:o2 base3:o3 ;\n base2:p2 \"\"\"", l2txt, "\"\"\"\n] ;\n" , " base2:p2 [] .\n" , "base2:s2 base2:p2 base2:o2 .\n" ] + +-} + +simpleN3Graph_b3 :: B.Builder +simpleN3Graph_b3 = + mconcat + [ commonPrefixesN [0,1,2] + , "base1:s1 base1:p1 _:b1 ;\n" + , " base2:p2 [] .\n" + , "base2:s2 base2:p2 base2:o2 .\n" + , "_:b1 base2:o2 base3:o3 ;\n base2:p2 \"\"\"", l2txt, "\"\"\" .\n" + ] simpleN3Graph_b4 :: B.Builder simpleN3Graph_b4 = diff --git a/tests/NTTest.hs b/tests/NTTest.hs --- a/tests/NTTest.hs +++ b/tests/NTTest.hs @@ -5,7 +5,7 @@ -------------------------------------------------------------------------------- -- | -- Module : NTTest --- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke +-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012, 2013 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke @@ -248,12 +248,19 @@ , checkGraph "graphm1r" graphm1r gm1 ] +oTests :: Test +oTests = + TestList + [ roundTrip "langtag" " \"Foo .\"@en-UK." + ] + allTests :: Test allTests = TestList [ rTests , eTests , gTests + , oTests ] main :: IO () @@ -262,7 +269,7 @@ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, --- 2011, 2012 Douglas Burke +-- 2011, 2012, 2013 Douglas Burke -- All rights reserved. -- -- This file is part of Swish. diff --git a/tests/TurtleTest.hs b/tests/TurtleTest.hs new file mode 100644 --- /dev/null +++ b/tests/TurtleTest.hs @@ -0,0 +1,728 @@ +{-# LANGUAGE OverloadedStrings #-} + +-------------------------------------------------------------------------------- +-- See end of this file for licence information. +-------------------------------------------------------------------------------- +-- | +-- Module : TurtleTest +-- Copyright : (c) 2013 Douglas Burke +-- License : GPL V2 +-- +-- Maintainer : Douglas Burke +-- Stability : experimental +-- Portability : OverloadedStrings +-- +-- This Module contains test cases for the module +-- "Swish.RDF.Parser.Turtle" and "Swish.RDF.Formatter.Turtle" based +-- on the examples given in +-- . +-- +-------------------------------------------------------------------------------- + +module Main where + +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Text.Lazy as L + +import Data.Maybe (fromMaybe) + +import Network.URI (URI, parseURIReference) + +import Swish.RDF.Graph ( RDFGraph + , RDFLabel (..) + , RDFTriple + , ToRDFLabel + -- , getArcs + , toRDFGraph + , toRDFTriple + ) + +import Swish.RDF.Formatter.Turtle (formatGraphAsText) +import Swish.RDF.Parser.Turtle (parseTurtle) +import Swish.RDF.Vocabulary.DublinCore (dcelemtitle) +import Swish.RDF.Vocabulary.FOAF (foafgivenName, foafknows, foafmbox, foafname, foafPerson) +import Swish.RDF.Vocabulary.RDF (rdfType, rdfFirst, rdfRest, rdfNil, rdfsLabel) +import Swish.RDF.Vocabulary.XSD (xsdDecimal, xsdDouble, xsdString) + +import Test.HUnit (Test(TestCase,TestList), (~=?), (~:), assertFailure) + +import TestHelpers (runTestSuite) + +triple :: (ToRDFLabel s, ToRDFLabel p, ToRDFLabel o) + => s -> p -> o -> RDFTriple +triple = toRDFTriple + +toURI :: String -> URI +toURI s = fromMaybe (error ("Internal error: invalid uri=" ++ s)) (parseURIReference s) + +toGraph :: T.Text -> Either String RDFGraph +toGraph = flip parseTurtle Nothing . L.fromStrict + +parseFail :: + String -- ^ error from parse + -> T.Text -- ^ original Turtle graph + -> String -- ^ label + -> Test +parseFail emsg gr lbl = + TestCase $ assertFailure $ concat + ["Unable to parse ", lbl, ":\n", emsg, "\n*** Turtle=\n", T.unpack gr] + +-- | Compare a Turtle format graph with its expected +-- contents. There is also a 'round trip' check, that +-- the contents, written out in Turtle format, then +-- read back in, match the original contents (this +-- only uses the list of triples, not the input Turtle +-- version). +-- +-- It is quicker to just check the statements when we +-- know that the graph can not contain a blank node +-- - i.e. compare getArcs gr to S.fromList o - but +-- stick with graph equality checks, for now. +compareExample :: + String -- ^ label + -> T.Text -- ^ Turtle representation + -> [RDFTriple] -- ^ Corresponding triples + -> Test +compareExample l t o = + let expectedGraph = toRDFGraph oset + egr = toGraph t + oset = S.fromList o + lbl = "example: " ++ l + + compareTriples = + case egr of + Left e -> parseFail e t $ "example " ++ l + Right gr -> lbl ~: expectedGraph ~=? gr + + compareRoundTrip = + let ttl = formatGraphAsText expectedGraph + tgr = toGraph ttl + in case tgr of + Left e -> parseFail e ttl $ "round-trip example " ++ l + Right gr -> lbl ~: expectedGraph ~=? gr + + + in TestList [ compareTriples + , compareRoundTrip + ] + +compareGraphs :: String -> T.Text -> T.Text -> Test +compareGraphs l t1 t2 = + case (toGraph t1, toGraph t2) of + (Left e1, _) -> parseFail e1 t1 $ "graph 1 of " ++ l + (_, Left e2) -> parseFail e2 t2 $ "graph 2 of " ++ l + (Right gr1, Right gr2) -> ("example: " ++ l) ~: gr1 ~=? gr2 + +-- ********************************************* +-- Examples from Turtle specification +-- ********************************************* + +-- would be nice to read these in from external files + +-- | From . +example1 :: T.Text +example1 = + T.unlines + [ "@base ." + , "@prefix rdf: ." + , "@prefix rdfs: ." + , "@prefix foaf: ." + , "@prefix rel: ." + , "" + , "<#green-goblin>" + , " rel:enemyOf <#spiderman> ;" + , " a foaf:Person ; # in the context of the Marvel universe" + , " foaf:name \"Green Goblin\" ." + , "" + , "<#spiderman>" + , " rel:enemyOf <#green-goblin> ;" + , " a foaf:Person ;" + , " foaf:name \"Spiderman\", \"Человек-паук\"@ru ." + ] + +result1 :: [RDFTriple] +result1 = + let greengoblin = toURI "http://example.org/#green-goblin" + spiderman = toURI "http://example.org/#spiderman" + enemyOf = toURI "http://www.perceive.net/schemas/relationship/enemyOf" + ruName = LangLit "Человек-паук" "ru" + in [ triple greengoblin enemyOf spiderman + , triple greengoblin rdfType foafPerson + , triple greengoblin foafname ("Green Goblin"::String) + , triple spiderman enemyOf greengoblin + , triple spiderman rdfType foafPerson + , triple spiderman foafname ("Spiderman"::String) + , triple spiderman foafname ruName + ] + +-- | From . +-- +-- Unfortunately we do not support IRIs at this time. +example2_4 :: T.Text +example2_4 = + T.unlines + [ "# A triple with all absolute IRIs" + , " ." + , "" + , "@base ." + , " . # relative IRIs, e.g. http://one.example/subject2" + , "" + , "@prefix p: ." + , "p:subject3 p:predicate3 p:object3 . # prefixed name, e.g. http://two.example/subject3" + , "" + , "@prefix p: . # prefix p: now stands for http://one.example/path/" + , "p:subject4 p:predicate4 p:object4 . # prefixed name, e.g. http://one.example/path/subject4" + , "" + , "@prefix : . # empty prefix" + , ":subject5 :predicate5 :object5 . # prefixed name, e.g. http://another.example/subject5" + , "" + , ":subject6 a :subject7 . # same as :subject6 :subject7 ." + , "" + , "# a :subject8 . # a multi-script subject IRI ." + ] + +result2_4 :: [RDFTriple] +result2_4 = + let s1 = toURI "http://one.example/subject1" + p1 = toURI "http://one.example/predicate1" + o1 = toURI "http://one.example/object1" + + s2 = toURI "http://one.example/subject2" + p2 = toURI "http://one.example/predicate2" + o2 = toURI "http://one.example/object2" + + s3 = toURI "http://two.example/subject3" + p3 = toURI "http://two.example/predicate3" + o3 = toURI "http://two.example/object3" + + s4 = toURI "http://one.example/path/subject4" + p4 = toURI "http://one.example/path/predicate4" + o4 = toURI "http://one.example/path/object4" + + s5 = toURI "http://another.example/subject5" + p5 = toURI "http://another.example/predicate5" + o5 = toURI "http://another.example/object5" + + s6 = toURI "http://another.example/subject6" + s7 = toURI "http://another.example/subject7" + + -- Replace once we support IRIs + -- utf8 = toURI "http://伝言.example/?user=أكرم&channel=R%26D" + -- s8 = toURI "http://another.example/subject8" + + in [ triple s1 p1 o1 + , triple s2 p2 o2 + , triple s3 p3 o3 + , triple s4 p4 o4 + , triple s5 p5 o5 + , triple s6 rdfType s7 + -- , triple utf8 rdfType s8 + ] + +-- | From . +-- +-- *NOTE*: at present we do not match the document since untyped strings are +-- *not* mapped to xsd:string. +-- +example2_5_1 :: T.Text +example2_5_1 = + T.unlines + [ "@prefix rdfs: ." + , "@prefix show: ." + , "@prefix xsd: ." -- added to example + , "" + , "show:218 rdfs:label \"That Seventies Show\"^^xsd:string . # literal with XML Schema string datatype" + , "show:218 rdfs:label \"That Seventies Show\"^^ . # same as above" + , "show:218 rdfs:label \"That Seventies Show\" . # same again" + , "show:218 show:localName \"That Seventies Show\"@en . # literal with a language tag" + , "show:218 show:localName 'Cette Série des Années Soixante-dix'@fr . # literal delimited by single quote" + , "show:218 show:localName \"Cette Série des Années Septante\"@fr-be . # literal with a region subtag" + , "show:218 show:blurb '''This is a multi-line # literal with embedded new lines and quotes" + , "literal with many quotes (\"\"\"\"\")" + , "and up to two sequential apostrophes ('').''' ." + ] + +result2_5_1 :: [RDFTriple] +result2_5_1 = + let show218 = toURI "http://example.org/vocab/show/218" + localName = toURI "http://example.org/vocab/show/localName" + blurb = toURI "http://example.org/vocab/show/blurb" + + -- Should be TypedLit v xsdString; once this happens then nameLit + -- is not needed + name = "That Seventies Show" + nameLit = Lit name + blurbLit = Lit "This is a multi-line # literal with embedded new lines and quotes\nliteral with many quotes (\"\"\"\"\")\nand up to two sequential apostrophes ('')." + + in [ triple show218 rdfsLabel (TypedLit name xsdString) + , triple show218 rdfsLabel nameLit + , triple show218 localName (LangLit name "en") + , triple show218 localName (LangLit "Cette Série des Années Soixante-dix" "fr") + , triple show218 localName (LangLit "Cette Série des Années Septante" "fr-be") + , triple show218 blurb blurbLit + ] + +-- | From . +example2_5_2 :: T.Text +example2_5_2 = + T.unlines + [ "@prefix : ." + , " " + , " :atomicNumber 2 ; # xsd:integer " + , " :atomicMass 4.002602 ; # xsd:decimal " + , " :specificGravity 1.663E-4 . # xsd:double" + ] + +result2_5_2 :: [RDFTriple] +result2_5_2 = + let helium = toURI "http://en.wikipedia.org/wiki/Helium" + aNum = toURI "http://example.org/elementsatomicNumber" + aMass = toURI "http://example.org/elementsatomicMass" + sGrav = toURI "http://example.org/elementsspecificGravity" + + in [ triple helium aNum (2::Int) + , triple helium aMass (TypedLit "4.002602" xsdDecimal) + -- , triple helium sGrav (1.663e-4::Double) + , triple helium sGrav (TypedLit "1.663E-4" xsdDouble) + ] + +-- | From . +example2_5_3 :: T.Text +example2_5_3 = + T.unlines + [ "@prefix : ." + , "" + , " :isLandlocked false . # xsd:boolean" + ] + +result2_5_3 :: [RDFTriple] +result2_5_3 = + [ triple + (toURI "http://somecountry.example/census2007") + (toURI "http://example.org/statsisLandlocked") + False + ] + +-- | From . +example2_6 :: T.Text +example2_6 = + T.unlines + [ "@prefix foaf: ." + , "" + , "_:alice foaf:knows _:bob ." + , "_:bob foaf:knows _:alice . " + ] + +result2_6 :: [RDFTriple] +result2_6 = + let alice = Blank "one" + bob = Blank "two" + + in [ triple alice foafknows bob + , triple bob foafknows alice + ] + +{- +If you write out result2_6 you get + +@prefix foaf: . +[ + foaf:knows [ + foaf:knows [] +] +] . + +which is + :_a foaf:knows :_b + :_b foaf:knows :_c + +which is obviously wrong +-} + +-- | From . +example2_7_a :: T.Text +example2_7_a = + T.unlines + [ "@prefix foaf: ." + , "" + , "# Someone knows someone else, who has the name \"Bob\"." + , "[] foaf:knows [ foaf:name \"Bob\" ] ." + ] + +result2_7_a :: [RDFTriple] +result2_7_a = + let someone = Blank "p" + bob = Blank "23" + + in [ triple someone foafknows bob + , triple bob foafname (Lit "Bob") -- TODO: change to TypedLit + ] + +{- +### Failure in: 0:6:1:"example: 2.7 a" +expected: Graph, formulae: +arcs: + (_:23,foaf:name,"Bob") + (_:p,foaf:knows,_:23) + but got: Graph, formulae: +arcs: + (_:1,foaf:name,"Bob") + (_:2,foaf:knows,_:3) + +Writing out as N3 and Turtle give different results, +but not convinced round-tripping is sensible here, +since reading back in the N3 version generates the +invalid results above. + +% ./dist/build/Swish/Swish -i=delme2.ttl -n3 -o +Swish 0.9.0.4 + + +@prefix : <#> . +@prefix foaf: . +[ + foaf:knows [ + foaf:name "Bob" +] +] . + +% ./dist/build/Swish/Swish -i=delme2.ttl -ttl -o +Swish 0.9.0.4 + + +@prefix : <#> . +@prefix foaf: . +[] + foaf:knows [ + foaf:name "Bob" +] + . + +Need to look at this to see what the difference is. + +-} + +-- | From . +example2_7_b1 :: T.Text +example2_7_b1 = + T.unlines + [ "@prefix foaf: ." + , "" + , "[ foaf:name \"Alice\" ] foaf:knows [" + , " foaf:name \"Bob\" ;" + , " foaf:knows [" + , " foaf:name \"Eve\" ] ;" + , " foaf:mbox ] ." + ] + +-- | From . +example2_7_b2 :: T.Text +example2_7_b2 = + T.unlines + [ "_:a \"Alice\" ." + , "_:a _:b ." + , "_:b \"Bob\" ." + , "_:b _:c ." + , "_:c \"Eve\" ." + , "_:b ." + ] + +-- | From . +example2_8 :: T.Text +example2_8 = + T.unlines + [ "@prefix : ." + , "# the object of this triple is the RDF collection blank node" + , ":subject :predicate ( :a :b :c ) ." + , "" + , "# an empty collection value - rdf:nil" + , ":subject :predicate2 () ." + ] + +result2_8 :: [RDFTriple] +result2_8 = + let s = toURI "http://example.org/foosubject" + p = toURI "http://example.org/foopredicate" + p2 = toURI "http://example.org/foopredicate2" + + a = toURI "http://example.org/fooa" + b = toURI "http://example.org/foob" + c = toURI "http://example.org/fooc" + + l1 = Blank "l1" + l2 = Blank "l2" + l3 = Blank "l3" + + in [ triple s p l1 + , triple l1 rdfFirst a + , triple l1 rdfRest l2 + , triple l2 rdfFirst b + , triple l2 rdfRest l3 + , triple l3 rdfFirst c + , triple l3 rdfRest rdfNil + , triple s p2 rdfNil + ] + +-- | From . +example3_a :: T.Text +example3_a = + T.unlines + [ "@prefix rdf: ." + , "@prefix dc: ." + , "@prefix ex: ." + , "" + , "" + , " dc:title \"RDF/XML Syntax Specification (Revised)\" ;" + , " ex:editor [" + , " ex:fullname \"Dave Beckett\";" + , " ex:homePage " + , " ] ." + ] + +result3_a :: [RDFTriple] +result3_a = + let g = toURI "http://www.w3.org/TR/rdf-syntax-grammar" + exEditor = toURI "http://example.org/stuff/1.0/editor" + exFullName = toURI "http://example.org/stuff/1.0/fullname" + exHomePage = toURI "http://example.org/stuff/1.0/homePage" + bn = Blank "foo" -- "$123_" + + in [ triple g dcelemtitle (Lit "RDF/XML Syntax Specification (Revised)") + , triple g exEditor bn + , triple bn exFullName (Lit "Dave Beckett") + , triple bn exHomePage (toURI "http://purl.org/net/dajobe/") + ] + +-- | From . +example3_b1 :: T.Text +example3_b1 = + T.unlines + [ "@prefix : ." + , ":a :b ( \"apple\" \"banana\" ) ." + ] + +example3_b2 :: T.Text +example3_b2 = + T.unlines + [ "@prefix : ." + , "@prefix rdf: ." + , ":a :b" + , " [ rdf:first \"apple\";" + , " rdf:rest [ rdf:first \"banana\";" + , " rdf:rest rdf:nil ]" + , " ] . " + ] + +-- | From . +example3_c1 :: T.Text +example3_c1 = + T.unlines + [ "@prefix : ." + , "" + , ":a :b \"The first line\\nThe second line\\n more\" ." + ] + +example3_c2 :: T.Text +example3_c2 = + T.unlines + [ "@prefix : ." + , "" + -- line feeds using U+000A + , ":a :b \"\"\"The first line" + , "The second line" + , " more\"\"\" ." + ] + +-- | From . +example3_d1 :: T.Text +example3_d1 = + T.unlines + [ "@prefix : ." + , "(1 2.0 3E1) :p \"w\" ." + ] + +example3_d2 :: T.Text +example3_d2 = + T.unlines + [ "@prefix rdf: ." + , "@prefix : ." + , "_:b0 rdf:first 1 ;" + , " rdf:rest _:b1 ." + , "_:b1 rdf:first 2.0 ;" + , " rdf:rest _:b2 ." + , "_:b2 rdf:first 3E1 ;" + , " rdf:rest rdf:nil ." + , "_:b0 :p \"w\" . " + ] + +{- +I do not see how this representation is valid, and rapper version 2.0.9 +does not parse it (well, it reports the triples and then +fails) so I am skipping this test. Am I mis-reading the test? + +See the discussion at http://lists.w3.org/Archives/Public/public-rdf-comments/2013May/0043.html +which suggests that this is indeed invalid. + +-- | From . +-- +example3_e1 :: T.Text +example3_e1 = + T.unlines + [ "@prefix : ." + , "(1 [:p :q] ( 2 ) ) ." + ] + +example3_e2 :: T.Text +example3_e2 = + T.unlines + [ "@prefix rdf: ." + , "@prefix : ." + , " _:b0 rdf:first 1 ;" + , " rdf:rest _:b1 ." + , " _:b1 rdf:first _:b2 ." + , " _:b2 :p :q ." + , " _:b1 rdf:rest _:b3 ." + , " _:b3 rdf:first _:b4 ." + , " _:b4 rdf:first 2 ;" + , " rdf:rest rdf:nil ." + , " _:b3 rdf:rest rdf:nil ." + ] + +-} + +-- | From . +example7_4 :: T.Text +example7_4 = + T.unlines + [ "@prefix ericFoaf: ." + , "@prefix : ." + , "ericFoaf:ericP :givenName \"Eric\" ;" + , " :knows ," + , " [ :mbox ] ," + , " ." + ] + +result7_4 :: [RDFTriple] +result7_4 = + let ericP = toURI "http://www.w3.org/People/Eric/ericP-foaf.rdf#ericP" + db = toURI "http://norman.walsh.name/knows/who/dan-brickley" + timbl = toURI "mailto:timbl@w3.org" + amyvdh = toURI "http://getopenid.com/amyvdh" + timbn = Blank "node" + + in [ triple ericP foafgivenName (Lit "Eric") + , triple ericP foafknows db + , triple ericP foafknows timbn + , triple ericP foafknows amyvdh + , triple timbn foafmbox timbl + ] + +-- ********************************************* +-- Set up test suites +-- ********************************************* + +initialTestSuite :: Test +initialTestSuite = + TestList + [ compareExample "1" example1 result1 + , compareExample "2.4" example2_4 result2_4 + , compareExample "2.5.1" example2_5_1 result2_5_1 + , compareExample "2.5.2" example2_5_2 result2_5_2 + , compareExample "2.5.3" example2_5_3 result2_5_3 + , compareExample "2.6" example2_6 result2_6 + , compareExample "2.7 a" example2_7_a result2_7_a + , compareGraphs "2.7 b" example2_7_b1 example2_7_b2 + , compareExample "2.8" example2_8 result2_8 + , compareExample "3 a" example3_a result3_a + , compareGraphs "3 b" example3_b1 example3_b2 + , compareGraphs "3 c" example3_c1 example3_c2 + , compareGraphs "3 d" example3_d1 example3_d2 + -- , compareGraphs "3 e" example3_e1 example3_e2 -- at present _e1 does not parse + , compareExample "7.4" example7_4 result7_4 + ] + +-- Cases to try and improve the test coverage + +-- | This was actually more a problem with output rather than input. +coverage1 :: T.Text +coverage1 = + T.unlines + [ " \"' -D RT @madeupname: \\\"Foo \\u0024 Zone\\\" \\U0000007e:\\\"\\\"\\\"D\" ." + ] + +resultc1 :: [RDFTriple] +resultc1 = + [ triple + (toURI "urn:a") + (toURI "urn:b") + (Lit "' -D RT @madeupname: \"Foo $ Zone\" ~:\"\"\"D") + ] + +coverageCases :: Test +coverageCases = + TestList + [ compareExample "p1" coverage1 resultc1 + ] + +-- Extracted from failures seen when using the W3C test suite +-- at . + +lt1T :: T.Text +lt1T = " \"\"\"A long string. \"\"\"@en-UK ." + +lt1A :: [RDFTriple] +lt1A = + [ triple (toURI "urn:a") (toURI "urn:b") + (LangLit "A long string. " "en-UK") + ] + +le1T :: T.Text +le1T = "@prefix : . :c\\~d." + +le1A :: [RDFTriple] +le1A = + [ triple (toURI "urn:a") (toURI "urn:b:") (toURI "urn:example/c~d") ] + +w3cCases :: Test +w3cCases = + TestList + [ compareExample "lang-tag1" lt1T lt1A + , compareExample "localEscapes" le1T le1A + ] + +-- + +allTests :: Test +allTests = TestList + [ initialTestSuite + , coverageCases + , w3cCases + ] + +main :: IO () +main = runTestSuite allTests + +-------------------------------------------------------------------------------- +-- +-- Copyright (c) 2013 Douglas Burke +-- All rights reserved. +-- +-- This file is part of Swish. +-- +-- Swish is free software; you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation; either version 2 of the License, or +-- (at your option) any later version. +-- +-- Swish is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with Swish; if not, write to: +-- The Free Software Foundation, Inc., +-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-- +--------------------------------------------------------------------------------