diff --git a/README b/README --- a/README +++ b/README @@ -0,0 +1,10 @@ +This is an update to Swish [1,2] so that it builds with a recent +Haskell platform (although it has not been tested against ghc-7 and +the 2011.2.0.0 Haskell Platform releases). + +For more information on this release see [3]. + + [1] http://www.ninebynine.org/Software/Swish-0.2.0.html + [2] http://www.ninebynine.org/RDFNotes/Swish/Intro.html + [2] https://bitbucket.org/doug_burke/swish/wiki/Home + diff --git a/Swish/RDF/GraphClass.hs b/Swish/RDF/GraphClass.hs --- a/Swish/RDF/GraphClass.hs +++ b/Swish/RDF/GraphClass.hs @@ -27,7 +27,7 @@ , Label(..) , Arc(..), arcSubj, arcPred, arcObj, arc, arcToTriple, arcFromTriple , Selector - , hasLabel, arcLabels + , hasLabel, arcLabels -- , arcNodes ) where @@ -36,39 +36,57 @@ import Data.List (union, (\\)) --------------------------------- --- Labelled Directed Graph class --------------------------------- +-- | Labelled Directed Graph class -- --- Minimum required implementation: setArcs, getArcs +-- Minimum required implementation: `setArcs`, `getArcs` and `containedIn`. -- -- NOTE: I wanted to declare this as a subclass of Functor, but -- the constraint on the label type seems to prevent that. -- So I've just declared specific instances to be Functors. +-- class (Eq (lg lb), Eq lb ) => LDGraph lg lb where -- empty graph -- emptyGr :: lg lb [[[TODO?]]] -- component-level operations - setArcs :: [Arc lb] -> lg lb -> lg lb -- setarcs [arcs] in g2 -> g3 - getArcs :: lg lb -> [Arc lb] -- g1 -> [arcs] - -- extract arcs from a graph - extract :: Selector lb -> lg lb -> lg lb -- select f1 from g2 -> g3 + + -- | Replace the existing arcs in the graph. + setArcs :: [Arc lb] -> lg lb -> lg lb + + -- | Extract all the arcs from a graph + getArcs :: lg lb -> [Arc lb] + + -- | Extract those arcs that match the given `Selector`. + extract :: Selector lb -> lg lb -> lg lb extract sel = update (filter sel) - -- graph-level operations - add :: lg lb -> lg lb -> lg lb -- g1 + g2 -> g3 + + -- | Add the two graphs + add :: lg lb -> lg lb -> lg lb add addg = update (union (getArcs addg)) - delete :: lg lb -> lg lb -> lg lb -- g2 - g1 -> g3 + + -- | Remove those arcs in the first graph from the second + -- graph + delete :: lg lb -- ^ g1 + -> lg lb -- ^ g2 + -> lg lb -- ^ g2 - g1 -> g3 delete delg = update (\\ getArcs delg) - -- enumerate distinct labels contained in a graph - labels :: lg lb -> [lb] -- g1 -> [labels] + + -- | Enumerate the distinct labels contained in a graph; + -- that is, any label that appears in the subject, + -- predicate or object position of an `Arc`. + labels :: lg lb -> [lb] labels g = foldl union [] (map arcLabels (getArcs g)) - -- enumerate distinct labels contained in a graph - nodes :: lg lb -> [lb] -- g1 -> [labels] + + -- | Enumerate the distinct nodes contained in a graph; + -- that is, any label that appears in the subject + -- or object position of an `Arc`. + nodes :: lg lb -> [lb] nodes g = foldl union [] (map arcNodes (getArcs g)) - -- test for graph containment in another - containedIn :: lg lb -> lg lb -> Bool -- g1 <= g2? - -- g1 update arcs in a graph using a supplied function: + + -- | Test for graph containment in another. + containedIn :: lg lb -> lg lb -> Bool + + -- | Update the arcs in a graph using a supplied function. update :: ( [Arc lb] -> [Arc lb] ) -> lg lb -> lg lb update f g = setArcs ( f (getArcs g) ) g @@ -76,9 +94,7 @@ replaceArcs :: (LDGraph lg lb) => lg lb -> [Arc lb] -> lg lb replaceArcs gr as = update (const as) gr ---------------- --- Label class ---------------- +-- | Label class -- -- A label may have a fixed binding, which means that the label identifies (is) a -- particular graph node, and different such labels are always distinct nodes. @@ -93,16 +109,23 @@ -- with fixed labels. class (Eq lb, Show lb, Ord lb) => Label lb where - labelIsVar :: lb -> Bool -- does this node have a variable binding? - labelHash :: Int -> lb -> Int -- calculate hash of label using supplied seed - getLocal :: lb -> String -- extract local id from variable node - makeLabel :: String -> lb -- make label value given local id - -- compare :: lb -> lb -> Ordering - -- compare l1 l2 = compare (show l1) (show l2) + + -- | Does this node have a variable binding? + labelIsVar :: lb -> Bool + + -- | Calculate the hash of the label using the supplied seed. + labelHash :: Int -> lb -> Int + + -- | Extract the local id from a variable node. + getLocal :: lb -> String + + -- | Make a label value from a local id. + makeLabel :: String -> lb + + -- compare :: lb -> lb -> Ordering + -- compare l1 l2 = compare (show l1) (show l2) ------------- --- Arc type ------------- +-- | Arc type data Arc lb = Arc { asubj, apred, aobj :: lb } deriving (Eq, Functor, F.Foldable, T.Traversable) @@ -116,7 +139,11 @@ arcObj :: Arc lb -> lb arcObj = aobj -arc :: lb -> lb -> lb -> Arc lb +-- | Create an arc. +arc :: lb -- ^ The subject of the arc. + -> lb -- ^ The predicate of the arc. + -> lb -- ^ The object of the arc. + -> Arc lb arc = Arc arcToTriple :: Arc lb -> (lb,lb,lb) @@ -135,10 +162,12 @@ cp = compare p1 p2 co = compare o1 o2 + {- not needed (Arc s1 p1 o1) <= (Arc s2 p2 o2) | s1 /= s2 = s1 <= s2 | p1 /= p2 = p1 <= p2 | otherwise = o1 <= o2 + -} instance (Show lb) => Show (Arc lb) where show (Arc lb1 lb2 lb3) = @@ -147,11 +176,13 @@ type Selector lb = Arc lb -> Bool hasLabel :: (Eq lb) => lb -> Arc lb -> Bool -hasLabel lbv (Arc lb1 lb2 lb3) = lbv `elem` [lb1, lb2, lb3] +hasLabel lbv lb = lbv `elem` arcLabels lb +-- | Return all the labels in an arc. arcLabels :: Arc lb -> [lb] arcLabels (Arc lb1 lb2 lb3) = [lb1,lb2,lb3] +-- | Return just the subject and object labels in the arc. arcNodes :: Arc lb -> [lb] arcNodes (Arc lb1 _ lb3) = [lb1,lb3] diff --git a/Swish/RDF/GraphMem.hs b/Swish/RDF/GraphMem.hs --- a/Swish/RDF/GraphMem.hs +++ b/Swish/RDF/GraphMem.hs @@ -49,7 +49,7 @@ getArcs = arcs setArcs as g = g { arcs=as } -- gmap f g = g { arcs = (map $ fmap f) (arcs g) } - containedIn = undefined -- TODO: what should this method do? + containedIn = error "containedIn for LDGraph GraphMem lb is undefined!" -- TODO: should there be one defined? instance (Label lb) => Eq (GraphMem lb) where (==) = graphEq diff --git a/Swish/RDF/N3Parser.hs b/Swish/RDF/N3Parser.hs --- a/Swish/RDF/N3Parser.hs +++ b/Swish/RDF/N3Parser.hs @@ -141,7 +141,6 @@ import Data.Char (isSpace, chr) - ---------------------------------------------------------------------- -- Set up token parsers ---------------------------------------------------------------------- @@ -891,22 +890,16 @@ updateState $ updateGraph $ setFormula (Formula bNode (graphState fstate')) return bNode --- need to work out what is going on here subgraph :: RDFLabel -> N3Parser RDFGraph -subgraph = undefined - -{- -subgraph :: RDFLabel -> N3Parser RDFGraph subgraph this = do pstate <- getState let fstate = pstate { graphState = emptyRDFGraph, thisNode = this } setState fstate -- switch new state into parser - statements -- parse statements of formula + statementsOptional -- parse statements of formula fstate' <- getState let nstate = pstate { nodeGen = nodeGen fstate' } setState nstate -- swap back state, with updated nodeGen return (graphState fstate') --} statementList :: N3Parser () statementList = ignore $ sepEndBy (lexeme statement) fullStop diff --git a/Swish/RDF/RDFGraph.hs b/Swish/RDF/RDFGraph.hs --- a/Swish/RDF/RDFGraph.hs +++ b/Swish/RDF/RDFGraph.hs @@ -153,13 +153,16 @@ compare (Blank _) (Res _) = GT -- .. else use show string comparison compare l1 l2 = comparing show l1 l2 + + {- <= is not used if compare is provided -- Similarly for <= (Res qn1) <= (Res qn2) = qn1 <= qn2 (Blank ln1) <= (Blank ln2) = ln1 <= ln2 (Res _) <= (Blank _) = True (Blank _) <= (Res _) = False l1 <= l2 = show l1 <= show l2 - + -} + instance Label RDFLabel where labelIsVar (Blank _) = True labelIsVar (Var _) = True @@ -413,7 +416,7 @@ instance (Label lb) => LDGraph NSGraph lb where getArcs = statements setArcs as g = g { statements=as } - containedIn = undefined -- TODO: should there be one defined? + containedIn = error "containedIn for LDGraph NSGraph lb is undefined!" -- TODO: should there be one defined? -- Optimized method to add arc .. don't check for duplicates. addArc :: (Label lb) => Arc lb -> NSGraph lb -> NSGraph lb diff --git a/Swish/RDF/SwishScript.hs b/Swish/RDF/SwishScript.hs --- a/Swish/RDF/SwishScript.hs +++ b/Swish/RDF/SwishScript.hs @@ -64,7 +64,8 @@ ( parseAnyfromString , parseN3 , N3Parser, N3State(..) - , whiteSpace, symbol, eof, identLetter + , whiteSpace, symbol, lexeme + , eof, identLetter , getPrefix , subgraph , n3symbol -- was uriRef2, @@ -117,18 +118,21 @@ import Control.Monad (unless, when, liftM) +import Data.List (isPrefixOf) + import qualified System.IO.Error as IO ------------------------------------------------------------ --- Parser for Swish script processor ------------------------------------------------------------- -- --- The parser is based on the Notation3 parser, and uses many +-- The parser used to be based on the Notation3 parser, and used many -- of the same syntax productions, but the top-level productions used --- are quite different. +-- are quite different. With the parser re-write it's less clear +-- what is going on. -- -- NOTE: during the parser re-write we strip out some of this functionality -- + +-- | Parser for Swish script processor parseScriptFromString :: Maybe QName -> String -> Either String [SwishStateIO ()] parseScriptFromString = parseAnyfromString script @@ -148,31 +152,35 @@ command :: N3Parser (SwishStateIO ()) command = - do { try $ isymbol "@prefix" - ; getPrefix - ; return $ return () - } - <|> nameItem - <|> readGraph - <|> writeGraph - <|> mergeGraphs - <|> compareGraphs - <|> assertEquiv - <|> assertMember - <|> defineRule - <|> defineRuleset - <|> defineConstraints - <|> checkProofCmd - <|> fwdChain - <|> bwdChain - - "script command" + prefixLine + <|> nameItem + <|> readGraph + <|> writeGraph + <|> mergeGraphs + <|> compareGraphs + <|> assertEquiv + <|> assertMember + <|> defineRule + <|> defineRuleset + <|> defineConstraints + <|> checkProofCmd + <|> fwdChain + <|> bwdChain + "script command" +prefixLine :: N3Parser (SwishStateIO ()) +prefixLine = do + try $ isymbol "@prefix" + getPrefix + whiteSpace + isymbol "." + return $ return () + nameItem :: N3Parser (SwishStateIO ()) nameItem = -- name :- graph -- name :- ( graph* ) - do { u <- n3symbol + do { u <- lexeme n3symbol ; isymbol ":-" ; g <- graphOrList ; return $ ssAddGraph u g @@ -182,8 +190,8 @@ readGraph = -- @read name [ ] do { commandName "@read" - ; n <- n3symbol - ; u <- option "" lexUriRef + ; n <- lexeme n3symbol + ; u <- option "" $ lexUriRef ; return $ ssRead n (if null u then Nothing else Just u) } @@ -191,7 +199,7 @@ writeGraph = -- @write name [ ] ; Comment do { commandName "@write" - ; n <- n3symbol + ; n <- lexeme n3symbol ; let gs = ssGetList n :: SwishStateIO (Either String [RDFGraph]) ; u <- option "" lexUriRef ; isymbol ";" @@ -206,7 +214,7 @@ do { commandName "@merge" ; gs <- graphList ; isymbol "=>" - ; n <- n3symbol + ; n <- lexeme n3symbol ; return $ ssMerge n gs } @@ -214,8 +222,8 @@ compareGraphs = -- @compare name name do { commandName "@compare" - ; n1 <- n3symbol - ; n2 <- n3symbol + ; n1 <- lexeme n3symbol + ; n2 <- lexeme n3symbol ; return $ ssCompare n1 n2 } @@ -223,8 +231,8 @@ assertEquiv = -- @asserteq name name ; Comment do { commandName "@asserteq" - ; n1 <- n3symbol - ; n2 <- n3symbol + ; n1 <- lexeme n3symbol + ; n2 <- lexeme n3symbol ; isymbol ";" ; c <- restOfLine ; return $ ssAssertEq n1 n2 c @@ -234,8 +242,8 @@ assertMember = -- @assertin name name ; Comment do { commandName "@assertin" - ; n1 <- n3symbol - ; n2 <- n3symbol + ; n1 <- lexeme n3symbol + ; n2 <- lexeme n3symbol ; isymbol ";" ; c <- restOfLine ; return $ ssAssertIn n1 n2 c @@ -245,7 +253,7 @@ defineRule = -- @rule name :- ( name* ) => name [ | ( (name var*)* ) ] do { commandName "@rule" - ; rn <- n3symbol + ; rn <- lexeme n3symbol ; isymbol ":-" ; ags <- graphOrList ; isymbol "=>" @@ -258,7 +266,7 @@ defineRuleset = -- @ruleset name :- ( name* ) ; ( name* ) do { commandName "@ruleset" - ; sn <- n3symbol + ; sn <- lexeme n3symbol ; isymbol ":-" ; ags <- nameList ; isymbol ";" @@ -270,7 +278,7 @@ defineConstraints = -- @constraints pref :- ( name* ) | ( name* ) do { commandName "@constraints" - ; sn <- n3symbol + ; sn <- lexeme n3symbol ; isymbol ":-" ; cgs <- graphOrList ; isymbol "|" @@ -285,7 +293,7 @@ -- @step name ( name* ) => name # rule-name, antecedents, consequent -- @result name do { commandName "@proof" - ; pn <- n3symbol + ; pn <- lexeme n3symbol ; sns <- nameList ; commandName "@input" ; igf <- formulaExpr @@ -300,7 +308,7 @@ -> SwishStateIO (Either String RDFProofStep)) checkStep = do { commandName "@step" - ; rn <- n3symbol + ; rn <- lexeme n3symbol ; agfs <- formulaList ; isymbol "=>" ; cgf <- formulaExpr @@ -312,11 +320,11 @@ -- # ruleset rule (antecedents) => result -- @fwdchain pref name ( name* ) => name do { commandName "@fwdchain" - ; sn <- n3symbol - ; rn <- n3symbol + ; sn <- lexeme n3symbol + ; rn <- lexeme n3symbol ; ags <- graphOrList ; isymbol "=>" - ; cn <- n3symbol + ; cn <- lexeme n3symbol ; s <- getState :: N3Parser N3State ; let prefs = prefixUris s :: NamespaceMap ; return $ ssFwdChain sn rn ags cn prefs @@ -327,11 +335,11 @@ -- # ruleset rule consequent <= (antecedent-alts) -- @bwdchain pref name graph <= name do { commandName "@bwdchain" - ; sn <- n3symbol - ; rn <- n3symbol + ; sn <- lexeme n3symbol + ; rn <- lexeme n3symbol ; cg <- graphExpr ; isymbol "<=" - ; an <- n3symbol + ; an <- lexeme n3symbol ; s <- getState :: N3Parser N3State ; let prefs = prefixUris s :: NamespaceMap ; return $ ssBwdChain sn rn cg an prefs @@ -358,14 +366,14 @@ nameList :: N3Parser [ScopedName] nameList = do { isymbol "(" - ; ns <- many n3symbol + ; ns <- many (lexeme n3symbol) ; isymbol ")" ; return ns } nameOrList :: N3Parser [ScopedName] nameOrList = - do { n <- n3symbol + do { n <- lexeme n3symbol ; return [n] } <|> @@ -411,7 +419,7 @@ formulaExpr :: N3Parser (SwishStateIO (Either String RDFFormula)) formulaExpr = - do { n <- n3symbol + do { n <- lexeme n3symbol ; namedGraph n } "Formula (name or named graph)" @@ -444,16 +452,15 @@ ; return vms } <|> - do { vm <- varMod + do { vm <- lexeme varMod ; return [vm] } varMod :: N3Parser (ScopedName,[RDFLabel]) -varMod = - do { rn <- n3symbol - ; vns <- many quickVariable - ; return (rn,vns) - } +varMod = do + rn <- lexeme n3symbol + vns <- many $ lexeme quickVariable + return (rn,vns) ---------------------------------------------------------------------- -- SwishState helper functions @@ -911,11 +918,11 @@ ; return $ Right dat } fromUri = fromFile - fromFile uri = - do { dat <- lift $ readFile uri - ; return $ Right dat - } - + fromFile uri | "file://" `isPrefixOf` uri = do + dat <- lift $ readFile $ drop 7 uri + return $ Right dat + | otherwise = error $ "Unsupported file name for read: " ++ uri + -- Temporary implementation: just write local file -- (Need to add logic to separate filenames from URIs, and -- attempt HTTP PUT, or similar.) @@ -933,8 +940,9 @@ } where toStdout = putStrLn gstr - toUri uri = writeFile uri gstr - gstr = gsh "" + toUri uri | "file://" `isPrefixOf` uri = writeFile (drop 7 uri) gstr + | otherwise = error $ "Unsupported file name for write: " ++ uri + gstr = gsh "\n" -------------------------------------------------------------------------------- -- diff --git a/scripts/SwishExample.ss b/scripts/SwishExample.ss new file mode 100644 --- /dev/null +++ b/scripts/SwishExample.ss @@ -0,0 +1,219 @@ +# Extracted from +# http://www.ninebynine.org/RDFNotes/Swish/Intro.html +# 09 April 2011 +# +# it is the same as the script in +# http://www.ninebynine.org/Software/Swish-0.2.0.html +# bar some minor formatting differences. +# +# -- Example Swish script -- +# +# Comment lines start with a '#' +# +# The script syntax is loosely based on Notation3, but it is a quite +# different language, except that embedded graphs (enclosed in {...}) +# are encoded using Notation3 syntax. +# +# -- Prefix declarations -- +# +# As well as being used for all labels defined and used by the script +# itself, these are applied to all graph expressions within the script +# file, and to graphs created by scripted inferences, +# but are not applied to any graphs read in from an external source. + +@prefix ex: . +@prefix pv: . +@prefix xsd: . +@prefix xsd_integer: . +@prefix rs_rdf: . +@prefix rs_rdfs: . +@prefix : . + +# Additionally, prefix declarations are provided automatically for: +# @prefix rdf: . +# @prefix rdfs: . +# @prefix rdfd: . +# @prefix rdfo: . +# @prefix owl: . + + +# -- Simple named graph declarations -- + +ex:Rule01Ant :- { ?p ex:son ?o . } + +ex:Rule01Con :- { ?o a ex:Male ; ex:parent ?p . } + +ex:TomSonDick :- { :Tom ex:son :Dick . } + +ex:TomSonHarry :- { :Tom ex:son :Harry . } + + +# -- Named rule definition -- + +@rule ex:Rule01 :- ( ex:Rule01Ant ) => ex:Rule01Con + + +# -- Named ruleset definition -- +# +# A 'ruleset' is a collection of axioms and rules. +# +# Currently, the ruleset is identified using the namespace alone; +# i.e. the 'rules' in 'ex:rules' below is not used. +# This is under review. + +@ruleset ex:rules :- (ex:TomSonDick ex:TomSonHarry) ; (ex:Rule01) + +# -- Forward application of rule -- +# +# The rule is identified here by ruleset and a name within the ruleset. + +@fwdchain ex:rules ex:Rule01 { :Tom ex:son :Charles . } => ex:Rule01fwd + +# -- Compare graphs -- +# +# Compare result of inference with expected result. +# This is a graph isomorphism test rather than strict equality, +# to allow for bnode renaming. +# If the graphs are not equal, a message is generated +# The comment (';' to end of line) is included in any message generated + +ex:ExpectedRule01fwd :- { :Charles a ex:Male ; ex:parent :Tom . } + +@asserteq ex:Rule01fwd ex:ExpectedRule01fwd + ; Infer that Charles is male and has parent Tom + +# -- Display graph -- +# +# Write graph as Notation3 to standard output. +# The comment is included in the output. + +@write ex:Rule01fwd ; Charles is male and has parent Tom + +# -- Write graph to file -- +# +# The comment is included at the head of the file. +# (TODO: support for output to Web using HTTP.) + +@write ex:Rule01fwd ; Charles is male and has parent Tom + +# -- Read graph from file -- +# +# Creates a new named graph in the Swish environment. +# (TODO: support for input from Web using HTTP.) + +@read ex:Rule01inp + +# -- Proof check -- +# +# This proof uses the built-in RDF and RDFS rulesets, +# which are the RDF- and RDFS- entailment rules described in the RDF +# formal semantics document. +# +# To prove: +# ex:foo ex:prop "a" . +# RDFS-entails +# ex:foo ex:prop _:x . +# _:x rdf:type rdfs:Resource . +# +# If the proof is not valid according to the axioms and rules of the +# ruleset(s) used and antecedents given, then an error is reported +# indicating the failed proof step. + +ex:Input01 :- { ex:foo ex:prop "a" . } + +ex:Result :- { ex:foo ex:prop _:a . _:a rdf:type rdfs:Resource . } + +@proof ex:Proof01 ( rs_rdf:rules rs_rdfs:rules ) + @input ex:Input01 + @step rs_rdfs:r3 ( rs_rdfs:a10 rs_rdfs:a39 ) + => ex:Step01a :- { rdfs:Literal rdf:type rdfs:Class . } + @step rs_rdfs:r8 ( ex:Step01a ) + => ex:Step01b :- { rdfs:Literal rdfs:subClassOf rdfs:Resource . } + @step rs_rdfs:r1 ( ex:Input01 ) + => ex:Step01c :- { ex:foo ex:prop _:a . _:a rdf:type rdfs:Literal . } + @step rs_rdfs:r9 ( ex:Step01b ex:Step01c ) + => ex:Step01d :- { _:a rdf:type rdfs:Resource . } + @step rs_rdf:se ( ex:Step01c ex:Step01d ) => ex:Result + @result ex:Result + +# -- Restriction based datatype inferencing -- +# +# Datatype inferencing based on a general class restriction and +# a predefined relation (per idea noted by Pan and Horrocks). + +ex:VehicleRule :- + { :PassengerVehicle a rdfd:GeneralRestriction ; + rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; + rdfd:constraint xsd_integer:sum ; + rdfd:maxCardinality "1"^^xsd:nonNegativeInteger . } + +# Define a new ruleset based on a declaration of a constraint class +# and reference to built-in datatype. +# The datatype constraint xsd_integer:sum is part of the definition +# of datatype xsd:integer that is cited in the constraint ruleset +# declaration. It relates named properties of a class instance. + +@constraints pv:rules :- ( ex:VehicleRule ) | xsd:integer + +# Input data for test cases: + +ex:Test01Inp :- + { _:a1 a :PassengerVehicle ; + :seatedCapacity "30"^^xsd:integer ; + :standingCapacity "20"^^xsd:integer . } + +# Forward chaining test case: + +ex:Test01Fwd :- { _:a1 :totalCapacity "50"^^xsd:integer . } + +@fwdchain pv:rules :PassengerVehicle ex:Test01Inp => :t1f +@asserteq :t1f ex:Test01Fwd ; Forward chain test + +# Backward chaining test case: +# +# Note that the result of backward chaining is a list of alternatives, +# any one of which is sufficient to derive the given conclusion. + +ex:Test01Bwd0 :- + { _:a1 a :PassengerVehicle . + _:a1 :totalCapacity "50"^^xsd:integer . + _:a1 :seatedCapacity "30"^^xsd:integer . } + +ex:Test01Bwd1 :- + { _:a1 a :PassengerVehicle . + _:a1 :totalCapacity "50"^^xsd:integer . + _:a1 :standingCapacity "20"^^xsd:integer . } + +# Declare list of graphs: + +ex:Test01Bwd :- ( ex:Test01Bwd0 ex:Test01Bwd1 ) + +@bwdchain pv:rules :PassengerVehicle ex:Test01Inp <= :t1b + +@asserteq :t1b ex:Test01Bwd ; Backward chain test + +# Can test for graph membership in a list + +@assertin ex:Test01Bwd0 :t1b ; Backward chain component test (0) +@assertin ex:Test01Bwd1 :t1b ; Backward chain component test (1) + +# -- Merge graphs -- +# +# Merging renames bnodes to avoid collisions. + +@merge ( ex:Test01Bwd0 ex:Test01Bwd1 ) => ex:Merged + +# This form of comparison sets the Swish exit status based on the result. + +ex:ExpectedMerged :- + { _:a1 a :PassengerVehicle . + _:a1 :totalCapacity "50"^^xsd:integer . + _:a1 :seatedCapacity "30"^^xsd:integer . + _:a2 a :PassengerVehicle . + _:a2 :totalCapacity "50"^^xsd:integer . + _:a2 :standingCapacity "20"^^xsd:integer . } + +@compare ex:Merged ex:ExpectedMerged + +# End of example script + diff --git a/scripts/SwishTest.ss b/scripts/SwishTest.ss new file mode 100644 --- /dev/null +++ b/scripts/SwishTest.ss @@ -0,0 +1,239 @@ +# $Id: SwishTest.ss,v 1.8 2003/12/18 20:46:24 graham Exp $ +# +# Swish script: test script +# +# --------+---------+---------+---------+---------+---------+---------+--------- + +@prefix ex: . +@prefix pv: . +@prefix xsd: . +@prefix xsd_integer: . +@prefix rs_rdf: . +@prefix rs_rdfs: . +@prefix : . + + +# Simple inference tests + +ex:VehicleRule :- + { + :PassengerVehicle a rdfd:GeneralRestriction ; + rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; + rdfd:constraint xsd_integer:sum . + } + +ex:VehicleRule1 :- + { + :PassengerVehicle1 a rdfd:GeneralRestriction ; + rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; + rdfd:constraint xsd_integer:sum ; + rdfd:maxCardinality "1"^^xsd:nonNegativeInteger . + } + +@merge ( ex:VehicleRule ex:VehicleRule1 ) => ex:VehicleRules +@write ex:VehicleRules ; Vehicle rules file +@read ex:VehicleRuleFile +@asserteq ex:VehicleRuleFile ex:VehicleRules ; Compare read and internal graphs + +ex:Test01Inp :- + { _:a1 a :PassengerVehicle ; + :seatedCapacity "30"^^xsd:integer ; + :standingCapacity "20"^^xsd:integer . + } + +ex:Test01Fwd :- + { _:a1 :totalCapacity "50"^^xsd:integer . + } + +ex:Test01Bwd0 :- + { _:a1 a :PassengerVehicle . + _:a1 :totalCapacity "50"^^xsd:integer . + _:a1 :seatedCapacity "30"^^xsd:integer . + } + +ex:Test01Bwd1 :- + { _:a1 a :PassengerVehicle . + _:a1 :totalCapacity "50"^^xsd:integer . + _:a1 :standingCapacity "20"^^xsd:integer . + } + +ex:Test01Bwd :- ( ex:Test01Bwd0 ex:Test01Bwd1 ) + +@constraints pv:rules :- ( ex:VehicleRule ex:VehicleRule1 ) | xsd:integer + +@fwdchain pv:rules :PassengerVehicle ex:Test01Inp => :t1f +# @write :t1f ; Forward chain result :t1f +@asserteq :t1f ex:Test01Fwd ; Forward chain test + +@bwdchain pv:rules :PassengerVehicle ex:Test01Inp <= :t1b +# @write :t1b ; Backward chain result :t1b +# @write ex:Test01Bwd ; Backward chain expected ex:Test01Bwd +@asserteq :t1b ex:Test01Bwd ; Backward chain test +@assertin ex:Test01Bwd0 :t1b ; Backward chain component test (0) +@assertin ex:Test01Bwd1 :t1b ; Backward chain component test (1) + +# Proof test, using simple built-in RDF ruleset +# +# To prove: +# ex:foo ex:prop "a" . +# RDFS-entails +# ex:foo ex:prop _:x . +# _:x rdf:type rdfs:Resource . +# + +ex:Input01 :- + { ex:foo ex:prop "a" . + } + +ex:Step01a :- + { rdfs:Literal rdf:type rdfs:Class . + } + +ex:Step01b :- + { rdfs:Literal rdfs:subClassOf rdfs:Resource . + } + +ex:Step01c :- + { ex:foo ex:prop _:a . + _:a rdf:_allocatedTo "a" . + } + +ex:Step01d :- + { _:a rdf:type rdfs:Literal . + } + +ex:Step01e :- + { _:a rdf:type rdfs:Resource . + } + +ex:Result :- + { ex:foo ex:prop _:a . + _:a rdf:type rdfs:Resource . + } + +@proof ex:Proof01 ( rs_rdf:rules rs_rdfs:rules ) + @input ex:Input01 + @step rs_rdfs:r3 ( rs_rdfs:a10 rs_rdfs:a39 ) => ex:Step01a + @step rs_rdfs:r8 ( ex:Step01a ) => ex:Step01b + @step rs_rdf:lg ( ex:Input01 ) => ex:Step01c + @step rs_rdfs:r1 ( ex:Step01c ) => ex:Step01d + @step rs_rdfs:r9 ( ex:Step01b ex:Step01d ) => ex:Step01e + @step rs_rdf:se ( ex:Step01c ex:Step01e ) => ex:Result + @result ex:Result + +#@fwdchain rs_rdfs:rules rs_rdfs:r9 ( ex:Step01b ex:Step01c ) => ex:Step01dd +#@write ex:Step01b ; ex:Step01b +#@write ex:Step01c ; ex:Step01c +#@write ex:Step01dd ; Forward chain simple rule rs_rdfs:r9 + + +# Simple deduction rule test + +ex:Rule01Ant :- + { ?p ex:son ?o . } +ex:Rule01Con :- + { ?o a ex:Male ; + ex:parent ?p . } + +ex:Rule02Ant :- + { ?p ex:daughter ?o . } +ex:Rule02Con :- + { ?o a ex:Female ; + ex:parent ?p . } + +ex:Rule03Ant :- + { ?o1 a ex:Male ; + ex:parent ?p . + ?o2 a ex:Female ; + ex:parent ?p . + } +ex:Rule03Con :- + { ?o1 ex:sister ?o2 . + ?o2 ex:brother ?o1 . + } + +@rule ex:Rule01 :- ( ex:Rule01Ant ) => ex:Rule01Con +@rule ex:Rule02 :- ( ex:Rule02Ant ) => ex:Rule02Con +@rule ex:Rule03 :- ( ex:Rule03Ant ) => ex:Rule03Con + +@ruleset ex:rules :- () ; ( ex:Rule01 ex:Rule02 ex:Rule03 ) + +@proof ex:Proof02 ( ex:rules ) + @input ex:inp :- { _:p ex:son ex:s ; ex:daughter ex:d . } + @step ex:Rule01 ( ex:inp ) => ex:st1 :- + { ex:s a ex:Male ; ex:parent _:a . } + @step ex:Rule02 ( ex:inp ) => ex:st2 :- + { ex:d a ex:Female ; ex:parent _:a . } + @step ex:Rule03 ( ex:st1 ex:st2 ) => ex:res :- + { ex:s ex:sister ex:d . + ex:d ex:brother ex:s . } + @result ex:res + +#ex:proof01inp :- { _:p ex:son ex:s ; ex:daughter ex:d . } +#@fwdchain ex:rules ex:Rule01 ex:proof01inp => ex:rule01fwd +#@write ex:rule01fwd ; Forward chain simple rule 01 +#@fwdchain ex:rules ex:Rule02 ex:proof01inp => ex:rule02fwd +#@write ex:rule02fwd ; Forward chain simple rule 02 +#@fwdchain ex:rules ex:Rule03 (ex:rule01fwd ex:rule02fwd) => ex:rule03fwd +#@write ex:rule03fwd ; Forward chain simple rule 03 + +# TODO: test rule with variable binding modifiers + +# Merge, I/O and compare tests + +ex:TestMerge :- + { _:b1 a :PassengerVehicle . + _:b1 :totalCapacity "50"^^xsd:integer . + _:b1 :seatedCapacity "30"^^xsd:integer . + _:b2 a :PassengerVehicle . + _:b2 :totalCapacity "50"^^xsd:integer . + _:b2 :standingCapacity "20"^^xsd:integer . + } + +@merge ( ex:Test01Bwd0 ex:Test01Bwd1 ) => ex:tmout + +@asserteq ex:TestMerge ex:tmout ; Check merged graph + +@write ex:tmout ; Test graph merge and read/write +@write ex:TestMerge ; Test graph merge and read/write + +@read ex:tmin + +@asserteq ex:TestMerge ex:tmin ; Check graph read back + +@compare ex:tmin ex:tmout +# @compare ex:tmin ex:VehicleRule + +# $Log: SwishTest.ss,v $ +# Revision 1.8 2003/12/18 20:46:24 graham +# Added xsd:string module to capture equivalence of xsd:string +# and plain literals without a language tag +# +# Revision 1.7 2003/12/11 19:11:07 graham +# Script processor passes all initial tests. +# +# Revision 1.6 2003/12/10 14:43:00 graham +# Backup. +# +# Revision 1.5 2003/12/10 03:48:58 graham +# SwishScript nearly complete: BwdChain and PrrofCheck to do. +# +# Revision 1.4 2003/12/08 23:55:36 graham +# Various enhancements to variable bindings and proof structure. +# New module BuiltInMap coded and tested. +# Script processor is yet to be completed. +# +# Revision 1.3 2003/12/05 02:31:32 graham +# Script parsing complete. +# Some Swish script functions run successfully. +# Command execution to be completed. +# +# Revision 1.2 2003/12/04 02:53:28 graham +# More changes to LookupMap functions. +# SwishScript logic part complete, type-checks OK. +# +# Revision 1.1 2003/12/01 18:51:38 graham +# Described syntax for Swish script. +# Created Swish scripting test data. +# Edited export/import lists in Swish main program modules. +# diff --git a/scripts/VehicleCapacity.ss b/scripts/VehicleCapacity.ss new file mode 100644 --- /dev/null +++ b/scripts/VehicleCapacity.ss @@ -0,0 +1,65 @@ +# $Id: VehicleCapacity.ss,v 1.1 2004/02/09 22:22:44 graham Exp $ +# +# Swish script: vehicle capacity examples +# +# --------+---------+---------+---------+---------+---------+---------+--------- + +@prefix ex: . +@prefix pv: . +@prefix xsd: . +@prefix xsd_integer: . +@prefix rs_rdf: . +@prefix rs_rdfs: . +@prefix : . + + +# Deduce total capacity using simple deduction with variable binding modifier + +ex:Test01Inp :- + { _:a1 a :PassengerVehicle ; + :seatedCapacity "98"^^xsd:integer ; + :standingCapacity "12"^^xsd:integer . + } + +ex:Rule01Ant :- + { _:a1 a :PassengerVehicle ; + :seatedCapacity ?c1 ; + :standingCapacity ?c2 . + } +ex:Rule01Con :- + { _:a1 :totalCapacity ?ct . + } + +@rule ex:Rule1 :- ( ex:Rule01Ant ) => ex:Rule01Con + | ( xsd_integer:sum ?ct ?c1 ?c2 ) + +@ruleset pv:rules1 :- () ; ( ex:Rule1 ) + +@fwdchain pv:rules1 ex:Rule1 ex:Test01Inp => :t1f +@write :t1f ; Forward chain result :t1f + + +# Deduce total capacity using general restriction + +ex:VehicleRule2 :- + { :PassengerVehicle a rdfd:GeneralRestriction ; + rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; + rdfd:constraint xsd_integer:sum ; + rdfd:maxCardinality "1"^^xsd:nonNegativeInteger . + } + +@constraints pv:rules2 :- ( ex:VehicleRule2 ) | xsd:integer + +@fwdchain pv:rules2 :PassengerVehicle ex:Test01Inp => :t2f +@write :t2f ; Forward chain result :t2f + +@bwdchain pv:rules2 :PassengerVehicle ex:Test01Inp <= :t2b +@write :t2b ; Backward chain result :t2b + +# $Log: VehicleCapacity.ss,v $ +# Revision 1.1 2004/02/09 22:22:44 graham +# Graph matching updates: change return value to give some indication +# of the extent match achieved in the case of no match. +# Added new module GraphPartition and test cases. +# Add VehicleCapcity demonstration script. +# diff --git a/swish.cabal b/swish.cabal --- a/swish.cabal +++ b/swish.cabal @@ -1,5 +1,5 @@ Name: swish -Version: 0.3.0.0 +Version: 0.3.0.1 Stability: experimental License: LGPL License-file: LICENSE @@ -27,7 +27,7 @@ Swish is a work-in-progress, and currently incorporates: . * Notation3 and NTriples input and output. The N3 support is - incomplete (no handling of @forAll@). + incomplete (no handling of @\@forAll@). . * RDF graph isomorphism testing and merging. . @@ -45,6 +45,11 @@ . Major Changes: . + [Version 0.3.0.1] updates the Swish script parser to work with the + changes in 0.3.0.0. Several example scripts are installed in the + @scripts/@ directory, although only @VehicleCapacity.ss@ works + with this release. + . [Version 0.3.0.0] is an attempt to update version 0.2.1 () to build against @@ -63,6 +68,7 @@ Build-Type: Simple Data-Files: README + scripts/*.ss Source-repository head type: mercurial @@ -75,7 +81,6 @@ Flag hpc Description: Use Hpc for the tests Default: False - Library Build-Depends: diff --git a/tests/GraphTest.hs b/tests/GraphTest.hs --- a/tests/GraphTest.hs +++ b/tests/GraphTest.hs @@ -19,13 +19,13 @@ import Test.HUnit ( Test(TestCase,TestList,TestLabel), assertEqual, runTestTT ) -import Data.List( elemIndex ) -import Data.Maybe( fromJust ) +import Data.List (sort, elemIndex) +import Data.Maybe (fromJust) import Swish.Utils.ListHelpers import Swish.Utils.MiscHelpers import Swish.RDF.GraphClass (Arc(..), LDGraph(..), - Label(..), + Label(..), arc, arcFromTriple,arcToTriple) import Swish.RDF.GraphMem import Swish.RDF.GraphMatch @@ -48,6 +48,8 @@ -- Define some common values ------------------------------------------------------------ +type Statement = Arc LabelMem + base1, base2, base3, base4 :: String base1 = "http://id.ninebynine.org/wip/2003/test/graph1/node#" @@ -59,17 +61,14 @@ -- Set, get graph arcs as lists of triples ------------------------------------------------------------ -setArcsT :: (Swish.RDF.GraphClass.LDGraph lg lb) => +setArcsT :: (LDGraph lg lb) => [(lb, lb, lb)] -> lg lb -> lg lb setArcsT a = setArcs $ map arcFromTriple a -getArcsT :: (Swish.RDF.GraphClass.LDGraph lg lb) => +getArcsT :: (LDGraph lg lb) => lg lb -> [(lb, lb, lb)] getArcsT g = map arcToTriple $ getArcs g -toStatement :: a -> a -> a -> Arc a -toStatement s p o = Arc s p o - ------------------------------------------------------------ -- Test class helper ------------------------------------------------------------ @@ -218,7 +217,7 @@ lab2v = LV "lab2" gr1 :: GraphMem LabelMem -gr1 = GraphMem { arcs=[]::[Arc LabelMem] } +gr1 = GraphMem { arcs=[]::[Statement] } ga1 :: [(LabelMem, LabelMem, LabelMem)] ga1 = @@ -238,7 +237,7 @@ (lab1v,lab2f,lab2v) ] -gs4 :: Arc LabelMem -> Bool +gs4 :: Statement -> Bool gs4 (Arc _ _ (LV "lab2")) = True gs4 (Arc _ _ _ ) = False @@ -253,7 +252,7 @@ ] gr2 :: GraphMem LabelMem -gr2 = GraphMem { arcs=[]::[Arc LabelMem] } +gr2 = GraphMem { arcs=[]::[Statement] } ga2 :: [(LabelMem, LabelMem, LabelMem)] ga2 = @@ -265,7 +264,7 @@ ] gr3 :: GraphMem LabelMem -gr3 = GraphMem { arcs=[]::[Arc LabelMem] } +gr3 = GraphMem { arcs=[]::[Statement] } ga3 :: [(LabelMem, LabelMem, LabelMem)] ga3 = @@ -463,12 +462,13 @@ -- Statement construction and equality tests ------------------------------------------------------------ -type Statement = Arc LabelMem - testStmtEq :: String -> Bool -> Statement -> Statement -> Test testStmtEq lab eq t1 t2 = TestCase ( assertEqual ("testStmtEq:"++lab) eq (t1==t2) ) +-- String argument is no longer needed, due to refactoring of +-- tlist, but left in +-- slist :: [(String, LabelMem)] slist = [ @@ -487,31 +487,30 @@ ("l1",l1), ("l4",l4), ("l7",l7), ("l8",l8), ("l10",l10) ] -tlist :: [(String, Arc LabelMem)] +tlist :: [(String, Statement)] tlist = - [ (lab s p o,trp s p o) | s <- slist, p <- plist, o <- olist ] + [ t s p o | (_,s) <- slist, (_,p) <- plist, (_,o) <- olist ] where - lab (s,_) (p,_) (o,_) = s++"."++p++"."++o - trp (_,s) (_,p) (_,o) = Arc s p o + t s p o = let a = Arc s p o in (show a, a) stmteqlist :: [(String, String)] stmteqlist = [ - ("s6.p1.l1", "s7.p1.l1"), - ("s6.p1.l4", "s7.p1.l4"), - ("s6.p1.l7", "s7.p1.l7"), - ("s6.p1.l7", "s7.p1.l8"), - ("s6.p1.l8", "s7.p1.l7"), - ("s6.p1.l8", "s7.p1.l8"), - ("s6.p1.l10","s7.p1.l10"), - ("s6.p1.o1", "s7.p1.o1"), - ("s6.p1.o4", "s7.p1.o4"), - ("s6.p1.o5", "s7.p1.o5"), - ("s1.p1.l7", "s1.p1.l8"), - ("s4.p1.l7", "s4.p1.l8"), - ("s5.p1.l7", "s5.p1.l8"), - ("s6.p1.l7", "s6.p1.l8"), - ("s7.p1.l7", "s7.p1.l8") + ("(s6,p1,l1)", "(s7,p1,l1)"), + ("(s6,p1,l4)", "(s7,p1,l4)"), + ("(s6,p1,l7)", "(s7,p1,l7)"), + ("(s6,p1,l7)", "(s7,p1,l8)"), + ("(s6,p1,l8)", "(s7,p1,l7)"), + ("(s6,p1,l8)", "(s7,p1,l8)"), + ("(s6,p1,l10)","(s7,p1,l10)"), + ("(s6,p1,o1)", "(s7,p1,o1)"), + ("(s6,p1,o4)", "(s7,p1,o4)"), + ("(s6,p1,o5)", "(s7,p1,o5)"), + ("(s1,p1,l7)", "(s1,p1,l8)"), + ("(s4,p1,l7)", "(s4,p1,l8)"), + ("(s5,p1,l7)", "(s5,p1,l8)"), + ("(s6,p1,l7)", "(s6,p1,l8)"), + ("(s7,p1,l7)", "(s7,p1,l8)") ] testStmtEqSuite :: Test @@ -617,25 +616,28 @@ -- Graph matching support ------------------------------------------------------------ -t01, t02, t03, t04, t05, t06 :: Arc LabelMem -t01 = toStatement s1 p1 o1 -t02 = toStatement s2 p1 o2 -t03 = toStatement s3 p1 o3 -t04 = toStatement s1 p1 l1 -t05 = toStatement s2 p1 l4 -t06 = toStatement s3 p1 l10 +t01, t02, t03, t04, t05, t06 :: Statement +t01 = arc s1 p1 o1 +t02 = arc s2 p1 o2 +t03 = arc s3 p1 o3 +t04 = arc s1 p1 l1 +t05 = arc s2 p1 l4 +t06 = arc s3 p1 l10 -t10, t11, t12 :: Arc LabelMem -t10 = toStatement s1 p1 b1 -t11 = toStatement b1 p2 b2 -t12 = toStatement b2 p3 o1 +tOrder16 :: [Statement] +tOrder16 = [t04, t01, t05, t02, t06, t03] + +t10, t11, t12 :: Statement +t10 = arc s1 p1 b1 +t11 = arc b1 p2 b2 +t12 = arc b2 p3 o1 -t20, t21, t22 :: Arc LabelMem -t20 = toStatement s1 p1 b3 -t21 = toStatement b3 p2 b4 -t22 = toStatement b4 p3 o1 +t20, t21, t22 :: Statement +t20 = arc s1 p1 b3 +t21 = arc b3 p2 b4 +t22 = arc b4 p3 o1 -as1, as2, as4, as5, as6 :: [Arc LabelMem] +as1, as2, as4, as5, as6 :: [Statement] as1 = [t01] as2 = [t01,t02,t03,t04,t05,t06] as4 = [t01,t02,t03,t04,t05,t06,t10,t11,t12] @@ -718,6 +720,9 @@ , testGraphLabels16 , testAssignLabelMap05 , testAssignLabelMap06 + -- implicitly tested elsewhere but included here for completeness + , testeq "O16-identity" tOrder16 $ sort tOrder16 + , testeq "O16-compare" tOrder16 $ sort [t01,t02,t03,t04,t05,t06] ] ------------------------------------------------------------ @@ -1207,22 +1212,22 @@ t10102, t10203, t10304, t10405, t10501, t10106, t10207, t10308, t10409, t10510, t10607, - t10708, t10809, t10910, t11006 :: Arc LabelMem -t10102 = toStatement v101 p101 v102 -t10203 = toStatement v102 p102 v103 -t10304 = toStatement v103 p103 v104 -t10405 = toStatement v104 p104 v105 -t10501 = toStatement v105 p105 v101 -t10106 = toStatement v101 p106 v106 -t10207 = toStatement v102 p107 v107 -t10308 = toStatement v103 p108 v108 -t10409 = toStatement v104 p109 v109 -t10510 = toStatement v105 p110 v110 -t10607 = toStatement v106 p111 v107 -t10708 = toStatement v107 p112 v108 -t10809 = toStatement v108 p113 v109 -t10910 = toStatement v109 p114 v110 -t11006 = toStatement v110 p115 v106 + t10708, t10809, t10910, t11006 :: Statement +t10102 = arc v101 p101 v102 +t10203 = arc v102 p102 v103 +t10304 = arc v103 p103 v104 +t10405 = arc v104 p104 v105 +t10501 = arc v105 p105 v101 +t10106 = arc v101 p106 v106 +t10207 = arc v102 p107 v107 +t10308 = arc v103 p108 v108 +t10409 = arc v104 p109 v109 +t10510 = arc v105 p110 v110 +t10607 = arc v106 p111 v107 +t10708 = arc v107 p112 v108 +t10809 = arc v108 p113 v109 +t10910 = arc v109 p114 v110 +t11006 = arc v110 p115 v106 -- Graph pattern 2: -- pentangle-in-pentangle, corresponding vertices linked downward @@ -1260,22 +1265,22 @@ t20102, t20203, t20304, t20405, t20501, t20601, t20702, t20803, t20904, t21005, t20607, - t20708, t20809, t20910, t21006 :: Arc LabelMem -t20102 = toStatement v201 p201 v202 -t20203 = toStatement v202 p202 v203 -t20304 = toStatement v203 p203 v204 -t20405 = toStatement v204 p204 v205 -t20501 = toStatement v205 p205 v201 -t20601 = toStatement v206 p206 v201 -t20702 = toStatement v207 p207 v202 -t20803 = toStatement v208 p208 v203 -t20904 = toStatement v209 p209 v204 -t21005 = toStatement v210 p210 v205 -t20607 = toStatement v206 p211 v207 -t20708 = toStatement v207 p212 v208 -t20809 = toStatement v208 p213 v209 -t20910 = toStatement v209 p214 v210 -t21006 = toStatement v210 p215 v206 + t20708, t20809, t20910, t21006 :: Statement +t20102 = arc v201 p201 v202 +t20203 = arc v202 p202 v203 +t20304 = arc v203 p203 v204 +t20405 = arc v204 p204 v205 +t20501 = arc v205 p205 v201 +t20601 = arc v206 p206 v201 +t20702 = arc v207 p207 v202 +t20803 = arc v208 p208 v203 +t20904 = arc v209 p209 v204 +t21005 = arc v210 p210 v205 +t20607 = arc v206 p211 v207 +t20708 = arc v207 p212 v208 +t20809 = arc v208 p213 v209 +t20910 = arc v209 p214 v210 +t21006 = arc v210 p215 v206 -- Graph pattern 3: -- star-in-pentangle, corresponding vertices linked toward star @@ -1317,22 +1322,22 @@ t30102, t30203, t30304, t30405, t30501, t30106, t30207, t30308, t30409, t30510, t30608, - t30709, t30810, t30906, t31007 :: Arc LabelMem -t30102 = toStatement v301 p301 v302 -t30203 = toStatement v302 p302 v303 -t30304 = toStatement v303 p303 v304 -t30405 = toStatement v304 p304 v305 -t30501 = toStatement v305 p305 v301 -t30106 = toStatement v301 p306 v306 -t30207 = toStatement v302 p307 v307 -t30308 = toStatement v303 p308 v308 -t30409 = toStatement v304 p309 v309 -t30510 = toStatement v305 p310 v310 -t30608 = toStatement v306 p311 v308 -t30709 = toStatement v307 p312 v309 -t30810 = toStatement v308 p313 v310 -t30906 = toStatement v309 p314 v306 -t31007 = toStatement v310 p315 v307 + t30709, t30810, t30906, t31007 :: Statement +t30102 = arc v301 p301 v302 +t30203 = arc v302 p302 v303 +t30304 = arc v303 p303 v304 +t30405 = arc v304 p304 v305 +t30501 = arc v305 p305 v301 +t30106 = arc v301 p306 v306 +t30207 = arc v302 p307 v307 +t30308 = arc v303 p308 v308 +t30409 = arc v304 p309 v309 +t30510 = arc v305 p310 v310 +t30608 = arc v306 p311 v308 +t30709 = arc v307 p312 v309 +t30810 = arc v308 p313 v310 +t30906 = arc v309 p314 v306 +t31007 = arc v310 p315 v307 -- Graph pattern 4: -- pentangle-in-pentangle, corresponding vertices linked upward @@ -1372,22 +1377,22 @@ t40102, t40203, t40304, t40405, t40501, t40106, t40207, t40308, t40409, t40510, t41009, - t40908, t40807, t40706, t40610:: Arc LabelMem -t40102 = toStatement v401 p401 v402 -t40203 = toStatement v402 p402 v403 -t40304 = toStatement v403 p403 v404 -t40405 = toStatement v404 p404 v405 -t40501 = toStatement v405 p405 v401 -t40106 = toStatement v401 p406 v406 -t40207 = toStatement v402 p407 v407 -t40308 = toStatement v403 p408 v408 -t40409 = toStatement v404 p409 v409 -t40510 = toStatement v405 p410 v410 -t41009 = toStatement v410 p411 v409 -t40908 = toStatement v409 p412 v408 -t40807 = toStatement v408 p413 v407 -t40706 = toStatement v407 p414 v406 -t40610 = toStatement v406 p415 v410 + t40908, t40807, t40706, t40610:: Statement +t40102 = arc v401 p401 v402 +t40203 = arc v402 p402 v403 +t40304 = arc v403 p403 v404 +t40405 = arc v404 p404 v405 +t40501 = arc v405 p405 v401 +t40106 = arc v401 p406 v406 +t40207 = arc v402 p407 v407 +t40308 = arc v403 p408 v408 +t40409 = arc v404 p409 v409 +t40510 = arc v405 p410 v410 +t41009 = arc v410 p411 v409 +t40908 = arc v409 p412 v408 +t40807 = arc v408 p413 v407 +t40706 = arc v407 p414 v406 +t40610 = arc v406 p415 v410 -- Graph pattern 5: -- Same as pattern 1, except same fixed property in all cases. @@ -1397,44 +1402,44 @@ t50102, t50203, t50304, t50405, t50501, t50106, t50207, t50308, t50409, t50510, t50607, t50708, t50809, - t50910, t51006 :: Arc LabelMem -t50102 = toStatement v101 p5 v102 -t50203 = toStatement v102 p5 v103 -t50304 = toStatement v103 p5 v104 -t50405 = toStatement v104 p5 v105 -t50501 = toStatement v105 p5 v101 -t50106 = toStatement v101 p5 v106 -t50207 = toStatement v102 p5 v107 -t50308 = toStatement v103 p5 v108 -t50409 = toStatement v104 p5 v109 -t50510 = toStatement v105 p5 v110 -t50607 = toStatement v106 p5 v107 -t50708 = toStatement v107 p5 v108 -t50809 = toStatement v108 p5 v109 -t50910 = toStatement v109 p5 v110 -t51006 = toStatement v110 p5 v106 + t50910, t51006 :: Statement +t50102 = arc v101 p5 v102 +t50203 = arc v102 p5 v103 +t50304 = arc v103 p5 v104 +t50405 = arc v104 p5 v105 +t50501 = arc v105 p5 v101 +t50106 = arc v101 p5 v106 +t50207 = arc v102 p5 v107 +t50308 = arc v103 p5 v108 +t50409 = arc v104 p5 v109 +t50510 = arc v105 p5 v110 +t50607 = arc v106 p5 v107 +t50708 = arc v107 p5 v108 +t50809 = arc v108 p5 v109 +t50910 = arc v109 p5 v110 +t51006 = arc v110 p5 v106 -- Graph pattern 6: -- Same as pattern 5, with different variables t60102, t60203, t60304, t60405, t60501, t60106, t60207, t60308, t60409, t60510, t60607, t60708, - t60809, t60910, t61006 :: Arc LabelMem -t60102 = toStatement v201 p5 v202 -t60203 = toStatement v202 p5 v203 -t60304 = toStatement v203 p5 v204 -t60405 = toStatement v204 p5 v205 -t60501 = toStatement v205 p5 v201 -t60106 = toStatement v201 p5 v206 -t60207 = toStatement v202 p5 v207 -t60308 = toStatement v203 p5 v208 -t60409 = toStatement v204 p5 v209 -t60510 = toStatement v205 p5 v210 -t60607 = toStatement v206 p5 v207 -t60708 = toStatement v207 p5 v208 -t60809 = toStatement v208 p5 v209 -t60910 = toStatement v209 p5 v210 -t61006 = toStatement v210 p5 v206 + t60809, t60910, t61006 :: Statement +t60102 = arc v201 p5 v202 +t60203 = arc v202 p5 v203 +t60304 = arc v203 p5 v204 +t60405 = arc v204 p5 v205 +t60501 = arc v205 p5 v201 +t60106 = arc v201 p5 v206 +t60207 = arc v202 p5 v207 +t60308 = arc v203 p5 v208 +t60409 = arc v204 p5 v209 +t60510 = arc v205 p5 v210 +t60607 = arc v206 p5 v207 +t60708 = arc v207 p5 v208 +t60809 = arc v208 p5 v209 +t60910 = arc v209 p5 v210 +t61006 = arc v210 p5 v206 -- @@ -1550,8 +1555,8 @@ -- Compare two rings of 5 with one ring of 10 -- (each node double-connected, but different overall topology) -t10901 :: Arc LabelMem -t10901 = toStatement v109 p109 v101 +t10901 :: Statement +t10901 = arc v109 p109 v101 g105 :: GraphMem LabelMem g105 = arcsToGraph @@ -1567,8 +1572,8 @@ -- Reverse one arc from test 01 -- (also, rearrange arcs to catch ordering artefacts) -t20201 :: Arc LabelMem -t20201 = toStatement v202 p201 v201 +t20201 :: Statement +t20201 = arc v202 p201 v201 g106 :: GraphMem LabelMem g106 = arcsToGraph @@ -1597,11 +1602,11 @@ -- Fix one arc from each -f10102, f10501, f21006, f20510 :: Arc LabelMem -f10102 = toStatement v101 f01 v102 -f10501 = toStatement v105 f01 v101 -f21006 = toStatement v210 f01 v206 -f20510 = toStatement v205 f01 v210 +f10102, f10501, f21006, f20510 :: Statement +f10102 = arc v101 f01 v102 +f10501 = arc v105 f01 v101 +f21006 = arc v210 f01 v206 +f20510 = arc v205 f01 v210 g107 :: GraphMem LabelMem g107 = arcsToGraph @@ -1629,11 +1634,11 @@ -- Fix two adjacent arcs from each -f10203, f10405, f20910, f20601 :: Arc LabelMem -f10203 = toStatement v102 f01 v103 -f10405 = toStatement v104 f01 v105 -f20910 = toStatement v209 f01 v210 -f20601 = toStatement v206 f01 v201 +f10203, f10405, f20910, f20601 :: Statement +f10203 = arc v102 f01 v103 +f10405 = arc v104 f01 v105 +f20910 = arc v209 f01 v210 +f20601 = arc v206 f01 v201 g108 :: GraphMem LabelMem g108 = arcsToGraph @@ -1661,10 +1666,10 @@ -- Fix two adjacent arcs with different properties -g10203, g10102, g10405 :: Arc LabelMem -g10203 = toStatement v102 f02 v103 -g10102 = toStatement v101 f02 v102 -g10405 = toStatement v104 f02 v105 +g10203, g10102, g10405 :: Statement +g10203 = arc v102 f02 v103 +g10102 = arc v101 f02 v102 +g10405 = arc v104 f02 v105 g109, g209, g309 :: GraphMem LabelMem g109 = arcsToGraph diff --git a/tests/RDFGraphTest.hs b/tests/RDFGraphTest.hs --- a/tests/RDFGraphTest.hs +++ b/tests/RDFGraphTest.hs @@ -133,13 +133,18 @@ -- Define some common values ------------------------------------------------------------ -base1, base2, base3, base4 :: Namespace +-- TODO: using a base of "" or "?" causes a fromJust failure somewhere +basee, baseu, base1, base2, base3, base4 :: Namespace +basee = Namespace "" "http://example.com/a#" +baseu = Namespace "?" "http://example.com/" base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node#" base2 = Namespace "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node/" base3 = Namespace "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node" base4 = Namespace "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase" -qb1s1, qb2s2, qb3s3, qb3, qb3bm, qb4m :: ScopedName +qbes1, qbus1, qb1s1, qb2s2, qb3s3, qb3, qb3bm, qb4m :: ScopedName +qbes1 = ScopedName basee "s1" +qbus1 = ScopedName baseu "s1" qb1s1 = ScopedName base1 "s1" qb2s2 = ScopedName base2 "s2" qb3s3 = ScopedName base3 "s3" @@ -147,7 +152,9 @@ qb3bm = ScopedName base3 "basemore" qb4m = ScopedName base4 "more" -s1, s2, s3, s4, s5, s6, s7, s8 :: RDFLabel +es1, us1, s1, s2, s3, s4, s5, s6, s7, s8 :: RDFLabel +es1 = Res qbes1 +us1 = Res qbus1 s1 = Res qb1s1 s2 = Res qb2s2 s3 = Res qb3s3 @@ -213,10 +220,11 @@ qb1t1 = ScopedName base1 "type1" qb1t2 = ScopedName base1 "type2" -l1, l2, l3, l4, l5, l6, l7, l8, +l1, l2, l2gb, l3, l4, l5, l6, l7, l8, l9, l10, l11, l12 :: RDFLabel l1 = Lit "l1" Nothing l2 = Lit "l2" (Just (langName "en")) +l2gb = Lit "l2" (Just (langName "en-gb")) l3 = Lit "l2" (Just (langName "fr")) l4 = Lit "l4" (Just qb1t1) l5 = Lit "l4" (Just qb1t1) @@ -253,12 +261,13 @@ nodelist :: [(String, RDFLabel)] nodelist = - [ ("s1",s1), ("s2",s2), ("s3",s3), ("s4",s4), ("s5",s5) + [ ("es1",es1), ("us1",us1) + , ("s1",s1), ("s2",s2), ("s3",s3), ("s4",s4), ("s5",s5) , ("s6",s6), ("s7",s7), ("s8",s8) , ("b1",b1), ("b2",b2), ("b3",b3), ("b4",b4) , ("p1",p1), ("p2",p2), ("p3",p3), ("p4",p4) , ("o1",o1), ("o2",o2), ("o3",o3), ("o4",o4), ("o5",o5) - , ("l1",l1), ("l2",l2), ("l3",l3) + , ("l1",l1), ("l2",l2), ("l2gb",l2gb), ("l3",l3) , ("l4",l4), ("l5",l5), ("l6",l6) , ("l7",l7), ("l8",l8), ("l9",l9) , ("l10",l10), ("l11",l11), ("l12",l12) @@ -473,11 +482,15 @@ nodeorder :: [String] nodeorder = - -- literals - [ "l1" + [ + -- literals + "l1" , "l11", "l12", "l10" - , "l2", "l3" + , "l2", "l2gb", "l3" , "l5", "l6", "l4", "l8", "l9", "l7" + -- URIs beginning with ':' and '<' + , "es1" + , "us1" -- variables , "v1", "v2" -- URIs @@ -1059,8 +1072,11 @@ tm73 = arc s4 p2 bn5 tm74 = arc bn6 p2 o4 -gm1, gm11, gm2, gm2f, gm22, gm3, gm3f, gm33, +gm0, gms, gms2, gm1, gm11, gm2, gm2f, gm22, gm3, gm3f, gm33, gm4, gm44 :: RDFGraph +gm0 = toGraph [] +gms = toGraph [arc s1 p1 o1, arc o1 p2 s3, arc s2 p3 o4] +gms2 = toGraph [arc us1 p1 o1, arc p1 p2 es1] gm1 = toGraph [tm01,tm02,tm03,tm04,tm05,tm06,tm07,tm08 ,tm09,tm10,tm11,tm12,tm13,tm14 ] @@ -1150,7 +1166,10 @@ testMergeSuite :: Test testMergeSuite = TestList - [ testMerge "01" gm1 gm1 gm11 + [ testMerge "00" gm0 gm0 gm0 + , testMerge "0s" gms gms gms + , testMerge "0s2" gms2 gms2 gms2 + , testMerge "01" gm1 gm1 gm11 , testMerge "02" gm2 gm2 gm22 , testMerge "03" gm3 gm3 gm33 , testMerge "04" gm4 gm4 gm44