swish 0.9.0.3 → 0.9.0.4
raw patch · 13 files changed
+1779/−551 lines, 13 filesdep ~basedep ~containersdep ~directorynew-component:exe:runw3ctestsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, containers, directory, filepath, hashable, network, text
API changes (from Hackage documentation)
Files
- app/RunW3CTests.hs +322/−0
- src/Swish/QName.hs +20/−15
- src/Swish/RDF/Formatter/Internal.hs +98/−39
- src/Swish/RDF/Formatter/N3.hs +1/−1
- src/Swish/RDF/Formatter/NTriples.hs +7/−1
- src/Swish/RDF/Formatter/Turtle.hs +16/−9
- src/Swish/RDF/Graph.hs +21/−10
- src/Swish/RDF/Parser/NTriples.hs +23/−9
- src/Swish/RDF/Parser/Turtle.hs +413/−455
- swish.cabal +72/−5
- tests/N3FormatterTest.hs +49/−5
- tests/NTTest.hs +9/−2
- tests/TurtleTest.hs +728/−0
+ app/RunW3CTests.hs view
@@ -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 <http://www.w3.org/2013/TurtleTests/>).+--+-- Possible improvements:+--+-- - create an EARL report (<http://www.w3.org/TR/EARL10-Schema/>), for+-- <https://dvcs.w3.org/hg/rdf/raw-file/default/rdf-turtle/reports/index.html>.+-- See also <http://lists.w3.org/Archives/Public/public-rdf-comments/2013Aug/0013.html>.+--+-- - 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) = "<NTriples parse " ++ _showBool a ++ ">"+ show (TurtleParse a) = "<Turtle parse " ++ _showBool a ++ ">"+ show TurtleCompare = "<Turtle compare>"+ +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 $ "*** <COMPARE> " ++ 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 $ "*** <PASS> " ++ 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 $ "*** <FAIL> " ++ 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 ++ " <manifest file>"+ exitFailure++
src/Swish/QName.hs view
@@ -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 @\<uri\>@, 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.
src/Swish/RDF/Formatter/Internal.hs view
@@ -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.
src/Swish/RDF/Formatter/N3.hs view
@@ -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
src/Swish/RDF/Formatter/NTriples.hs view
@@ -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, -- <http://www.w3.org/TR/rdf-testcases/#ntriples>+--+-- NOTES:+--+-- - Update to the document \"N-Triples. A line-based syntax for an RDF graph\"+-- W3C Working Group Note 09 April 2013,+-- <http://www.w3.org/TR/2013/NOTE-n-triples-20130409/> -- --------------------------------------------------------------------------------
src/Swish/RDF/Formatter/Turtle.hs view
@@ -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 (<http://www.w3.org/TR/2011/WD-turtle-20110809/>) -- <http://www.w3.org/TR/turtle/> --+-- NOTES:+--+-- - The formatter needs to be updated to the W3C+-- Candidate Recommendation (19 February 2013,+-- <http://www.w3.org/TR/2013/CR-turtle-20130219/>).+--+-- - 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+-- <http://www.w3.org/TR/2011/WD-turtle-20110809/#terms>).+-- -------------------------------------------------------------------------------- {-@@ -311,16 +322,12 @@ -- (b) URI nodes: if possible, replace URI with qname, -- else display as <uri> -- (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.
src/Swish/RDF/Graph.hs view
@@ -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. <http://www.w3.org/TR/rdf-concepts/#section-Graph-syntax>+-- cf. <http://www.w3.org/TR/rdf-concepts/#section-Graph-syntax> 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.
src/Swish/RDF/Parser/NTriples.hs view
@@ -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,+-- <http://www.w3.org/TR/2013/NOTE-n-triples-20130409/>+-- -------------------------------------------------------------------------------- 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.
src/Swish/RDF/Parser/Turtle.hs view
@@ -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 (<http://www.w3.org/TR/2011/WD-turtle-20110809/>),+-- W3C Candidate Recommendation 19 February 2013 (<http://www.w3.org/TR/2013/CR-turtle-20130219/L), -- <http://www.w3.org/TR/turtle/> -- -- 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,--- <http://www.w3.org/TR/2012/WD-turtle-20120710/#sec-changelog>).---+-- - Prior to version @0.9.0.4@, the parser followed the+-- W3C Working Draft 09 August 2011 (<http://www.w3.org/TR/2011/WD-turtle-20110809/>)+-- -- - Strings with no language tag are converted to a 'LitTag' not a -- 'TypedLitTag' with a type of @xsd:string@ (e.g. see -- <http://www.w3.org/TR/2011/WD-turtle-20110809/#terms>). -- -- - 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+-- <http://www.w3.org/2013/TurtleTests/> 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. <http://www.w3.org/2013/TurtleTests/turtle-syntax-bad-prefix-01.ttl> -+-- 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+(<?) ::+ Parser s a+ -> String -- ^ Error message to add (a new line is added after the message)+ -> Parser s a+(<?) p m = adjustErr p ((m++"\n")++) +-- Applicative's <* et al are infixl 4, with <|> infixl 3+infixl 4 <?++{-++Syntax productions; the Turtle ENBF grammar elements are from+http://www.w3.org/TR/2013/CR-turtle-20130219/#sec-grammar-grammar+ The element names are converted to match Haskell syntax and idioms where possible: @@ -359,9 +375,8 @@ - upper-case identifiers prepended by _ after above form -}- {--[1] turtleDoc ::= (statement)*+[1] turtleDoc ::= statement* -} turtleDoc :: TurtleParser RDFGraph turtleDoc = mkGr <$> (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 <? "Unable to parse @prefix statement."+ <|> base <? "Unable to parse @base statement."+ <|> sparqlPrefix <? "Unable to parse Sparql PREFIX statement."+ <|> sparqlBase <? "Unable to parse Sparql BASE statement.") {--[4] prefixID ::= PREFIX PNAME_NS IRI_REF +[4] prefixID ::= '@prefix' PNAME_NS IRIREF '.' -} prefixID :: TurtleParser () prefixID = do- _prefix - p <- lexeme _pnameNS- u <- _iriRef- stUpdate (setPrefix (fmap L.toStrict p) u)+ atWord "prefix"+ p <- commit $ lexeme _pnameNS+ u <- lexeme _iriRef+ fullStop+ stUpdate $ setPrefix (fmap L.toStrict p) u {--[5] base ::= BASE IRI_REF +[5] base ::= '@base' IRIREF '.' -} base :: TurtleParser ()-base = _base >> _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> ::= "@base" --}+[16] NumericLiteral ::= INTEGER | DECIMAL | DOUBLE -_base :: TurtleParser ()-_base = atWord "base"+NOTE: We swap the order from this production -{--[18] <PREFIX> ::= "@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] <UCHAR> ::= ( "\\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] <IRI_REF> ::= "<" ( [^<>\"{}|^`\\] - [#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] <PNAME_NS> ::= (PN_PREFIX)? ":" +[139s] PNAME_NS ::= PN_PREFIX? ':' -}- _pnameNS :: TurtleParser (Maybe L.Text) _pnameNS = optional _pnPrefix <* char ':' {--[72s] <PNAME_LN> ::= 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] <BLANK_NODE_LABEL> ::= "_:" 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_REST> :== ( ( PN_CHARS | '.' )* PN_CHARS )? -[74s] <VAR1> ::= "?" VARNAME -[75s] <VAR2> ::= "$" 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] <LANGTAG> ::= 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] <INTEGER> ::= [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] <DECIMAL> ::= [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] <DOUBLE> ::= [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_POSITIVE> ::= "+" INTEGER -[81s] <DECIMAL_POSITIVE> ::= "+" DECIMAL -[82s] <DOUBLE_POSITIVE> ::= "+" 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_NEGATIVE> ::= "-" INTEGER -[84s] <DECIMAL_NEGATIVE> ::= "-" DECIMAL -[85s] <DOUBLE_NEGATIVE> ::= "-" 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] <EXPONENT> ::= [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] <STRING_LITERAL1> ::= "'" ( ( [^'\\\n\r] ) | ECHAR | UCHAR )* "'" -[88s] <STRING_LITERAL2> ::= '"' ( ( [^\"\\\n\r] ) | ECHAR | UCHAR )* '"' -[89s] <STRING_LITERAL_LONG1> ::= "'''" ( ( "'" | "''" )? ( [^'\\] | ECHAR | UCHAR ) )* "'''" -[90s] <STRING_LITERAL_LONG2> ::= '"""' ( ( '"' | '""' )? ( [^\"\\] | 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] <ECHAR> ::= "\\" [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] <NIL> ::= "(" (WS)* ")" +[161s] WS ::= #x20 | #x9 | #xD | #xA -} -{--[93s] <WS> ::= " " - | "\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] <ANON> ::= "[" (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] <PN_CHARS_BASE> ::= [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_U> ::= 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] <VARNAME> ::= ( PN_CHARS_U | [0-9] ) ( PN_CHARS_U | [0-9] | #00B7 | [#0300-#036F] | [# - 203F-#2040] )* --}--{--[98s] <PN_CHARS> ::= 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_PREFIX> ::= 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_LOCAL> ::= ( 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_REST> :== ( ( 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.
swish.cabal view
@@ -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+ <http://www.w3.org/2013/TurtleTests/>).+ .+ * 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
tests/N3FormatterTest.hs view
@@ -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 <http://www.w3.org/1999/02/22-rdf-syntax-ns#first> "+ , b1n+ , " ;\n <http://www.w3.org/1999/02/22-rdf-syntax-ns#rest> ( ", 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 =
tests/NTTest.hs view
@@ -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" "<urn:a> <urn:b> \"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.
+ tests/TurtleTest.hs view
@@ -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+-- <http://www.w3.org/TR/2013/CR-turtle-20130219/>.+-- +--------------------------------------------------------------------------------++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 <http://www.w3.org/TR/2013/CR-turtle-20130219/#sec-intro>.+example1 :: T.Text+example1 =+ T.unlines+ [ "@base <http://example.org/> ."+ , "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> ."+ , "@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> ."+ , "@prefix foaf: <http://xmlns.com/foaf/0.1/> ."+ , "@prefix rel: <http://www.perceive.net/schemas/relationship/> ."+ , ""+ , "<#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 <http://www.w3.org/TR/2013/CR-turtle-20130219/#sec-iri>.+-- +-- Unfortunately we do not support IRIs at this time.+example2_4 :: T.Text+example2_4 = + T.unlines+ [ "# A triple with all absolute IRIs"+ , "<http://one.example/subject1> <http://one.example/predicate1> <http://one.example/object1> ."+ , ""+ , "@base <http://one.example/> ."+ , "<subject2> <predicate2> <object2> . # relative IRIs, e.g. http://one.example/subject2"+ , ""+ , "@prefix p: <http://two.example/> ."+ , "p:subject3 p:predicate3 p:object3 . # prefixed name, e.g. http://two.example/subject3"+ , ""+ , "@prefix p: <path/> . # 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 : <http://another.example/> . # empty prefix"+ , ":subject5 :predicate5 :object5 . # prefixed name, e.g. http://another.example/subject5"+ , ""+ , ":subject6 a :subject7 . # same as :subject6 <http://www.w3.org/1999/02/22-rdf-syntax-ns#type> :subject7 ."+ , ""+ , "# <http://伝言.example/?user=أكرم&channel=R%26D> 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 <http://www.w3.org/TR/2013/CR-turtle-20130219/#turtle-literals>.+-- +-- *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: <http://www.w3.org/2000/01/rdf-schema#> ."+ , "@prefix show: <http://example.org/vocab/show/> ."+ , "@prefix xsd: <http://www.w3.org/2001/XMLSchema#> ." -- 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\"^^<http://www.w3.org/2001/XMLSchema#string> . # 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 <http://www.w3.org/TR/2013/CR-turtle-20130219/#abbrev>.+example2_5_2 :: T.Text+example2_5_2 =+ T.unlines+ [ "@prefix : <http://example.org/elements> ."+ , "<http://en.wikipedia.org/wiki/Helium> "+ , " :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 <http://www.w3.org/TR/2013/CR-turtle-20130219/#booleans>.+example2_5_3 :: T.Text+example2_5_3 =+ T.unlines+ [ "@prefix : <http://example.org/stats> ."+ , "<http://somecountry.example/census2007>"+ , " :isLandlocked false . # xsd:boolean"+ ]+ +result2_5_3 :: [RDFTriple]+result2_5_3 =+ [ triple+ (toURI "http://somecountry.example/census2007")+ (toURI "http://example.org/statsisLandlocked")+ False+ ]++-- | From <http://www.w3.org/TR/2013/CR-turtle-20130219/#BNodes>.+example2_6 :: T.Text+example2_6 =+ T.unlines+ [ "@prefix foaf: <http://xmlns.com/foaf/0.1/> ."+ , ""+ , "_: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: <http://xmlns.com/foaf/0.1/> .+[+ foaf:knows [+ foaf:knows []+]+] .++which is+ :_a foaf:knows :_b+ :_b foaf:knows :_c++which is obviously wrong+-}+ +-- | From <http://www.w3.org/TR/2013/CR-turtle-20130219/#unlabeled-bnodes>.+example2_7_a :: T.Text+example2_7_a =+ T.unlines+ [ "@prefix foaf: <http://xmlns.com/foaf/0.1/> ."+ , ""+ , "# 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: <http://xmlns.com/foaf/0.1/> .+[+ foaf:knows [+ foaf:name "Bob"+]+] .++% ./dist/build/Swish/Swish -i=delme2.ttl -ttl -o+Swish 0.9.0.4+++@prefix : <#> .+@prefix foaf: <http://xmlns.com/foaf/0.1/> .+[]+ foaf:knows [+ foaf:name "Bob"+]+ .++Need to look at this to see what the difference is.++-}++-- | From <http://www.w3.org/TR/2013/CR-turtle-20130219/#unlabeled-bnodes>.+example2_7_b1 :: T.Text+example2_7_b1 =+ T.unlines+ [ "@prefix foaf: <http://xmlns.com/foaf/0.1/> ."+ , ""+ , "[ foaf:name \"Alice\" ] foaf:knows ["+ , " foaf:name \"Bob\" ;"+ , " foaf:knows ["+ , " foaf:name \"Eve\" ] ;"+ , " foaf:mbox <bob@example.com> ] ."+ ]++-- | From <http://www.w3.org/TR/2013/CR-turtle-20130219/#unlabeled-bnodes>.+example2_7_b2 :: T.Text+example2_7_b2 =+ T.unlines+ [ "_:a <http://xmlns.com/foaf/0.1/name> \"Alice\" ."+ , "_:a <http://xmlns.com/foaf/0.1/knows> _:b ."+ , "_:b <http://xmlns.com/foaf/0.1/name> \"Bob\" ."+ , "_:b <http://xmlns.com/foaf/0.1/knows> _:c ."+ , "_:c <http://xmlns.com/foaf/0.1/name> \"Eve\" ."+ , "_:b <http://xmlns.com/foaf/0.1/mbox> <bob@example.com> ."+ ]+ +-- | From <http://www.w3.org/TR/2013/CR-turtle-20130219/#collections>.+example2_8 :: T.Text+example2_8 =+ T.unlines+ [ "@prefix : <http://example.org/foo> ."+ , "# 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 <http://www.w3.org/TR/2013/CR-turtle-20130219/#sec-examples>.+example3_a :: T.Text+example3_a =+ T.unlines+ [ "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> ."+ , "@prefix dc: <http://purl.org/dc/elements/1.1/> ."+ , "@prefix ex: <http://example.org/stuff/1.0/> ."+ , ""+ , "<http://www.w3.org/TR/rdf-syntax-grammar>"+ , " dc:title \"RDF/XML Syntax Specification (Revised)\" ;"+ , " ex:editor ["+ , " ex:fullname \"Dave Beckett\";"+ , " ex:homePage <http://purl.org/net/dajobe/>"+ , " ] ."+ ]++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 <http://www.w3.org/TR/2013/CR-turtle-20130219/#sec-examples>.+example3_b1 :: T.Text+example3_b1 =+ T.unlines+ [ "@prefix : <http://example.org/stuff/1.0/> ."+ , ":a :b ( \"apple\" \"banana\" ) ."+ ]++example3_b2 :: T.Text+example3_b2 =+ T.unlines+ [ "@prefix : <http://example.org/stuff/1.0/> ."+ , "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> ."+ , ":a :b"+ , " [ rdf:first \"apple\";"+ , " rdf:rest [ rdf:first \"banana\";"+ , " rdf:rest rdf:nil ]"+ , " ] . "+ ]++-- | From <http://www.w3.org/TR/2013/CR-turtle-20130219/#sec-examples>.+example3_c1 :: T.Text+example3_c1 =+ T.unlines+ [ "@prefix : <http://example.org/stuff/1.0/> ."+ , ""+ , ":a :b \"The first line\\nThe second line\\n more\" ."+ ]++example3_c2 :: T.Text+example3_c2 = + T.unlines+ [ "@prefix : <http://example.org/stuff/1.0/> ."+ , ""+ -- line feeds using U+000A+ , ":a :b \"\"\"The first line"+ , "The second line"+ , " more\"\"\" ."+ ]++-- | From <http://www.w3.org/TR/2013/CR-turtle-20130219/#sec-examples>.+example3_d1 :: T.Text+example3_d1 =+ T.unlines+ [ "@prefix : <http://example.org/stuff/1.0/> ."+ , "(1 2.0 3E1) :p \"w\" ."+ ]++example3_d2 :: T.Text+example3_d2 =+ T.unlines+ [ "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> ."+ , "@prefix : <http://example.org/stuff/1.0/> ."+ , "_: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 <http://www.w3.org/TR/2013/CR-turtle-20130219/#sec-examples>.+--+example3_e1 :: T.Text+example3_e1 =+ T.unlines+ [ "@prefix : <http://example.org/stuff/1.0/> ."+ , "(1 [:p :q] ( 2 ) ) ."+ ]+ +example3_e2 :: T.Text+example3_e2 =+ T.unlines+ [ "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> ."+ , "@prefix : <http://example.org/stuff/1.0/> ."+ , " _: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 <http://www.w3.org/TR/2013/CR-turtle-20130219/#sec-parsing-example>.+example7_4 :: T.Text+example7_4 =+ T.unlines+ [ "@prefix ericFoaf: <http://www.w3.org/People/Eric/ericP-foaf.rdf#> ."+ , "@prefix : <http://xmlns.com/foaf/0.1/> ."+ , "ericFoaf:ericP :givenName \"Eric\" ;"+ , " :knows <http://norman.walsh.name/knows/who/dan-brickley> ,"+ , " [ :mbox <mailto:timbl@w3.org> ] ,"+ , " <http://getopenid.com/amyvdh> ."+ ]++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+ [ "<urn:a> <urn:b> \"' -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 <http://www.w3.org/2013/TurtleTests/>.++lt1T :: T.Text+lt1T = "<urn:a> <urn:b> \"\"\"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 : <urn:example/>.<urn:a> <urn:b:> :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+--+--------------------------------------------------------------------------------