swish-0.8.0.0: tests/RDFRulesetTest.hs
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
-- Module : RDFRulesetTest
-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke
-- License : GPL V2
--
-- Maintainer : Douglas Burke
-- Stability : experimental
-- Portability : OverloadedStrings
--
-- This module contains test cases for ruleset data.
--
-- Note that the proof-related methods defined in RDFRuleset are tested
-- by RDFProofTest and/or RDFProofCheck.
--
module Main where
import Swish.Namespace (Namespace, makeNamespace, getNamespaceTuple, getNamespaceURI, ScopedName, makeScopedName, makeNSScopedName, namespaceToBuilder)
import Swish.QName (LName)
import Swish.Rule (Formula(..), Rule(..), fwdCheckInference )
import Swish.Ruleset (makeRuleset, getRulesetNamespace, getRulesetAxioms)
import Swish.Ruleset (getRulesetRules, getRulesetAxiom, getRulesetRule)
import Swish.VarBinding (makeVarBinding, vbmCompose, makeVarFilterModify)
import Swish.RDF.Ruleset
( RDFFormula, RDFRule, RDFClosure, RDFRuleset
, GraphClosure(..)
, makeRDFGraphFromN3Builder
, makeRDFFormula
, makeN3ClosureSimpleRule
, makeNodeAllocTo
, graphClosureFwdApply, graphClosureBwdApply
)
import Swish.RDF.Query (rdfQueryBack, rdfQueryBackModify)
import Swish.RDF.VarBinding
( RDFVarBinding
, RDFVarBindingModify
, RDFVarBindingFilter
, rdfVarBindingXMLLiteral
)
import Swish.RDF.Graph
( Label (..), RDFLabel(..), RDFGraph
, RDFArcSet
, getArcs
, allLabels
, toRDFGraph
)
import Swish.RDF.Vocabulary (namespaceRDF, namespaceRDFS, namespaceOWL, scopeRDF)
import Test.HUnit
( Test(TestCase,TestList)
, assertBool
)
import Network.URI (URI, parseURI)
import Data.Monoid (Monoid(..))
import Data.List (sort)
import Data.Maybe (isJust, fromJust)
import Data.Text (Text)
import qualified Data.Set as S
import qualified Data.Text.Lazy.Builder as B
import TestHelpers (runTestSuite
, test
, testLe
, testCompare
, testCompareEq
, testMaker
)
import qualified TestHelpers as TH
------------------------------------------------------------
-- Test case helpers
------------------------------------------------------------
testVal :: (Eq a, Show a) => String -> a -> a -> Test
testVal = testCompare "testVal:"
testEq :: (Eq a, Show a) => String -> Bool -> a -> a -> Test
testEq = testCompareEq "testIsEq:"
testEqual :: (Eq a, Show a) => String -> a -> a -> Test
testEqual = TH.testEq
testStringEq :: String -> String -> String -> Test
testStringEq = testCompare "testStringEq:"
testSameNamespace :: String -> Namespace -> Namespace -> Test
testSameNamespace = testMaker getNamespaceTuple "testSameNamespace:"
testScopedNameEq :: String -> Bool -> ScopedName -> ScopedName -> Test
testScopedNameEq = testCompareEq "testScopedNameEq:"
testSameAs :: (Ord a) => String -> String -> [a] -> [a] -> Test
testSameAs l1 l2 x y =
let z = sort x == sort y
in TestCase (assertBool ("testSameAs:" ++ l1 ++ ":" ++ l2) z)
testSameAxioms :: String -> [RDFFormula] -> [RDFFormula] -> Test
testSameAxioms = testSameAs "Axioms"
testSameRules :: String -> [RDFRule] -> [RDFRule] -> Test
testSameRules = testSameAs "Rules"
------------------------------------------------------------
-- Common values
------------------------------------------------------------
pref_rdf, pref_owl :: URI
pref_rdf = getNamespaceURI namespaceRDF
pref_owl = getNamespaceURI namespaceOWL
toURI :: String -> URI
toURI = fromJust . parseURI
toNS :: Maybe Text -> String -> Namespace
toNS p = makeNamespace p . toURI
------------------------------------------------------------
-- Define and manipulate rulesets
------------------------------------------------------------
--
-- A ruleset is essentially a collection of axioms and rules
-- associated with a namespace.
--
-- Rulesets for RDF, RDFS and basic datatyping are predefined:
-- see RDFRuleset, RDFSRuleset and RDFDRuleset.
-- Additional rulesets may be defined for specific datatypes.
--
-- A proof context is a list of rulesets,
-- which may be cited by a proof.
rn1 :: Namespace
rn1 = toNS (Just "r1") "http://id.ninebynine.org/wip/2003/rulesettest/r1"
-- Common prefix declarations for graph expressions
mkPrefix :: Namespace -> B.Builder
mkPrefix = namespaceToBuilder
prefix :: B.Builder
prefix =
mconcat
[ mkPrefix namespaceRDF
, mkPrefix namespaceRDFS
, mkPrefix (toNS (Just "ex") "http://example.org/")
]
a11, a12 :: RDFFormula
a11 = makeRDFFormula rn1 "a11" $ prefix `mappend` "ex:R1 rdf:type ex:C1 ."
a12 = makeRDFFormula rn1 "a12" $ prefix `mappend` "ex:R2 rdf:type ex:C2 ."
r11, r12 :: RDFRule
r11 = makeN3ClosureSimpleRule rn1 "r11"
( prefix `mappend` "?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )
( prefix `mappend` "?r1 ex:P1 ?r2 ." )
r12 = makeN3ClosureSimpleRule rn1 "r12"
( prefix `mappend` "?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )
( prefix `mappend` "?r2 ex:P2 ?r1 ." )
-- Basic formula and rule comparison tests
-- (tests support code added in module Proof.hs)
testFormulaSuite :: Test
testFormulaSuite =
TestList
[ testEq "testCmpAX01" True a11 a11
, testEq "testCmpAX02" False a11 a12
, testLe "testCmpAX03" True a11 a11
, testLe "testCmpAX04" True a11 a12
, testLe "testCmpAX05" False a12 a11
]
testRuleSuite :: Test
testRuleSuite =
TestList
[ testEq "testCmpRU01" True r11 r11
, testEq "testCmpRU02" False r11 r12
, testLe "testCmpRU03" True r11 r11
, testLe "testCmpRU04" True r11 r12
, testLe "testCmpRU05" False r12 r11
]
-- Test simple ruleset construction and access
a1s :: [RDFFormula]
a1s = [ a11, a12 ]
r1s :: [RDFRule]
r1s = [ r11, r12 ]
r1 :: RDFRuleset
r1 = makeRuleset rn1 a1s r1s
testRulesetSuite :: Test
testRulesetSuite =
TestList
[ testSameNamespace "testNS01" rn1 (getRulesetNamespace r1)
, testSameAxioms "testAX01" a1s (getRulesetAxioms r1)
, testSameRules "testRU01" r1s (getRulesetRules r1)
, testEqual "testGeta11" (Just a11) $
getRulesetAxiom (makeNSScopedName rn1 "a11") r1
, testEqual "testGeta11" (Just a12) $
getRulesetAxiom (makeNSScopedName rn1 "a12") r1
, testEqual "testGetr11" (Just r11) $
getRulesetRule (makeNSScopedName rn1 "r11") r1
, testEqual "testGetr12" (Just r12) $
getRulesetRule (makeNSScopedName rn1 "r12") r1
, testEqual "testGetnone" Nothing $
getRulesetRule (makeNSScopedName rn1 "none") r1
]
------------------------------------------------------------
-- Component tests for RDF proof context
------------------------------------------------------------
scopeex :: Namespace
scopeex = toNS (Just "ex") "http://id.ninebynine.org/wip/2003/RDFProofCheck#"
makeFormula :: Namespace -> LName -> B.Builder -> RDFFormula
makeFormula scope local gr =
makeRDFFormula scope local $ prefix `mappend` gr
allocateTo :: String -> String -> [RDFLabel] -> RDFVarBindingModify
allocateTo bv av = makeNodeAllocTo (Var bv) (Var av)
isXMLLit :: String -> RDFVarBindingFilter
isXMLLit = rdfVarBindingXMLLiteral . Var
queryBack :: RDFArcSet -> RDFGraph -> [[RDFVarBinding]]
queryBack qas = rdfQueryBack (toRDFGraph qas)
-- Backward chaining rdf:r2
rdfr2ant, rdfr2con :: RDFGraph
rdfr2ant = makeRDFGraphFromN3Builder "?x ?a ?l . "
rdfr2con = makeRDFGraphFromN3Builder "?x ?a ?b . ?b rdf:type rdf:XMLLiteral ."
rdfr2modv :: RDFVarBindingModify
rdfr2modv = allocateTo "b" "l" $ S.toList $ allLabels labelIsVar rdfr2ant
rdfr2modc :: Maybe RDFVarBindingModify
rdfr2modc = vbmCompose (makeVarFilterModify $ isXMLLit "l") rdfr2modv
rdfr2grc :: RDFClosure
rdfr2grc = GraphClosure
{ nameGraphRule = makeNSScopedName scopeRDF "r2"
, ruleAnt = getArcs rdfr2ant
, ruleCon = getArcs rdfr2con
, ruleModify = fromJust rdfr2modc
}
rdfr2rul :: RDFRule
rdfr2rul = Rule
{ ruleName = nameGraphRule rdfr2grc
, fwdApply = graphClosureFwdApply rdfr2grc
, bwdApply = graphClosureBwdApply rdfr2grc
, checkInference = fwdCheckInference rdfr2rul
}
con03 :: RDFGraph
con03 = formExpr $ makeFormula scopeex "con03" $
"ex:s ex:p1 _:l1 ; ex:p2a _:l2; ex:p2b _:l2 ." `mappend`
"_:l1 rdf:type rdf:XMLLiteral ." `mappend`
"_:l2 rdf:type rdf:XMLLiteral ."
v_a, v_b, v_x :: RDFLabel
v_a = Var "a"
v_b = Var "b"
v_x = Var "x"
exURI :: URI
exURI = toURI "http://example.org/"
u_s, u_p1, u_p2a, u_p2b, u_rt, u_rx :: RDFLabel
u_s = Res $ makeScopedName Nothing exURI "s"
u_p1 = Res $ makeScopedName Nothing exURI "p1"
u_p2a = Res $ makeScopedName Nothing exURI "p2a"
u_p2b = Res $ makeScopedName Nothing exURI "p2b"
u_rt = Res $ makeScopedName Nothing pref_rdf "type"
u_rx = Res $ makeScopedName Nothing pref_rdf "XMLLiteral"
b_l1, b_l2 :: RDFLabel
b_l1 = Blank "l1"
b_l2 = Blank "l2"
-- could look at S.Set (S.Set RDFVarBinding) which would make
-- comparison easier to write
--
rdfr2v1, rdfr2b1, rdfr2v2 :: [[RDFVarBinding]]
rdfr2v1 = queryBack (ruleCon rdfr2grc) con03
rdfr2b1 = [ [ makeVarBinding [ (v_b,b_l2) ]
, makeVarBinding [ (v_b,b_l1) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p2b), (v_b,b_l2) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p2a), (v_b,b_l2) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p1), (v_b,b_l1) ]
]
, [ makeVarBinding [ (v_x,b_l2), (v_a,u_rt), (v_b,u_rx) ]
, makeVarBinding [ (v_b,b_l1) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p2b), (v_b,b_l2) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p2a), (v_b,b_l2) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p1), (v_b,b_l1) ]
]
, [ makeVarBinding [ (v_b,b_l2) ]
, makeVarBinding [ (v_x,b_l1), (v_a,u_rt), (v_b,u_rx) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p2b), (v_b,b_l2) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p2a), (v_b,b_l2) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p1), (v_b,b_l1) ]
]
, [ makeVarBinding [ (v_x,b_l2), (v_a,u_rt), (v_b,u_rx) ]
, makeVarBinding [ (v_x,b_l1), (v_a,u_rt), (v_b,u_rx) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p2b), (v_b,b_l2) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p2a), (v_b,b_l2) ]
, makeVarBinding [ (v_x,u_s), (v_a,u_p1), (v_b,b_l1) ]
]
]
rdfr2v2 = rdfQueryBackModify (ruleModify rdfr2grc) rdfr2v1
-- as rdfr2v2 is empty no point in the following
-- rdfr2v3 :: [[RDFVarBinding]]
-- rdfr2v3 = map nub rdfr2v2
testRDFSuite :: Test
testRDFSuite =
TestList
[ test "testRDF01" (isJust rdfr2modc)
, testVal "testRDF02" rdfr2b1 rdfr2v1
, test "testRDF03" $ rdfr2v2 == []
-- , test "testRDF04" $ rdfr2v3 == []
, testEq "testRDF09" True [] $ bwdApply rdfr2rul con03
]
------------------------------------------------------------
-- All tests
------------------------------------------------------------
allTests :: Test
allTests = TestList
[ testFormulaSuite
, testRuleSuite
, testRulesetSuite
, testRDFSuite
]
main :: IO ()
main = runTestSuite allTests
{-
runTestFile t = do
h <- openFile "a.tmp" WriteMode
runTestText (putTextToHandle h False) t
hClose h
tf = runTestFile
tt = runTestTT
-}
--------------------------------------------------------------------------------
--
-- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
-- 2011, 2012 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
--
--------------------------------------------------------------------------------