swish 0.3.2.1 → 0.4.0.0
raw patch · 50 files changed
+7198/−7898 lines, 50 filesdep +polyparsedep +textdep −old-timedep −parsec
Dependencies added: polyparse, text
Dependencies removed: old-time, parsec
Files
- Swish/RDF/ClassRestrictionRule.hs +40/−58
- Swish/RDF/Datatype.hs +44/−40
- Swish/RDF/GraphMatch.hs +6/−4
- Swish/RDF/MapXsdInteger.hs +17/−33
- Swish/RDF/N3Formatter.hs +191/−273
- Swish/RDF/N3Parser.hs +286/−290
- Swish/RDF/NTFormatter.hs +87/−61
- Swish/RDF/NTParser.hs +121/−94
- Swish/RDF/RDFDatatype.hs +6/−7
- Swish/RDF/RDFDatatypeXsdInteger.hs +103/−108
- Swish/RDF/RDFDatatypeXsdString.hs +66/−81
- Swish/RDF/RDFGraph.hs +208/−122
- Swish/RDF/RDFGraphShowM.hs +8/−16
- Swish/RDF/RDFParser.hs +190/−81
- Swish/RDF/RDFProof.hs +2/−2
- Swish/RDF/RDFProofContext.hs +16/−19
- Swish/RDF/RDFQuery.hs +20/−29
- Swish/RDF/RDFRuleset.hs +51/−52
- Swish/RDF/RDFVarBinding.hs +3/−1
- Swish/RDF/Rule.hs +16/−18
- Swish/RDF/SwishCommands.hs +33/−48
- Swish/RDF/SwishMain.hs +8/−10
- Swish/RDF/SwishScript.hs +84/−130
- Swish/RDF/VarBinding.hs +7/−3
- Swish/RDF/Vocabulary.hs +117/−142
- Swish/Utils/DateTime.hs +0/−328
- Swish/Utils/ListHelpers.hs +9/−120
- Swish/Utils/LookupMap.hs +0/−23
- Swish/Utils/MiscHelpers.hs +0/−56
- Swish/Utils/Namespace.hs +79/−42
- Swish/Utils/QName.hs +151/−66
- Swish/Utils/ShowM.hs +1/−16
- Swish/Utils/TraceHelpers.hs +0/−55
- scripts/SwishExample.ss +7/−8
- scripts/SwishTest.ss +4/−0
- scripts/VehicleCapacity.ss +1/−2
- swish.cabal +14/−5
- tests/BuiltInMapTest.hs +3/−1
- tests/GraphTest.hs +1/−25
- tests/N3FormatterTest.hs +425/−339
- tests/N3ParserTest.hs +1486/−1406
- tests/NTTest.hs +34/−19
- tests/QNameTest.hs +138/−61
- tests/RDFDatatypeXsdIntegerTest.hs +1391/−1789
- tests/RDFGraphTest.hs +131/−120
- tests/RDFProofContextTest.hs +81/−85
- tests/RDFProofTest.hs +1037/−1168
- tests/RDFQueryTest.hs +414/−381
- tests/RDFRulesetTest.hs +56/−60
- tests/VarBindingTest.hs +5/−1
Swish/RDF/ClassRestrictionRule.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -9,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : MultiParamTypeClasses+-- Portability : MultiParamTypeClasses, OverloadedStrings -- -- This module implements an inference rule based on a restruction on class -- membership of one or more values.@@ -17,13 +18,13 @@ -------------------------------------------------------------------------------- module Swish.RDF.ClassRestrictionRule- ( ClassRestriction(..), ClassRestrictionFn- , makeDatatypeRestriction, makeDatatypeRestrictionFn- , makeRDFClassRestrictionRules- , makeRDFDatatypeRestrictionRules- , falseGraph, falseGraphStr - )-where+ ( ClassRestriction(..), ClassRestrictionFn+ , makeDatatypeRestriction, makeDatatypeRestrictionFn+ , makeRDFClassRestrictionRules+ , makeRDFDatatypeRestrictionRules+ , falseGraph, falseGraphStr + )+ where import Swish.RDF.RDFGraph ( RDFLabel(..)@@ -33,19 +34,12 @@ , merge , toRDFGraph, emptyRDFGraph , Arc(..)- , res_rdf_type- , res_rdfd_maxCardinality- )--import Swish.RDF.RDFRuleset- ( RDFRule- , makeRDFGraphFromN3String+ , resRdfType+ , resRdfdMaxCardinality ) -import Swish.RDF.RDFDatatype- ( RDFDatatypeVal- , fromRDFLabel, toRDFLabel- )+import Swish.RDF.RDFRuleset (RDFRule, makeRDFGraphFromN3Builder)+import Swish.RDF.RDFDatatype (RDFDatatypeVal, fromRDFLabel, toRDFLabel) import Swish.RDF.RDFQuery ( rdfQueryFind@@ -53,28 +47,13 @@ , rdfFindList ) -import Swish.RDF.RDFVarBinding- ( RDFVarBinding )--import Swish.RDF.Datatype- ( DatatypeVal(..)- , DatatypeRel(..), DatatypeRelFn- )--import Swish.RDF.Rule- ( Rule(..)- , bwdCheckInference- )-+import Swish.RDF.RDFVarBinding (RDFVarBinding)+import Swish.RDF.Datatype (DatatypeVal(..), DatatypeRel(..), DatatypeRelFn)+import Swish.RDF.Rule ( Rule(..), bwdCheckInference) import Swish.RDF.VarBinding (VarBinding(..))--import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..)- )- import Swish.RDF.Vocabulary (namespaceRDFD) +import Swish.Utils.Namespace (Namespace(..),ScopedName(..), namespaceToBuilder) import Swish.Utils.PartOrderedCollection ( minima, maxima , partCompareEq, partComparePair@@ -82,18 +61,17 @@ , partCompareListSubset ) -import Swish.Utils.LookupMap- ( LookupEntryClass(..), LookupMap(..)- , mapFindMaybe- )-+import Swish.Utils.LookupMap (LookupEntryClass(..), LookupMap(..),mapFindMaybe) import Swish.Utils.ListHelpers (powerSet) import Control.Monad (liftM) +import Data.Monoid (Monoid (..)) import Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe) import Data.List (delete, nub, (\\)) +import qualified Data.Text.Lazy.Builder as B+ ------------------------------------------------------------ -- Class restriction data type ------------------------------------------------------------@@ -156,20 +134,24 @@ -- Make rules from supplied class restrictions and graph ------------------------------------------------------------ -ruleQuery :: RDFGraph-ruleQuery = makeRDFGraphFromN3String $- "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++- " ?c a rdfd:GeneralRestriction ; " ++- " rdfd:onProperties ?p ; " ++- " rdfd:constraint ?r . "+mkPrefix :: Namespace -> B.Builder+mkPrefix = namespaceToBuilder +ruleQuery :: RDFGraph+ruleQuery = makeRDFGraphFromN3Builder $+ mconcat+ [ mkPrefix namespaceRDFD+ , " ?c a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties ?p ; " + , " rdfd:constraint ?r . "+ ]+ -- Placeholder false graph for now. falseGraph :: RDFGraph-falseGraph = makeRDFGraphFromN3String $- "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++- falseGraphStr+falseGraph = makeRDFGraphFromN3Builder $+ mkPrefix namespaceRDFD `mappend` falseGraphStr -falseGraphStr :: String+falseGraphStr :: B.Builder falseGraphStr = "_:a rdfd:false _:b . " -- |Make a list of class restriction rules given a list of class restriction@@ -191,7 +173,7 @@ p = fromMaybe NoNode $ vbMap vb (Var "p") r = fromMaybe NoNode $ vbMap vb (Var "r") cs = filter (>0) $ map fromInteger $- rdfFindPredInt c res_rdfd_maxCardinality gr+ rdfFindPredInt c resRdfdMaxCardinality gr ps = rdfFindList gr p rn = mapFindMaybe (getScopedName r) (LookupMap crs) @@ -220,7 +202,7 @@ if isJust newgrs then concat $ fromJust newgrs else [falseGraph] where -- Instances of the named class in the graph:- ris = nub $ rdfFindValSubj res_rdf_type cls antgr+ ris = nub $ rdfFindValSubj resRdfType cls antgr -- Merge antecedent graphs into one (with bnode renaming): -- (Uses 'if' and 'foldl1' to avoid merging in the common case -- of just one graph supplied.)@@ -263,7 +245,7 @@ fromMaybe [[falseGraph]] newgrs where -- Instances of the named class in the graph:- ris = rdfFindValSubj res_rdf_type cls congr+ ris = rdfFindValSubj resRdfType cls congr -- Apply class restriction to single instance of the restricted class newgr :: RDFLabel -> Maybe [[RDFGraph]] newgr ri = bwdApplyRestriction1 restriction cls ri props cs congr@@ -311,7 +293,7 @@ newArcs dts = [ Arc ci p v | mvs <- dts, (p,Just v) <- zip props mvs ] -- Make graphs for one alternative- makeGraphs = map (toRDFGraph . (:[])) . (Arc ci res_rdf_type cls :)+ makeGraphs = map (toRDFGraph . (:[])) . (Arc ci resRdfType cls :) -- Helper function to select sub-tuples from which some of a set of -- values can be derived using a class restriction.
Swish/RDF/Datatype.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses #-}+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -9,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : ExistentialQuantification, MultiParamTypeClasses+-- Portability : ExistentialQuantification, MultiParamTypeClasses, OverloadedStrings -- -- This module defines the structures used by Swish to represent and -- manipulate datatypes. It is designed as a basis for handling datatyped@@ -43,11 +44,11 @@ , ApplyModifier , nullDatatypeMod -- , applyDatatypeMod- , makeVmod_1_1_inv, makeVmod_1_1- , makeVmod_2_1_inv, makeVmod_2_1- , makeVmod_2_0- , makeVmod_2_2- , makeVmod_N_1+ , makeVmod11inv, makeVmod11+ , makeVmod21inv, makeVmod21+ , makeVmod20+ , makeVmod22+ , makeVmodN1 , DatatypeSub(..) ) where@@ -94,6 +95,8 @@ import Control.Monad( join, liftM ) +import qualified Data.Text as T+ ------------------------------------------------------------ -- Datatype framework ------------------------------------------------------------@@ -135,7 +138,7 @@ getTypeRule nam dt = getRulesetRule nam (typeRules dt) -- |Get the canonical form of a datatype value.-typeMkCanonicalForm :: Datatype ex lb vn -> String -> Maybe String+typeMkCanonicalForm :: Datatype ex lb vn -> T.Text -> Maybe T.Text typeMkCanonicalForm (Datatype dtv) = tvalMkCanonicalForm dtv ------------------------------------------------------------@@ -265,7 +268,7 @@ -- |Get the canonical form of a datatype value, or @Nothing@. ---tvalMkCanonicalForm :: DatatypeVal ex vt lb vn -> String -> Maybe String+tvalMkCanonicalForm :: DatatypeVal ex vt lb vn -> T.Text -> Maybe T.Text tvalMkCanonicalForm dtv str = can where dtmap = tvalMap dtv@@ -275,16 +278,17 @@ -- |DatatypeMap consists of methods that perform lexical-to-value -- and value-to-canonical-lexical mappings for a datatype. ----- The datatype mappings apply to string lexical forms.+-- The datatype mappings apply to string lexical forms which+-- are stored as `Data.Text`. -- data DatatypeMap vt = DatatypeMap- { mapL2V :: String -> Maybe vt+ { mapL2V :: T.Text -> Maybe vt -- ^ Function to map a lexical string to -- the datatype value. This effectively -- defines the lexical space of the -- datatype to be all strings for which -- yield a value other than @Nothing@.- , mapV2L :: vt -> Maybe String+ , mapV2L :: vt -> Maybe T.Text -- ^ Function to map a value to its canonical -- lexical form, if it has such. }@@ -430,8 +434,8 @@ -- for the 'VarBindingModify' value can be extracted using an undefined -- label value. ---makeVmod_1_1_inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn-makeVmod_1_1_inv nam [f0,f1,f2] lbs@(~[lb1,lb2]) = VarBindingModify+makeVmod11inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod11inv nam [f0,f1,f2] lbs@(~[lb1,lb2]) = VarBindingModify { vbmName = nam , vbmApply = concatMap app1 , vbmVocab = lbs@@ -443,8 +447,8 @@ app2 [Nothing,Just v2] vbind = addv lb1 (f1 [v2]) vbind app2 [Just v1,Nothing] vbind = addv lb2 (f2 [v1]) vbind app2 _ _ = []-makeVmod_1_1_inv _ _ _ =- error "makeVmod_1_1_inv: requires 3 functions and 2 labels"+makeVmod11inv _ _ _ =+ error "makeVmod11inv: requires 3 functions and 2 labels" -- |'ApplyModifier' function for use with 'DatatypeMod' in cases when -- the value mapping is a non-invertable @1->1@ injection, such as@@ -469,8 +473,8 @@ -- for the 'VarBindingModify' value can be extracted using an undefined -- label value. ---makeVmod_1_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn-makeVmod_1_1 nam [f0,f1] lbs@(~[lb1,_]) = VarBindingModify+makeVmod11 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod11 nam [f0,f1] lbs@(~[lb1,_]) = VarBindingModify { vbmName = nam , vbmApply = concatMap app1 , vbmVocab = lbs@@ -481,8 +485,8 @@ app2 [Just v1,Just v2] vbind = selv (f0 [v1,v2]) vbind app2 [Nothing,Just v2] vbind = addv lb1 (f1 [v2]) vbind app2 _ _ = []-makeVmod_1_1 _ _ _ =- error "makeVmod_1_1: requires 2 functions and 2 labels"+makeVmod11 _ _ _ =+ error "makeVmod11: requires 2 functions and 2 labels" -- |'ApplyModifier' function for use with 'DatatypeMod' in cases -- when the value mapping is a @2->1@ invertable function, such as@@ -514,8 +518,8 @@ -- for the 'VarBindingModify' value can be extracted using an undefined -- label value. ---makeVmod_2_1_inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn-makeVmod_2_1_inv nam [f0,f1,f2,f3] lbs@(~[lb1,lb2,lb3]) = VarBindingModify+makeVmod21inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod21inv nam [f0,f1,f2,f3] lbs@(~[lb1,lb2,lb3]) = VarBindingModify { vbmName = nam , vbmApply = concatMap app1 , vbmVocab = lbs@@ -528,8 +532,8 @@ app2 [Just v1,Nothing,Just v3] vbind = addv lb2 (f2 [v1,v3]) vbind app2 [Just v1,Just v2,Nothing] vbind = addv lb3 (f3 [v1,v2]) vbind app2 _ _ = []-makeVmod_2_1_inv _ _ _ =- error "makeVmod_2_1_inv: requires 4 functions and 3 labels"+makeVmod21inv _ _ _ =+ error "makeVmod21inv: requires 4 functions and 3 labels" -- |'ApplyModifier' function for use with 'DatatypeMod' in cases -- when the value mapping is a @2->1@ non-invertable function, such as@@ -555,8 +559,8 @@ -- for the 'VarBindingModify' value can be extracted using an undefined -- label value. ---makeVmod_2_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn-makeVmod_2_1 nam [f0,f1] lbs@(~[lb1,_,_]) = VarBindingModify+makeVmod21 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod21 nam [f0,f1] lbs@(~[lb1,_,_]) = VarBindingModify { vbmName = nam , vbmApply = concatMap app1 , vbmVocab = lbs@@ -567,8 +571,8 @@ app2 [Just v1,Just v2,Just v3] vbind = selv (f0 [v1,v2,v3]) vbind app2 [Nothing,Just v2,Just v3] vbind = addv lb1 (f1 [v2,v3]) vbind app2 _ _ = []-makeVmod_2_1 _ _ _ =- error "makeVmod_2_1: requires 2 functions and 3 labels"+makeVmod21 _ _ _ =+ error "makeVmod21: requires 2 functions and 3 labels" -- |'ApplyModifier' function for use with 'DatatypeMod' in cases -- when the value mapping is a simple comparson of two values.@@ -590,8 +594,8 @@ -- for the 'VarBindingModify' value can be extracted using an undefined -- label value. ---makeVmod_2_0 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn-makeVmod_2_0 nam [f0] lbs@(~[_,_]) = VarBindingModify+makeVmod20 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod20 nam [f0] lbs@(~[_,_]) = VarBindingModify { vbmName = nam , vbmApply = concatMap app1 , vbmVocab = lbs@@ -601,8 +605,8 @@ app1 vbind = app2 (map (vbMap vbind) lbs) vbind app2 [Just v1,Just v2] vbind = selv (f0 [v1,v2]) vbind app2 _ _ = []-makeVmod_2_0 _ _ _ =- error "makeVmod_2_0: requires 1 function and 2 labels"+makeVmod20 _ _ _ =+ error "makeVmod20: requires 1 function and 2 labels" -- |'ApplyModifier' function for use with 'DatatypeMod' in cases -- when the value mapping is a @2->2@ non-invertable function, such as@@ -631,8 +635,8 @@ -- NOTE: this might be generalized to allow one of @w@ or @x@ to be -- specified, and return null if it doesn't match the calculated value. ---makeVmod_2_2 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn-makeVmod_2_2 nam [f0,f1] lbs@(~[lb1,lb2,_,_]) = VarBindingModify+makeVmod22 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmod22 nam [f0,f1] lbs@(~[lb1,lb2,_,_]) = VarBindingModify { vbmName = nam , vbmApply = concatMap app1 , vbmVocab = lbs@@ -645,8 +649,8 @@ app2 [Nothing,Nothing,Just v3,Just v4] vbind = addv2 lb1 lb2 (f1 [v3,v4]) vbind app2 _ _ = []-makeVmod_2_2 _ _ _ =- error "makeVmod_2_2: requires 2 functions and 4 labels"+makeVmod22 _ _ _ =+ error "makeVmod22: requires 2 functions and 4 labels" -- |'ApplyModifier' function for use with 'DatatypeMod' in cases -- when the value mapping is a @N->1@ function,@@ -671,8 +675,8 @@ -- for the 'VarBindingModify' value can be extracted using an undefined -- label value. ---makeVmod_N_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn-makeVmod_N_1 nam [f0,f1] lbs@(~(lb1:_)) = VarBindingModify+makeVmodN1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn+makeVmodN1 nam [f0,f1] lbs@(~(lb1:_)) = VarBindingModify { vbmName = nam , vbmApply = concatMap app1 , vbmVocab = lbs@@ -689,8 +693,8 @@ jvs = catMaybes vs app2 _ _ = error "app2 sent empty list" -- -Wall -makeVmod_N_1 _ _ _ =- error "makeVmod_N_1: requires 2 functions and at 1 or more labels"+makeVmodN1 _ _ _ =+ error "makeVmodN1: requires 2 functions and at 1 or more labels" -------------------------------------------------------- -- Local helper functions for makeVmodXXX variants
Swish/RDF/GraphMatch.hs view
@@ -32,6 +32,8 @@ graphMatch1, graphMatch2, equivalenceClasses, reclassify ) where +import Control.Exception.Base (assert)+ import Data.Ord (comparing) import Data.List (foldl', nub, sortBy, partition) import qualified Data.List@@ -43,7 +45,7 @@ makeLookupMap, listLookupMap, mapFind, mapReplaceAll, mapAddIfNew, mapReplaceMap, mapMerge) import Swish.Utils.ListHelpers (select, equiv, pairSort, pairGroup, pairUngroup)-import Swish.Utils.MiscHelpers (assert, hash, hashModulus)+import Swish.Utils.MiscHelpers (hash, hashModulus) -------------------------- -- Label index value type@@ -357,8 +359,8 @@ -- NOTE: final test is call of external matchable function glp = [ (l1,l2) | l1 <- ls1 , l2 <- ls2 , matchable l1 l2 ] in- assert (ev1==ev2) "GraphMatch2: Equivalence class value mismatch" $- try glp+ assert (ev1==ev2) -- "GraphMatch2: Equivalence class value mismatch" $+ $ try glp -- | Returns a string representation of a LabelMap value --@@ -491,7 +493,7 @@ -- then `True`, otherwise `False`. reclassify gs1 gs2 lmap@(LabelMap _ lm) ecpairs =- assert (gen1==gen2) "Label map generation mismatch"+ assert (gen1==gen2) -- "Label map generation mismatch" (LabelMap gen1 lm',ecpairs',newPart,matchPart) where LabelMap gen1 lm1 =
Swish/RDF/MapXsdInteger.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,22 +10,20 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module defines the datatytpe mapping and relation values -- used for RDF dataype xsd:integer -- -------------------------------------------------------------------------------- -module Swish.RDF.MapXsdInteger- ( mapXsdInteger- )-where+module Swish.RDF.MapXsdInteger (mapXsdInteger) where -import Swish.RDF.Datatype- ( DatatypeMap(..)- )+import Swish.RDF.Datatype (DatatypeMap(..)) +import qualified Data.Text as T+import qualified Data.Text.Read as T+ ------------------------------------------------------------ -- Implementation of DatatypeMap for xsd:integer ------------------------------------------------------------@@ -33,32 +33,16 @@ -- mapXsdInteger :: DatatypeMap Integer mapXsdInteger = DatatypeMap- { -- mapL2V :: String -> Maybe Integer- mapL2V = fromString- - -- mapV2L :: Integer -> Maybe String- , mapV2L = Just . show+ { -- mapL2V :: T.Text -> Maybe Integer+ mapL2V = \txt -> case T.signed T.decimal txt of+ Right (val, "") -> Just val+ _ -> Nothing+ + -- mapV2L :: Integer -> Maybe T.Text+ -- TODO: for now convert via String as issues with text-format+ -- (inability to use with ghci) + , mapV2L = Just . T.pack . show }---- basic little parser for integer values;--- do we need to bother about rejecting --- input like "-000" or "+0"?----fromString :: String -> Maybe Integer-fromString ('-':xs) = fs False xs-fromString ('+':xs) = fs True xs-fromString xs = fs True xs--fs :: Bool -> String -> Maybe Integer-fs _ [] = Nothing-fs f is = - let val = go is []- - go [] ys = Just $ read $ reverse ys- go (x:xs) ys | x `elem` ['0'..'9'] = go xs (x:ys)- | otherwise = Nothing- - in if f then val else fmap ((-1) *) val -------------------------------------------------------------------------------- --
Swish/RDF/N3Formatter.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This Module implements a Notation 3 formatter (see [1], [2] and [3]), -- for an RDFGraph value.@@ -49,10 +51,10 @@ module Swish.RDF.N3Formatter ( NodeGenLookupMap- , formatGraphAsStringNl- , formatGraphAsString- , formatGraphAsShowS- , formatGraphIndent+ , formatGraphAsText+ , formatGraphAsLazyText+ , formatGraphAsBuilder+ , formatGraphIndent , formatGraphDiag ) where@@ -65,20 +67,21 @@ getArcs, labels, setNamespaces, getNamespaces, getFormulae,- emptyRDFGraph,- res_rdf_first, res_rdf_rest, res_rdf_nil+ emptyRDFGraph+ , quote+ , quoteT+ , resRdfFirst, resRdfRest, resRdfNil ) import Swish.RDF.Vocabulary ( isLang, langTag, - rdf_type,- rdf_nil,- owl_sameAs, log_implies- , xsd_boolean, xsd_decimal, xsd_integer, xsd_double + rdfType,+ rdfNil,+ owlSameAs, logImplies+ , xsdBoolean, xsdDecimal, xsdInteger, xsdDouble ) -import Swish.RDF.GraphClass- ( Arc(..) )+import Swish.RDF.GraphClass (Arc(..)) import Swish.Utils.LookupMap ( LookupEntryClass(..)@@ -90,26 +93,26 @@ import Swish.Utils.Namespace ( ScopedName(..), getScopeURI ) -import Data.Char (ord, isDigit, toLower)--import Data.List (foldl', delete, groupBy, partition, sort)+import Data.Char (isDigit) -import Text.Printf (printf)+import Data.List (foldl', delete, groupBy, partition, sort, intersperse) +import Data.Monoid (Monoid(..)) import Control.Monad (liftM, when)-import Control.Monad.State (State, get, put, runState)+import Control.Monad.State (State, modify, get, put, runState) -------------------------------------------------------------------------- Ouptut string concatenation----------------------------------------------------------------------------- Function puts uses the shows mechanism to avoid the cost of--- quadratic string concatenation times. (Use function composition to--- concatenate strings thus reprersented.)+-- it strikes me that using Lazy Text here is likely to be+-- wrong; however I have done no profiling to back this+-- assumption up! -puts :: String -> ShowS-puts = showString+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Builder as B +-- temporary conversion+quoteB :: Bool -> String -> B.Builder+quoteB f v = B.fromString $ quote f v+ ---------------------------------------------------------------------- -- Graph formatting state monad ----------------------------------------------------------------------@@ -124,7 +127,7 @@ type PredTree lb = [(lb,[lb])] data N3FormatterState = N3FS- { indent :: String+ { indent :: B.Builder , lineBreak :: Bool , graph :: RDFGraph , subjs :: SubjTree RDFLabel@@ -178,29 +181,23 @@ data LabelContext = SubjContext | PredContext | ObjContext deriving (Eq, Show) -getIndent :: Formatter String+getIndent :: Formatter B.Builder getIndent = indent `liftM` get -setIndent :: String -> Formatter ()-setIndent ind = do- st <- get- put $ st { indent = ind }+setIndent :: B.Builder -> Formatter ()+setIndent ind = modify $ \st -> st { indent = ind } getLineBreak :: Formatter Bool getLineBreak = lineBreak `liftM` get setLineBreak :: Bool -> Formatter ()-setLineBreak brk = do- st <- get- put $ st {lineBreak = brk}+setLineBreak brk = modify $ \st -> st { lineBreak = brk } getNgs :: Formatter NodeGenState getNgs = nodeGenSt `liftM` get setNgs :: NodeGenState -> Formatter ()-setNgs ngs = do- st <- get- put $ st { nodeGenSt = ngs }+setNgs ngs = modify $ \st -> st { nodeGenSt = ngs } getPrefixes :: Formatter NamespaceMap getPrefixes = prefixes `liftM` getNgs@@ -209,17 +206,13 @@ getSubjs = subjs `liftM` get setSubjs :: SubjTree RDFLabel -> Formatter ()-setSubjs sl = do- st <- get- put $ st { subjs = sl }+setSubjs sl = modify $ \st -> st { subjs = sl } getProps :: Formatter (PredTree RDFLabel) getProps = props `liftM` get setProps :: PredTree RDFLabel -> Formatter ()-setProps ps = do- st <- get- put $ st { props = ps }+setProps ps = modify $ \st -> st { props = ps } {- getObjs :: Formatter ([RDFLabel])@@ -296,7 +289,7 @@ serialisation using the '(..)' syntax and does not make any statement about semantics of the statements with regard to RDF Collections): - - there must be one rdf_first and one rdf_rest statement+ - there must be one rdf_first and one rdfRest statement - there must be no other predicates for the label -} @@ -311,11 +304,11 @@ -- order). getCollection subjList lbl = go subjList lbl ([],[]) where- go sl l (cs,ss) | l == res_rdf_nil = Just (sl, reverse cs, ss)+ go sl l (cs,ss) | l == resRdfNil = Just (sl, reverse cs, ss) | otherwise = do (pList1, sl') <- removeItem sl l- (pFirst, pList2) <- removeItem pList1 res_rdf_first- (pNext, pList3) <- removeItem pList2 res_rdf_rest+ (pFirst, pList2) <- removeItem pList1 resRdfFirst+ (pNext, pList3) <- removeItem pList2 resRdfRest -- QUS: could I include these checks implicitly in the pattern matches above? -- ie instrad of (pFirst, pos1) <- ..@@ -338,7 +331,7 @@ let mlst = getCollection osubjs' ln -- we only want to send in rdf:first/rdf:rest here- fprops = filter ((`elem` [res_rdf_first, res_rdf_rest]) . fst) oprops+ fprops = filter ((`elem` [resRdfFirst, resRdfRest]) . fst) oprops osubjs' = case lctxt of@@ -351,28 +344,11 @@ -- sl is guaranteed to be free of (ln,fprops) here if lctxt is SubjContext Just (sl,ls,_) -> do setSubjs sl- when (lctxt == SubjContext) $ setProps $ filter ((`notElem` [res_rdf_first, res_rdf_rest]) . fst) oprops+ when (lctxt == SubjContext) $ setProps $ filter ((`notElem` [resRdfFirst, resRdfRest]) . fst) oprops return (Just ls) Nothing -> return Nothing -{---- for safety I am assuming no ordering of the subject tree--- but really should be using one of the container types--- -deleteItems :: (Eq a) => [(a,b)] -> [a] -> [(a,b)]-deleteItems [] _ = []-deleteItems os [] = os-deleteItems os (x:xs) =- deleteItems (deleteItem os x) xs- -deleteItem :: (Eq a) => [(a,b)] -> a -> [(a,b)]-deleteItem os x =- case removeItem os x of- Just (_, rest) -> rest- Nothing -> os--}- {-| Removes the first occurrence of the item from the association list, returning it's contents and the rest@@ -387,70 +363,51 @@ ---------------------------------------------------------------------- -- Define a top-level formatter function:--- accepts a graph and returns a string ---------------------------------------------------------------------- -formatGraphAsStringNl :: RDFGraph -> String-formatGraphAsStringNl gr = formatGraphAsShowS gr "\n"--formatGraphAsString :: RDFGraph -> String-formatGraphAsString gr = formatGraphAsShowS gr ""--formatGraphAsShowS :: RDFGraph -> ShowS-formatGraphAsShowS = formatGraphIndent "\n" True-{- old code:- where- (out,_,_,_) = formatGraphDiag gr--}+formatGraphAsText :: RDFGraph -> T.Text+formatGraphAsText = L.toStrict . formatGraphAsLazyText -formatGraphIndent :: String -> Bool -> RDFGraph -> ShowS-{- working version-formatGraphIndent ind dopref gr = out- where- (_,out) = formatGraphDiag1 ind dopref emptyLookupMap gr--}-formatGraphIndent ind dopref = fst . formatGraphDiag1 ind dopref emptyLookupMap-{- -formatGraphIndent ind dopref gr = out- where- (out',fgs) = formatGraphDiag1 ind dopref emptyLookupMap gr- tbuff = traceBuf fgs- -- tr = if null tbuff then "" else "\nDEBUG:\n" ++ concat (reverse tbuff)- tr = ""- out = out' . (++ tr)--}- +formatGraphAsLazyText :: RDFGraph -> L.Text+formatGraphAsLazyText = B.toLazyText . formatGraphAsBuilder+ +formatGraphAsBuilder :: RDFGraph -> B.Builder+formatGraphAsBuilder = formatGraphIndent "\n" True+ +formatGraphIndent :: B.Builder -> Bool -> RDFGraph -> B.Builder+formatGraphIndent indnt flag gr = + let (res, _, _, _) = formatGraphDiag indnt flag gr+ in res+ -- | Format graph and return additional information-formatGraphDiag ::- RDFGraph -> (ShowS,NodeGenLookupMap,Int,[String])-formatGraphDiag gr = (out,nodeMap ngs,nodeGen ngs,traceBuf fgs)- where- (out,fgs) = formatGraphDiag1 "\n" True emptyLookupMap gr- ngs = nodeGenSt fgs---- Internal function starts with supplied prefix table and indent string,--- and returns final state and formatted string.--- This is provided for diagnostic access to the final state-formatGraphDiag1 :: String -> Bool -> NamespaceMap -> RDFGraph -> (ShowS,N3FormatterState)-formatGraphDiag1 ind dopref pref gr = - let fg = formatGraph ind " ." False dopref gr- ngs = emptyNgs {- prefixes=pref,- nodeGen=findMaxBnode gr- }+formatGraphDiag :: + B.Builder -- ^ indentation+ -> Bool -- ^ are prefixes to be generated?+ -> RDFGraph + -> (B.Builder, NodeGenLookupMap, Int, [String])+formatGraphDiag indnt flag gr = + let fg = formatGraph indnt " .\n" False flag gr+ ngs = emptyNgs {+ prefixes = emptyLookupMap,+ nodeGen = findMaxBnode gr+ } - in runState fg (emptyN3FS ngs)+ (out, fgs) = runState fg (emptyN3FS ngs)+ ogs = nodeGenSt fgs+ + in (out, nodeMap ogs, nodeGen ogs, traceBuf fgs) ---------------------------------------------------------------------- -- Formatting as a monad-based computation ---------------------------------------------------------------------- --- ind is indentation string--- end is ending string to be placed after final statement--- dobreak is True if a line break is to be inserted at the start--- dopref is True if prefix strings are to be generated----formatGraph :: String -> String -> Bool -> Bool -> RDFGraph -> Formatter ShowS+formatGraph :: + B.Builder -- indentation string+ -> B.Builder -- text to be placed after final statement+ -> Bool -- True if a line break is to be inserted at the start+ -> Bool -- True if prefix strings are to be generated+ -> RDFGraph -- graph to convert+ -> Formatter B.Builder formatGraph ind end dobreak dopref gr = do setIndent ind setLineBreak dobreak@@ -458,23 +415,30 @@ fp <- if dopref then formatPrefixes (getNamespaces gr)- else return $ puts ""+ else return mempty more <- moreSubjects if more then do fr <- formatSubjects- return $ fp . fr . puts end+ return $ mconcat [fp, fr, end] else return fp -formatPrefixes :: NamespaceMap -> Formatter ShowS+formatPrefixes :: NamespaceMap -> Formatter B.Builder formatPrefixes pmap = do let mls = map (pref . keyVal) (listLookupMap pmap) ls <- sequence mls- return $ puts $ concat ls+ return $ mconcat ls where- pref (p,u) = nextLine $ "@prefix "++p++": <"++ quote True u ++"> ."+ pref (Just p,u) = nextLine $ mconcat ["@prefix ", B.fromText p, ": <", quoteB True (show u), "> ."]+ pref (_,u) = nextLine $ mconcat ["@prefix : <", quoteB True (show u), "> ."] -formatSubjects :: Formatter ShowS+{-+NOTE:+I expect there to be confusion below where I need to+convert from Text to Builder+-}++formatSubjects :: Formatter B.Builder formatSubjects = do sb <- nextSubject sbstr <- formatLabel SubjContext sb@@ -483,15 +447,12 @@ if flagP then do prstr <- formatProperties sb sbstr- -- fmstr <- formatFormulae "" flagS <- moreSubjects if flagS then do fr <- formatSubjects- return $ puts (prstr ++ " .") . fr- -- return $ puts (prstr ++ fmstr ++ " .") . fr- else return $ puts prstr- -- else return $ puts $ prstr ++ fmstr+ return $ mconcat [prstr, " .", fr]+ else return prstr else do txt <- nextLine sbstr@@ -500,108 +461,89 @@ if flagS then do fr <- formatSubjects- return $ puts (txt ++ " .") . fr- else return $ puts txt+ return $ mconcat [txt, " .", fr]+ else return txt -formatProperties :: RDFLabel -> String -> Formatter String+{-+TODO: now we are throwing a Builder around it is awkward to+get the length of the text to calculate the indentation++So++ a) change the indentation scheme+ b) pass around text instead of builder++mkIndent :: L.Text -> L.Text+mkIndent inVal = L.replicate (L.length inVal) " "+-}++hackIndent :: B.Builder+hackIndent = " "++formatProperties :: RDFLabel -> B.Builder -> Formatter B.Builder formatProperties sb sbstr = do pr <- nextProperty sb prstr <- formatLabel PredContext pr- obstr <- formatObjects sb pr (sbstr++" "++prstr)+ obstr <- formatObjects sb pr $ mconcat [sbstr, " ", prstr] more <- moreProperties- let sbindent = replicate (length sbstr) ' '+ let sbindent = hackIndent -- mkIndent sbstr if more then do fr <- formatProperties sb sbindent- nl <- nextLine $ obstr ++ " ;"- return $ nl ++ fr+ nl <- nextLine $ obstr `mappend` " ;"+ return $ nl `mappend` fr else nextLine obstr -formatObjects :: RDFLabel -> RDFLabel -> String -> Formatter String+formatObjects :: RDFLabel -> RDFLabel -> B.Builder -> Formatter B.Builder formatObjects sb pr prstr = do ob <- nextObject sb pr obstr <- formatLabel ObjContext ob more <- moreObjects if more then do- let prindent = replicate (length prstr) ' '+ let prindent = hackIndent -- mkIndent prstr fr <- formatObjects sb pr prindent- nl <- nextLine $ prstr ++ " " ++ obstr ++ ","- return $ nl ++ fr- else return $ prstr ++ " " ++ obstr--{--formatFormulae :: String -> Formatter String-formatFormulae fp = do- more <- moreFormulae- if more- then do- fnlgr <- nextFormula- fnstr <- formatFormula fnlgr- formatFormulae $ fp ++ " ." ++ fnstr- else return fp--TODO: need to remove the use of :-. It's not clear to me whether-we are guaranteed that fn is only used once in the graph - ie-if it is safe to inline this formula at the label location.--formatFormula :: (RDFLabel,RDFGraph) -> Formatter String-formatFormula (fn,gr) = do- fnstr <- formatLabel SubjContext fn- f1str <- nextLine $ fnstr ++ " :-"- f2str <- nextLine " {"- ngs0 <- getNgs- ind <- getIndent- let grm = formatGraph (ind++" ") "" True False- (setNamespaces emptyNamespaceMap gr)- - (f3str, fgs') = runState grm (emptyN3FS ngs0)-- setNgs (nodeGenSt fgs')- f4str <- nextLine " }"- return $ f1str ++ f2str ++ f3str f4str---}+ nl <- nextLine $ mconcat [prstr, " ", obstr, ","]+ return $ nl `mappend` fr+ else return $ mconcat [prstr, " ", obstr] ---- DJB's version of formatFormula when it can be inserted inline-insertFormula :: RDFGraph -> Formatter String+insertFormula :: RDFGraph -> Formatter B.Builder insertFormula gr = do ngs0 <- getNgs ind <- getIndent- let grm = formatGraph (ind++" ") "" True False+ let grm = formatGraph (ind `mappend` " ") "" True False (setNamespaces emptyNamespaceMap gr) (f3str, fgs') = runState grm (emptyN3FS ngs0) setNgs (nodeGenSt fgs') f4str <- nextLine " } "- return $ " { " ++ f3str f4str+ return $ mconcat [" { ",f3str, f4str] {- Add a list inline. We are given the labels that constitute the list, in order, so just need to display them surrounded by (). -}-insertList :: [RDFLabel] -> Formatter String+insertList :: [RDFLabel] -> Formatter B.Builder insertList [] = return "()" -- not convinced this can happen insertList xs = do ls <- mapM (formatLabel ObjContext) xs- return $ "( " ++ unwords ls ++ " )"- - + return $ mconcat ("( " : intersperse " " ls) `mappend` " )"+ {- Add a blank node inline. -} -insertBnode :: LabelContext -> RDFLabel -> Formatter String +insertBnode :: LabelContext -> RDFLabel -> Formatter B.Builder insertBnode SubjContext lbl = do flag <- moreProperties txt <- if flag- then liftM (++"\n") $ formatProperties lbl ""+ then (`mappend` "\n") `liftM` formatProperties lbl "" else return "" -- TODO: handle indentation?- return $ "[" ++ txt ++ "]"+ return $ mconcat ["[", txt, "]"] insertBnode _ lbl = do ost <- get@@ -629,7 +571,7 @@ put nst flag <- moreProperties txt <- if flag- then liftM (++"\n") $ formatProperties lbl ""+ then (`mappend` "\n") `liftM` formatProperties lbl "" else return "" -- TODO: how do we restore the original set up?@@ -645,13 +587,13 @@ } -- TODO: handle indentation?- return $ "[" ++ txt ++ "]"+ return $ mconcat ["[", txt, "]"] ---------------------------------------------------------------------- -- Formatting helpers ---------------------------------------------------------------------- -setGraph :: RDFGraph -> Formatter ()+setGraph :: RDFGraph -> Formatter () setGraph gr = do st <- get @@ -670,11 +612,23 @@ put nst -moreSubjects :: Formatter Bool-moreSubjects = (not . null . subjs) `liftM` get+hasMore :: (N3FormatterState -> [b]) -> Formatter Bool+hasMore lens = (not . null . lens) `liftM` get -nextSubject :: Formatter RDFLabel-nextSubject = do+moreSubjects :: Formatter Bool+moreSubjects = hasMore subjs+-- moreSubjects = (not . null . subjs) `liftM` get++moreProperties :: Formatter Bool+moreProperties = hasMore props+-- moreProperties = (not . null . props) `liftM` get++moreObjects :: Formatter Bool+moreObjects = hasMore objs+-- moreObjects = (not . null . objs) `liftM` get++nextSubject :: Formatter RDFLabel+nextSubject = do st <- get let sb:sbs = subjs st@@ -686,10 +640,7 @@ put nst return $ fst sb -moreProperties :: Formatter Bool-moreProperties = (not . null . props) `liftM` get--nextProperty :: RDFLabel -> Formatter RDFLabel+nextProperty :: RDFLabel -> Formatter RDFLabel nextProperty _ = do st <- get @@ -701,11 +652,7 @@ put nst return $ fst pr --moreObjects :: Formatter Bool-moreObjects = (not . null . objs) `liftM` get--nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel+nextObject :: RDFLabel -> RDFLabel -> Formatter RDFLabel nextObject _ _ = do st <- get @@ -715,12 +662,12 @@ put nst return ob -nextLine :: String -> Formatter String+nextLine :: B.Builder -> Formatter B.Builder nextLine str = do ind <- getIndent brk <- getLineBreak if brk- then return $ ind++str+ then return $ ind `mappend` str else do -- After first line, always insert line break setLineBreak True@@ -749,13 +696,13 @@ specialTable :: [(ScopedName, String)] specialTable = - [ (rdf_type, "a")- , (owl_sameAs, "=")- , (log_implies, "=>")- , (rdf_nil, "()")+ [ (rdfType, "a")+ , (owlSameAs, "=")+ , (logImplies, "=>")+ , (rdfNil, "()") ]- -formatLabel :: LabelContext -> RDFLabel -> Formatter String++formatLabel :: LabelContext -> RDFLabel -> Formatter B.Builder {- formatLabel lab@(Blank (_:_)) = do name <- formatNodeId lab@@ -782,16 +729,24 @@ formatLabel _ lab@(Res sn) = case lookup sn specialTable of- Just txt -> return $ quote True txt -- TODO: do we need to quote?+ Just txt -> return $ quoteB True txt -- TODO: do we need to quote? Nothing -> do pr <- getPrefixes let nsuri = getScopeURI sn local = snLocal sn premap = reverseLookupMap pr :: RevNamespaceMap prefix = mapFindMaybe nsuri premap+ name = case prefix of- Just p -> quote True (p ++ ":" ++ local) -- TODO: what are quoting rules for QNames- _ -> "<"++ quote True (nsuri++local) ++">"+ Just (Just p) -> B.fromText $ quoteT True $ mconcat [p, ":", local] -- TODO: what are quoting rules for QNames+ _ -> mconcat ["<", quoteB True (show nsuri ++ T.unpack local), ">"]+ + {-+ name = case prefix of+ Just p -> quoteB True (p ++ ":" ++ local) -- TODO: what are quoting rules for QNames+ _ -> mconcat ["<", quoteB True (nsuri++local), ">"]+ -}+ queueFormula lab return name @@ -801,22 +756,19 @@ -- we just convert E to e for now. -- formatLabel _ (Lit lit (Just dtype)) - | dtype == xsd_double = return $ map toLower lit- | dtype `elem` [xsd_boolean, xsd_decimal, xsd_integer] = return lit- | otherwise = return $ quoteStr lit ++ formatAnnotation dtype-formatLabel _ (Lit lit Nothing) = return $ quoteStr lit+ | dtype == xsdDouble = return $ B.fromText $ T.toLower lit+ | dtype `elem` [xsdBoolean, xsdDecimal, xsdInteger] = return $ B.fromText lit+ | otherwise = return $ quoteText lit `mappend` formatAnnotation dtype+formatLabel _ (Lit lit Nothing) = return $ quoteText lit -formatLabel _ lab = return $ show lab+formatLabel _ lab = return $ B.fromString $ show lab -- the annotation for a literal (ie type or language)-formatAnnotation :: ScopedName -> String-formatAnnotation a | isLang a = '@' : langTag a- | otherwise = '^':'^': showScopedName a+formatAnnotation :: ScopedName -> B.Builder+formatAnnotation a | isLang a = "@" `mappend` B.fromText (langTag a)+ | otherwise = "^^" `mappend` showScopedName a {--Swish.Utils.MiscHelpers contains a quote routine-which we expand upon here to match the N3 syntax.- We have to decide whether to use " or """ to quote the string. @@ -828,54 +780,20 @@ last character if it is a " (assuming it isn't protected). -} -quoteStr :: String -> String-quoteStr st = - let qst = quote (n==1) st+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- qch = replicate n '"' - in qch ++ qst ++ qch---- The boolean flag is True if the string is being displayed--- with single quotes, which should mean that there are--- no newline or quote characters in the string.------ TODO: when flag == False need to worry about n > 2 quotes--- in a row.----quote :: Bool -> String -> String-quote _ [] = ""-quote False s@(c:'"':[]) | c == '\\' = s -- handle triple-quoted strings ending in "- | otherwise = [c, '\\', '"']---- quote True ('"': st) = '\\':'"': quote True st -- this should not happen--- quote True ('\n':st) = '\\':'n': quote True st -- this should not happen--quote True ('\t':st) = '\\':'t': quote True st-quote False ('"': st) = '"': quote False st-quote False ('\n':st) = '\n': quote False st-quote False ('\t':st) = '\t': quote False st-quote f ('\r':st) = '\\':'r': quote f st-quote f ('\\':st) = '\\':'\\': quote f st -- not sure about this-quote f (c:st) = - let nc = ord c- rst = quote f st- - -- lazy way to convert to a string- hstr = printf "%08X" nc- ustr = hstr ++ rst+ qch = B.fromString (replicate n '"')+ in mconcat [qch, qst, qch] - in if nc > 0xffff - then '\\':'U': ustr- else if nc > 0x7e || nc < 0x20- then '\\':'u': drop 4 ustr- else c : rst- -formatNodeId :: RDFLabel -> Formatter String+formatNodeId :: RDFLabel -> Formatter B.Builder formatNodeId lab@(Blank (lnc:_)) =- if isDigit lnc then mapBlankNode lab else return $ show lab+ if isDigit lnc then mapBlankNode lab else return $ B.fromString $ show lab formatNodeId other = error $ "formatNodeId not expecting a " ++ show other -- to shut up -Wall -mapBlankNode :: RDFLabel -> Formatter String+mapBlankNode :: RDFLabel -> Formatter B.Builder mapBlankNode lab = do ngs <- getNgs let cmap = nodeMap ngs@@ -890,18 +808,18 @@ n -> return n -- TODO: is this what we want?- return $ "_:swish" ++ show nv+ return $ "_:swish" `mappend` B.fromString (show nv) -- TODO: need to be a bit more clever with this than we did in NTriples -- not sure the following counts as clever enough ... -- -showScopedName :: ScopedName -> String+showScopedName :: ScopedName -> B.Builder {- showScopedName (ScopedName n l) = let uri = nsURI n ++ l in quote uri -}-showScopedName = quote True . show+showScopedName = quoteB True . show ---------------------------------------------------------------------- -- Graph-related helper functions
Swish/RDF/N3Parser.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-} -- only used in 'fromMaybe "" mbase' line of parseN3+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,14 +10,12 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This Module implements a Notation 3 parser (see [1], [2], [3]), returning a -- new 'RDFGraph' consisting of triples and namespace information parsed from -- the supplied N3 input string, or an error indication. ----- Uses the Parsec monadic parser library.--- -- REFERENCES: -- -- 1 <http://www.w3.org/TeamSubmission/2008/SUBM-n3-20080114/>@@ -50,16 +50,15 @@ module Swish.RDF.N3Parser ( ParseResult , parseN3 - , parseN3fromString- , parseAnyfromString- , parseTextFromString, parseAltFromString- , parseNameFromString, parsePrefixFromString- , parseAbsURIrefFromString, parseLexURIrefFromString, parseURIref2FromString+ , parseN3fromText + , parseAnyfromText+ , parseTextFromText, parseAltFromText+ , parseNameFromText -- , parsePrefixFromText+ , parseAbsURIrefFromText, parseLexURIrefFromText, parseURIref2FromText -- * Exports for parsers that embed Notation3 in a bigger syntax , N3Parser, N3State(..), SpecialMap- , whiteSpace, symbol, lexeme, eof, identStart, identLetter- -- + , getPrefix -- a combination of the old defaultPrefix and namedPrefix productions , n3symbol -- replacement for uriRef2 -- TODO: check this is semantically correct , quickVariable -- was varid @@ -91,65 +90,57 @@ ( Namespace(..) , ScopedName(..) , getScopedNameURI- , makeScopedName, makeUriScopedName+ , makeURIScopedName , makeQNameScopedName , nullScopedName ) -import Swish.Utils.QName (QName, getQNameURI)+import Swish.Utils.QName (QName) import Swish.RDF.Vocabulary ( langName- , rdf_type- , rdf_first, rdf_rest, rdf_nil- , owl_sameAs, log_implies- , xsd_boolean, xsd_integer, xsd_decimal, xsd_double+ , rdfType+ , rdfFirst, rdfRest, rdfNil+ , owlSameAs, logImplies+ , xsdBoolean, xsdInteger, xsdDecimal, xsdDouble ) import Swish.RDF.RDFParser ( SpecialMap- , mapPrefix- , prefixTable, specialTable- , ParseResult, RDFParser- , n3Style, n3Lexer, ignore- , annotateParsecError+ , ParseResult+ -- , mapPrefix+ , prefixTable+ , specialTable+ , ignore+ , notFollowedBy+ , endBy+ , sepEndBy+ , manyTill+ , noneOf+ , char+ , ichar+ , string+ , stringT+ , symbol+ , lexeme+ , whiteSpace , mkTypedLit+ , hex4 + , hex8 + , appendURIs ) import Control.Applicative import Control.Monad (forM_, foldM) -import Network.URI (URI, - relativeTo,- parseURI, parseURIReference, uriToString)+import Network.URI (URI(..), parseURIReference) +import Data.Char (isSpace, isDigit, ord) import Data.Maybe (fromMaybe, fromJust) -import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))-import qualified Text.ParserCombinators.Parsec as PC-import qualified Text.ParserCombinators.Parsec.Token as P--import Data.Char (isSpace, chr) --------------------------------------------------------------------------- Set up token parsers-------------------------------------------------------------------------lexer :: P.TokenParser N3State-lexer = n3Lexer--whiteSpace :: N3Parser ()-whiteSpace = P.whiteSpace lexer--symbol :: String -> N3Parser String-symbol = P.symbol lexer--lexeme :: N3Parser a -> N3Parser a-lexeme = P.lexeme lexer--identStart , identLetter :: CharParser st Char-identStart = P.identStart n3Style-identLetter = P.identLetter n3Style+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import Text.ParserCombinators.Poly.StateText ---------------------------------------------------------------------- -- Define parser state and helper functions@@ -162,12 +153,13 @@ , prefixUris :: NamespaceMap -- namespace prefix mapping table , syntaxUris :: SpecialMap -- special name mapping table , nodeGen :: Int -- blank node id generator- , keywordsList :: [String] -- contents of the @keywords statement+ , keywordsList :: [T.Text] -- contents of the @keywords statement , allowLocalNames :: Bool -- True if @keywords used so that bare names are QNames in default namespace } --- | Functions to update N3State vector (use with Parsec updateState)-setPrefix :: String -> String -> N3State -> N3State+-- | Functions to update N3State vector (use with stUpdate)++setPrefix :: Maybe T.Text -> URI -> N3State -> N3State setPrefix pre uri st = st { prefixUris=p' } where p' = mapReplaceOrAdd (Namespace pre uri) (prefixUris st)@@ -177,12 +169,13 @@ setSName nam snam st = st { syntaxUris=s' } where s' = mapReplaceOrAdd (nam,snam) (syntaxUris st)-setSUri :: String -> String -> N3State -> N3State-setSUri nam suri = setSName nam (makeScopedName "" suri "") +setSUri :: String -> URI -> N3State -> N3State+setSUri nam = setSName nam . makeURIScopedName+ -- | Set the list of tokens that can be used without needing the leading -- \@ symbol.-setKeywordsList :: [String] -> N3State -> N3State+setKeywordsList :: [T.Text] -> N3State -> N3State setKeywordsList ks st = st { keywordsList = ks, allowLocalNames = True } -- Functions to access state:@@ -191,14 +184,14 @@ getSName :: N3State -> String -> ScopedName getSName st nam = mapFind nullScopedName nam (syntaxUris st) -getSUri :: N3State -> String -> String+getSUri :: N3State -> String -> URI getSUri st nam = getScopedNameURI $ getSName st nam --- Map prefix to namespace-getPrefixNs :: N3State -> String -> Namespace-getPrefixNs st pre = Namespace pre (mapPrefix (prefixUris st) pre)+-- Map prefix to URI+getPrefixURI :: N3State -> Maybe T.Text -> Maybe URI+getPrefixURI st pre = mapFindMaybe pre (prefixUris st) -getKeywordsList :: N3State -> [String]+getKeywordsList :: N3State -> [T.Text] getKeywordsList = keywordsList getAllowLocalNames :: N3State -> Bool@@ -206,8 +199,8 @@ -- Return function to update graph in N3 parser state, -- using the supplied function of a graph--- (use returned function with Parsec updateState)-updateGraph :: ( RDFGraph -> RDFGraph ) -> N3State -> N3State+--+updateGraph :: (RDFGraph -> RDFGraph) -> N3State -> N3State updateGraph f s = s { graphState = f (graphState s) } ----------------------------------------------------------------------@@ -215,26 +208,26 @@ -- accepts a string and returns a graph or error ---------------------------------------------------------------------- -type N3Parser a = RDFParser N3State a+type N3Parser a = Parser N3State a -- | Parse a string as N3 (with no real base URI). -- -- See 'parseN3' if you need to provide a base URI. ---parseN3fromString ::- String -- ^ input in N3 format.+parseN3fromText ::+ L.Text -- ^ input in N3 format. -> ParseResult-parseN3fromString = parseAnyfromString document Nothing +parseN3fromText = flip parseN3 Nothing -- | Parse a string with an optional base URI. -- -- See also 'parseN3fromString'. -- parseN3 ::- String -- ^ input in N3 format.+ L.Text -- ^ input in N3 format. -> Maybe QName -- ^ optional base URI -> ParseResult-parseN3 = flip (parseAnyfromString document)+parseN3 txt mbase = parseAnyfromText document mbase txt {- -- useful for testing@@ -242,16 +235,19 @@ test = either error id . parseAnyfromString document Nothing -} +hashURI :: URI+hashURI = fromJust $ parseURIReference "#"++-- TODO: change from QName to URI for the base?+ -- | Function to supply initial context and parse supplied term. ----- We augment the Parsec error with the context.----parseAnyfromString :: N3Parser a -- ^ parser to apply- -> Maybe QName -- ^ base URI of the input, or @Nothing@ to use default base value- -> String -- ^ input to be parsed- -> Either String a-parseAnyfromString parser mbase input =- let pmap = LookupMap [] -- [Namespace "" "#"] -- [] -- emptyLookupMap -- LookupMap prefixTable+parseAnyfromText :: N3Parser a -- ^ parser to apply+ -> Maybe QName -- ^ base URI of the input, or @Nothing@ to use default base value+ -> L.Text -- ^ input to be parsed+ -> Either String a+parseAnyfromText parser mbase input =+ let pmap = LookupMap [Namespace Nothing hashURI] muri = fmap makeQNameScopedName mbase smap = LookupMap $ specialTable muri pstate = N3State@@ -264,38 +260,31 @@ , allowLocalNames = False } - puri = case mbase of- Just base -> fmap showURI $ appendUris (getQNameURI base) "#"- _ -> Right "#"-- -- this is getting a bit ugly- - in case puri of- Left emsg -> Left $ "Invalid base: " ++ emsg- Right p -> case runParser parser (setPrefix "" p pstate) "" input of- Right res -> Right res- Left err -> Left $ annotateParsecError 1 (lines input) err+ (result, _, _) = runParser parser pstate input+ + in result newBlankNode :: N3Parser RDFLabel newBlankNode = do- s <- getState- let n = succ (nodeGen s)- setState $ s { nodeGen = n } + n <- stQuery (succ . nodeGen)+ stUpdate $ \s -> s { nodeGen = n } return $ Blank (show n) -- Test functions for selected element parsing -parseTextFromString :: String -> String -> Either String String-parseTextFromString s =- parseAnyfromString (string s) Nothing+-- TODO: remove these+ +parseTextFromText :: String -> L.Text -> Either String String+parseTextFromText s =+ parseAnyfromText (string s) Nothing -parseAltFromString :: String -> String -> String -> Either String String-parseAltFromString s1 s2 =- parseAnyfromString ( string s1 <|> string s2 ) Nothing+parseAltFromText :: String -> String -> L.Text -> Either String String+parseAltFromText s1 s2 =+ parseAnyfromText (string s1 <|> string s2) Nothing -parseNameFromString :: String -> Either String String-parseNameFromString =- parseAnyfromString n3Name Nothing+parseNameFromText :: L.Text -> Either String String+parseNameFromText =+ parseAnyfromText n3NameStr Nothing {- This has been made tricky by the attempt to remove the default list@@ -307,42 +296,38 @@ -} addTestPrefixes :: N3Parser ()-addTestPrefixes = updateState $ \st -> st { prefixUris = LookupMap prefixTable } -- should append to existing map+addTestPrefixes = stUpdate $ \st -> st { prefixUris = LookupMap prefixTable } -- should append to existing map -parsePrefixFromString :: String -> Either String Namespace-parsePrefixFromString =- parseAnyfromString p Nothing+{-+parsePrefixFromText :: L.Text -> Either String URI+parsePrefixFromText =+ parseAnyfromText p Nothing where p = do addTestPrefixes pref <- n3Name- st <- getState- return (getPrefixNs st pref) -- map prefix to namespace+ st <- stGet+ case getPrefixURI st (Just pref) of+ Just uri -> return uri+ _ -> fail $ "Undefined prefix: '" ++ pref ++ "'"+-} -parseAbsURIrefFromString :: String -> Either String String-parseAbsURIrefFromString =- parseAnyfromString (fmap showURI explicitURI) Nothing- -- parseAnyfromString absUriRef Nothing+parseAbsURIrefFromText :: L.Text -> Either String URI+parseAbsURIrefFromText =+ parseAnyfromText explicitURI Nothing -parseLexURIrefFromString :: String -> Either String String-parseLexURIrefFromString =- parseAnyfromString lexUriRef Nothing+parseLexURIrefFromText :: L.Text -> Either String URI+parseLexURIrefFromText =+ parseAnyfromText lexUriRef Nothing -parseURIref2FromString :: String -> Either String ScopedName-parseURIref2FromString = - parseAnyfromString (addTestPrefixes >> n3symbol) Nothing- -- parseAnyfromString uriRef2 Nothing+parseURIref2FromText :: L.Text -> Either String ScopedName+parseURIref2FromText = + parseAnyfromText (addTestPrefixes *> n3symbol) Nothing ---------------------------------------------------------------------- -- Syntax productions ---------------------------------------------------------------------- -{-- TODO:- - this parser is a *lot* slower than the original one- --}- -- helper routines comma, semiColon , fullStop :: N3Parser ()@@ -352,22 +337,26 @@ -- a specialization of bracket/between br :: String -> String -> N3Parser a -> N3Parser a-br lsym rsym = between (symbol lsym) (symbol rsym)+br lsym rsym = bracket (symbol lsym) (symbol rsym) +-- to make porting from parsec to polyparse easier+between :: Parser s lbr -> Parser s rbr -> Parser s a -> Parser s a+between = bracket+ -- The @ character is optional if the keyword is in the -- keyword list ---atSign :: String -> N3Parser ()+atSign :: T.Text -> N3Parser () atSign s = do- st <- getState+ st <- stGet - let p = ignore $ char '@'+ let p = ichar '@' if s `elem` getKeywordsList st- then PC.optional p+ then ignore $ optional p else p -atWord :: String -> N3Parser String+atWord :: T.Text -> N3Parser T.Text atWord s = do atSign s @@ -375,17 +364,9 @@ -- apply to both cases even though should only really be necessary -- when the at sign is not given --- lexeme $ string s *> notFollowedBy (char ':')+ lexeme $ stringT s *> notFollowedBy (== ':') return s -showURI :: URI -> String-showURI u = uriToString id u ""---- TODO: look at using URIs throughout-getScopedNameURI' :: URI -> String-getScopedNameURI' = showURI--- getScopedNameURI' = getScopedNameURI . makeUriScopedName . showURI- {- Since operatorLabel can be used to add a label with an unknown namespace, we need to ensure that the namespace@@ -402,7 +383,7 @@ -} operatorLabel :: ScopedName -> N3Parser RDFLabel operatorLabel snam@(ScopedName sns _) = do- st <- getState+ st <- stGet let opmap = prefixUris st pkey = entryKey sns pval = entryVal sns@@ -413,11 +394,11 @@ case mapFindMaybe pkey opmap of Just val | val == pval -> return rval | otherwise -> do- setState $ st { prefixUris = mapReplace opmap sns }+ stUpdate $ \s -> s { prefixUris = mapReplace opmap sns } return rval _ -> do- setState $ st { prefixUris = mapAdd opmap sns }+ stUpdate $ \s -> s { prefixUris = mapAdd opmap sns } return rval {-@@ -435,14 +416,14 @@ type AddStatement = RDFLabel -> N3Parser () addStatement :: RDFLabel -> RDFLabel -> AddStatement-addStatement s p o@(Lit _ (Just dtype)) | dtype `elem` [xsd_boolean, xsd_integer, xsd_decimal, xsd_double] = do - st <- getState+addStatement s p o@(Lit _ (Just dtype)) | dtype `elem` [xsdBoolean, xsdInteger, xsdDecimal, xsdDouble] = do + ost <- stGet let stmt = arc s p o- oldp = prefixUris st- ogs = graphState st+ oldp = prefixUris ost+ ogs = graphState ost newp = mapReplaceOrAdd (snScope dtype) oldp- setState $ st { prefixUris = newp, graphState = addArc stmt ogs }-addStatement s p o = updateState (updateGraph (addArc (arc s p o) ))+ stUpdate $ \st -> st { prefixUris = newp, graphState = addArc stmt ogs }+addStatement s p o = stUpdate (updateGraph (addArc (arc s p o) )) addStatementRev :: RDFLabel -> RDFLabel -> AddStatement addStatementRev o p s = addStatement s p o@@ -459,29 +440,54 @@ we encode this as the n3Name production -} -initChar , bodyChar :: String-initChar =- ['A'..'Z'] ++ "_" ++ ['a'..'z'] ++- map chr - ([0x00c0..0x00d6] ++ [0x00d8..0x00f6] ++ [0x00f8..0x02ff] ++ [0x0370..0x037d] ++ [0x037f..0x1fff] ++ [0x200c..0x200d] ++ [0x2070..0x218f] ++ [0x2c00..0x2fef] ++ [0x3001..0xd7ff] ++ [0xf900..0xfdcf] ++ [0xfdf0..0xfffd] ++ [0x00010000..0x000effff])-bodyChar = - '-' : ['0'..'9'] ++ ['A'..'Z'] ++ "_" ++ ['a'..'z'] ++- map chr- (0x00b7 : [0x00c0..0x00d6] ++ [0x00d8..0x00f6] ++ [0x00f8..0x037d] ++ [0x037f..0x1fff] ++ [0x200c..0x200d] ++ [0x203f..0x2040] ++ [0x2070..0x218f] ++ [0x2c00..0x2fef] ++ [0x3001..0xd7ff] ++ [0xf900..0xfdcf] ++ [0xfdf0..0xfffd] ++ [0x00010000..0x000effff])+isaz, is09, isaz09 :: Char -> Bool+isaz c = c >= 'a' && c <= 'z'+is09 c = c >= '0' && c <= '9'+isaz09 c = isaz c || is09 c -n3Name :: N3Parser String-n3Name = (:) <$> n3Init <*> n3Body+startChar :: Char -> Bool+startChar c = let i = ord c+ match :: (Ord a) => a -> [(a,a)] -> Bool+ match v = any (\(l,h) -> v >= l && v <= h)+ in c == '_' || + match c [('A', 'Z'), ('a', 'z')] ||+ match i [(0x00c0, 0x00d6), (0x00d8, 0x00f6), (0x00f8, 0x02ff), + (0x0370, 0x037d), + (0x037f, 0x1fff), (0x200c, 0x200d), + (0x2070, 0x218f), (0x2c00, 0x2fef), (0x3001, 0xd7ff), + (0xf900, 0xfdcf), (0xfdf0, 0xfffd), + (0x00010000, 0x000effff)] + +inBody :: Char -> Bool+inBody c = let i = ord c+ match :: (Ord a) => a -> [(a,a)] -> Bool+ match v = any (\(l,h) -> v >= l && v <= h)+ in c `elem` "-_" || i == 0x007 ||+ match c [('0', '9'), ('A', 'Z'), ('a', 'z')] ||+ match i [(0x00c0, 0x00d6), (0x00d8, 0x00f6), (0x00f8, 0x037d), + (0x037f, 0x1fff), (0x200c, 0x200d), (0x203f, 0x2040), + (0x2070, 0x218f), (0x2c00, 0x2fef), (0x3001, 0xd7ff), + (0xf900, 0xfdcf), (0xfdf0, 0xfffd), + (0x00010000, 0x000effff)] ++-- should this be strict or lazy text?+n3Name :: N3Parser T.Text+n3Name = T.cons <$> n3Init <*> n3Body where- n3Init = oneOf initChar <?> "Initial character of a name"- n3Body = many (oneOf bodyChar) <?> "Body of the name"+ n3Init = satisfy startChar+ n3Body = L.toStrict <$> manySatisfy inBody ++n3NameStr :: N3Parser String+n3NameStr = T.unpack <$> n3Name+ {- quickvariable ::= \?[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#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]* -} -- TODO: is mapping to Var correct? quickVariable :: N3Parser RDFLabel-quickVariable = char '?' *> (Var <$> n3Name) <?> "quickvariable"+quickVariable = char '?' *> (Var <$> n3NameStr) {- string ::= ("""[^"\\]*(?:(?:\\.|"(?!""))[^"\\]*)*""")|("[^"\\]*(?:\\.[^"\\]*)*")@@ -492,8 +498,8 @@ -} -n3string :: N3Parser String-n3string = tripleQuoted <|> singleQuoted <?> "string"+n3string :: N3Parser T.Text+n3string = tripleQuoted <|> singleQuoted {- singleQuoted ::= "[^"\\]*(?:\\.[^"\\]*)*"@@ -506,27 +512,8 @@ -} --- the grammer has only upper-case A-F but some lower case values--- seen in the wild, so support them----ntHexDigit :: N3Parser Char-ntHexDigit = oneOf $ ['0'..'9'] ++ ['A'..'F'] ++ ['a'..'f']--hex4 :: N3Parser Char-hex4 = do- digs <- count 4 ntHexDigit- let dstr = "0x" ++ digs- dchar = read dstr :: Int- return $ chr dchar- -hex8 :: N3Parser Char-hex8 = do- digs <- count 8 ntHexDigit- let dstr = "0x" ++ digs- dchar = read dstr :: Int- if dchar <= 0x10FFFF- then return $ chr dchar- else unexpected "\\UHHHHHHHH format is limited to a maximum of \\U0010FFFF"+digit :: N3Parser Char+digit = satisfy isDigit {- This is very similar to NTriples accept that also allow the escaping of '@@ -565,41 +552,48 @@ sQuot :: N3Parser Char sQuot = char '"' -singleQuoted :: N3Parser String-singleQuoted = between sQuot sQuot $ many n3Character+{-+TODO: there must be a better way of building up the Text+-}++singleQuoted :: N3Parser T.Text+singleQuoted = fmap T.pack (bracket sQuot sQuot $ many n3Character) {- tripleQUoted ::= """[^"\\]*(?:(?:\\.|"(?!""))[^"\\]*)*""" -}-tripleQuoted :: N3Parser String-tripleQuoted = tQuot *> manyTill (n3Character <|> sQuot <|> char '\n') tQuot+tripleQuoted :: N3Parser T.Text+tripleQuoted = tQuot *> fmap T.pack (manyTill (n3Character <|> sQuot <|> char '\n') tQuot) where- tQuot = try (count 3 sQuot)+ -- tQuot = try (count 3 sQuot)+ tQuot = exactly 3 sQuot getDefaultPrefix :: N3Parser Namespace getDefaultPrefix = do- s <- getState- return (getPrefixNs s "")+ s <- stGet+ case getPrefixURI s Nothing of+ Just uri -> return $ Namespace Nothing uri+ _ -> fail "No default prefix defined; how unexpected!" addBase :: URI -> N3Parser ()-addBase = updateState . setSUri "base" . getScopedNameURI'+addBase = stUpdate . setSUri "base" -addPrefix :: Maybe String -> URI -> N3Parser ()-addPrefix p = updateState . setPrefix (fromMaybe "" p) . getScopedNameURI'+addPrefix :: Maybe T.Text -> URI -> N3Parser ()+addPrefix p = stUpdate . setPrefix p {-| Update the set of keywords that can be given without an \@ sign. -}-updateKeywordsList :: [String] -> N3Parser ()-updateKeywordsList = updateState . setKeywordsList+updateKeywordsList :: [T.Text] -> N3Parser ()+updateKeywordsList = stUpdate . setKeywordsList {- document ::= | statements_optional EOF -} document :: N3Parser RDFGraph-document = mkGr <$> (whiteSpace *> statementsOptional *> eof *> getState)+document = mkGr <$> (whiteSpace *> statementsOptional *> eof *> stGet) where mkGr s = setNamespaces (prefixUris s) (graphState s) @@ -639,13 +633,19 @@ -- (if applicable) which should mean being able to get rid of try -- declaration :: N3Parser ()-declaration = +declaration = oneOf [+ atWord "base" >> explicitURI >>= addBase,+ atWord "keywords" >> bareNameCsl >>= updateKeywordsList,+ atWord "prefix" *> getPrefix+ ]++ {- (try (atWord "base") >> explicitURI >>= addBase) <|> (try (atWord "keywords") >> bareNameCsl >>= updateKeywordsList) <|> (try (atWord "prefix") *> getPrefix)- <?> "declaration"+ -} getPrefix :: N3Parser () getPrefix = do@@ -665,32 +665,19 @@ rb = char '>' -- TODO: do the whitespace definitions match?- ustr <- between lb (rb <?> "end of URI '>'") $ many (satisfy (/= '>'))+ ustr <- between lb rb $ many (satisfy (/= '>')) let uclean = filter (not . isSpace) ustr- - s <- getState- let base = getSUri s "base"- - case appendUris base uclean of - Right uri -> return uri- Left emsg -> fail emsg- -appendUris :: String -> String -> Either String URI-appendUris base uri =- case parseURI uri of- Just absuri -> Right absuri- _ -> case parseURIReference uri of- Just reluri -> - let baseuri = fromJust $ parseURI base- in case relativeTo reluri baseuri of- Just resuri -> Right resuri- _ -> Left $ "Unable to append <" ++ uri ++ "> to base=<" ++ base ++ ">"- - _ -> Left $ "Invalid URI: <" ++ uri ++ ">"+ + case parseURIReference uclean of+ Nothing -> fail $ "Unable to convert <" ++ uclean ++ "> to a URI"+ Just uref -> do+ s <- stGet+ let base = getSUri s "base"+ either fail return $ appendURIs base uref --- production from the old parser-lexUriRef :: N3Parser String-lexUriRef = fmap showURI $ lexeme explicitURI+-- production from the old parser; used in SwishScript+lexUriRef :: N3Parser URI+lexUriRef = lexeme explicitURI {- barename ::= [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#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*@@ -700,19 +687,19 @@ | void -} -bareNameCsl :: N3Parser [String]+bareNameCsl :: N3Parser [T.Text] bareNameCsl = sepBy (lexeme bareName) comma -bareName :: N3Parser String-bareName = n3Name <?> "barename"+bareName :: N3Parser T.Text+bareName = n3Name {- prefix ::= ([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#x00010000-#x000effff][\-0-9A-Z_a-z#x00b7#x00c0-#x00d6#x00d8-#x00f6#x00f8-#x037d#x037f-#x1fff#x200c-#x200d#x203f-#x2040#x2070-#x218f#x2c00-#x2fef#x3001-#xd7ff#xf900-#xfdcf#xfdf0-#xfffd#x00010000-#x000effff]*)?: -} -prefix :: N3Parser (Maybe String)+prefix :: N3Parser (Maybe T.Text) prefix = optional (lexeme n3Name) <* char ':'- <?> "prefix name"+ {- symbol ::= | explicituri@@ -726,9 +713,8 @@ n3symbol :: N3Parser ScopedName n3symbol = - ((makeUriScopedName . showURI) <$> explicitURI)+ (makeURIScopedName <$> explicitURI) <|> qname- <?> "symbol" symbolCsl :: N3Parser [ScopedName] symbolCsl = sepBy (lexeme n3symbol) comma@@ -747,37 +733,33 @@ qname = (char ':' *> toSN getDefaultPrefix) <|> (n3Name >>= fullOrLocalQName)- <?> "QName" where toSN p = ScopedName <$> p <*> (n3Name <|> return "") -fullOrLocalQName :: String -> N3Parser ScopedName+fullOrLocalQName :: T.Text -> N3Parser ScopedName fullOrLocalQName name = (char ':' *> fullQName name) <|> localQName name -fullQName :: String -> N3Parser ScopedName+fullQName :: T.Text -> N3Parser ScopedName fullQName name = do pre <- findPrefix name lname <- n3Name <|> return "" return $ ScopedName pre lname -findPrefix :: String -> N3Parser Namespace+findPrefix :: T.Text -> N3Parser Namespace findPrefix pre = do- st <- getState- case mapFindMaybe pre (prefixUris st) of- Just uri -> return $ Namespace pre uri- Nothing -> unexpected $ "Prefix '" ++ pre ++ ":' not bound."+ st <- stGet+ case mapFindMaybe (Just pre) (prefixUris st) of+ Just uri -> return $ Namespace (Just pre) uri+ Nothing -> failBad $ "Prefix '" ++ T.unpack pre ++ ":' not bound." -localQName :: String -> N3Parser ScopedName+localQName :: T.Text -> N3Parser ScopedName localQName name = do- st <- getState+ st <- stGet if getAllowLocalNames st- then do- pre <- getDefaultPrefix- return $ ScopedName pre name- - else fail "Invalid 'bare' word" -- TODO: not ideal error message; can we handle this case differently?+ then ScopedName <$> getDefaultPrefix <*> pure name+ else fail ("Invalid 'bare' word: " ++ T.unpack name)-- TODO: not ideal error message; can we handle this case differently? {- existential ::= | "@forSome" symbol_csl@@ -790,7 +772,8 @@ -} existential :: N3Parser ()-existential = try (atWord "forSome") *> symbolCsl >> return ()+-- existential = try (atWord "forSome") *> symbolCsl >> return ()+existential = atWord "forSome" *> symbolCsl *> pure () {- simpleStatement ::= | subject propertylist@@ -857,13 +840,13 @@ br "(" ")" pathList <|> br "[" "]" propertyListBNode <|> br "{" "}" formulaContent- <|> try boolean+ -- <|> try boolean+ <|> boolean <|> literal <|> numericLiteral <|> quickVariable- <|> Blank <$> (string "_:" *> n3Name) -- TODO a hack that needs fixing+ <|> Blank <$> (string "_:" *> n3NameStr) -- TODO a hack that needs fixing <|> Res <$> n3symbol- <?> "pathitem" {- we create a blank node for the list and return it, whilst@@ -871,25 +854,25 @@ -} pathList :: N3Parser RDFLabel pathList = do- cts <- many (lexeme expression) <?> "pathlist"- eNode <- operatorLabel rdf_nil+ cts <- many (lexeme expression)+ eNode <- operatorLabel rdfNil case cts of [] -> return eNode (c:cs) -> do sNode <- newBlankNode- first <- operatorLabel rdf_first+ first <- operatorLabel rdfFirst addStatement sNode first c lNode <- foldM addElem sNode cs- rest <- operatorLabel rdf_rest+ rest <- operatorLabel rdfRest addStatement lNode rest eNode return sNode where addElem prevNode curElem = do bNode <- newBlankNode- first <- operatorLabel rdf_first- rest <- operatorLabel rdf_rest+ first <- operatorLabel rdfFirst+ rest <- operatorLabel rdfRest addStatement prevNode rest bNode addStatement bNode first curElem return bNode@@ -905,8 +888,8 @@ restoreState :: N3State -> N3Parser N3State restoreState origState = do- oldState <- getState- setState $ origState { nodeGen = nodeGen oldState }+ oldState <- stGet+ stUpdate $ \_ -> origState { nodeGen = nodeGen oldState } return oldState {-@@ -919,19 +902,17 @@ formulaContent :: N3Parser RDFLabel formulaContent = do bNode <- newBlankNode- pstate <- getState- let fstate = pstate { graphState = emptyRDFGraph, thisNode = bNode }- setState fstate+ pstate <- stGet+ stUpdate $ \st -> st { graphState = emptyRDFGraph, thisNode = bNode } statementList oldState <- restoreState pstate- updateState $ updateGraph $ setFormula (Formula bNode (graphState oldState))+ stUpdate $ updateGraph $ setFormula (Formula bNode (graphState oldState)) return bNode subgraph :: RDFLabel -> N3Parser RDFGraph subgraph this = do- pstate <- getState- let fstate = pstate { graphState = emptyRDFGraph, thisNode = this }- setState fstate -- switch new state into parser+ pstate <- stGet+ stUpdate $ \st -> st { graphState = emptyRDFGraph, thisNode = this } statementsOptional -- parse statements of formula oldState <- restoreState pstate return $ graphState oldState@@ -945,8 +926,9 @@ -} boolean :: N3Parser RDFLabel-boolean = mkTypedLit xsd_boolean <$> - (try (atWord "false") <|> atWord "true")+boolean = mkTypedLit xsdBoolean <$> + (atWord "false" <|> atWord "true")+ -- (try (atWord "false") <|> atWord "true") {- dtlang ::= | "@" langcode@@ -959,19 +941,19 @@ -} literal :: N3Parser RDFLabel-literal = Lit <$> n3string <*> optionMaybe dtlang+literal = Lit <$> n3string <*> optional dtlang dtlang :: N3Parser ScopedName dtlang = - (char '@' *> langcode <?> "langcode")- <|> (try (string "^^") *> n3symbol)- <?> "dtlang"+ (char '@' *> langcode)+ <|> string "^^" *> n3symbol+ -- <|> (try (string "^^") *> n3symbol) langcode :: N3Parser ScopedName langcode = do- h <- many1 (oneOf ['a'..'z']) <?> "start of langcode (a to z)"- mt <- optionMaybe ( (:) <$> char '-' <*> many1 (oneOf (['a'..'z'] ++ ['0'..'9']))) <?> "a to z or 0 to 9 (langcode after the hyphen)"- return $ langName $ h ++ fromMaybe "" mt+ h <- many1Satisfy isaz+ mt <- optional ( L.append <$> (char '-' *> pure (L.singleton '-')) <*> many1Satisfy isaz09)+ return $ langName $ L.toStrict $ L.append h (fromMaybe L.empty mt) {- decimal ::= [-+]?[0-9]+(\.[0-9]+)?@@ -981,6 +963,9 @@ | double | integer +We actually support 1. for decimal values which isn't supported +by the above production.+ TODO: we could convert via something like maybeRead value :: Double >>= Just . toRDFLabel@@ -993,31 +978,35 @@ numericLiteral :: N3Parser RDFLabel numericLiteral =- -- try (mkTypedLit xsd_double <$> n3double)- try (d2s <$> n3double)- <|> try (mkTypedLit xsd_decimal <$> n3decimal)- <|> mkTypedLit xsd_integer <$> n3integer- <?> "numericliteral"+ -- -- try (mkTypedLit xsdDouble <$> n3double)+ -- try (d2s <$> n3double)+ -- <|> try (mkTypedLit xsdDecimal <$> n3decimal)+ d2s <$> n3double+ <|> mkTypedLit xsdDecimal . T.pack <$> n3decimal+ <|> mkTypedLit xsdInteger . T.pack <$> n3integer n3sign :: N3Parser Char n3sign = char '+' <|> char '-' n3integer :: N3Parser String n3integer = do- ms <- optionMaybe n3sign+ ms <- optional n3sign ds <- many1 digit case ms of Just s -> return $ s : ds _ -> return ds n3decimal :: N3Parser String-n3decimal = (++) <$> n3integer <*> ( (:) <$> char '.' <*> many1 digit )+-- n3decimal = (++) <$> n3integer <*> ( (:) <$> char '.' <*> many1 digit )+n3decimal = (++) <$> n3integer <*> ( (:) <$> char '.' <*> many digit ) -n3double :: N3Parser String -n3double = (++) <$> n3decimal <*> ( (:) <$> oneOf "eE" <*> n3integer )+n3double :: N3Parser String+n3double = (++) <$> n3decimal <*> ( (:) <$> satisfy (`elem` "eE") <*> n3integer ) --- convert a double, as returned by n3double, into it's--- canonical XSD form+-- Convert a double, as returned by n3double, into it's+-- canonical XSD form. We assume that n3double returns+-- a syntactivally valid Double, so do not bother with reads here+-- d2s :: String -> RDFLabel d2s s = toRDFLabel (read s :: Double) @@ -1099,20 +1088,26 @@ -- we check reverse first so that <= is tried before looking for a URI via expression rule (,) addStatementRev <$> verbReverse <|> (,) addStatement <$> verbForward- <?> "verb" -- those verbs for which subject is on the right and object on the left verbReverse :: N3Parser RDFLabel verbReverse =- try (string "<=") *> operatorLabel log_implies+ string "<=" *> operatorLabel logImplies+ <|> between (atWord "is") (atWord "of") (lexeme expression)++{-+ try (string "<=") *> operatorLabel logImplies <|> between (try (atWord "is")) (atWord "of") (lexeme expression)+-} -- those verbs with subject on the left and object on the right verbForward :: N3Parser RDFLabel verbForward = - (try (string "=>") *> operatorLabel log_implies)- <|> (string "=" *> operatorLabel owl_sameAs)- <|> (try (atWord "a") *> operatorLabel rdf_type)+ -- (try (string "=>") *> operatorLabel logImplies)+ (string "=>" *> operatorLabel logImplies)+ <|> (string "=" *> operatorLabel owlSameAs)+ -- <|> (try (atWord "a") *> operatorLabel rdfType)+ <|> (atWord "a" *> operatorLabel rdfType) <|> (atWord "has" *> lexeme expression) <|> lexeme expression @@ -1123,8 +1118,9 @@ -} universal :: N3Parser () universal = - try (atWord "forAll") *> - unexpected "universal (@forAll) currently unsupported." + -- try (atWord "forAll") *> + atWord "forAll" *> + failBad "universal (@forAll) currently unsupported." -- will be something like: *> symbolCsl {-
Swish/RDF/NTFormatter.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +9,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This Module implements a NTriples formatter (see [1]) -- for an RDFGraph value.@@ -24,8 +25,9 @@ module Swish.RDF.NTFormatter ( NodeGenLookupMap- , formatGraphAsString- , formatGraphAsShowS+ , formatGraphAsText+ , formatGraphAsLazyText+ , formatGraphAsBuilder ) where @@ -45,12 +47,20 @@ , mapFind, mapAdd ) -import Text.Printf (printf)-import Data.Char (ord)+import Data.Char (ord, intToDigit, toUpper) --- import "mtl" Control.Monad.State import Control.Monad.State+import Control.Applicative ((<$>))+import Data.Monoid +-- it strikes me that using Lazy Text here is likely to be+-- wrong; however I have done no profiling to back this+-- assumption up!++import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Builder as B+ ---------------------------------------------------------------------- -- Graph formatting state monad ----------------------------------------------------------------------@@ -74,46 +84,41 @@ type Formatter a = State NTFormatterState a -------------------------------------------------------------------------- Define a top-level formatter function:--- accepts a graph and returns a string-------------------------------------------------------------------------formatGraphAsString :: RDFGraph -> String-formatGraphAsString gr = formatGraphAsShowS gr "\n"+-- | Convert a RDF graph to NTriples format.+formatGraphAsText :: RDFGraph -> T.Text+formatGraphAsText = L.toStrict . formatGraphAsLazyText -formatGraphAsShowS :: RDFGraph -> ShowS-formatGraphAsShowS gr = - let (out, _, _) = formatGraphInternal gr- in out +-- | Convert a RDF graph to NTriples format.+formatGraphAsLazyText :: RDFGraph -> L.Text+formatGraphAsLazyText = B.toLazyText . formatGraphAsBuilder -formatGraphInternal :: RDFGraph -> (ShowS, NodeGenLookupMap, Int)-formatGraphInternal gr = - let (out, st) = runState (formatGraph gr) emptyNTFS- in (out, ntfsNodeMap st, ntfsNodeGen st)+-- | Convert a RDF graph to NTriples format.+formatGraphAsBuilder :: RDFGraph -> B.Builder+formatGraphAsBuilder gr = fst $ runState (formatGraph gr) emptyNTFS ---------------------------------------------------------------------- -- Formatting as a monad-based computation ---------------------------------------------------------------------- --- Are there better ways to do this (could look at moving to a Builder--- style system)?--- -applyShowS :: [ShowS] -> ShowS-applyShowS = foldr (.) id+formatGraph :: RDFGraph -> Formatter B.Builder+formatGraph gr = mconcat <$> mapM formatArc (getArcs gr) -formatGraph :: RDFGraph -> Formatter ShowS-formatGraph gr = do- ls <- mapM formatArc (getArcs gr)- return $ applyShowS ls+-- TODO: this reverses the contents but may be faster?+-- that is if I've got the order right in the mappend call+-- formatGraphBuilder gr = foldl' (\a b -> b `mappend` (formatArcBuilder a)) B.empty (getArcs gr) -formatArc :: Arc RDFLabel -> Formatter ShowS+space, nl :: B.Builder+space = B.singleton ' '+nl = " .\n"++formatArc :: Arc RDFLabel -> Formatter B.Builder formatArc (Arc s p o) = do sl <- formatLabel s pl <- formatLabel p ol <- formatLabel o- return $ applyShowS $ map showString [sl, " ", pl, " ", ol, " .\n"]-+ return $ mconcat [sl, space, pl, space, ol, nl]+ -- return $ sl `mappend` $ space `mappend` $ pl `mappend` $ space `mappend` $ ol `mappend` nl+ {- If we have a blank node then can @@ -129,18 +134,23 @@ formatLabel lab = return $ show lab -} -formatLabel :: RDFLabel -> Formatter String+squote, at, carets :: B.Builder+squote = "\""+at = "@"+carets = "^^"++formatLabel :: RDFLabel -> Formatter B.Builder formatLabel lab@(Blank _) = mapBlankNode lab formatLabel (Res sn) = return $ showScopedName sn-formatLabel (Lit lit Nothing) = return $ quoteStr lit-formatLabel (Lit lit (Just nam)) | isLang nam = return $ quoteStr lit ++ "@" ++ langTag nam- | otherwise = return $ quoteStr lit ++ "^^" ++ showScopedName nam+formatLabel (Lit lit Nothing) = return $ quoteText lit+formatLabel (Lit lit (Just nam)) | isLang nam = return $ mconcat [quoteText lit, at, B.fromText (langTag nam)]+ | otherwise = return $ mconcat [quoteText lit, carets, showScopedName nam] -- do not expect to get the following, but include -- just in case rather than failing-formatLabel lab = return $ show lab+formatLabel lab = return $ B.fromString $ show lab -mapBlankNode :: RDFLabel -> Formatter String+mapBlankNode :: RDFLabel -> Formatter B.Builder mapBlankNode lab = do st <- get let cmap = ntfsNodeMap st@@ -156,42 +166,58 @@ n -> return n - return $ "_:swish" ++ show nv+ return $ "_:swish" `mappend` B.fromString (show nv) -showScopedName :: ScopedName -> String+-- TODO: can we use Network.URI to protect the URI?+showScopedName :: ScopedName -> B.Builder showScopedName (ScopedName n l) = - let uri = nsURI n ++ l- in "<" ++ quote uri ++ ">"+ let uri = T.pack (show (nsURI n)) `mappend` l+ in mconcat ["<", B.fromText (quote uri), ">"] {- Swish.Utils.MiscHelpers contains a quote routine which we expand upon here to match the NT syntax. -} -quoteStr :: String -> String-quoteStr st = '"' : quote st ++ "\""+quoteText :: T.Text -> B.Builder+quoteText st = mconcat [squote, B.fromText (quote st), squote] -quote :: String -> String-quote [] = ""-quote ('\\':st) = '\\':'\\': quote st-quote ('"': st) = '\\':'"': quote st-quote ('\n':st) = '\\':'n': quote st-quote ('\r':st) = '\\':'r': quote st-quote ('\t':st) = '\\':'t': quote st-quote (c:st) = +{-+QUS: should we be operating on Text like this?+-}++quote :: T.Text -> T.Text+quote = T.concatMap quoteT++quoteT :: Char -> T.Text+quoteT '\\' = "\\\\"+quoteT '"' = "\\\""+quoteT '\n' = "\\n"+quoteT '\t' = "\\t"+quoteT '\r' = "\\r"+quoteT c = let nc = ord c- rst = quote st - -- lazy way to convert to a string- hstr = printf "%08X" nc- ustr = hstr ++ rst- in if nc > 0xffff - then '\\':'U': ustr+ then T.pack ('\\':'U': numToHex 8 nc) else if nc > 0x7e || nc < 0x20- then '\\':'u': drop 4 ustr- else c : rst+ then T.pack ('\\':'u': numToHex 4 nc)+ else T.singleton c +-- we assume c > 0, n >= 0 and that the input value fits+-- into the requested number of digits+numToHex :: Int -> Int -> String+numToHex c v = go [] v+ where+ go s 0 = replicate (c - length s) '0' ++ s+ go s n = + let (m,x) = divMod n 16+ in go (iToD x:s) m++ -- Data.Char.intToDigit uses lower-case Hex+ iToD x | x < 10 = intToDigit x+ | otherwise = toUpper $ intToDigit x+ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke
Swish/RDF/NTParser.hs view
@@ -14,8 +14,6 @@ -- new 'RDFGraph' consisting of triples and namespace information parsed from -- the supplied NTriples input string, or an error indication. ----- Uses the Parsec monadic parser library.--- -- REFERENCES: -- -- 1 <http://www.w3.org/TR/rdf-testcases/#ntriples>@@ -29,6 +27,7 @@ , parseNT , parsefromString + {- -- * Exports for parsers that embed NTriples in a bigger syntax , NTParser, NTState(..) , ntripleDoc@@ -37,7 +36,8 @@ , subject, predicate, object , uriref, urirefLbl , nodeID, literal, language-+ -}+ ) where @@ -47,32 +47,44 @@ , emptyRDFGraph ) -import Swish.RDF.GraphClass- ( arc )+import Swish.RDF.GraphClass (arc) -import Swish.Utils.Namespace- ( ScopedName(..)- , makeUriScopedName- )+import Swish.Utils.Namespace (ScopedName(..), makeURIScopedName) import Swish.RDF.Vocabulary (langName) +import Swish.RDF.RDFParser ( ParseResult+ , ignore+ , skipMany+ , noneOf+ , char+ , string+ , eoln+ , fullStop+ , hex4+ , hex8+ )+ +{- import Swish.RDF.RDFParser ( ParseResult, RDFParser , ignore , annotateParsecError )+-} import Control.Applicative-import Control.Monad (when) import Network.URI (parseURI) -import Data.Char (chr) -import Data.Maybe (fromMaybe, isNothing)+import qualified Data.Text as T+import qualified Data.Text.Lazy as L -import Text.ParserCombinators.Parsec hiding (many, optional, (<|>))+import Data.Char (ord) +import Data.Maybe (fromMaybe) +import Text.ParserCombinators.Poly.StateText+ ---------------------------------------------------------------------- -- Define parser state and helper functions ----------------------------------------------------------------------@@ -83,9 +95,10 @@ } -- Return function to update graph in NT parser state,--- using the supplied function of a graph--- (use returned function with Parsec updateState)-updateGraph :: ( RDFGraph -> RDFGraph ) -> NTState -> NTState+-- using the supplied function of a graph. This is for use+-- with stUpdate.+--+updateGraph :: (RDFGraph -> RDFGraph) -> NTState -> NTState updateGraph f s = s { graphState = f (graphState s) } ----------------------------------------------------------------------@@ -93,46 +106,45 @@ -- accepts a string and returns a graph or error ---------------------------------------------------------------------- -type NTParser a = RDFParser NTState a+-- | Parser that carries around a `NTState` record.+type NTParser a = Parser NTState a -- | Parse a string. -- parseNT ::- String -- ^ input in NTriples format.+ L.Text -- ^ input in NTriples format. -> ParseResult-parseNT = parsefromString ntripleDoc--- parseNT = either Error Result . parsefromString ntripleDoc+parseNT = parsefromText ntripleDoc {- -- useful for testing test :: String -> RDFGraph-test = either error id . parsefromString ntripleDoc+test = either error id . parseNT -} -- | Function to supply initial context and parse supplied term. ----- We augment the Parsec error with the context.--- parsefromString :: NTParser a -- ^ parser to apply -> String -- ^ input to be parsed -> Either String a-parsefromString parser input =- let- pstate = NTState+parsefromString parser = parsefromText parser . L.pack++-- | Function to supply initial context and parse supplied term.+--+parsefromText :: + NTParser a -- ^ parser to apply+ -> L.Text -- ^ input to be parsed+ -> Either String a+parsefromText parser input =+ let istate = NTState { graphState = emptyRDFGraph }- result = runParser parser pstate "" input- in- case result of- Right res -> Right res- Left err -> Left $ annotateParsecError 1 (lines input) err-+ (result, _, _) = runParser parser istate input+ in result + -- helper routines -fullStop :: NTParser ()-fullStop = ignore (char '.')- {- lineFeed :: NTParser () lineFeed = ignore (char '\r')@@ -141,7 +153,7 @@ -- Add statement to graph in NT parser state addStatement :: RDFLabel -> RDFLabel -> RDFLabel -> NTParser ()-addStatement s p o = updateState (updateGraph (addArc (arc s p o) ))+addStatement s p o = stUpdate (updateGraph (addArc (arc s p o) )) ---------------------------------------------------------------------- -- Syntax productions@@ -178,10 +190,10 @@ -} ntripleDoc :: NTParser RDFGraph-ntripleDoc = graphState <$> (sepBy line eoln *> optional eoln *> skipMany ws *> eof *> getState)+ntripleDoc = graphState <$> (sepBy line eoln *> optional eoln *> skipWS *> eof *> stGet) line :: NTParser ()-line = skipMany ws *> ignore (optional (comment <|> triple))+line = skipWS *> ignore (optional (comment <|> triple)) {- ws ::= space | tab @@ -189,52 +201,76 @@ Could use whiteSpace rule here, but that would permit constructs (e.g. comments) where we do not support them. -}++isWS :: Char -> Bool+isWS = (`elem` " \t")++{- ws :: NTParser ()-ws = ignore (char ' ' <|> tab) <?> "white space (' ' or tab)"+-- ws = ignore (char ' ' <|> tab)+ws = ignore $ satisfy isWS+-}+ +skipWS :: NTParser ()+skipWS = ignore $ manySatisfy isWS +skip1WS :: NTParser ()+skip1WS = ignore $ many1Satisfy isWS+ {- comment ::= '#' ( character - ( cr | lf ) )* -} comment :: NTParser ()-comment = char '#' *> skipMany (noneOf "\r\n") <?> "comment line"+comment = char '#' *> skipMany (noneOf "\r\n") {- eoln ::= cr | lf | cr lf -} -eoln :: NTParser ()--- eoln = ignore (newline <|> (lineFeed *> optional newline))-eoln = ignore (try (string "\r\n") <|> string "\r" <|> string "\n")- <?> "new line"- {- name ::= [A-Za-z][A-Za-z0-9]* -} -hChars, bChars :: String-hChars = ['a'..'z'] ++ ['A'..'Z']-bChars = hChars ++ ['0'..'9']+isaz, isAZ, is09 :: Char -> Bool+isaz c = c >= 'a' && c <= 'z'+isAZ c = c >= 'A' && c <= 'Z'+is09 c = c >= '0' && c <= '9' -name :: NTParser String-name = (:) <$> oneOf hChars <*> many (oneOf bChars)+isHeadChar, isBodyChar :: Char -> Bool+isHeadChar c = isaz c || isAZ c+isBodyChar c = isHeadChar c || is09 c +name :: NTParser L.Text+name = L.cons <$> satisfy isHeadChar <*> manySatisfy isBodyChar++nameStr :: NTParser String+nameStr = L.unpack <$> name+ {- triple ::= subject ws+ predicate ws+ object ws* '.' ws* -} triple :: NTParser ()-triple = do- s <- subject- skipMany1 ws- p <- predicate- skipMany1 ws- o <- object- skipMany ws- fullStop- skipMany ws- addStatement s p o+triple = + {- tryin to be fancy but addStatement is a Parser not a pure function+ addStatement + <$> (subject <* skip1WS)+ <*> (predicate <* skip1WS)+ <*> (object <* (skipWS *> fullStop *> skipWS))+ -}+ + do+ s <- subject+ skip1WS+ p <- predicate+ skip1WS+ o <- object+ skipWS+ fullStop+ skipWS+ addStatement s p o {- subject ::= uriref | nodeID @@ -259,10 +295,14 @@ uriref :: NTParser ScopedName uriref = do- ustr <- char '<' *> manyTill character (char '>')- when (isNothing (parseURI ustr)) $- fail ("Invalid URI: <" ++ ustr ++ ">")- return $ makeUriScopedName ustr+ -- not ideal, as want to reject invalid characters immediately rather than via parseURI+ ustr <- L.unpack <$> bracket (char '<') (char '>') (many1Satisfy (/= '>'))+ -- ustr <- bracket (char '<') (char '>') $ many1 character -- looks like need to exclude > from character+ -- ustr <- char '<' *> manyTill character (char '>')+ + maybe (failBad ("Invalid URI: <" ++ ustr ++ ">"))+ (return . makeURIScopedName)+ (parseURI ustr) urirefLbl :: NTParser RDFLabel urirefLbl = Res <$> uriref@@ -272,7 +312,7 @@ -} nodeID :: NTParser RDFLabel-nodeID = Blank <$> (string "_:" *> name) <?> "blank node (_:label)"+nodeID = Blank <$> (string "_:" *> nameStr) {- literal ::= langString | datatypeString @@ -285,8 +325,11 @@ -} literal :: NTParser RDFLabel-literal = Lit <$> between (char '"') (char '"') (many character) <*> optionMaybe dtlang+literal = Lit <$> (T.pack <$> ntstring) <*> optional dtlang +ntstring :: NTParser String+ntstring = bracket (char '"') (char '"') (many character)+ dtlang :: NTParser ScopedName dtlang = (char '@' *> language)@@ -294,9 +337,9 @@ language :: NTParser ScopedName language = do- h <- many1 (oneOf ['a'..'z'])- mt <- optionMaybe ( (:) <$> char '-' <*> many1 (oneOf (['a'..'z'] ++ ['0'..'9'])) )- return $ langName $ h ++ fromMaybe "" mt+ h <- many1Satisfy isaz+ mt <- optional ( L.cons <$> char '-' <*> many1Satisfy (\c -> isaz c || is09 c) )+ return $ langName $ L.toStrict $ L.append h $ fromMaybe L.empty mt {- String handling: @@ -337,30 +380,13 @@ -} -asciiChars :: String-asciiChars = map chr [0x20..0x7e]--asciiCharsNT :: String-asciiCharsNT = filter (`notElem` "\\\"") asciiChars--ntHexDigit :: NTParser Char-ntHexDigit = oneOf $ ['0'..'9'] ++ ['A'..'F']+-- 0x22 is " and 0x5c is \ -hex4 :: NTParser Char-hex4 = do- digs <- count 4 ntHexDigit- let dstr = "0x" ++ digs- dchar = read dstr :: Int- return $ chr dchar- -hex8 :: NTParser Char-hex8 = do- digs <- count 8 ntHexDigit- let dstr = "0x" ++ digs- dchar = read dstr :: Int- if dchar <= 0x10FFFF- then return $ chr dchar- else unexpected "\\UHHHHHHHH format is limited to a maximum of \\U0010FFFF"+isAsciiChar :: Char -> Bool+isAsciiChar c = let i = ord c+ in i >= 0x20 && i <= 0x21 ||+ i >= 0x23 && i <= 0x5b ||+ i >= 0x5d && i <= 0x7e protectedChar :: NTParser Char protectedChar =@@ -373,8 +399,9 @@ <|> (char 'U' *> hex8) character :: NTParser Char-character = (char '\\' *> protectedChar)- <|> (oneOf asciiCharsNT <?> "ASCII character")+character = + (char '\\' *> protectedChar)+ <|> satisfy isAsciiChar -------------------------------------------------------------------------------- --
Swish/RDF/RDFDatatype.hs view
@@ -52,11 +52,10 @@ import Swish.RDF.VarBinding ( VarBindingModify(..) ) -import Data.Maybe- ( fromMaybe, isJust, fromJust )+import Control.Monad (liftM)+import Data.Maybe (fromMaybe, isJust, fromJust) -import Control.Monad- ( liftM )+import qualified Data.Text as T ------------------------------------------------------------ -- Specialize datatype framework types for use with RDF@@ -177,9 +176,9 @@ dtmap = tvalMap dtv -- | Create a typed literal from the given value.-makeDatatypedLiteral :: ScopedName -> String -> RDFLabel-makeDatatypedLiteral dtnam strval =- Lit strval (Just dtnam)+makeDatatypedLiteral :: ScopedName -> T.Text -> RDFLabel+makeDatatypedLiteral dtnam txtval =+ Lit txtval (Just dtnam) -------------------------------------------------------------------------------- --
Swish/RDF/RDFDatatypeXsdInteger.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module defines the structures used by Swish to represent and -- manipulate RDF @xsd:integer@ datatyped literals.@@ -26,7 +28,7 @@ import Swish.RDF.RDFRuleset ( RDFFormula, RDFRule, RDFRuleset - , makeRDFGraphFromN3String+ , makeRDFGraphFromN3Builder , makeRDFFormula ) @@ -37,13 +39,8 @@ , makeRdfDtOpenVarBindingModifiers ) -import Swish.RDF.ClassRestrictionRule- ( makeRDFDatatypeRestrictionRules- )--import Swish.RDF.MapXsdInteger- ( mapXsdInteger- )+import Swish.RDF.ClassRestrictionRule (makeRDFDatatypeRestrictionRules)+import Swish.RDF.MapXsdInteger (mapXsdInteger) import Swish.RDF.Datatype ( Datatype(..)@@ -54,18 +51,15 @@ , BinaryFnTable, binaryFnApp , BinMaybeFnTable, binMaybeFnApp , DatatypeMod(..) - , makeVmod_1_1_inv, makeVmod_1_1- , makeVmod_2_1_inv, makeVmod_2_1- , makeVmod_2_0- , makeVmod_2_2+ , makeVmod11inv, makeVmod11+ , makeVmod21inv, makeVmod21+ , makeVmod20+ , makeVmod22 ) import Swish.RDF.Ruleset (makeRuleset) -import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..)- )+import Swish.Utils.Namespace (Namespace(..), ScopedName(..), namespaceToBuilder) import Swish.RDF.Vocabulary ( namespaceRDF@@ -75,16 +69,19 @@ , namespaceXsdType ) +import Data.Monoid(Monoid(..))+import Control.Monad (liftM) import Data.Maybe (maybeToList) -import Control.Monad (liftM)+import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as B ------------------------------------------------------------ -- Misc values ------------------------------------------------------------ -- Local name for Integer datatype-nameXsdInteger :: String+nameXsdInteger :: T.Text nameXsdInteger = "integer" -- |Type name for xsd:integer datatype@@ -95,14 +92,6 @@ namespaceXsdInteger :: Namespace namespaceXsdInteger = namespaceXsdType nameXsdInteger --- Helper to catenate strings with newline separator,--- used for making textual representations of graphs.--- (the newline makes N3 parser diagnostics easier to interpret)----infixr 5 +++-(+++) :: String -> ShowS-(+++) str = ((str++"\n")++)- -- Compose with function of two arguments c2 :: (b -> c) -> (a -> d -> b) -> a -> d -> c c2 = (.) . (.)@@ -177,7 +166,7 @@ ] mkIntRel2 ::- String -> DatatypeRelPr Integer -> UnaryFnTable Integer+ T.Text -> DatatypeRelPr Integer -> UnaryFnTable Integer -> DatatypeRel Integer mkIntRel2 nam pr fns = DatatypeRel { dtRelName = ScopedName namespaceXsdInteger nam@@ -185,7 +174,7 @@ } mkIntRel3 ::- String -> DatatypeRelPr Integer -> BinaryFnTable Integer+ T.Text -> DatatypeRelPr Integer -> BinaryFnTable Integer -> DatatypeRel Integer mkIntRel3 nam pr fns = DatatypeRel { dtRelName = ScopedName namespaceXsdInteger nam@@ -193,7 +182,7 @@ } mkIntRel3maybe ::- String -> DatatypeRelPr Integer -> BinMaybeFnTable Integer+ T.Text -> DatatypeRelPr Integer -> BinMaybeFnTable Integer -> DatatypeRel Integer mkIntRel3maybe nam pr fns = DatatypeRel { dtRelName = ScopedName namespaceXsdInteger nam@@ -317,7 +306,7 @@ modXsdIntegerAbs = DatatypeMod { dmName = ScopedName namespaceXsdInteger "abs" , dmModf = [ f0, f1 ]- , dmAppf = makeVmod_1_1+ , dmAppf = makeVmod11 } where f0 vs@[v1,v2] = if v1 == abs v2 then vs else []@@ -329,7 +318,7 @@ modXsdIntegerNeg = DatatypeMod { dmName = ScopedName namespaceXsdInteger "neg" , dmModf = [ f0, f1, f1 ]- , dmAppf = makeVmod_1_1_inv+ , dmAppf = makeVmod11inv } where f0 vs@[v1,v2] = if v1 == negate v2 then vs else []@@ -341,7 +330,7 @@ modXsdIntegerSum = DatatypeMod { dmName = ScopedName namespaceXsdInteger "sum" , dmModf = [ f0, f1, f2, f2 ]- , dmAppf = makeVmod_2_1_inv+ , dmAppf = makeVmod21inv } where f0 vs@[v1,v2,v3] = if v1 == v2+v3 then vs else []@@ -355,7 +344,7 @@ modXsdIntegerDiff = DatatypeMod { dmName = ScopedName namespaceXsdInteger "diff" , dmModf = [ f0, f1, f2, f3 ]- , dmAppf = makeVmod_2_1_inv+ , dmAppf = makeVmod21inv } where f0 vs@[v1,v2,v3] = if v1 == v2-v3 then vs else []@@ -371,7 +360,7 @@ modXsdIntegerProd = DatatypeMod { dmName = ScopedName namespaceXsdInteger "prod" , dmModf = [ f0, f1, f2, f2 ]- , dmAppf = makeVmod_2_1_inv+ , dmAppf = makeVmod21inv } where f0 vs@[v1,v2,v3] = if v1 == v2*v3 then vs else []@@ -386,7 +375,7 @@ modXsdIntegerDivMod = DatatypeMod { dmName = ScopedName namespaceXsdInteger "divmod" , dmModf = [ f0, f1 ]- , dmAppf = makeVmod_2_2+ , dmAppf = makeVmod22 } where f0 vs@[v1,v2,v3,v4] = if (v1,v2) == divMod v3 v4 then vs else []@@ -398,7 +387,7 @@ modXsdIntegerPower = DatatypeMod { dmName = ScopedName namespaceXsdInteger "power" , dmModf = [ f0, f1 ]- , dmAppf = makeVmod_2_1+ , dmAppf = makeVmod21 } where f0 vs@[v1,v2,v3] = if Just v1 == intPower v2 v3 then vs else []@@ -415,11 +404,11 @@ modXsdIntegerGe = modXsdIntegerCompare "ge" (>=) modXsdIntegerCompare ::- String -> (Integer->Integer->Bool) -> RDFDatatypeMod Integer+ T.Text -> (Integer->Integer->Bool) -> RDFDatatypeMod Integer modXsdIntegerCompare nam rel = DatatypeMod { dmName = ScopedName namespaceXsdInteger nam , dmModf = [ f0 ]- , dmAppf = makeVmod_2_0+ , dmAppf = makeVmod20 } where f0 vs@[v1,v2] = if rel v1 v2 then vs else []@@ -437,22 +426,22 @@ rdfRulesetXsdInteger = makeRuleset namespaceXsdInteger axiomsXsdInteger rulesXsdInteger -mkPrefix :: Namespace -> String-mkPrefix ns =- "@prefix " ++ nsPrefix ns ++ ": <" ++ nsURI ns ++ "> . \n"+mkPrefix :: Namespace -> B.Builder+mkPrefix = namespaceToBuilder -prefixXsdInteger :: String-prefixXsdInteger =- mkPrefix namespaceRDF ++- mkPrefix namespaceRDFS ++- mkPrefix namespaceRDFD ++- mkPrefix namespaceXSD ++- mkPrefix namespaceXsdInteger ++- " \n"+prefixXsdInteger :: B.Builder+prefixXsdInteger = + mconcat+ [ mkPrefix namespaceRDF+ , mkPrefix namespaceRDFS+ , mkPrefix namespaceRDFD+ , mkPrefix namespaceXSD+ , mkPrefix namespaceXsdInteger+ ] -mkAxiom :: String -> String -> RDFFormula+mkAxiom :: T.Text -> B.Builder -> RDFFormula mkAxiom local gr =- makeRDFFormula namespaceXsdInteger local (prefixXsdInteger++gr)+ makeRDFFormula namespaceXsdInteger local (prefixXsdInteger `mappend` gr) axiomsXsdInteger :: [RDFFormula] axiomsXsdInteger =@@ -462,63 +451,69 @@ rulesXsdInteger :: [RDFRule] rulesXsdInteger = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr where- gr = makeRDFGraphFromN3String rulesXsdIntegerStr--rulesXsdIntegerStr :: String-rulesXsdIntegerStr = prefixXsdInteger- +++ "xsd_integer:Abs a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2) ; "- +++ " rdfd:constraint xsd_integer:abs ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Neg a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2) ; "- +++ " rdfd:constraint xsd_integer:neg ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Sum a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "- +++ " rdfd:constraint xsd_integer:sum ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Diff a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "- +++ " rdfd:constraint xsd_integer:diff ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Prod a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "- +++ " rdfd:constraint xsd_integer:prod ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:DivMod a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3 rdf:_4) ; "- +++ " rdfd:constraint xsd_integer:divmod ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Power a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "- +++ " rdfd:constraint xsd_integer:power ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Eq a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2) ; "- +++ " rdfd:constraint xsd_integer:eq ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Ne a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2) ; "- +++ " rdfd:constraint xsd_integer:ne ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Lt a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2) ; "- +++ " rdfd:constraint xsd_integer:lt ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Le a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2) ; "- +++ " rdfd:constraint xsd_integer:le ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Gt a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2) ; "- +++ " rdfd:constraint xsd_integer:gt ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_integer:Ge a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2) ; "- +++ " rdfd:constraint xsd_integer:ge ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ gr = makeRDFGraphFromN3Builder rulesXsdIntegerBuilder +--- I have removed the newline which was added between each line+--- to improve the clarity of parser errors.+---+rulesXsdIntegerBuilder :: B.Builder+rulesXsdIntegerBuilder = + mconcat+ [ prefixXsdInteger+ , "xsd_integer:Abs a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2) ; "+ , " rdfd:constraint xsd_integer:abs ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Neg a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2) ; "+ , " rdfd:constraint xsd_integer:neg ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Sum a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "+ , " rdfd:constraint xsd_integer:sum ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Diff a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "+ , " rdfd:constraint xsd_integer:diff ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Prod a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "+ , " rdfd:constraint xsd_integer:prod ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:DivMod a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3 rdf:_4) ; "+ , " rdfd:constraint xsd_integer:divmod ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Power a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "+ , " rdfd:constraint xsd_integer:power ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Eq a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2) ; "+ , " rdfd:constraint xsd_integer:eq ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Ne a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2) ; "+ , " rdfd:constraint xsd_integer:ne ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Lt a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2) ; "+ , " rdfd:constraint xsd_integer:lt ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Le a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2) ; "+ , " rdfd:constraint xsd_integer:le ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Gt a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2) ; "+ , " rdfd:constraint xsd_integer:gt ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_integer:Ge a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2) ; "+ , " rdfd:constraint xsd_integer:ge ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ ]+ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke
Swish/RDF/RDFDatatypeXsdString.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,13 +10,15 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module defines the structures used by Swish to represent and -- manipulate RDF @xsd:string@ datatyped literals. -- -------------------------------------------------------------------------------- +-- TODO: this should convert to/from T.Text rather than String+ module Swish.RDF.RDFDatatypeXsdString ( rdfDatatypeXsdString , rdfDatatypeValXsdString@@ -22,18 +26,16 @@ , axiomsXsdString, rulesXsdString , prefixXsdString )-where+ where import Swish.RDF.RDFRuleset ( RDFFormula, RDFRule, RDFRuleset- , makeRDFGraphFromN3String+ , makeRDFGraphFromN3Builder , makeRDFFormula , makeN3ClosureRule ) -import Swish.RDF.RDFVarBinding- ( RDFVarBindingModify- )+import Swish.RDF.RDFVarBinding (RDFVarBindingModify) import Swish.RDF.RDFDatatype ( RDFDatatype@@ -42,12 +44,8 @@ , makeRdfDtOpenVarBindingModifiers ) -import Swish.RDF.RDFGraph- ( RDFLabel(..) )--import Swish.RDF.ClassRestrictionRule- ( makeRDFDatatypeRestrictionRules- )+import Swish.RDF.RDFGraph (RDFLabel(..))+import Swish.RDF.ClassRestrictionRule (makeRDFDatatypeRestrictionRules) import Swish.RDF.Datatype ( Datatype(..)@@ -57,17 +55,11 @@ , altArgs , UnaryFnTable, unaryFnApp , DatatypeMod(..) - , makeVmod_2_0- )--import Swish.RDF.Ruleset- ( makeRuleset + , makeVmod20 ) -import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..)- )+import Swish.RDF.Ruleset (makeRuleset)+import Swish.Utils.Namespace (Namespace(..), ScopedName(..), namespaceToBuilder) import Swish.RDF.Vocabulary ( namespaceRDF@@ -77,19 +69,20 @@ , namespaceXsdType ) -import Swish.RDF.VarBinding- ( VarBinding(..)- , addVarBinding- , VarBindingModify(..)- )+import Swish.RDF.VarBinding (VarBinding(..), addVarBinding, VarBindingModify(..)) +import Data.Monoid(Monoid(..))++import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as B+ ------------------------------------------------------------ -- Misc values ------------------------------------------------------------ -- Local name for Integer datatype-nameXsdString :: String-nameXsdString = "string"+nameXsdString :: T.Text+nameXsdString = "string" -- |Type name for @xsd:string@ datatype typeNameXsdString :: ScopedName@@ -99,14 +92,6 @@ namespaceXsdString :: Namespace namespaceXsdString = namespaceXsdType nameXsdString --- Helper to catenate strings with newline separator,--- used for making textual representations of graphs.--- (the newline makes N3 parser diagnostics easier to interpret)----infixr 5 +++-(+++) :: String -> ShowS-(+++) str = ((str++"\n")++)- ------------------------------------------------------------ -- Declare exported RDFDatatype value for xsd:integer ------------------------------------------------------------@@ -120,16 +105,15 @@ -- |Define Datatype value for @xsd:string@. ---rdfDatatypeValXsdString :: RDFDatatypeVal String+rdfDatatypeValXsdString :: RDFDatatypeVal T.Text rdfDatatypeValXsdString = DatatypeVal { tvalName = typeNameXsdString- , tvalRules = rdfRulesetXsdString -- Ruleset RDFGraph+ , tvalRules = rdfRulesetXsdString , tvalMkRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString- -- RDFGraph -> [RDFRules] , tvalMkMods = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdString- , tvalMap = mapXsdString -- DatatypeMap Integer- , tvalRel = relXsdString -- [DatatypeRel Integer]- , tvalMod = modXsdString -- [DatatypeMod Integer]+ , tvalMap = mapXsdString+ , tvalRel = relXsdString+ , tvalMod = modXsdString } -- |mapXsdString contains functions that perform lexical-to-value@@ -137,25 +121,23 @@ -- -- These are identity mappings. ---mapXsdString :: DatatypeMap String+mapXsdString :: DatatypeMap T.Text mapXsdString = DatatypeMap- { -- mapL2V :: String -> Maybe String- mapL2V = Just- -- mapV2L :: String -> Maybe String+ { mapL2V = Just , mapV2L = Just } -- |relXsdString contains useful relations for @xsd:string@ values. ---relXsdString :: [DatatypeRel String]+relXsdString :: [DatatypeRel T.Text] relXsdString = [ relXsdStringEq , relXsdStringNe ] mkStrRel2 ::- String -> DatatypeRelPr String -> UnaryFnTable String- -> DatatypeRel String+ T.Text -> DatatypeRelPr T.Text -> UnaryFnTable T.Text+ -> DatatypeRel T.Text mkStrRel2 nam pr fns = DatatypeRel { dtRelName = ScopedName namespaceXsdString nam , dtRelFunc = altArgs pr fns unaryFnApp@@ -187,34 +169,34 @@ -- eq -relXsdStringEq :: DatatypeRel String+relXsdStringEq :: DatatypeRel T.Text relXsdStringEq = mkStrRel2 "eq" (lcomp (==)) ( repeat (const True, []) ) -- ne -relXsdStringNe :: DatatypeRel String+relXsdStringNe :: DatatypeRel T.Text relXsdStringNe = mkStrRel2 "ne" (lcomp (/=)) ( repeat (const True, []) ) -- |modXsdString contains variable binding modifiers for @xsd:string@ values. ---modXsdString :: [RDFDatatypeMod String]+modXsdString :: [RDFDatatypeMod T.Text] modXsdString = [ modXsdStringEq , modXsdStringNe ] -modXsdStringEq, modXsdStringNe :: RDFDatatypeMod String+modXsdStringEq, modXsdStringNe :: RDFDatatypeMod T.Text modXsdStringEq = modXsdStringCompare "eq" (==) modXsdStringNe = modXsdStringCompare "ne" (/=) modXsdStringCompare ::- String -> (String->String->Bool) -> RDFDatatypeMod String+ T.Text -> (T.Text->T.Text->Bool) -> RDFDatatypeMod T.Text modXsdStringCompare nam rel = DatatypeMod { dmName = ScopedName namespaceXsdString nam , dmModf = [ f0 ]- , dmAppf = makeVmod_2_0+ , dmAppf = makeVmod20 } where f0 vs@[v1,v2] = if rel v1 v2 then vs else []@@ -229,22 +211,22 @@ rdfRulesetXsdString = makeRuleset namespaceXsdString axiomsXsdString rulesXsdString -mkPrefix :: Namespace -> String-mkPrefix ns =- "@prefix " ++ nsPrefix ns ++ ": <" ++ nsURI ns ++ "> . \n"--prefixXsdString :: String-prefixXsdString =- mkPrefix namespaceRDF ++- mkPrefix namespaceRDFS ++- mkPrefix namespaceRDFD ++- mkPrefix namespaceXSD ++- mkPrefix namespaceXsdString ++- " \n"+mkPrefix :: Namespace -> B.Builder+mkPrefix = namespaceToBuilder -mkAxiom :: String -> String -> RDFFormula+prefixXsdString :: B.Builder+prefixXsdString = + mconcat+ [ mkPrefix namespaceRDF+ , mkPrefix namespaceRDFS+ , mkPrefix namespaceRDFD+ , mkPrefix namespaceXSD+ , mkPrefix namespaceXsdString+ ]+ +mkAxiom :: T.Text -> B.Builder -> RDFFormula mkAxiom local gr =- makeRDFFormula namespaceXsdString local (prefixXsdString++gr)+ makeRDFFormula namespaceXsdString local (prefixXsdString `mappend` gr) axiomsXsdString :: [RDFFormula] axiomsXsdString =@@ -258,19 +240,22 @@ rulesXsdStringRestriction = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString gr where- gr = makeRDFGraphFromN3String rulesXsdStringStr--rulesXsdStringStr :: String-rulesXsdStringStr = prefixXsdString- +++ "xsd_string:Eq a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2) ; "- +++ " rdfd:constraint xsd_string:eq ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "- +++ "xsd_string:Ne a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (rdf:_1 rdf:_2) ; "- +++ " rdfd:constraint xsd_string:ne ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ gr = makeRDFGraphFromN3Builder rulesXsdStringBuilder +rulesXsdStringBuilder :: B.Builder+rulesXsdStringBuilder = + mconcat+ [ prefixXsdString+ , "xsd_string:Eq a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2) ; "+ , " rdfd:constraint xsd_string:eq ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ , "xsd_string:Ne a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (rdf:_1 rdf:_2) ; "+ , " rdfd:constraint xsd_string:ne ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ ]+ rulesXsdStringClosure :: [RDFRule] rulesXsdStringClosure = [ xsdstrls
Swish/RDF/RDFGraph.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -9,7 +11,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances+-- Portability : FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, OverloadedStrings -- -- This module defines a memory-based RDF graph instance. --@@ -26,7 +28,9 @@ , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral , isDatatyped, isMemberProp, isUri, isBlank, isQueryVar , getLiteralText, getScopedName, makeBlank- + , quote+ , quoteT+ -- * RDF Graphs , RDFTriple , toRDFTriple, fromRDFTriple@@ -47,17 +51,17 @@ , arc, arcSubj, arcPred, arcObj, Selector -- * Export selected RDFLabel values- , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil- , res_rdfs_member- , res_rdfd_GeneralRestriction- , res_rdfd_onProperties, res_rdfd_constraint, res_rdfd_maxCardinality- , res_owl_sameAs, res_log_implies+ , resRdfType, resRdfFirst, resRdfRest, resRdfNil+ , resRdfsMember+ , resRdfdGeneralRestriction+ , resRdfdOnProperties, resRdfdConstraint, resRdfdMaxCardinality+ , resOwlSameAs, resLogImplies -- * Exported for testing , grMatchMap, grEq , mapnode, maplist )-where+ where import Swish.Utils.Namespace ( Namespace(..)@@ -65,22 +69,21 @@ , ScopedName(..) , getQName , makeQNameScopedName- , makeUriScopedName+ , makeURIScopedName , nullScopedName ) import Swish.RDF.Vocabulary ( namespaceRDF , langTag, isLang- , rdf_type- , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral- , rdfs_member- , rdfd_GeneralRestriction- , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality- , owl_sameAs, log_implies- -- , xsd_type- , xsd_boolean, xsd_decimal, xsd_float, xsd_double, xsd_integer- , xsd_dateTime, xsd_date + , rdfType+ , rdfFirst, rdfRest, rdfNil, rdfXMLLiteral+ , rdfsMember+ , rdfdGeneralRestriction+ , rdfdOnProperties, rdfdConstraint, rdfdMaxCardinality+ , owlSameAs, logImplies+ , xsdBoolean, xsdDecimal, xsdFloat, xsdDouble, xsdInteger+ , xsdDateTime, xsdDate ) import Swish.RDF.GraphClass@@ -91,7 +94,7 @@ import Swish.RDF.GraphMatch (graphMatch, LabelMap, ScopedLabel(..)) import Swish.Utils.QName (QName)-import Swish.Utils.MiscHelpers (hash, quote)+import Swish.Utils.MiscHelpers (hash) import Swish.Utils.ListHelpers (addSetElem) import Swish.Utils.LookupMap@@ -100,16 +103,22 @@ , mapFind, mapFindMaybe, mapReplaceOrAdd, mapAddIfNew , mapVals, mapKeys ) -import qualified Data.Foldable as F-import qualified Data.Traversable as T+import qualified Data.Foldable as Foldable+import qualified Data.Traversable as Traversable +import qualified Data.Text as T+import qualified Data.Text.Read as T+-- import qualified Data.Text.Lazy as L+-- import Data.Text.Format (format)+-- import Data.Text.Buildable+-- import Data.Text.Format.Types (Only(..))+ import Control.Applicative (Applicative, liftA, (<$>), (<*>))--- import Control.Monad (liftM, ap) -import Network.URI (URI, parseURI, uriToString)+import Network.URI (URI) import Data.Monoid (Monoid(..))-import Data.Char (isDigit, toLower)+import Data.Char (ord, isDigit) import Data.List (intersect, union, findIndices, foldl') import Data.Ord (comparing) import Data.String (IsString(..))@@ -138,7 +147,7 @@ -- data RDFLabel = Res ScopedName -- ^ resource- | Lit String (Maybe ScopedName) -- ^ literal [type/language]+ | Lit T.Text (Maybe ScopedName) -- ^ literal [type/language] | Blank String -- ^ blank node | Var String -- ^ variable (not used in ordinary graphs) | NoNode -- ^ no node (not used in ordinary graphs)@@ -160,17 +169,17 @@ Lit s1 Nothing == Lit s2 Nothing = s1 == s2 Lit s1 (Just t1) == Lit s2 (Just t2) = s1 == s2 && (t1 == t2 || (isLang t1 && isLang t2 &&- (map toLower . langTag) t1 == (map toLower . langTag) t2))+ (T.toLower . langTag) t1 == (T.toLower . langTag) t2)) _ == _ = False instance Show RDFLabel where show (Res sn) = show sn- show (Lit st Nothing) = quote st+ show (Lit st Nothing) = quote1Str st show (Lit st (Just nam))- | isLang nam = quote st ++ "@" ++ langTag nam- | nam `elem` [xsd_boolean, xsd_double, xsd_decimal, xsd_integer] = st- | otherwise = quote st ++ "^^" ++ show nam+ | isLang nam = quote1Str st ++ "@" ++ T.unpack (langTag nam)+ | nam `elem` [xsdBoolean, xsdDouble, xsdDecimal, xsdInteger] = T.unpack st+ | otherwise = quote1Str st ++ "^^" ++ show nam show (Blank ln) = "_:"++ln show (Var ln) = '?' : ln show NoNode = "<NoNode>"@@ -199,7 +208,7 @@ labelIsVar _ = False getLocal (Blank loc) = loc getLocal (Var loc) = '?':loc- getLocal (Res sn) = "Res_"++snLocal sn+ getLocal (Res sn) = "Res_" ++ T.unpack (snLocal sn) getLocal (NoNode) = "None" getLocal _ = "Lit_" makeLabel ('?':loc) = Var loc@@ -207,7 +216,7 @@ labelHash seed lb = hash seed (showCanon lb) instance IsString RDFLabel where- fromString = flip Lit Nothing+ fromString = flip Lit Nothing . T.pack {-| A type that can be converted to a RDF Label.@@ -269,104 +278,140 @@ instance FromRDFLabel RDFLabel where fromRDFLabel = Just . id --- TODO: need to check that the Haskell read/show instances match--- the RDF syntactical constraints--maybeRead :: (Read a) => String -> Maybe a-maybeRead inStr = - case reads inStr of- [(val, "")] -> Just val+-- TODO: remove this hack when finished conversion to Text+maybeReadStr :: (Read a) => T.Text -> Maybe a +maybeReadStr txt = case reads (T.unpack txt) of+ [(val, "")] -> Just val+ _ -> Nothing+ +maybeRead :: T.Reader a -> T.Text -> Maybe a+maybeRead rdr inTxt = + case rdr inTxt of+ Right (val, "") -> Just val _ -> Nothing -fLabel :: (String -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a+fLabel :: (T.Text -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a fLabel conv dtype (Lit xs (Just dt)) | dt == dtype = conv xs | otherwise = Nothing fLabel _ _ _ = Nothing -tLabel :: (Show a) => ScopedName -> (String -> String) -> a -> RDFLabel +tLabel :: (Show a) => ScopedName -> (String -> T.Text) -> a -> RDFLabel tLabel dtype conv = flip Lit (Just dtype) . conv . show -- | The character is converted to an untyped literal of length one. instance ToRDFLabel Char where- toRDFLabel = flip Lit Nothing . (:[])+ toRDFLabel = flip Lit Nothing . T.singleton -- | The label must be an untyped literal containing a single character. instance FromRDFLabel Char where- fromRDFLabel (Lit [c] Nothing) = Just c+ fromRDFLabel (Lit cs Nothing) | T.compareLength cs 1 == EQ = Just (T.head cs)+ | otherwise = Nothing fromRDFLabel _ = Nothing -- | Strings are converted to untyped literals. instance ToRDFLabel String where- toRDFLabel = flip Lit Nothing+ toRDFLabel = flip Lit Nothing . T.pack -- | Only untyped literals are converted to strings. instance FromRDFLabel String where- fromRDFLabel (Lit xs Nothing) = Just xs+ fromRDFLabel (Lit xs Nothing) = Just (T.unpack xs) fromRDFLabel _ = Nothing -strToBool :: String -> Maybe Bool-strToBool s | s `elem` ["1", "true"] = Just True- | s `elem` ["0", "false"] = Just False- | otherwise = Nothing+textToBool :: T.Text -> Maybe Bool+textToBool s | s `elem` ["1", "true"] = Just True+ | s `elem` ["0", "false"] = Just False+ | otherwise = Nothing -- | Converts to a literal with a @xsd:boolean@ datatype. instance ToRDFLabel Bool where- toRDFLabel b = Lit (if b then "true" else "false") (Just xsd_boolean)+ toRDFLabel b = Lit (if b then "true" else "false") (Just xsdBoolean) -- | Converts from a literal with a @xsd:boolean@ datatype. The -- literal can be any of the supported XSD forms - e.g. \"0\" or -- \"true\". instance FromRDFLabel Bool where- fromRDFLabel = fLabel strToBool xsd_boolean+ fromRDFLabel = fLabel textToBool xsdBoolean +-- fromRealFloat :: (RealFloat a, Buildable a) => ScopedName -> a -> RDFLabel fromRealFloat :: (RealFloat a, PrintfArg a) => ScopedName -> a -> RDFLabel fromRealFloat dtype f | isNaN f = toL "NaN" | isInfinite f = toL $ if f > 0.0 then "INF" else "-INF"- | otherwise = toL $ printf "%E" f+ -- + -- Would like to use Data.Text.Format.format but there are + -- issues with this module; 0.3.0.2 doesn't build under+ -- 6.12.3 due to a missing RelaxedPolyRec language extension+ -- and it relies on double-conversion which has issues+ -- when used in ghci due to a dlopen issue with libstdc++.+ -- + -- -- | otherwise = toL $ L.toStrict $ format "{}" (Only f) + -- + | otherwise = toL $ T.pack $ printf "%E" f+ where toL = flip Lit (Just dtype) -strToRealFloat :: (RealFloat a, Read a) => (a -> Maybe a) -> String -> Maybe a-strToRealFloat conv = rconv+-- textToRealFloat :: (RealFloat a) => (a -> Maybe a) -> T.Text -> Maybe a+textToRealFloat :: (RealFloat a, Read a) => (a -> Maybe a) -> T.Text -> Maybe a+textToRealFloat conv = rconv where rconv "NaN" = Just (0.0/0.0) -- how best to create a NaN? rconv "INF" = Just (1.0/0.0) -- ditto for Infinity rconv "-INF" = Just ((-1.0)/0.0)- rconv istr - -- xsd semantics allows "2." but Haskell syntax does not so add on a "0" in this case- | null istr = Nothing- | last istr == '.' = maybeRead (istr ++ "0") >>= conv- | otherwise = maybeRead istr >>= conv+ rconv ival + -- xsd semantics allows "2." but Haskell syntax does not.+ | T.null ival = Nothing+ + | otherwise = case maybeReadStr ival of+ Just val -> conv val+ _ -> if T.last ival == '.' -- could drop the check+ then maybeReadStr (T.snoc ival '0') >>= conv+ else Nothing+ + {-++ Unfortunately T.rational does not handle "3.01e4" the same+ as read; see https://bitbucket.org/bos/text/issue/7/++ | otherwise = case maybeRead T.rational ival of+ Just val -> conv val+ _ -> if T.last ival == '.' -- could drop the check+ then maybeRead T.rational (T.snoc ival '0') >>= conv+ else Nothing+ -}+ + -- not sure the above is any improvement on the following+ -- -- | T.last ival == '.' = maybeRead T.rational (T.snoc ival '0') >>= conv+ -- -- | otherwise = maybeRead T.rational ival >>= conv -strToFloat :: String -> Maybe Float-strToFloat = +textToFloat :: T.Text -> Maybe Float+textToFloat = let -- assume that an invalid value (NaN/Inf) from maybeRead means -- that the value is out of bounds for Float so we do not -- convert conv f | isNaN f || isInfinite f = Nothing | otherwise = Just f- in strToRealFloat conv+ in textToRealFloat conv -strToDouble :: String -> Maybe Double -strToDouble = strToRealFloat Just+textToDouble :: T.Text -> Maybe Double +textToDouble = textToRealFloat Just -- | Converts to a literal with a @xsd:float@ datatype. instance ToRDFLabel Float where- toRDFLabel = fromRealFloat xsd_float+ toRDFLabel = fromRealFloat xsdFloat -- | Converts from a literal with a @xsd:float@ datatype. -- The conversion will fail if the value is outside the valid range of -- a Haskell `Float`. instance FromRDFLabel Float where- fromRDFLabel = fLabel strToFloat xsd_float+ fromRDFLabel = fLabel textToFloat xsdFloat -- | Converts to a literal with a @xsd:double@ datatype. instance ToRDFLabel Double where- toRDFLabel = fromRealFloat xsd_double+ toRDFLabel = fromRealFloat xsdDouble -- | Converts from a literal with a @xsd:double@ datatype. instance FromRDFLabel Double where- fromRDFLabel = fLabel strToDouble xsd_double+ fromRDFLabel = fLabel textToDouble xsdDouble -- TODO: are there subtypes of xsd::integer that are -- useful here? @@ -376,40 +421,36 @@ -- | Converts to a literal with a @xsd:integer@ datatype. instance ToRDFLabel Int where- toRDFLabel = tLabel xsd_integer id+ toRDFLabel = tLabel xsdInteger T.pack {--it appears that reads doesn't fail when the input is outside-the Int range; instead it overflows. So instead of-- fromRDFLabel = fLabel maybeRead xsd_integer--we convert via Integer.+Since decimal will just over/under-flow when converting to Int+we go via Integer and explicitlu check for overflow. -} -strToInt :: String -> Maybe Int-strToInt s = +textToInt :: T.Text -> Maybe Int+textToInt s = let conv :: Integer -> Maybe Int conv i = let lb = fromIntegral (minBound :: Int) ub = fromIntegral (maxBound :: Int) in if (i >= lb) && (i <= ub) then Just (fromIntegral i) else Nothing - in maybeRead s >>= conv+ in maybeRead (T.signed T.decimal) s >>= conv -- | Converts from a literal with a @xsd:integer@ datatype. -- The conversion will fail if the value is outside the valid range of -- a Haskell `Int`. instance FromRDFLabel Int where- fromRDFLabel = fLabel strToInt xsd_integer+ fromRDFLabel = fLabel textToInt xsdInteger -- | Converts to a literal with a @xsd:integer@ datatype. instance ToRDFLabel Integer where- toRDFLabel = tLabel xsd_integer id+ toRDFLabel = tLabel xsdInteger T.pack -- | Converts from a literal with a @xsd:integer@ datatype. instance FromRDFLabel Integer where- fromRDFLabel = fLabel maybeRead xsd_integer+ fromRDFLabel = fLabel (maybeRead (T.signed T.decimal)) xsdInteger {- Support an ISO-8601 style format supporting@@ -448,27 +489,27 @@ o@(Just _) -> o _ -> pt fmt -toUTCFormat :: String -> Maybe UTCTime-toUTCFormat = toTimeFormat "%FT%T%Q"+toUTCFormat :: T.Text -> Maybe UTCTime+toUTCFormat = toTimeFormat "%FT%T%Q" . T.unpack -toDayFormat :: String -> Maybe Day-toDayFormat = toTimeFormat "%F"+toDayFormat :: T.Text -> Maybe Day+toDayFormat = toTimeFormat "%F" . T.unpack -- | Converts to a literal with a @xsd:datetime@ datatype. instance ToRDFLabel UTCTime where- toRDFLabel = flip Lit (Just xsd_dateTime) . fromUTCFormat+ toRDFLabel = flip Lit (Just xsdDateTime) . T.pack . fromUTCFormat -- | Converts from a literal with a @xsd:datetime@ datatype. instance FromRDFLabel UTCTime where- fromRDFLabel = fLabel toUTCFormat xsd_dateTime+ fromRDFLabel = fLabel toUTCFormat xsdDateTime -- | Converts to a literal with a @xsd:date@ datatype. instance ToRDFLabel Day where- toRDFLabel = flip Lit (Just xsd_date) . fromDayFormat+ toRDFLabel = flip Lit (Just xsdDate) . T.pack . fromDayFormat -- | Converts from a literal with a @xsd:date@ datatype. instance FromRDFLabel Day where- fromRDFLabel = fLabel toDayFormat xsd_date+ fromRDFLabel = fLabel toDayFormat xsdDate -- | Converts to a Resource. instance ToRDFLabel ScopedName where @@ -490,11 +531,11 @@ -- | Converts to a Resource. instance ToRDFLabel URI where - toRDFLabel u = Res $ makeUriScopedName $ uriToString id u ""+ toRDFLabel = Res . makeURIScopedName -- | Converts from a Resource. instance FromRDFLabel URI where- fromRDFLabel (Res sn) = parseURI $ getScopedNameURI sn+ fromRDFLabel (Res sn) = Just $ getScopedNameURI sn fromRDFLabel _ = Nothing -- | Get the canonical string for RDF label.@@ -503,34 +544,79 @@ -- the same hash value. -- showCanon :: RDFLabel -> String-showCanon (Res sn) = "<"++getScopedNameURI sn++">"+showCanon (Res sn) = "<"++show (getScopedNameURI sn)++">" showCanon (Lit st (Just nam))- | isLang nam = quote st ++ "@" ++ langTag nam- | otherwise = quote st ++ "^^" ++ getScopedNameURI nam+ | isLang nam = quote1Str st ++ "@" ++ T.unpack (langTag nam)+ | otherwise = quote1Str st ++ "^^" ++ show (getScopedNameURI nam) showCanon s = show s +-- | See `quote`.+quoteT :: Bool -> T.Text -> T.Text+quoteT f = T.pack . quote f . T.unpack +{-| N3-style quoting rules for a string.++TODO: when flag is `False` need to worry about multiple quotes (> 2)+in a row.+-}++quote :: + Bool -- ^ @True@ if the string is to be displayed using one rather than three quotes.+ -> String -- ^ String to quote.+ -> String+quote _ [] = ""+quote False s@(c:'"':[]) | c == '\\' = s -- handle triple-quoted strings ending in "+ | otherwise = [c, '\\', '"']++quote True ('"': st) = '\\':'"': quote True st+quote True ('\n':st) = '\\':'n': quote True st++quote True ('\t':st) = '\\':'t': quote True st+quote False ('"': st) = '"': quote False st+quote False ('\n':st) = '\n': quote False st+quote False ('\t':st) = '\t': quote False st+quote f ('\r':st) = '\\':'r': quote f st+quote f ('\\':st) = '\\':'\\': quote f st -- not sure about this+quote f (c:st) = + let nc = ord c+ rst = quote f st+ + -- lazy way to convert to a string+ hstr = printf "%08X" nc+ ustr = hstr ++ rst++ in if nc > 0xffff + then '\\':'U': ustr+ else if nc > 0x7e || nc < 0x20+ then '\\':'u': drop 4 ustr+ else c : rst++-- surround a string with quotes ("...")++quote1Str :: T.Text -> String+quote1Str t = '"' : quote False (T.unpack t) ++ ['"']+ --------------------------------------------------------- -- Selected RDFLabel values --------------------------------------------------------- -res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil,- res_rdfs_member, res_rdfd_GeneralRestriction,- res_rdfd_onProperties, res_rdfd_constraint,- res_rdfd_maxCardinality, res_owl_sameAs, res_log_implies+resRdfType, resRdfFirst, resRdfRest, resRdfNil,+ resRdfsMember, resRdfdGeneralRestriction,+ resRdfdOnProperties, resRdfdConstraint,+ resRdfdMaxCardinality, resOwlSameAs, resLogImplies :: RDFLabel -res_rdf_type = Res rdf_type -res_rdf_first = Res rdf_first -res_rdf_rest = Res rdf_rest-res_rdf_nil = Res rdf_nil-res_rdfs_member = Res rdfs_member-res_rdfd_GeneralRestriction = Res rdfd_GeneralRestriction-res_rdfd_onProperties = Res rdfd_onProperties-res_rdfd_constraint = Res rdfd_constraint-res_rdfd_maxCardinality = Res rdfd_maxCardinality-res_owl_sameAs = Res owl_sameAs-res_log_implies = Res log_implies+resRdfType = Res rdfType +resRdfFirst = Res rdfFirst +resRdfRest = Res rdfRest+resRdfNil = Res rdfNil+resRdfsMember = Res rdfsMember+resRdfdGeneralRestriction = Res rdfdGeneralRestriction+resRdfdOnProperties = Res rdfdOnProperties+resRdfdConstraint = Res rdfdConstraint+resRdfdMaxCardinality = Res rdfdMaxCardinality+resOwlSameAs = Res owlSameAs+resLogImplies = Res logImplies --------------------------------------------------------- -- Additional functions on RDFLabel values@@ -559,7 +645,7 @@ -- |Test if supplied labal is an XML literal node isXMLLiteral :: RDFLabel -> Bool-isXMLLiteral = isDatatyped rdf_XMLLiteral+isXMLLiteral = isDatatyped rdfXMLLiteral -- |Test if supplied label is an typed literal node of a given datatype isDatatyped :: ScopedName -> RDFLabel -> Bool@@ -573,8 +659,8 @@ -- remaining characters of local name are all digits isMemberProp :: RDFLabel -> Bool isMemberProp (Res sn) = snScope sn == namespaceRDF &&- head loc == '_' &&- all isDigit (tail loc)+ T.head loc == '_' &&+ T.all isDigit (T.tail loc) where loc = snLocal sn isMemberProp _ = False@@ -590,7 +676,7 @@ isQueryVar _ = False -- |Extract text value from a literal node-getLiteralText :: RDFLabel -> String+getLiteralText :: RDFLabel -> T.Text getLiteralText (Lit s _) = s getLiteralText _ = "" @@ -617,7 +703,7 @@ -- | Convert 3 RDF labels to a RDF triple. ----- See also `Swish.RDF.GraphClass.arcFromTriple`.+-- See also @Swish.RDF.GraphClass.arcFromTriple@. toRDFTriple :: (ToRDFLabel s, ToRDFLabel p, ToRDFLabel o) => s -- ^ Subject @@ -629,7 +715,7 @@ -- | Extract the contents of a RDF triple. ----- See also `Swish.RDF.GraphClass.arcToTriple`.+-- See also @Swish.RDF.GraphClass.arcToTriple@. fromRDFTriple :: (FromRDFLabel s, FromRDFLabel p, FromRDFLabel o) => RDFTriple @@ -645,7 +731,7 @@ data RevNamespace = RevNamespace Namespace -instance LookupEntryClass RevNamespace String String where+instance LookupEntryClass RevNamespace URI (Maybe T.Text) where keyVal (RevNamespace (Namespace pre uri)) = (uri,pre) newEntry (uri,pre) = RevNamespace (Namespace pre uri) @@ -700,14 +786,14 @@ formulaeMapA :: Applicative f => (lb -> f l2) -> FormulaMap lb -> f (FormulaMap l2)-formulaeMapA f = T.traverse (formulaEntryMapA f)+formulaeMapA f = Traversable.traverse (formulaEntryMapA f) formulaEntryMapA :: (Applicative f) => (lb -> f l2) -> Formula lb -> f (Formula l2)-formulaEntryMapA f (Formula k gr) = Formula `liftA` f k <*> T.traverse f gr+formulaEntryMapA f (Formula k gr) = Formula `liftA` f k <*> Traversable.traverse f gr {- formulaeMapM ::@@ -791,12 +877,12 @@ fmap f (NSGraph ns fml stmts) = NSGraph ns (formulaeMap f fml) ((map $ fmap f) stmts) -instance F.Foldable NSGraph where- foldMap = T.foldMapDefault+instance Foldable.Foldable NSGraph where+ foldMap = Traversable.foldMapDefault -instance T.Traversable NSGraph where+instance Traversable.Traversable NSGraph where traverse f (NSGraph ns fml stmts) = - NSGraph ns <$> formulaeMapA f fml <*> (T.traverse $ T.traverse f) stmts+ NSGraph ns <$> formulaeMapA f fml <*> (Traversable.traverse $ Traversable.traverse f) stmts instance (Label lb) => Eq (NSGraph lb) where (==) = grEq
Swish/RDF/RDFGraphShowM.hs view
@@ -17,26 +17,18 @@ -- -------------------------------------------------------------------------------- -module Swish.RDF.RDFGraphShowM()-where--import Swish.RDF.RDFGraph- ( RDFGraph )--import Swish.RDF.N3Formatter- ( formatGraphIndent )--import Swish.Utils.ShowM- ( ShowM(..) )+module Swish.RDF.RDFGraphShowM() where +import Swish.RDF.RDFGraph (RDFGraph)+import Swish.RDF.N3Formatter (formatGraphIndent)+import Swish.Utils.ShowM (ShowM(..)) ---------------------------------------------------------------- ShowM instance for RDFGraph-------------------------------------------------------------+-- import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Builder as B instance ShowM RDFGraph where- showms linebreak = formatGraphIndent linebreak False -+ -- showms linebreak = shows . L.unpack . B.toLazyText . formatGraphIndent linebreak False + showms linebreak = shows . formatGraphIndent (B.fromString linebreak) False -------------------------------------------------------------------------------- --
Swish/RDF/RDFParser.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +9,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- Support for the RDF Parsing modules. --@@ -16,89 +17,103 @@ module Swish.RDF.RDFParser ( SpecialMap- , mapPrefix+ -- , mapPrefix -- tables , prefixTable, specialTable -- parser- , ParseResult, RDFParser- , n3Style, n3Lexer+ , ParseResult , ignore- , annotateParsecError+ , char+ , ichar+ , string+ , stringT+ , symbol+ , lexeme+ , notFollowedBy+ , whiteSpace+ , skipMany+ , skipMany1+ , endBy+ , sepEndBy+ , sepEndBy1+ , manyTill+ , noneOf+ , eoln+ , fullStop , mkTypedLit- )-where--import Swish.RDF.RDFGraph- ( RDFGraph, RDFLabel(..)- , NamespaceMap- )--import Swish.Utils.LookupMap- ( LookupMap(..)- , mapFind - )--import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..)+ , hex4+ , hex8+ , appendURIs )+ where +import Swish.RDF.RDFGraph (RDFGraph, RDFLabel(..)) import Swish.RDF.Vocabulary ( namespaceRDF , namespaceRDFS , namespaceRDFD , namespaceOWL , namespaceLOG- , rdf_type- , rdf_first, rdf_rest, rdf_nil- , owl_sameAs, log_implies- , default_base+ , rdfType+ , rdfFirst, rdfRest, rdfNil+ , owlSameAs, logImplies+ , defaultBase ) -import Control.Applicative-import Control.Monad (MonadPlus(..), ap)+import Swish.Utils.LookupMap (LookupMap(..))+import Swish.Utils.Namespace (Namespace(..), ScopedName(..)) -import Text.ParserCombinators.Parsec (GenParser, ParseError, char, letter, alphaNum, errorPos, sourceLine, sourceColumn)-import Text.ParserCombinators.Parsec.Error (errorMessages, showErrorMessages)-import Text.ParserCombinators.Parsec.Language (emptyDef)-import qualified Text.ParserCombinators.Parsec.Token as P+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Read as R -import Data.Maybe (fromMaybe)+import Text.ParserCombinators.Poly.StateText --- Code+import Network.URI (URI(..), relativeTo, parseURIReference) -{-|-The language definition for N3-style formats.--}+import Data.Char (isSpace, isHexDigit, chr)+import Data.Maybe (fromMaybe, fromJust) -n3Style :: P.LanguageDef st-n3Style =- emptyDef- { P.commentStart = ""- , P.commentEnd = ""- , P.commentLine = "#"- , P.nestedComments = True- , P.identStart = letter <|> char '_' -- oneOf "_"- , P.identLetter = alphaNum <|> char '_'- , P.reservedNames = []- , P.reservedOpNames= []- , P.caseSensitive = True- }+-- Code -{-|-The lexer for N3 style languages.--}-n3Lexer :: P.TokenParser st-n3Lexer = P.makeTokenParser n3Style+-- | Append the two URIs. Should probably be moved+-- out of RDFParser. It is also just a thin wrapper around+-- `Network.URI.relativeTo`. +appendURIs ::+ URI -- ^ The base URI+ -> URI -- ^ The URI to append (it can be an absolute URI).+ -> Either String URI+appendURIs base uri =+ case uriScheme uri of+ "" -> case uri `relativeTo` base of+ Just out -> Right out+ _ -> Left $ "Unable to append <" ++ show uri ++ "> to base=<" ++ show base ++ ">"+ _ -> Right uri+ -- | Type for special name lookup table type SpecialMap = LookupMap (String,ScopedName) --- | Lookup prefix in table and return URI or 'prefix:'-mapPrefix :: NamespaceMap -> String -> String-mapPrefix ps pre = mapFind (pre++":") pre ps+{-+-- | Lookup prefix in table and return the matching URI.+--+-- If the prefix is unknown then we currently error+-- out (used to return 'prefix:' or ':' but now using+-- URIs I am changing this behavior). This may well be+-- backed out.+mapPrefix :: NamespaceMap -> Maybe String -> URI+mapPrefix pmap pfix = + case mapFindMaybe pfix pmap of+ Just uri -> uri+ Nothing -> error $ "Unable to find prefix: " ++ show pfix -- fromMaybe "" pfix ++ ":"+-}+ +{-+mapPrefix ps p@(Just pre) = mapFind (pre++":") p ps+mapPrefix ps _ = mapFind ":" Nothing ps+-} -- | Define default table of namespaces prefixTable :: [Namespace]@@ -107,7 +122,7 @@ , namespaceRDFD -- datatypes , namespaceOWL , namespaceLOG- , Namespace "" "#" -- is this correct?+ , Namespace Nothing $ fromJust (parseURIReference "#") -- is this correct? ] {-|@@ -116,36 +131,98 @@ -} specialTable :: Maybe ScopedName -> [(String,ScopedName)] specialTable mbase =- [ ("a", rdf_type ),- ("equals", owl_sameAs ),- ("implies", log_implies ),- ("listfirst", rdf_first ),- ("listrest", rdf_rest ),- ("listnull", rdf_nil ),- ("base", fromMaybe default_base mbase ) + [ ("a", rdfType ),+ ("equals", owlSameAs ),+ ("implies", logImplies ),+ ("listfirst", rdfFirst ),+ ("listrest", rdfRest ),+ ("listnull", rdfNil ),+ ("base", fromMaybe defaultBase mbase ) ] -------------------------------------------------------------------------- Define top-level parser function:--- accepts a string and returns a graph or error-----------------------------------------------------------------------+-- Parser routines, heavily based on Parsec -type RDFParser a b = GenParser Char a b+type ParseResult = Either String RDFGraph --- Applicative/Alternative are defined for us in Parsec 3-instance Applicative (GenParser a b) where- pure = return- (<*>) = ap+ignore :: (Applicative f) => f a -> f ()+ignore f = f *> pure ()++char :: Char -> Parser s Char+char c = satisfy (==c)++ichar :: Char -> Parser s ()+ichar = ignore . char++-- TODO: is there a better way to do this?+string :: String -> Parser s String+string = mapM char -instance Alternative (GenParser a b) where- empty = mzero- (<|>) = mplus+stringT :: T.Text -> Parser s T.Text+stringT s = string (T.unpack s) >> return s++skipMany :: Parser s a -> Parser s ()+skipMany = ignore . many -type ParseResult = Either String RDFGraph+skipMany1 :: Parser s a -> Parser s ()+skipMany1 = ignore . many1+ +endBy :: Parser s a -> Parser s b -> Parser s [a]+endBy p sep = many (p <* sep) -ignore :: (Monad m) => m a -> m ()-ignore p = p >> return ()+sepEndBy :: Parser s a -> Parser s b -> Parser s [a]+sepEndBy p sep = sepEndBy1 p sep <|> pure [] +-- is the separator optional?+sepEndBy1 :: Parser s a -> Parser s b -> Parser s [a]+sepEndBy1 p sep = do+ x <- p+ (sep *> ((x:) <$> sepEndBy p sep)) <|> return [x]+ +manyTill :: Parser s a -> Parser s b -> Parser s [a]+manyTill p end = go+ where+ go = (end *> return [])+ <|>+ ((:) <$> p <*> go)+++noneOf :: String -> Parser s Char +noneOf istr = satisfy (`notElem` istr)+ +fullStop :: Parser s ()+fullStop = ichar '.'++eoln :: Parser s ()+-- eoln = ignore (newline <|> (lineFeed *> optional newline))+-- eoln = ignore (try (string "\r\n") <|> string "\r" <|> string "\n")+eoln = ignore (oneOf [string "\r\n", string "\r", string "\n"])+ +notFollowedBy :: (Char -> Bool) -> Parser s ()+notFollowedBy p = do+ c <- next+ if p c + then fail $ "Unexpected character: " ++ show [c]+ else reparse $ L.singleton c++symbol :: String -> Parser s String+symbol = lexeme . string++lexeme :: Parser s a -> Parser s a+lexeme p = p <* whiteSpace++whiteSpace :: Parser s ()+whiteSpace = skipMany (simpleSpace <|> oneLineComment)++simpleSpace :: Parser s ()+simpleSpace = ignore $ many1Satisfy isSpace++oneLineComment :: Parser s ()+oneLineComment = ichar '#' *> manySatisfy (/= '\n') *> pure ()++{-++Not sure we can get this with polyparse+ -- | Annotate a Parsec error with the local context - i.e. the actual text -- that caused the error and preceeding/succeeding lines (if available) --@@ -182,13 +259,45 @@ in unlines eHdr ++ eMsg +-}+ -- | Create a typed literal. mkTypedLit :: ScopedName -- ^ the type- -> String -- ^ the value+ -> T.Text -- ^ the value -> RDFLabel mkTypedLit u v = Lit v (Just u) +{-+Handle hex encoding; the spec for N3 and NTriples suggest that+only upper-case A..F are valid but you can find lower-case values+out there so support these too.+-}++hexDigit :: Parser a Char+-- hexDigit = satisfy (`elem` ['0'..'9'] ++ ['A'..'F'])+hexDigit = satisfy isHexDigit++hex4 :: Parser a Char+hex4 = do+ digs <- exactly 4 hexDigit+ let mhex = R.hexadecimal (T.pack digs)+ case mhex of+ Left emsg -> failBad $ "Internal error: unable to parse hex4: " ++ emsg+ Right (v, "") -> return $ chr v+ Right (_, vs) -> failBad $ "Internal error: hex4 has remained of " ++ T.unpack vs+ +hex8 :: Parser a Char+hex8 = do+ digs <- exactly 8 hexDigit+ let mhex = R.hexadecimal (T.pack digs)+ case mhex of+ Left emsg -> failBad $ "Internal error: unable to parse hex8: " ++ emsg+ Right (v, "") -> if v <= 0x10FFFF+ then return $ chr v+ else failBad "\\UHHHHHHHH format is limited to a maximum of \\U0010FFFF"+ Right (_, vs) -> failBad $ "Internal error: hex8 has remained of " ++ T.unpack vs+ -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke
Swish/RDF/RDFProof.hs view
@@ -67,7 +67,7 @@ import Swish.Utils.ListHelpers ( subset , powerSet- , powerSequences_len+ , powerSequencesLen , flist ) @@ -219,7 +219,7 @@ -- Generate a substitution for each combination of variable -- and vocabulary node. varBindings = map (makeVarBinding . zip varNodes) vocSequences- vocSequences = powerSequences_len (length varNodes) vocab+ vocSequences = powerSequencesLen (length varNodes) vocab in -- Generate a substitution for each combination of variable -- and vocabulary:
Swish/RDF/RDFProofContext.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module contains proof-context declarations based on -- the RDF, RDFS and RDF datatyping semantics specifications.@@ -17,14 +19,11 @@ -- -------------------------------------------------------------------------------- -module Swish.RDF.RDFProofContext- ( rulesetRDF- , rulesetRDFS- , rulesetRDFD )-where+module Swish.RDF.RDFProofContext ( rulesetRDF + , rulesetRDFS+ , rulesetRDFD) where -import Swish.RDF.BuiltInDatatypes- ( findRDFDatatype )+import Swish.RDF.BuiltInDatatypes (findRDFDatatype) import Swish.RDF.RDFProof ( makeRdfSubgraphEntailmentRule@@ -64,13 +63,8 @@ ) import Swish.RDF.Ruleset (makeRuleset)--import Swish.RDF.Datatype- ( typeMkCanonicalForm )--import Swish.Utils.Namespace- ( Namespace(..), ScopedName(..)- )+import Swish.RDF.Datatype (typeMkCanonicalForm)+import Swish.Utils.Namespace (Namespace(..), ScopedName(..)) import Swish.RDF.Vocabulary ( namespaceRDFD@@ -79,15 +73,18 @@ , scopeRDFD ) +import Control.Monad (liftM)+import Data.Monoid (Monoid(..)) import Data.Maybe (isJust, fromJust) -import Control.Monad (liftM)+import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as B ------------------------------------------------------------ -- Define query binding filter auxiliaries ------------------------------------------------------------ -makeFormula :: Namespace -> String -> String -> RDFFormula+makeFormula :: Namespace -> T.Text -> B.Builder -> RDFFormula makeFormula = makeRDFFormula requireAny :: [RDFVarBindingFilter] -> RDFVarBindingFilter@@ -175,7 +172,7 @@ dqn2 = getRes t2 mdt1 = findRDFDatatype dqn1 dt1 = fromJust mdt1- mkLit st = Lit st (Just dqn2)+ mkLit = flip Lit (Just dqn2) getRes (Res dqnam) = dqnam getRes x = error $ "Expected a Resource, sent " ++ show x -- for -Wall@@ -808,7 +805,7 @@ -- rdfdr3 :: RDFRule rdfdr3 = makeN3ClosureModifyRule scopeRDFD "r3"- ( "?d rdf:type rdfs:Datatype . ?e rdf:type rdfs:Datatype . " +++ ( "?d rdf:type rdfs:Datatype . ?e rdf:type rdfs:Datatype . " `mappend` "?a ?p ?s ." ) "?a ?p ?t ." (makeVarFilterModify $ isDatatypedV "s" "d")
Swish/RDF/RDFQuery.hs view
@@ -46,18 +46,13 @@ , RDFTriple , RDFGraph, emptyRDFGraph , allLabels, remapLabels- , res_rdf_first- , res_rdf_rest- , res_rdf_nil- )--import Swish.RDF.MapXsdInteger- ( mapXsdInteger+ , resRdfFirst+ , resRdfRest+ , resRdfNil ) -import Swish.RDF.Datatype- ( DatatypeMap(..)- )+import Swish.RDF.MapXsdInteger (mapXsdInteger)+import Swish.RDF.Datatype (DatatypeMap(..)) import Swish.RDF.VarBinding ( VarBinding(..)@@ -67,21 +62,18 @@ , VarBindingFilter(..) ) -import Swish.RDF.Vocabulary- ( xsd_integer, xsd_nonneg_integer- )+import Swish.RDF.Vocabulary (xsdInteger, xsdNonNegInteger) -import Swish.Utils.ListHelpers- ( listProduct, allp, anyp )+import Swish.Utils.ListHelpers (listProduct, allp, anyp) -import qualified Data.Traversable as T+import qualified Data.Traversable as Traversable -import Control.Monad.State- ( State, runState, modify )+import Control.Monad.State (State, runState, modify) -import Data.Maybe- ( mapMaybe, isJust, fromJust )+import Data.Maybe (mapMaybe, isJust, fromJust) +-- import qualified Data.Text as T+ ------------------------------------------------------------ -- Primitive RDF graph queries ------------------------------------------------------------@@ -403,8 +395,7 @@ rdfQuerySubs2 :: RDFVarBinding -> RDFGraph -> (RDFGraph,[RDFLabel]) rdfQuerySubs2 varb gr = (add emptyRDFGraph g,vs) where- (g,vs) = runState ( T.traverse (mapNode varb) gr ) []- -- (g,vs) = runState ( fmapM (mapNode varb) gr ) []+ (g,vs) = runState ( Traversable.traverse (mapNode varb) gr ) [] -- Auxiliary monad function for rdfQuerySubs2. -- This returns a state transformer Monad which in turn returns the@@ -491,8 +482,8 @@ where pvs = rdfFindPredVal s p isint = anyp- [ isDatatyped xsd_integer- , isDatatyped xsd_nonneg_integer+ [ isDatatyped xsdInteger+ , isDatatyped xsdNonNegInteger ] getint = mapL2V mapXsdInteger . getLiteralText @@ -512,13 +503,13 @@ rdfFindList gr hd = findhead $ rdfFindList gr findrest where findhead = headOr (const []) $- map (:) (rdfFindPredVal hd res_rdf_first gr)- findrest = headOr res_rdf_nil (rdfFindPredVal hd res_rdf_rest gr)+ map (:) (rdfFindPredVal hd resRdfFirst gr)+ findrest = headOr resRdfNil (rdfFindPredVal hd resRdfRest gr) {- findhead = headOr (const [])- [ (ob:) | Arc _ sb ob <- subgr, sb == res_rdf_first ]- findrest = headOr res_rdf_nil- [ ob | Arc _ sb ob <- subgr, sb == res_rdf_rest ]+ [ (ob:) | Arc _ sb ob <- subgr, sb == resRdfFirst ]+ findrest = headOr resRdfNil+ [ ob | Arc _ sb ob <- subgr, sb == resRdfRest ] subgr = filter ((==) hd . arcSubj) $ getArcs gr -} headOr = foldr const
Swish/RDF/RDFRuleset.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module defines some datatypes and functions that are -- used to define rules and rulesets over RDF graphs.@@ -24,7 +26,7 @@ , RDFClosure, RDFRuleset, RDFRulesetMap , nullRDFFormula , GraphClosure(..), makeGraphClosureRule- , makeRDFGraphFromN3String+ , makeRDFGraphFromN3Builder , makeRDFFormula , makeRDFClosureRule -- * Create rules using Notation3 statements@@ -51,15 +53,9 @@ , merge, allLabels , toRDFGraph, emptyRDFGraph ) -import Swish.RDF.RDFVarBinding- ( RDFVarBinding, RDFVarBindingModify )--import Swish.RDF.N3Parser- ( parseN3fromString )--import Swish.RDF.Ruleset- ( Ruleset(..), RulesetMap- )+import Swish.RDF.RDFVarBinding (RDFVarBinding, RDFVarBindingModify)+import Swish.RDF.N3Parser (parseN3)+import Swish.RDF.Ruleset (Ruleset(..), RulesetMap) import Swish.RDF.Rule ( Formula(..), Rule(..), RuleMap@@ -75,10 +71,7 @@ , varBindingId ) -import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..) )-+import Swish.Utils.Namespace (Namespace(..), ScopedName(..), namespaceToBuilder) import Swish.RDF.Vocabulary (swishName, namespaceRDF, namespaceRDFS) {-@@ -86,15 +79,16 @@ ( Proof(..), Step(..) ) -} -import Swish.RDF.GraphClass- ( Label(..), Arc(..), LDGraph(..) )--import Swish.Utils.ListHelpers- ( equiv, flist )+import Swish.RDF.GraphClass (Label(..), Arc(..), LDGraph(..))+import Swish.Utils.ListHelpers (equiv, flist) import Data.List (nub) import Data.Maybe (fromMaybe)+import Data.Monoid (Monoid(..)) +import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as B+ ------------------------------------------------------------ -- Datatypes for RDF ruleset ------------------------------------------------------------@@ -240,30 +234,35 @@ -- Method for creating an RDF formula value from N3 text ------------------------------------------------------------ -prefixRDF :: String-prefixRDF =- "@prefix rdf: <" ++ nsURI namespaceRDF ++ "> . \n" ++- "@prefix rdfs: <" ++ nsURI namespaceRDFS ++ "> . \n" ++- -- "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++- " \n"+mkPrefix :: Namespace -> B.Builder+mkPrefix = namespaceToBuilder +prefixRDF :: B.Builder+prefixRDF = + mconcat + [ mkPrefix namespaceRDF+ , mkPrefix namespaceRDFS+ ]+ -- |Helper function to parse a string containing Notation3 -- and return the corresponding RDFGraph value. ---makeRDFGraphFromN3String :: String -> RDFGraph-makeRDFGraphFromN3String str = case parseN3fromString (prefixRDF ++ str) of+makeRDFGraphFromN3Builder :: B.Builder -> RDFGraph+makeRDFGraphFromN3Builder b = + let t = B.toLazyText (prefixRDF `mappend` b)+ in case parseN3 t Nothing of Left msg -> error msg Right gr -> gr -- |Create an RDF formula. makeRDFFormula ::- Namespace -- ^ namespace to which the formula is allocated- -> String -- ^ local name for the formula in the namespace- -> String -- ^ graph in Notation 3 format+ Namespace -- ^ namespace to which the formula is allocated+ -> T.Text -- ^ local name for the formula in the namespace+ -> B.Builder -- ^ graph in Notation 3 format -> RDFFormula makeRDFFormula scope local gr = Formula { formName = ScopedName scope local- , formExpr = makeRDFGraphFromN3String gr+ , formExpr = makeRDFGraphFromN3Builder gr } ------------------------------------------------------------@@ -318,12 +317,12 @@ -- makeN3ClosureRule :: Namespace -- ^ namespace to which the rule is allocated- -> String -- ^ local name for the rule in the namespace- -> String + -> T.Text -- ^ local name for the rule in the namespace+ -> B.Builder -- ^ the Notation3 representation -- of the antecedent graph. (Note: multiple antecedents -- can be handled by combining multiple graphs.)- -> String -- ^ the Notation3 representation of the consequent graph.+ -> B.Builder -- ^ the Notation3 representation of the consequent graph. -> RDFVarBindingModify -- ^ a variable binding modifier value that may impose -- additional conditions on the variable bindings that@@ -342,20 +341,20 @@ makeN3ClosureRule scope local ant con = makeRDFClosureRule (ScopedName scope local) [antgr] congr where- antgr = makeRDFGraphFromN3String ant- congr = makeRDFGraphFromN3String con+ antgr = makeRDFGraphFromN3Builder ant+ congr = makeRDFGraphFromN3Builder con -- |Construct a simple RDF graph closure rule without -- additional node allocations or variable binding constraints. -- makeN3ClosureSimpleRule :: Namespace -- ^ namespace to which the rule is allocated- -> String -- ^ local name for the rule in the namepace- -> String + -> T.Text -- ^ local name for the rule in the namepace+ -> B.Builder -- ^ the Notation3 representation -- of the antecedent graph. (Note: multiple antecedents -- can be handled by combining multiple graphs.)- -> String -- ^ the Notation3 representation of the consequent graph.+ -> B.Builder -- ^ the Notation3 representation of the consequent graph. -> RDFRule makeN3ClosureSimpleRule scope local ant con = makeN3ClosureRule scope local ant con varBindingId@@ -365,11 +364,11 @@ -- makeN3ClosureModifyRule :: Namespace -- ^ namespace to which the rule is allocated- -> String -- ^ local name for the rule in the given namespace- -> String -- ^ the Notation3 representation- -- of the antecedent graph. (Note: multiple antecedents- -- can be handled by combining multiple graphs.)- -> String -- ^ the Notation3 representation of the consequent graph.+ -> T.Text -- ^ local name for the rule in the given namespace+ -> B.Builder -- ^ the Notation3 representation+ -- of the antecedent graph. (Note: multiple antecedents+ -- can be handled by combining multiple graphs.)+ -> B.Builder -- ^ the Notation3 representation of the consequent graph. -> RDFVarBindingModify -- ^ a variable binding modifier value that may impose -- additional conditions on the variable bindings that@@ -408,11 +407,11 @@ -- makeN3ClosureAllocatorRule :: Namespace -- ^ namespace to which the rule is allocated- -> String -- ^ local name for the rule in the given namespace- -> String -- ^ the Notation3 representation- -- of the antecedent graph. (Note: multiple antecedents- -- can be handled by combining multiple graphs.)- -> String -- ^ the Notation3 representation of the consequent graph.+ -> T.Text -- ^ local name for the rule in the given namespace+ -> B.Builder -- ^ the Notation3 representation+ -- of the antecedent graph. (Note: multiple antecedents+ -- can be handled by combining multiple graphs.)+ -> B.Builder -- ^ the Notation3 representation of the consequent graph. -> RDFVarBindingModify -- ^ variable binding modifier value that may impose -- additional conditions on the variable bindings that@@ -432,8 +431,8 @@ makeN3ClosureAllocatorRule scope local ant con vflt aloc = makeRDFClosureRule (ScopedName scope local) [antgr] congr modc where- antgr = makeRDFGraphFromN3String ant- congr = makeRDFGraphFromN3String con+ antgr = makeRDFGraphFromN3Builder ant+ congr = makeRDFGraphFromN3Builder con vmod = aloc (allLabels labelIsVar antgr) modc = fromMaybe varBindingId $ vbmCompose vmod vflt
Swish/RDF/RDFVarBinding.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module instantiates the `VarBinding` types and methods for use -- with RDF graph labels.
Swish/RDF/Rule.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -9,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : MultiParamTypeClasses+-- Portability : MultiParamTypeClasses, OverloadedStrings -- -- This module defines a framework for defining inference rules -- over some expression form. It is intended to be used with@@ -19,24 +20,20 @@ -------------------------------------------------------------------------------- module Swish.RDF.Rule- ( Expression(..), Formula(..), Rule(..), RuleMap- , nullScope, nullFormula, nullRule- , fwdCheckInference, bwdCheckInference- , showsFormula, showsFormulae, showsWidth- )-where--import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..)- )--import Swish.Utils.LookupMap- ( LookupEntryClass(..), LookupMap(..)- )+ ( Expression(..), Formula(..), Rule(..), RuleMap+ , nullScope, nullFormula, nullRule+ , fwdCheckInference, bwdCheckInference+ , showsFormula, showsFormulae, showsWidth+ )+ where +import Swish.Utils.Namespace (Namespace(..), ScopedName(..))+import Swish.Utils.LookupMap (LookupEntryClass(..), LookupMap(..)) import Swish.Utils.ShowM (ShowM(..)) +import Network.URI (parseURI)+import Data.Maybe (fromJust)+ ------------------------------------------------------------ -- Expressions ------------------------------------------------------------@@ -73,7 +70,8 @@ -- | The namespace @http:\/\/id.ninebynine.org\/2003\/Ruleset\/null@ nullScope :: Namespace-nullScope = Namespace "null" "http://id.ninebynine.org/2003/Ruleset/null"+nullScope = Namespace (Just "null") + $ fromJust $ parseURI "http://id.ninebynine.org/2003/Ruleset/null" -- | The null formula. nullFormula :: Formula ex
Swish/RDF/SwishCommands.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- SwishCommands: functions to deal with indivudual Swish command options. --@@ -37,9 +39,7 @@ , reportLine ) -import Swish.RDF.SwishScript- ( parseScriptFromString- )+import Swish.RDF.SwishScript (parseScriptFromText) import Swish.RDF.GraphPartition ( GraphPartition(..)@@ -53,8 +53,9 @@ import qualified Swish.RDF.N3Formatter as N3F import qualified Swish.RDF.NTFormatter as NTF -import Swish.RDF.N3Parser (parseN3) -- (parseN3fromString)+import Swish.RDF.N3Parser (parseN3) import Swish.RDF.NTParser (parseNT)+import Swish.RDF.RDFParser (appendURIs) import Swish.RDF.GraphClass ( LDGraph(..)@@ -65,19 +66,19 @@ import System.IO ( Handle, openFile, IOMode(..)- , hPutStr, hPutStrLn, hClose, hGetContents+ , hPutStr, hPutStrLn, hClose , hIsReadable, hIsWritable , stdin, stdout ) -import Network.URI (URI, - relativeTo,- parseURI, parseURIReference, uriToString)+import Network.URI (parseURIReference) import Control.Monad.Trans (MonadTrans(..)) import Control.Monad.State (modify, gets) import Control.Monad (liftM, when) +import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as IO import System.IO.Error import Data.Maybe (isJust, fromMaybe)@@ -209,47 +210,31 @@ -} defURI :: QName-defURI = qnameFromURI "http://id.ninebynine.org/2003/Swish/"+defURI = "http://id.ninebynine.org/2003/Swish/" calculateBaseURI :: Maybe FilePath -- ^ file name -> SwishStateIO QName -- ^ base URI- calculateBaseURI Nothing = fromMaybe defURI `liftM` gets base- -calculateBaseURI (Just fnam) = do- mbase <- gets base- case mbase of- Just buri -> case appendUris (getQNameURI buri) fnam of- Left emsg -> fail emsg -- TODO: think about this ...- Right res -> return $ qnameFromURI $ showURI res- Nothing -> lift $ qnameFromFilePath fnam---- this is also in N3Parser-showURI :: URI -> String-showURI u = uriToString id u ""+calculateBaseURI (Just fnam) =+ case parseURIReference fnam of+ Just furi -> do+ mbase <- gets base+ case mbase of+ Just buri -> case appendURIs (getQNameURI buri) furi of+ Left emsg -> fail emsg -- TODO: think about this ...+ Right res -> return $ qnameFromURI res+ Nothing -> lift $ qnameFromFilePath fnam+ + Nothing -> fail $ "Unable to convert to URI: filepath=" ++ fnam --- this is also in N3Parser-appendUris :: String -> String -> Either String URI-appendUris buri uri =- case parseURI uri of- Just absuri -> Right absuri- _ -> case parseURIReference uri of- Just reluri -> case parseURI buri of- Just baseuri -> case relativeTo reluri baseuri of- Just resuri -> Right resuri- _ -> Left $ "Unable to append <" ++ uri ++ "> to base=<" ++ buri ++ ">"- - _ -> Left $ "Invalid base URI: <" ++ buri ++ ">"- _ -> Left $ "Invalid URI: <" ++ uri ++ ">"- swishParseScript :: Maybe String -- file name (or "stdin" if Nothing)- -> String -- script contents+ -> T.Text -- script contents -> SwishStateIO [SwishStateIO ()] swishParseScript mfpath inp = do buri <- calculateBaseURI mfpath- case parseScriptFromString (Just buri) inp of+ case parseScriptFromText (Just buri) inp of Left err -> do let inName = maybe "standard input" ("file " ++) mfpath swishError ("Script syntax error in " ++ inName ++ ": "++err) SwishDataInputError@@ -283,11 +268,11 @@ let writeOut formatter = do out <- gets $ formatter . graph- lift $ hPutStrLn hnd (out "")+ lift $ IO.hPutStrLn hnd out case fmt of- N3 -> writeOut N3F.formatGraphAsShowS- NT -> writeOut NTF.formatGraphAsShowS+ N3 -> writeOut N3F.formatGraphAsLazyText+ NT -> writeOut NTF.formatGraphAsLazyText -- _ -> swishError ("Unsupported file format: "++show fmt) SwishArgumentError ------------------------------------------------------------@@ -303,14 +288,14 @@ -- | Open a file (or stdin), read its contents, and process them. -- swishReadFile :: - (Maybe String -> String -> SwishStateIO a) -- ^ Convert filename and contents into desired value+ (Maybe String -> T.Text -> SwishStateIO a) -- ^ Convert filename and contents into desired value -> a -- ^ the value to use if the file can not be read in -> Maybe String -- ^ the file name or @stdin@ if @Nothing@ -> SwishStateIO a swishReadFile conv errVal fnam = let reader (h,f,i) = do res <- conv fnam i- when f $ lift $ hClose h+ when f $ lift $ hClose h -- given that we use IO.hGetContents not sure the close is needed return res in swishOpenFile fnam >>= maybe (return errVal) reader@@ -318,7 +303,7 @@ -- | Open and read file, returning its handle and content, or Nothing -- WARNING: the handle must not be closed until input is fully evaluated ---swishOpenFile :: Maybe String -> SwishStateIO (Maybe (Handle, Bool, String))+swishOpenFile :: Maybe String -> SwishStateIO (Maybe (Handle, Bool, T.Text)) swishOpenFile Nothing = readFromHandle stdin Nothing swishOpenFile (Just fnam) = do o <- lift $ try $ openFile fnam ReadMode@@ -329,12 +314,12 @@ Right hnd -> readFromHandle hnd $ Just ("file: " ++ fnam) -readFromHandle :: Handle -> Maybe String -> SwishStateIO (Maybe (Handle, Bool, String))+readFromHandle :: Handle -> Maybe String -> SwishStateIO (Maybe (Handle, Bool, T.Text)) readFromHandle hdl mlbl = do hrd <- lift $ hIsReadable hdl if hrd then do- fc <- lift $ hGetContents hdl+ fc <- lift $ IO.hGetContents hdl return $ Just (hdl, isJust mlbl, fc) else do@@ -346,7 +331,7 @@ swishParse :: Maybe String -- ^ filename (if not stdin)- -> String -- ^ contents of file+ -> T.Text -- ^ contents of file -> SwishStateIO (Maybe RDFGraph) swishParse mfpath inp = do fmt <- gets format
Swish/RDF/SwishMain.hs view
@@ -155,11 +155,9 @@ splitArgument "-q" = Left "-q" splitArgument x = Right x --- | Represent an Swish action, with an optional argument and--- the Swish routine to act on that argument.+-- | Represent a Swish action. -- --- At present this type is a black box to external modules.-newtype SwishAction = SA (Maybe String, Maybe String -> SwishStateIO ())+newtype SwishAction = SA (SwishStateIO ()) -- | Given a list of command-line arguments create the list of actions -- to perform or a string and status value indicating an input error.@@ -179,7 +177,7 @@ arg = drop 1 more marg = if null arg then Nothing else Just arg - wrap f = Right $ SA (marg, f)+ wrap f = Right $ SA $ f marg in case nam of "-nt" -> wrap $ swishFormat NT "-n3" -> wrap $ swishFormat N3@@ -198,17 +196,17 @@ -- | Execute an action. swishCommand :: SwishAction -> SwishStateIO ()-swishCommand (SA (marg,act)) = act marg+swishCommand (SA act) = act validateBase :: Maybe String -> Either (String, SwishStatus) SwishAction-validateBase Nothing = Right $ SA (Nothing, swishBase Nothing)+validateBase Nothing = Right $ SA $ swishBase Nothing Nothing validateBase (Just b) =- case parseURI b of- Just _ -> Right $ SA (Nothing, swishBase (Just (qnameFromURI b)))+ case fmap qnameFromURI (parseURI b) of+ j@(Just _) -> Right $ SA $ swishBase j Nothing _ -> Left ("Invalid base URI <" ++ b ++ ">", SwishArgumentError) --------------------------------------------------------------- Interactive test function (e.g. for use in Hugs)+-- Interactive test function (e.g. for use in ghci) ------------------------------------------------------------ -- this ignores the "flags" options, namely
Swish/RDF/SwishScript.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +9,7 @@ Maintainer : Douglas Burke Stability : experimental-Portability : H98+Portability : OverloadedStrings This module implements the Swish script processor: it parses a script from a supplied string, and returns a list of Swish state transformer@@ -66,7 +67,7 @@ -- * Parsing - parseScriptFromString + parseScriptFromText ) where @@ -106,12 +107,12 @@ , merge, add ) +import Swish.RDF.RDFParser (whiteSpace, lexeme, symbol, eoln, manyTill)+ import Swish.RDF.N3Parser- ( parseAnyfromString+ ( parseAnyfromText , parseN3 , N3Parser, N3State(..)- , whiteSpace, symbol, lexeme- , eof, identLetter , getPrefix , subgraph , n3symbol -- was uriRef2,@@ -120,56 +121,30 @@ , newBlankNode ) -import Swish.RDF.N3Formatter- ( formatGraphAsShowS )--import Swish.RDF.Datatype- ( typeMkRules )--import Swish.RDF.Proof- ( explainProof, showsProof )--import Swish.RDF.Ruleset- ( makeRuleset, getRulesetRule, getMaybeContextRule )--import Swish.RDF.Rule- ( Formula(..), Rule(..) -- , RuleMap- )--import Swish.RDF.VarBinding- ( composeSequence )--import Swish.Utils.Namespace- ( ScopedName(..) )+import Swish.RDF.N3Formatter (formatGraphAsBuilder)+import Swish.RDF.Datatype (typeMkRules)+import Swish.RDF.Proof (explainProof, showsProof)+import Swish.RDF.Ruleset (makeRuleset, getRulesetRule, getMaybeContextRule)+import Swish.RDF.Rule (Formula(..), Rule(..)) +import Swish.RDF.VarBinding (composeSequence) +import Swish.Utils.Namespace (ScopedName(..)) import Swish.Utils.QName (QName, qnameFromURI)--import Swish.Utils.LookupMap- ( mapReplaceOrAdd )--import Swish.Utils.ListHelpers- ( equiv, flist )--import Text.ParserCombinators.Parsec- ( (<?>) - -- , (<|>)- -- , many- , manyTill- , option, sepBy, between, try, notFollowedBy- , string, anyChar- , getState- )--import Control.Applicative+import Swish.Utils.LookupMap (mapReplaceOrAdd)+import Swish.Utils.ListHelpers (equiv, flist) -import Control.Monad.State- ( modify, gets, lift- )+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Builder as B+import qualified Data.Text.Lazy.IO as LIO+import Text.ParserCombinators.Poly.StateText import Control.Monad (unless, when, liftM)+import Control.Monad.State (modify, gets, lift) -import Data.List (isPrefixOf)+import Network.URI (URI(..)) +import Data.Monoid (Monoid(..))+ import qualified System.IO.Error as IO ------------------------------------------------------------@@ -183,16 +158,19 @@ -- -- | Parser for Swish script processor-parseScriptFromString :: +parseScriptFromText :: Maybe QName -- ^ Default base for the script- -> String -- ^ Swish script+ -> L.Text -- ^ Swish script -> Either String [SwishStateIO ()]-parseScriptFromString = parseAnyfromString script +parseScriptFromText = parseAnyfromText script ---------------------------------------------------------------------- -- Syntax productions ---------------------------------------------------------------------- +between :: Parser s lbr -> Parser s rbr -> Parser s a -> Parser s a+between = bracket+ n3SymLex :: N3Parser ScopedName n3SymLex = lexeme n3symbol @@ -234,11 +212,11 @@ <|> checkProofCmd <|> fwdChain <|> bwdChain- <?> "script command" prefixLine :: N3Parser (SwishStateIO ()) prefixLine = do- try $ isymbol "@prefix"+ -- try $ isymbol "@prefix"+ isymbol "@prefix" getPrefix whiteSpace isymbol "."@@ -250,7 +228,7 @@ nameItem = ssAddGraph <$> n3SymLex <*> (symbol ":-" *> graphOrList) -maybeURI :: N3Parser (Maybe String)+maybeURI :: N3Parser (Maybe URI) maybeURI = (Just <$> lexUriRef) <|> return Nothing -- @read name [ <uri> ]@@ -306,7 +284,7 @@ ; ags <- graphOrList ; isymbol "=>" ; cg <- graphExpr- ; vms <- option [] varModifiers+ ; vms <- varModifiers <|> pure [] ; return $ ssDefineRule rn ags cg vms } @@ -356,8 +334,8 @@ ; ags <- graphOrList ; isymbol "=>" ; cn <- n3SymLex- ; s <- getState :: N3Parser N3State- ; let prefs = prefixUris s :: NamespaceMap+ ; s <- stGet+ ; let prefs = prefixUris s ; return $ ssFwdChain sn rn ags cn prefs } @@ -371,8 +349,8 @@ ; cg <- graphExpr ; isymbol "<=" ; an <- n3SymLex- ; s <- getState :: N3Parser N3State- ; let prefs = prefixUris s :: NamespaceMap+ ; s <- stGet+ ; let prefs = prefixUris s ; return $ ssBwdChain sn rn cg an prefs } @@ -380,17 +358,13 @@ -- Syntax clause helpers ---------------------------------------------------------------------- +-- TODO: is the loss of identLetter a problem? commandName :: String -> N3Parser ()-commandName cmd = try (string cmd *> notFollowedBy identLetter *> whiteSpace)---- taken from NTParser-eoln :: N3Parser ()--- eoln = ignore (newline <|> (lineFeed *> optional newline))-eoln = (try (string "\r\n") <|> string "\r" <|> string "\n") >> return ()- <?> "new line"+-- commandName cmd = try (string cmd *> notFollowedBy identLetter *> whiteSpace)+commandName cmd = symbol cmd *> pure () restOfLine :: N3Parser String-restOfLine = manyTill anyChar eoln <* whiteSpace+restOfLine = manyTill (satisfy (const True)) eoln <* whiteSpace br :: N3Parser a -> N3Parser a br = between (symbol "(") (symbol ")")@@ -405,7 +379,6 @@ nameOrList = (toList <$> n3SymLex) <|> nameList- <?> "Name, or list of names" graphExpr :: N3Parser (SwishStateIO (Either String RDFGraph)) graphExpr =@@ -414,34 +387,28 @@ do { f <- formulaExpr ; return $ liftM (liftM formExpr) f }- <?>- "Graph expression, graph name or named graph definition" graphOnly :: N3Parser (SwishStateIO (Either String RDFGraph)) graphOnly = do { isymbol "{" ; b <- newBlankNode- ; g <- subgraph b :: N3Parser RDFGraph+ ; g <- subgraph b ; isymbol "}"- ; s <- getState+ ; s <- stGet ; let gp = setNamespaces (prefixUris s) g ; return $ return (Right gp) } graphList :: N3Parser [SwishStateIO (Either String RDFGraph)] graphList = br (many graphExpr)- <?> "List of graphs" graphOrList :: N3Parser [SwishStateIO (Either String RDFGraph)] graphOrList = (toList <$> graphExpr) <|> graphList- <?> "Graph, or list of graphs" formulaExpr :: N3Parser (SwishStateIO (Either String RDFFormula))-formulaExpr = - (n3SymLex >>= namedGraph)- <?> "Formula (name or named graph)"+formulaExpr = n3SymLex >>= namedGraph namedGraph :: ScopedName -> N3Parser (SwishStateIO (Either String RDFFormula)) namedGraph n =@@ -450,7 +417,6 @@ formulaList :: N3Parser [SwishStateIO (Either String RDFFormula)] formulaList = between (symbol "(") (symbol ")") (many formulaExpr)- <?> "List of formulae (names or named graphs)" varModifiers :: N3Parser [(ScopedName,[RDFLabel])] varModifiers = symbol "|" *> varModList@@ -525,10 +491,10 @@ Nothing -> Left ("Graph or list not present: "++show nam) Just grs -> Right grs -ssRead :: ScopedName -> Maybe String -> SwishStateIO ()+ssRead :: ScopedName -> Maybe URI -> SwishStateIO () ssRead nam muri = ssAddGraph nam [ssReadGraph muri] -ssReadGraph :: Maybe String -> SwishStateIO (Either String RDFGraph)+ssReadGraph :: Maybe URI -> SwishStateIO (Either String RDFGraph) ssReadGraph muri = let gf inp = case inp of Left es -> Left es@@ -537,41 +503,29 @@ in gf `liftM` getResourceData muri ssWriteList ::- Maybe String -> SwishStateIO (Either String [RDFGraph]) -> String+ Maybe URI -> SwishStateIO (Either String [RDFGraph]) -> String -> SwishStateIO ()-ssWriteList muri gf comment =- do { esgs <- gf- ; case esgs of- Left er -> modify $ setError ("Cannot write list: "++er)- Right [] -> putResourceData Nothing (("# " ++ comment ++ "\n+ Swish: Writing empty list")++)- Right [gr] -> ssWriteGraph muri gr comment- Right grs -> mapM_ writegr (zip [(0::Int)..] grs)- where- writegr (n,gr) = ssWriteGraph (murin muri n) gr- ("["++show n++"] "++comment)- murin Nothing _ = Nothing- murin (Just uri) n = Just (inituri++show n++lasturi)- where- splituri1 = splitBy (=='/') uri- splituri2 = splitBy (=='.') (lastseg splituri1)- inituri = concat (initseg splituri1 ++ initseg splituri2)- lasturi = lastseg splituri2- }--splitBy :: (a->Bool) -> [a] -> [[a]]-splitBy _ [] = []-splitBy p (s0:str) = let (s1,sr) = break p str in- (s0:s1):splitBy p sr--lastseg :: [[a]] -> [a]-lastseg [] = []-lastseg [_] = []-lastseg ass = last ass--initseg :: [[a]] -> [[a]]-initseg [] = []-initseg [as] = [as]-initseg ass = init ass+ssWriteList muri gf comment = do+ esgs <- gf+ case esgs of+ Left er -> modify $ setError ("Cannot write list: "++er)+ Right [] -> putResourceData Nothing (B.fromLazyText (L.concat ["# ", L.pack comment, "\n+ Swish: Writing empty list"]))+ Right [gr] -> ssWriteGraph muri gr comment+ Right grs -> mapM_ writegr (zip [(0::Int)..] grs)+ where+ writegr (n,gr) = ssWriteGraph (murin muri n) gr+ ("["++show n++"] "++comment)+ murin Nothing _ = Nothing+ murin (Just uri) n = + let rp = reverse $ uriPath uri+ (rLastSet, rRest) = break (=='/') rp+ (before, after) = break (=='.') $ reverse rLastSet+ newPath = reverse rRest ++ "/" ++ before ++ show n ++ after+ in case rLastSet of+ "" -> error $ "Invalid URI (path ends in /): " ++ show uri+ _ -> Just $ uri { uriPath = newPath }+ + {- ssWrite ::@@ -585,11 +539,11 @@ } -} -ssWriteGraph :: Maybe String -> RDFGraph -> String -> SwishStateIO ()+ssWriteGraph :: Maybe URI -> RDFGraph -> String -> SwishStateIO () ssWriteGraph muri gr comment =- putResourceData muri ((c++) . formatGraphAsShowS gr)+ putResourceData muri (c `mappend` formatGraphAsBuilder gr) where- c = "# "++comment++"\n"+ c = B.fromLazyText $ L.concat ["# ", L.pack comment, "\n"] ssMerge :: ScopedName -> [SwishStateIO (Either String RDFGraph)]@@ -804,8 +758,10 @@ ; when False $ case proof of (Left _) -> return () (Right pr) -> putResourceData Nothing $- (("Proof "++show pn++"\n")++)- . showsProof "\n" pr+ B.fromLazyText (L.concat ["Proof ", L.pack (show pn), "\n"])+ `mappend`+ B.fromString (showsProof "\n" pr "\n")+ -- TODO: clean up ; let checkproof = case proof of (Left er) -> setError er (Right pr) ->@@ -923,26 +879,24 @@ -- Temporary implementation: just read local file WNH -- (Add logic to separate filenames from URIs, and -- attempt HTTP GET, or similar.)-getResourceData :: Maybe String -> SwishStateIO (Either String String)+getResourceData :: Maybe URI -> SwishStateIO (Either String L.Text) getResourceData muri = case muri of Nothing -> fromStdin Just uri -> fromUri uri where fromStdin =- do { dat <- lift getContents+ do { dat <- lift LIO.getContents ; return $ Right dat } fromUri = fromFile- fromFile uri | "file://" `isPrefixOf` uri = do- dat <- lift $ readFile $ drop 7 uri- return $ Right dat- | otherwise = error $ "Unsupported file name for read: " ++ uri+ fromFile uri | uriScheme uri == "file:" = Right `fmap` (lift $ LIO.readFile $ uriPath uri)+ | otherwise = error $ "Unsupported file name for read: " ++ show uri -- Temporary implementation: just write local file -- (Need to add logic to separate filenames from URIs, and -- attempt HTTP PUT, or similar.)-putResourceData :: Maybe String -> ShowS -> SwishStateIO ()+putResourceData :: Maybe URI -> B.Builder -> SwishStateIO () putResourceData muri gsh = do { ios <- lift $ IO.try $ case muri of@@ -955,10 +909,10 @@ Right a -> return a } where- toStdout = putStrLn gstr- toUri uri | "file://" `isPrefixOf` uri = writeFile (drop 7 uri) gstr- | otherwise = error $ "Unsupported file name for write: " ++ uri- gstr = gsh "\n"+ toStdout = LIO.putStrLn gstr+ toUri uri | uriScheme uri == "file:" = LIO.writeFile (uriPath uri) gstr+ | otherwise = error $ "Unsupported file name for write: " ++ show uri+ gstr = B.toLazyText gsh {- $syntax
Swish/RDF/VarBinding.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -9,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : MultiParamTypeClasses, TypeSynonymInstances+-- Portability : MultiParamTypeClasses, TypeSynonymInstances, OverloadedStrings -- -- This module defines functions for representing and manipulating query -- binding variable sets. This is the key data that mediates between@@ -49,7 +50,10 @@ import Data.List (find, intersect, union, (\\), foldl') +import Data.Monoid (mconcat) +-- import qualified Data.Text as T+ ------------------------------------------------------------ -- Query variable bindings ------------------------------------------------------------@@ -303,7 +307,7 @@ (VarBindingModify nam1 app1 voc1 use1) (VarBindingModify nam2 app2 voc2 use2) | not (null use12) = Just VarBindingModify- { vbmName = swishName ("_"++ snLocal nam1 ++"_"++ snLocal nam2 ++"_")+ { vbmName = swishName $ mconcat ["_", snLocal nam1, "_", snLocal nam2, "_"] , vbmApply = app2 . app1 , vbmVocab = voc1 `union` voc2 , vbmUsage = use12
Swish/RDF/Vocabulary.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module defines some commonly used vocabulary terms, -- using the 'Namespace' and 'ScopedName' data types.@@ -16,8 +18,7 @@ -------------------------------------------------------------------------------- module Swish.RDF.Vocabulary- ( namespaceNull- , namespaceRDF+ ( namespaceRDF , namespaceRDFS , namespaceRDFD , namespaceOWL@@ -32,81 +33,70 @@ , scopeRDF , scopeRDFS , scopeRDFD- , rdf_datatype, rdf_resource, rdf_about, rdf_ID- , rdf_type- , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral- , rdfs_member- , rdfd_GeneralRestriction- , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality- , owl_sameAs, log_implies- , xsd_type, xsd_string, xsd_boolean- , xsd_decimal, xsd_integer- , xsd_nonneg_integer, xsd_nonpos_integer, xsd_pos_integer, xsd_neg_integer- , xsd_float, xsd_double- , xsd_date, xsd_dateTime- , default_base+ , rdfDatatype, rdfResource, rdfAbout, rdfID+ , rdfType+ , rdfFirst, rdfRest, rdfNil, rdfXMLLiteral+ , rdfsMember+ , rdfdGeneralRestriction+ , rdfdOnProperties, rdfdConstraint, rdfdMaxCardinality+ , owlSameAs, logImplies+ , xsdType, xsdString, xsdBoolean+ , xsdDecimal, xsdInteger+ , xsdNonNegInteger, xsdNonPosInteger, xsdPosInteger, xsdNegInteger+ , xsdFloat, xsdDouble+ , xsdDate, xsdDateTime+ , defaultBase ) where import Swish.Utils.Namespace (Namespace(..), ScopedName(..))-import Swish.Utils.MiscHelpers (lower) +import Data.Monoid (mappend, mconcat)+import Data.Maybe (fromMaybe)+import Network.URI (parseURI)++import qualified Data.Text as T+ ------------------------------------------------------------ -- Define some common namespace values ------------------------------------------------------------ -namespaceNull :: Namespace-namespaceNull- = Namespace "" ""+toNS :: T.Text -> T.Text -> Namespace+toNS p utxt = + let ustr = T.unpack utxt+ uri = fromMaybe (error ("Unable to convert " ++ ustr ++ " to a URI")) $+ parseURI ustr+ in Namespace (Just p) uri -namespaceRDF :: Namespace-namespaceRDF =- Namespace "rdf" "http://www.w3.org/1999/02/22-rdf-syntax-ns#"+namespaceXsdType :: T.Text -> Namespace+namespaceXsdType dtn = toNS ("xsd_" `mappend` dtn)+ (mconcat ["http://id.ninebynine.org/2003/XMLSchema/", dtn, "#"]) +namespaceRDF :: Namespace namespaceRDFS :: Namespace-namespaceRDFS =- Namespace "rdfs" "http://www.w3.org/2000/01/rdf-schema#"- namespaceRDFD :: Namespace-namespaceRDFD =- Namespace "rdfd" "http://id.ninebynine.org/2003/rdfext/rdfd#"- namespaceOWL :: Namespace-namespaceOWL =- Namespace "owl" "http://www.w3.org/2002/07/owl#"- namespaceXSD :: Namespace-namespaceXSD =- Namespace "xsd" "http://www.w3.org/2001/XMLSchema#"--namespaceXsdType :: String -> Namespace-namespaceXsdType dtname =- Namespace ("xsd_"++dtname)- ("http://id.ninebynine.org/2003/XMLSchema/"++dtname++"#")- namespaceMATH :: Namespace-namespaceMATH =- Namespace "math" "http://www.w3.org/2000/10/swap/math#"- namespaceLOG :: Namespace-namespaceLOG =- Namespace "log" "http://www.w3.org/2000/10/swap/log#"- -- Namespace "log" "http://www.w3.org/2000/10/swap/log.n3#"- namespaceDAML :: Namespace-namespaceDAML =- Namespace "daml" "http://www.daml.org/2000/10/daml-ont#"-+namespaceSwish :: Namespace namespaceDefault :: Namespace-namespaceDefault- -- = Namespace "default" "#"- = Namespace "default" "http://id.ninebynine.org/default/"+namespaceLang :: Namespace -namespaceSwish :: Namespace-namespaceSwish- = Namespace "swish" "http://id.ninebynine.org/2003/Swish/"+namespaceRDF = toNS "rdf" "http://www.w3.org/1999/02/22-rdf-syntax-ns#"+namespaceRDFS = toNS "rdfs" "http://www.w3.org/2000/01/rdf-schema#"+namespaceRDFD = toNS "rdfd" "http://id.ninebynine.org/2003/rdfext/rdfd#"+namespaceOWL = toNS "owl" "http://www.w3.org/2002/07/owl#"+namespaceXSD = toNS "xsd" "http://www.w3.org/2001/XMLSchema#"+namespaceMATH = toNS "math" "http://www.w3.org/2000/10/swap/math#"+namespaceLOG = toNS "log" "http://www.w3.org/2000/10/swap/log#"+namespaceDAML = toNS "daml" "http://www.daml.org/2000/10/daml-ont#"+namespaceSwish = toNS "swish" "http://id.ninebynine.org/2003/Swish/"+namespaceLang = toNS "lang" "http://id.ninebynine.org/2003/Swish/Lang/" -- To be replaced by urn:ietf:params:lang?+namespaceDefault = toNS "default" "http://id.ninebynine.org/default/" -swishName :: String -> ScopedName+swishName :: T.Text -> ScopedName swishName = ScopedName namespaceSwish -----------------------------------------------------------@@ -119,15 +109,10 @@ -- Fortunately, they do not currently need to appear in Notation3 as -- distinct labels (but future developments may change that). -namespaceLang :: Namespace-namespaceLang- = Namespace "lang" "http://id.ninebynine.org/2003/Swish/Lang/"- -- To be replaced by urn:ietf:params:lang?--langName :: String -> ScopedName-langName = ScopedName namespaceLang . lower+langName :: T.Text -> ScopedName+langName = ScopedName namespaceLang . T.toLower -langTag :: ScopedName -> String+langTag :: ScopedName -> T.Text langTag = snLocal isLang :: ScopedName -> Bool@@ -137,109 +122,99 @@ -- Define namespaces for RDF rules, axioms, etc ------------------------------------------------------------ -scopeRDF :: Namespace-scopeRDF =- Namespace "rs_rdf" "http://id.ninebynine.org/2003/Ruleset/rdf#"--scopeRDFS :: Namespace-scopeRDFS =- Namespace "rs_rdfs" "http://id.ninebynine.org/2003/Ruleset/rdfs#"+scopeRDF, scopeRDFS, scopeRDFD :: Namespace -scopeRDFD :: Namespace-scopeRDFD =- Namespace "rs_rdfd" "http://id.ninebynine.org/2003/Ruleset/rdfd#"+scopeRDF = toNS "rs_rdf" "http://id.ninebynine.org/2003/Ruleset/rdf#"+scopeRDFS = toNS "rs_rdfs" "http://id.ninebynine.org/2003/Ruleset/rdfs#"+scopeRDFD = toNS "rs_rdfd" "http://id.ninebynine.org/2003/Ruleset/rdfd#" ------------------------------------------------------------ -- Define some common vocabulary terms ------------------------------------------------------------ -rdf_datatype :: ScopedName-rdf_datatype = ScopedName namespaceRDF "datatype"--rdf_resource :: ScopedName-rdf_resource = ScopedName namespaceRDF "resource"--rdf_about :: ScopedName-rdf_about = ScopedName namespaceRDF "about"--rdf_ID :: ScopedName-rdf_ID = ScopedName namespaceRDF "ID"--rdf_type :: ScopedName-rdf_type = ScopedName namespaceRDF "type"--rdf_first :: ScopedName-rdf_first = ScopedName namespaceRDF "first"--rdf_rest :: ScopedName-rdf_rest = ScopedName namespaceRDF "rest"--rdf_nil :: ScopedName-rdf_nil = ScopedName namespaceRDF "nil"--rdf_XMLLiteral :: ScopedName-rdf_XMLLiteral = ScopedName namespaceRDF "XMLLiteral"+toRDF, toRDFS, toRDFD :: T.Text -> ScopedName+toRDF = ScopedName namespaceRDF+toRDFS = ScopedName namespaceRDFS+toRDFD = ScopedName namespaceRDFD -rdfs_member :: ScopedName-rdfs_member = ScopedName namespaceRDFS "member"+rdfDatatype :: ScopedName+rdfResource :: ScopedName+rdfAbout :: ScopedName+rdfID :: ScopedName+rdfType :: ScopedName+rdfFirst :: ScopedName+rdfRest :: ScopedName+rdfNil :: ScopedName+rdfXMLLiteral :: ScopedName -rdfd_GeneralRestriction :: ScopedName-rdfd_GeneralRestriction = ScopedName namespaceRDFD "GeneralRestriction"+rdfDatatype = toRDF "datatype"+rdfResource = toRDF "resource"+rdfAbout = toRDF "about"+rdfID = toRDF "ID"+rdfType = toRDF "type"+rdfFirst = toRDF "first"+rdfRest = toRDF "rest"+rdfNil = toRDF "nil"+rdfXMLLiteral = toRDF "XMLLiteral" -rdfd_onProperties :: ScopedName-rdfd_onProperties = ScopedName namespaceRDFD "onProperties"+rdfsMember :: ScopedName+rdfsMember = toRDFS "member" -rdfd_constraint :: ScopedName-rdfd_constraint = ScopedName namespaceRDFD "constraint"+rdfdGeneralRestriction :: ScopedName+rdfdOnProperties :: ScopedName+rdfdConstraint :: ScopedName+rdfdMaxCardinality :: ScopedName -rdfd_maxCardinality :: ScopedName-rdfd_maxCardinality = ScopedName namespaceRDFD "maxCardinality"+rdfdGeneralRestriction = toRDFD "GeneralRestriction"+rdfdOnProperties = toRDFD "onProperties"+rdfdConstraint = toRDFD "constraint"+rdfdMaxCardinality = toRDFD "maxCardinality" -xsd_type :: String -> ScopedName-xsd_type = ScopedName namespaceXSD+xsdType :: T.Text -> ScopedName+xsdType = ScopedName namespaceXSD -xsd_string :: ScopedName-xsd_string = xsd_type "string"+xsdString :: ScopedName+xsdString = xsdType "string" -xsd_boolean :: ScopedName-xsd_boolean = xsd_type "boolean"+xsdBoolean :: ScopedName+xsdBoolean = xsdType "boolean" -xsd_decimal :: ScopedName-xsd_decimal = xsd_type "decimal"+xsdDecimal :: ScopedName+xsdDecimal = xsdType "decimal" -xsd_integer :: ScopedName-xsd_integer = xsd_type "integer"+xsdInteger :: ScopedName+xsdInteger = xsdType "integer" -xsd_nonneg_integer :: ScopedName-xsd_nonneg_integer = xsd_type "nonNegativeInteger"+xsdNonNegInteger :: ScopedName+xsdNonNegInteger = xsdType "nonNegativeInteger" -xsd_nonpos_integer :: ScopedName-xsd_nonpos_integer = xsd_type "nonPositiveInteger"+xsdNonPosInteger :: ScopedName+xsdNonPosInteger = xsdType "nonPositiveInteger" -xsd_pos_integer :: ScopedName-xsd_pos_integer = xsd_type "positiveInteger"+xsdPosInteger :: ScopedName+xsdPosInteger = xsdType "positiveInteger" -xsd_neg_integer :: ScopedName-xsd_neg_integer = xsd_type "negativeInteger"+xsdNegInteger :: ScopedName+xsdNegInteger = xsdType "negativeInteger" -xsd_float :: ScopedName-xsd_float = xsd_type "float"+xsdFloat :: ScopedName+xsdFloat = xsdType "float" -xsd_double :: ScopedName-xsd_double = xsd_type "double"+xsdDouble :: ScopedName+xsdDouble = xsdType "double" -xsd_date, xsd_dateTime :: ScopedName-xsd_date = xsd_type "date"-xsd_dateTime = xsd_type "dateTime"+xsdDate, xsdDateTime :: ScopedName+xsdDate = xsdType "date"+xsdDateTime = xsdType "dateTime" -owl_sameAs :: ScopedName-owl_sameAs = ScopedName namespaceOWL "sameAs"+owlSameAs :: ScopedName+owlSameAs = ScopedName namespaceOWL "sameAs" -log_implies :: ScopedName-log_implies = ScopedName namespaceLOG "implies"+logImplies :: ScopedName+logImplies = ScopedName namespaceLOG "implies" -default_base :: ScopedName-default_base = ScopedName namespaceDefault "base"+defaultBase :: ScopedName+defaultBase = ScopedName namespaceDefault "base" -------------------------------------------------------------------------------- --
− Swish/Utils/DateTime.hs
@@ -1,328 +0,0 @@------------------------------------------------------------------------------------ See end of this file for licence information.------------------------------------------------------------------------------------ |--- Module : DateTime--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke--- License : GPL V2------ Maintainer : Douglas Burke--- Stability : experimental--- Portability : H98------ This Module defines a collection of date/time manipulation functions. It--- is deprecated - since it's functionality is available from other--- modules - and will be removed in the next minor release of Swish--- (@0.3.3@).------------------------------------------------------------------------------------------ Date/time value manipulation.------ Date/time can be date-only or time-only------ type DateTime is an instance of built-in classes Eq and Show------ type DateTime has a constructor that accepts a string in the format--- defined by RFC 3339.--- Timezone interpretation is per RFC3339.--------- year,month,day,hour,min,sec,millisec,timezone---class (Show a,Eq a) => DateTimeClass a where--- newDateTime :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> a--- toString :: a -> String--- size :: a -> Int--- toDateTime :: String -> a--- toDate :: String -> a--- toTime :: String -> a--- (==) :: a -> a -> Bool -- same date/time--- (<) :: a -> a -> Bool -- first precedes second--- (+) :: a -> a -> a -- advance by time--- (-) :: a -> a -> a -- difference between times--- dtShow :: a -> String -- return string form--- dtYear :: a -> Int--- dtMonth :: a -> Int--- dtDay :: a -> Int--- dtHour :: a -> Int--- dtMinute :: a -> Int--- dtSecond :: a -> Int--- dtMillisecs :: a -> Int--- dtTimezone :: a -> Int -- time zone offset in minutes--------------------------------------------------------------------------------------module Swish.Utils.DateTime where--data DateTime- = DateTime Int Int Int Int Int Int Int Int--instance Eq DateTime where- d1 == d2 = simpleEq ( normTZ d1 ) ( normTZ d2 )--instance Show DateTime where- show = dtShow--instance Ord DateTime where- dt1 < dt2 = simpleLT ( normTZ dt1 ) ( normTZ dt2 )- dt1 > dt2 = dt2 < dt1- dt1 <= dt2 = (dt1 < dt2)||(dt1==dt2)- dt1 >= dt2 = (dt2 < dt1)||(dt1==dt2)--leapYear :: Int -> Bool-leapYear year- | ( year `mod` 4 == 0 ) &&- not ( ( year `mod` 100 == 0 ) &&- ( (year `mod` 400) /= 0 ) ) = True- | otherwise = False--daysInMonth :: Int -> Int -> Int-daysInMonth month year- | month==1 = 31 --Jan- | month==2 = if leapYear year then 29 else 28 --Feb- | month==3 = 31 --Mar- | month==4 = 30 --Apr- | month==5 = 31 --May- | month==6 = 30 --Jun- | month==7 = 31 --Jul- | month==8 = 31 --Aug- | month==9 = 30 --Sep- | month==10 = 31 --Oct- | month==11 = 30 --Nov- | month==12 = 31 --Dec- | otherwise = 0--validJulianDate :: Int -> Int -> Int -> Bool-validJulianDate yr mo da- | yr < 1900 = False- | mo > 12 = False- | da > daysInMonth mo yr = False- | otherwise = True--toJulianDate1 :: DateTime -> Int-toJulianDate1 (DateTime y m d _ _ _ _ _) = toJulianDate y m d--toJulianDate :: Int -> Int -> Int -> Int-toJulianDate year month day--- | not (validJulianDate year month day) = -1- | year==1900 && month<=2 = if month==2 then day + 30 else day - 1- | month>=3 = toJD1 (year-1900) (month-3) day- | otherwise = toJD1 (year-1901) (month+9) day- where- toJD1 :: Int -> Int -> Int -> Int- toJD1 y m d- = ( (1461*y) `div` 4 ) -- (y `div` 100) +- ((y+300) `div` 400) +- ( ( (153*m) + 2 ) `div` 5 ) +- d + 58--fromJulianDate:: Int -> DateTime-fromJulianDate jdate- | jdate <= 58 = fromJD1 jdate- | otherwise = fromJD2 jdate- where- fromJD1 :: Int -> DateTime- fromJD1 j- | j<=30 = DateTime 1900 1 (j+1 ) 0 0 0 0 0- | otherwise = DateTime 1900 2 (j-30) 0 0 0 0 0-- fromJD2 :: Int -> DateTime- fromJD2 j- = DateTime y2 m2 d1 0 0 0 0 0- where--- t1 = (400*(j+((j+36467)`div`36525)-((j+109517)`div`dc))) - 23638 -- 1/400-days from 1900-02-28 [t]- t1 = (400*- (j- +((4*(j+36465))`div`146097)- -((j+109513)`div`146097))) - 23638 -- 1/400-days from 1900-02-28 [t]- dc = 146100 -- days in cycle period (400 years) = 1/400-days in year- t2 = ( ( t1 `mod` dc ) `div` 400 )*5 + 2 -- fifth-days into year, +2 [j3]- d1 = ( t2 `mod` 153 ) `div` 5 + 1 -- day of month (magic number 153) [d]- m1 = t2 `div` 153 -- month Mar=0 -> Feb=11 [j4]- m2 = if m1 <= 9 then m1+3 else m1-9 -- correct month to Jan=1 -> Dec=12 [m]- y1 = t1 `div` dc + 1900 -- year from 1900-02-28- y2 = if m1 <= 9 then y1 else y1+1 -- correct year for month wrap-around- -- 36525 = days/century, not counting century adjustments- -- 109517 = 146100 * (1900-1600)/400 - 58- -- 23238 = 58*400 + 38 ??? 38=152/4 ??--{- -- this code works for dates before 2100 only- t1 = (4*j) - 233 -- quarter-days from 1900-02-28- dc = 1461 -- days in cycle period (4 years) = quarter-days in year- t2 = ( ( t1 `mod` dc ) `div` 4 )*5 + 2 -- fifth-days into year, +2- d1 = ( t2 `mod` 153 ) `div` 5 + 1 -- day of month (magic number 153)- m1 = t2 `div` 153 -- month Mar=0 -> Feb=11- m2 = if m1 <= 9 then m1+3 else m1-9 -- correct month to Jan=1 -> Dec=12- y1 = t1 `div` dc + 1900 -- year from 1900-02-28- y2 = if m1 <= 9 then y1 else y1+1 -- correct year for month wrap-around--}--date :: Int -> Int -> Int -> DateTime-date y m d = DateTime y m d 0 0 0 0 0--time :: Int -> Int -> Int -> Int -> Int -> DateTime-time = DateTime 0 0 0--dtYear :: DateTime -> Int-dtMonth :: DateTime -> Int-dtDay :: DateTime -> Int-dtHour :: DateTime -> Int-dtMinute :: DateTime -> Int-dtSecond :: DateTime -> Int-dtMillisecs :: DateTime -> Int-dtTimezone :: DateTime -> Int -- time zone offset in minutes-dtYear ( DateTime x _ _ _ _ _ _ _ ) = x-dtMonth ( DateTime _ x _ _ _ _ _ _ ) = x-dtDay ( DateTime _ _ x _ _ _ _ _ ) = x-dtHour ( DateTime _ _ _ x _ _ _ _ ) = x-dtMinute ( DateTime _ _ _ _ x _ _ _ ) = x-dtSecond ( DateTime _ _ _ _ _ x _ _ ) = x-dtMillisecs ( DateTime _ _ _ _ _ _ x _ ) = x-dtTimezone ( DateTime _ _ _ _ _ _ _ x ) = x--lenFix :: String -> Int -> String-lenFix inStr newLen- | length inStr >= newLen = inStr- | otherwise = lenFix ('0':inStr) newLen--showTZ :: Int -> String-showTZ tz- | tz<0 = '-' : showTZabs (-tz)- | tz==0 = showTZabs tz- | otherwise = '+' : showTZabs tz--showTZabs :: Int -> String-showTZabs tz- | tz==0 = "Z"- | otherwise = lenFix ( show ( tz `div` 60 ) ) 2 ++ ":" ++- lenFix ( show ( tz `mod` 60 ) ) 2--showTime :: DateTime -> String-showTime ( DateTime _ _ _ hr mi se ms _ )- | ms==0 = lenFix ( show hr ) 2 ++ ":" ++- lenFix ( show mi ) 2 ++ ":" ++- lenFix ( show se ) 2- | otherwise = lenFix ( show hr ) 2 ++ ":" ++- lenFix ( show mi ) 2 ++ ":" ++- lenFix ( show se ) 2 ++ "." ++- lenFix ( show ms ) 3--showDate :: DateTime -> String-showDate ( DateTime yr mo da _ _ _ _ _ )- = lenFix ( show yr ) 4 ++ "-" ++- lenFix ( show mo ) 2 ++ "-" ++- lenFix ( show da ) 2--dtShow :: DateTime -> String -- return string form-dtShow ( DateTime yr mo da hr mi se ms tz )- = showDate ( DateTime yr mo da hr mi se ms tz ) ++ "T" ++- showTime ( DateTime yr mo da hr mi se ms tz ) ++ showTZ tz--carryMins :: DateTime -> DateTime-carryMins ( DateTime yr mo da hr mi se ms tz )- | newhrs >= 24 = carryHours ( DateTime yr mo da newhrs (mi`mod`60) se ms tz )- | otherwise = DateTime yr mo da newhrs (mi`mod`60) se ms tz- where- newhrs = hr + (mi`div`60)--carryHours :: DateTime -> DateTime-carryHours ( DateTime yr mo da hr mi se ms tz )- = DateTime y m d (hr`mod`24) mi se ms tz- where- (DateTime y m d _ _ _ _ _) = fromJulianDate (toJulianDate yr mo da + (hr`div`24))--normTZ :: DateTime -> DateTime-normTZ ( DateTime yr mo da hr mi se ms tz )- = carryMins ( DateTime yr mo da hr (mi-tz) se ms 0 )--- = addMinutes (-tz) ( DateTime yr mo da hr mi se ms tz )--{- another way -}--addMilliSecs :: Int -> DateTime -> DateTime-addMilliSecs addms ( DateTime yr mo da hr mi se ms tz )- | totms < 1000 = DateTime yr mo da hr mi se totms tz- | otherwise = addSeconds addse ( DateTime yr mo da hr mi se newms tz )- where- totms = ms + addms- newms = totms `mod` 1000- addse = totms `div` 1000--addSeconds :: Int -> DateTime -> DateTime-addSeconds addse ( DateTime yr mo da hr mi se ms tz )- | totse < 60 = DateTime yr mo da hr mi totse ms tz- | otherwise = addMinutes addmi ( DateTime yr mo da hr mi newse ms tz )- where- totse = se + addse- newse = totse `mod` 60- addmi = totse `div` 60--addMinutes :: Int -> DateTime -> DateTime-addMinutes addmi ( DateTime yr mo da hr mi se ms tz )- | totmi < 60 = DateTime yr mo da hr totmi se ms tz- | otherwise = addHours addhr ( DateTime yr mo da hr newmi se ms tz )- where- totmi = mi + addmi- newmi = totmi `mod` 60- addhr = totmi `div` 60--addHours :: Int -> DateTime -> DateTime-addHours addhr ( DateTime yr mo da hr mi se ms tz )- | tothr < 24 = DateTime yr mo da tothr mi se ms tz- | otherwise = addDays addda ( DateTime yr mo da newhr mi se ms tz )- where- tothr = hr + addhr- newhr = tothr `mod` 24- addda = tothr `div` 24--addDays :: Int -> DateTime -> DateTime-addDays addda ( DateTime yr mo da hr mi se ms tz )- = DateTime newyr newmo newda hr mi se ms tz- where- -- newdate = fromJulianDate (toJulianDate yr mo (da+addda) )- -- newyr = dtYear newdate- -- newmo = dtMonth newdate- -- newda = dtDay newdate- DateTime newyr newmo newda _ _ _ _ _ = fromJulianDate ( toJulianDate yr mo da + addda )--{- another way -}--simpleEq :: DateTime -> DateTime -> Bool---simpleEq ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) = ( ( yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) == ( yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) )-simpleEq ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) =- ( yr1 == yr2 ) && ( mo1 == mo2 ) && ( da1 == da2 ) && ( hr1 == hr2 ) && ( mi1 == mi2 ) && ( se1 == se2 ) && ( ms1 == ms2 ) && ( tz1 == tz2 )--simpleLT :: DateTime -> DateTime -> Bool-simpleLT ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 _ ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 _ )- | yr1 < yr2 = True- | (yr1==yr2)&&(mo1<mo2) = True- | (yr1==yr2)&&(mo1==mo2)&&(da1<da2) = True- | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1<hr2) = True- | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1<mi2) = True- | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1==mi2)&&(se1<se2) = True- | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1==mi2)&&(se1==se2)&&(ms1<ms2) = True- | otherwise = False---------------------------------------------------------------------------------------- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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------------------------------------------------------------------------------------
Swish/Utils/ListHelpers.hs view
@@ -10,10 +10,7 @@ -- Stability : experimental -- Portability : H98 ----- This module defines some generic list and related helper functions. Although--- some routines are explicitly marked as deprecated, the intention is to--- move this functionality into the modules that need it, or replace it by--- other modules, where possible.+-- This module defines some generic list and related helper functions. -- -------------------------------------------------------------------------------- @@ -39,31 +36,16 @@ , powerSet -- ClassRestrictionRule, RDFProof , permutations -- VarBinding , listProduct -- RDFQuery- , powerSequences_len -- RDFProof+ , powerSequencesLen -- RDFProof , flist -- Datatype, RDFProof, RDFRuleset, SwishScript, VarBinding , allp -- RDFQuery , anyp -- RDFQuery - -- * Deprecated routines- --- -- | These routines will be removed at the next minor release of- -- of Swish (@0.3.3@).- --- , mapset- , pairsUngroup- , ffold- , hasPartitions- , powerSequences- , powerSequences_inf- , allf- , anyf- , combinations -- used by powerSet- ) where import Data.Ord (comparing) -import Data.List (union, intersect, sortBy, groupBy)+import Data.List (sortBy, groupBy) ------------------------------------------------------------ -- Generic helpers@@ -78,11 +60,6 @@ | otherwise = select f l1 l2 select _ _ _ = error "select supplied with different length lists" --- |Collect set of values from list under supplied mapping function-mapset :: Eq b => ( a -> b ) -> [a] -> [b]-mapset _ [] = []-mapset f (e:l) = [f e] `union` mapset f l- -- |Delete the n'th element of a list, returning the result -- -- If the list doesn't have an n'th element, return the list unchanged.@@ -122,14 +99,6 @@ equiv :: (Eq a) => [a] -> [a] -> Bool a `equiv` b = a `subset` b && b `subset` a --- |Set partition test------ Is it possible to be more efficient here?--- Maybe something like sort\/merge\/compare?-hasPartitions :: (Eq a) => [a] -> ([a],[a]) -> Bool-a `hasPartitions` (b1,b2) =- null (b1 `intersect` b2) && (a `equiv` (b1 `union` b2))- -- |Add element to set addSetElem :: (Eq a) => a -> [a] -> [a]@@ -160,9 +129,6 @@ pairUngroup :: (a,[b]) -> [(a,b)] pairUngroup (a,bs) = [ (a,b) | b <- bs ] -pairsUngroup :: [(a,[b])] -> [(a,b)]-pairsUngroup ps = [ (a,b) | (a,bs) <- ps, b <- bs ]- pairSort :: (Ord a) => [(a,b)] -> [(a,b)] pairSort = sortBy (comparing fst) @@ -295,50 +261,18 @@ -- Powersequence (?) -- all sequences from some base values ------------------------------------------------------------ --- |Function to choose all sequences of any length--- from a supplied set of values, returned in--- increasing length.-powerSequences :: [a] -> [[a]]-powerSequences rs = concat $ powerSeq_bylen rs [[]]- -- |Construct list of lists of sequences of increasing length-powerSeq_bylen :: [a] -> [[a]] -> [[[a]]]-powerSeq_bylen rs ps = ps : powerSeq_bylen rs (powerSeq_next rs ps)+powerSeqBylen :: [a] -> [[a]] -> [[[a]]]+powerSeqBylen rs ps = ps : powerSeqBylen rs (powerSeqNext rs ps) -- |Return sequences of length n+1 given original sequence -- and list of all sequences of length n-powerSeq_next :: [a] -> [[a]] -> [[a]]-powerSeq_next rs rss = [ h:t | t <- rss, h <- rs ]+powerSeqNext :: [a] -> [[a]] -> [[a]]+powerSeqNext rs rss = [ h:t | t <- rss, h <- rs ] -- |Return all powersequences of a given length-powerSequences_len :: Int -> [a] -> [[a]]-powerSequences_len len rs = powerSeq_bylen rs [[]] !! len---- |Return all powersequences of indefinite length--- Observe that any such powersequence will consist of a sequence--- of a finite length sequence followed by an indefinite number of--- copies of the head of the base set. To prevent duplicates, the--- generator constructs only sequences that do not end in the first--- member of the base set.-powerSequences_inf :: [a] -> [[a]]-powerSequences_inf rs =- map (++pst) $ [] : concat (powerSeq_bylen rs psh)- where- psh = map (:[]) (tail rs)- pst = repeat $ head rs--{- Powersequence tests-t0 = [1,2,3,4,5,6]-t1 = powerSequences t0-t2 = take 15 t1-t3 = powerSequences_len 3 t0-t4 = powerSequences_inf t0-t5 = map (take 6) $ take 15 t4-t6 = take 15 (powerSequences_len 6 t0)-t7 = t5 == t6-t8 = powerSequences_len1 3 t0-t9 = t8 == t3--}+powerSequencesLen :: Int -> [a] -> [[a]]+powerSequencesLen len rs = powerSeqBylen rs [[]] !! len ------------------------------------------------------------ -- Functions, lists and monads@@ -371,51 +305,6 @@ {- fmonadtest = fmonad [(1*),(2*),(3*)] 3 -- [3,6,9]--}---- |Fold result from list of functions applied to some value,--- returning the result of the fold.------ This is similar to the 'ap' function in the Monad library.----ffold :: (b->c->c) -> c -> [a->b] -> a -> c-ffold rf ri fs v = foldr rf ri (flist fs v)--{--ffoldtest0 = ffold ge4and True [(1+),(2+),(3+)] 0 -- False-ffoldtest1 = ffold ge4and True [(1+),(2+),(3+)] 1 -- False-ffoldtest2 = ffold ge4and True [(1+),(2+),(3+)] 2 -- False-ffoldtest3 = ffold ge4and True [(1+),(2+),(3+)] 3 -- True-ge4and v b = (v>=4 && b)-ffoldtest = and [not ffoldtest0,not ffoldtest1,not ffoldtest2,ffoldtest3]--}---- |Test if application of all functions in list to a given value--- satisfies a given condition----allf :: (b->Bool) -> [a->b] -> a -> Bool-allf pf fs a = all pf (flist fs a)--{--allftest0 = allf (>=4) [(1+),(2+),(3+)] 0 -- False-allftest1 = allf (>=4) [(1+),(2+),(3+)] 1 -- False-allftest2 = allf (>=4) [(1+),(2+),(3+)] 2 -- False-allftest3 = allf (>=4) [(1+),(2+),(3+)] 3 -- True-allftest = and [not allftest0,not allftest1,not allftest2,allftest3]--}---- |Test if application of any functions in list to a given value--- satisfies a given condition----anyf :: (b->Bool) -> [a->b] -> a -> Bool-anyf pf fs a = any pf (flist fs a)--{--anyftest0 = anyf (>=4) [(1+),(2+),(3+)] 0 -- False-anyftest1 = anyf (>=4) [(1+),(2+),(3+)] 1 -- True-anyftest2 = anyf (>=4) [(1+),(2+),(3+)] 2 -- True-anyftest3 = anyf (>=4) [(1+),(2+),(3+)] 3 -- True-anyftest = and [not anyftest0,anyftest1,anyftest2,anyftest3] -} -- |Test if a value satisfies all predicates in a list
Swish/Utils/LookupMap.hs view
@@ -37,13 +37,6 @@ , mapTranslateKeys, mapTranslateVals , mapTranslateEntries, mapTranslateEntriesM - -- * Deprecated routines- --- -- | These routines will be removed at the next minor release of- -- of Swish (@0.3.3@).- --- , mapSortByKey, mapSortByVal- ) where @@ -396,22 +389,6 @@ then error ("mapMerge key conflict: " ++ show e1 ++ " with " ++ show e2) else e1 : merge et1 et2---- |Creates a new map that is the same as the supplied map, except--- that its entries are sorted by key value.----mapSortByKey :: (LookupEntryClass a k v, Ord k) =>- LookupMap a -> LookupMap a-mapSortByKey (LookupMap es) =- LookupMap $ L.sortBy (comparing entryKey) es---- |Creates a new map that is the same as the supplied map, except--- that its entries are sorted by key value.----mapSortByVal :: (LookupEntryClass a k v, Ord v) =>- LookupMap a -> LookupMap a-mapSortByVal (LookupMap es) =- LookupMap $ L.sortBy (comparing entryVal) es -- |An fmap-like function that returns a new lookup map that is a -- copy of the supplied map with entry keys replaced according to
Swish/Utils/MiscHelpers.hs view
@@ -19,64 +19,8 @@ ( hash -- RDFGraph, GraphMem, GraphMatch , hashModulus -- GraphMatch - -- * Deprecated routines- --- -- | These routines will be removed at the next minor release of- -- of Swish (@0.3.3@).- --- , assert -- GraphMatch QUS: can we use Control.Exception.assert?- , stricmp- , lower -- Vocabulary- , quote -- RDFGraph- ) where--import Data.Char (toLower)----------------------------------------------------------------- assert test---------------------------------------------------------------assert :: Bool -> String -> a -> a-assert cond msg expr = if not cond then error msg else expr----------------------------------------------------------------- Generate lowercase form of supplied string---------------------------------------------------------------lower :: String -> String-lower = foldr ((:) . toLower) "" ----------------------------------------------------------------- Case insensitive compare.------------------------------------------------------------------- Should be used only for values using just the US ASCII--- character set. Use with richer character sets can yield--- surprising results.--stricmp :: String -> String -> Bool-stricmp (c1:s1) (c2:s2) = toLower c1 == toLower c2 && stricmp s1 s2-stricmp [] [] = True-stricmp _ _ = False----------------------------------------------------------------- Generate quoted form of supplied string:------------------------------------------------------------------- [[[TODO: The list of quoting options here is incomplete]]]--quote :: String -> String-quote st = ['"'] ++ quote1 st ++ ['"']--quote1 :: String -> String-quote1 ('"': st) = '\\':'"' : quote1 st-quote1 ('\\':st) = '\\':'\\': quote1 st-quote1 ('\n':st) = '\\':'n': quote1 st-quote1 ('\r':st) = '\\':'r': quote1 st-quote1 (c:st) = c: quote1 st-quote1 [] = "" ------------------------------------------------------------ -- Hash function and values
Swish/Utils/Namespace.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -9,7 +11,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : TypeSynonymInstances, MultiParamTypeClasses+-- Portability : TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances, OverloadedStrings -- -- This module defines algebraic datatypes for namespaces and scoped names. --@@ -22,60 +24,74 @@ module Swish.Utils.Namespace ( Namespace(..) , makeNamespaceQName- , nullNamespace+ -- , nullNamespace , ScopedName(..) , getScopePrefix, getScopeURI , getQName, getScopedNameURI , matchName- , makeScopedName, makeQNameScopedName, makeUriScopedName+ , makeScopedName+ , makeQNameScopedName+ , makeURIScopedName , nullScopedName+ , namespaceToBuilder )-where+ where -import Swish.Utils.QName (QName(..), getQNameURI)+import Swish.Utils.QName (QName, newQName, getQNameURI, getNamespace, getLocalName) import Swish.Utils.LookupMap (LookupEntryClass(..)) +import Data.Monoid (Monoid(..)) import Data.String (IsString(..))+import Data.Maybe (fromMaybe) +import Network.URI (URI(..), parseURIReference, nullURI)++import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as B+ ------------------------------------------------------------ -- Namespace, having a prefix and a URI ------------------------------------------------------------ --- |A NameSpace value consists of a prefix and a corresponding URI.--- The prefix may be empty (@\"\"@), in which case it is assumed to be unknown.------ NOTE: not clear whether @nsPrefix@ should be empty or set to @\"?\"@.+-- |A NameSpace value consists of an optional prefix and a corresponding URI. ---data Namespace = Namespace { nsPrefix :: String, nsURI :: String } -{--getNamespacePrefix :: Namespace -> String-getNamespacePrefix = nsPrefix--getNamespaceURI :: Namespace -> String-getNamespaceURI = nsURI--}-+data Namespace = Namespace+ {+ nsPrefix :: Maybe T.Text+ , nsURI :: URI+ }+ instance Eq Namespace where (==) = nsEq instance Show Namespace where- show (Namespace p u) =- (if p == "?" then "" else p ++ ":") ++ "<" ++ u ++ ">"+ show (Namespace (Just p) u) = show p ++ ":<" ++ show u ++ ">"+ show (Namespace _ u) = "<" ++ show u ++ ">" -instance LookupEntryClass Namespace String String where+instance LookupEntryClass Namespace (Maybe T.Text) URI where keyVal (Namespace pre uri) = (pre,uri) newEntry (pre,uri) = Namespace pre uri nsEq :: Namespace -> Namespace -> Bool nsEq (Namespace _ u1) (Namespace _ u2) = u1 == u2 -makeNamespaceQName :: Namespace -> String -> QName-makeNamespaceQName ns = QName (nsURI ns)+makeNamespaceQName :: Namespace -> T.Text -> QName+makeNamespaceQName (Namespace _ uri) = newQName uri +{- nullNamespace :: Namespace-nullNamespace = Namespace "?" ""+nullNamespace = Namespace Nothing ""+-} +-- | Utility routine to create a \@prefix line (matching N3/Turtle)+-- grammar for this namespace.+--+namespaceToBuilder :: Namespace -> B.Builder+namespaceToBuilder (Namespace pre uri) =+ mconcat $ map B.fromText + [ "@prefix ", fromMaybe "" pre, ": <", T.pack (show uri), "> .\n"]+ ------------------------------------------------------------ -- ScopedName, made from a namespace and a local name ------------------------------------------------------------@@ -87,16 +103,19 @@ -- Some applications may handle null namespace URIs as meaning -- the local part is relative to some base URI. ---data ScopedName = ScopedName { snScope :: Namespace, snLocal :: String }+data ScopedName = ScopedName { snScope :: Namespace, snLocal :: T.Text } -getScopePrefix :: ScopedName -> String+getScopePrefix :: ScopedName -> Maybe T.Text getScopePrefix = nsPrefix . snScope -getScopeURI :: ScopedName -> String+getScopeURI :: ScopedName -> URI getScopeURI = nsURI . snScope +-- | This is not total since it will fail if the input string is not a valid URI. instance IsString ScopedName where- fromString = makeUriScopedName+ fromString s =+ maybe (error ("Unable to convert " ++ s ++ " into a ScopedName"))+ makeURIScopedName (parseURIReference s) instance Eq ScopedName where (==) = snEq@@ -105,11 +124,9 @@ (<=) = snLe instance Show ScopedName where- show (ScopedName n l) =- if pre == "?" then "<"++uri++l++">" else pre++":"++l- where- pre = nsPrefix n- uri = nsURI n+ show (ScopedName n l) = case nsPrefix n of+ Just pre -> T.unpack $ mconcat [pre, ":", l]+ _ -> "<" ++ show (nsURI n) ++ T.unpack l ++ ">" -- Scoped names are equal if their corresponding QNames are equal snEq :: ScopedName -> ScopedName -> Bool@@ -121,33 +138,53 @@ -- |Get QName corresponding to a scoped name getQName :: ScopedName -> QName-getQName n = QName (getScopeURI n) (snLocal n)+getQName n = newQName (getScopeURI n) (snLocal n) -- |Get URI corresponding to a scoped name (using RDF conventions)-getScopedNameURI :: ScopedName -> String+getScopedNameURI :: ScopedName -> URI getScopedNameURI = getQNameURI . getQName +-- for the moment leave this as String rather than Text+ -- |Test if supplied string matches the display form of a -- scoped name. matchName :: String -> ScopedName -> Bool matchName str nam = str == show nam -- |Construct a ScopedName from prefix, URI and local name-makeScopedName :: String -> String -> String -> ScopedName+makeScopedName :: Maybe T.Text -> URI -> T.Text -> ScopedName makeScopedName pre nsuri = ScopedName (Namespace pre nsuri) +{-+TODO: should just pass URIs around.++At the moment support the use of URI references. Unclear of semantics+to know whether this is sensible (probably is, but should look at).+-}+ -- |Construct a ScopedName from a QName makeQNameScopedName :: QName -> ScopedName-makeQNameScopedName (QName u l) = makeScopedName "?" u l+{-+The following is not correct+makeQNameScopedName qn = makeScopedName Nothing (getNamespace qn) (getLocalName qn)+since you get+swish> let sn1 = makeQNameScopedName "file:///foo/bar/baz"+swish> sn1+<file:///foo/barbaz>+-}+makeQNameScopedName qn = + let ns = getNamespace qn+ ln = getLocalName qn+ in makeScopedName Nothing ns ln --- |Construct a ScopedName for a bare URI-makeUriScopedName :: String -> ScopedName-makeUriScopedName u = makeScopedName "?" u ""+-- |Construct a ScopedName for a bare URI (the label is set to \"\").+makeURIScopedName :: URI -> ScopedName+makeURIScopedName uri = makeScopedName Nothing uri "" -- |This should never appear as a valid name nullScopedName :: ScopedName-nullScopedName = makeScopedName "?" "" ""+nullScopedName = makeURIScopedName nullURI -------------------------------------------------------------------------------- --
Swish/Utils/QName.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,126 +10,184 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module defines an algebraic datatype for qualified names (QNames). -- -------------------------------------------------------------------------------- +-- At present we support using URI references rather than forcing an absolute+-- URI. This is partly to support the existing tests (to lazy to resolve whether+-- the tests really should be using relative URIs in this case).+ module Swish.Utils.QName- ( QName(..) -- , maybeQnEq- , newQName, qnameFromPair, qnameFromURI- , getNamespace, getLocalName, getQNameURI- , splitURI+ ( QName+ , newQName+ , qnameFromURI+ , getNamespace+ , getLocalName+ , getQNameURI , qnameFromFilePath )-where--import Data.Char (isAlpha, isAlphaNum)+ where import System.Directory (canonicalizePath)-import System.FilePath (splitDirectories)+-- import System.FilePath (splitDirectories)++import Network.URI (URI(..), URIAuth(..), parseURIReference)+ import Data.String (IsString(..))-import Data.List (intercalate)+-- import Data.Char (isAlpha, isAlphaNum)+import Data.Maybe (fromMaybe)+-- import Data.List (intercalate) +import qualified Data.Text as T+ ------------------------------------------------------------ -- Qualified name ------------------------------------------------------------ -- -- cf. http://www.w3.org/TR/REC-xml-names/ -data QName = QName { qnNsuri, qnLocal :: String }+{-| +A qualified name, consisting of a namespace URI+and the local part of the identifier.++-}++{-+For now I have added in storing the actual URI+as well as the namespace component. This may or+may not be a good idea (space vs time saving).+-}++data QName = QName+ { qnURI :: URI -- ^ URI+ , qnNsuri :: URI -- ^ namespace + , qnLocal :: T.Text -- ^ local component+ }++-- | This is not total since it will fail if the input string is not a valid URI. instance IsString QName where- fromString = qnameFromURI+ fromString s = + maybe (error ("Unable to convert " ++ s ++ " into a QName"))+ qnameFromURI (parseURIReference s) instance Eq QName where (==) = qnEq +-- ugly, use show instance+ instance Ord QName where+ {- (QName u1 l1) <= (QName u2 l2) = if up1 /= up2 then up1 <= up2 else (ur1++l1) <= (ur2++l2) where n = min (length u1) (length u2) (up1,ur1) = splitAt n u1 (up2,ur2) = splitAt n u2-+ -}+ + -- TODO: which is faster?+ (QName u1 _ _) <= (QName u2 _ _) = show u1 <= show u2+ {-+ (QName _ uri1 l1) <= (QName _ uri2 l2) =+ if up1 /= up2 then up1 <= up2 else (ur1 ++ T.unpack l1) <= (ur2 ++ T.unpack l2)+ where+ u1 = show uri1+ u2 = show uri2+ + n = min (length u1) (length u2)+ (up1,ur1) = splitAt n u1+ (up2,ur2) = splitAt n u2+ -}+ instance Show QName where- show (QName ns ln) = "<" ++ ns ++ ln ++ ">"+ show (QName u _ _) = "<" ++ show u ++ ">" -newQName :: String -> String -> QName-newQName = QName+{-+Should this be clever and ensure that local doesn't+contain /, say? -qnameFromPair :: (String,String) -> QName-qnameFromPair = uncurry QName+We could also me more clever, and safer, when constructing+the overall uri.+-}+newQName :: URI -> T.Text -> QName+newQName ns local = + let l = T.unpack local+ uristr = show ns ++ l+ uri = fromMaybe (error ("Unable to parse URI from: '" ++ show ns ++ "' + '" ++ l ++ "'")) (parseURIReference uristr)+ in QName uri ns local -qnameFromURI :: String -> QName-qnameFromURI = qnameFromPair . splitURI+{- -getNamespace :: QName -> String+old behavior++ splitQname "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")+ splitQname "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")+ splitQname "http://example.org/aaa/" = ("http://example.org/aaa/","")++Should "urn:foo:bar" have a local name of "" or "foo:bar"? For now go+with the first option.++-}++qnameFromURI :: URI -> QName+qnameFromURI uri =+ let uf = uriFragment uri+ up = uriPath uri+ q0 = QName uri uri ""+ in case uf of+ "#" -> q0+ '#':xs -> QName uri (uri { uriFragment = "#" }) (T.pack xs)+ "" -> case break (=='/') (reverse up) of+ ("",_) -> q0 -- path ends in / or is empty+ (_,"") -> q0 -- path contains no /+ (rlname,rpath) -> QName uri (uri {uriPath = reverse rpath}) (T.pack (reverse rlname))+ + e -> error $ "Unexpected: uri=" ++ show uri ++ " has fragment='" ++ show e ++ "'" ++getNamespace :: QName -> URI getNamespace = qnNsuri -getLocalName :: QName -> String+getLocalName :: QName -> T.Text getLocalName = qnLocal -getQNameURI :: QName -> String-getQNameURI (QName ns ln) = ns++ln+getQNameURI :: QName -> URI+getQNameURI = qnURI --- Original used comparison of concatenated strings,--- but that was very inefficient. This version does the--- comparison without constructing new values+{-+Original used comparison of concatenated strings,+but that was very inefficient. The longer version below+does the comparison without constructing new values but is+no longer valid with the namespace being stored as a URI,+so for now just compare the overall URIs and we can+optimize this at a later date if needed.+-} qnEq :: QName -> QName -> Bool-qnEq (QName n1 l1) (QName n2 l2) = qnEq1 n1 n2 l1 l2+qnEq (QName u1 _ _) (QName u2 _ _) = u1 == u2+{-+qnEq (QName _ n1 l1) (QName _ n2 l2) = qnEq1 n1 n2 l1 l2 where qnEq1 (c1:ns1) (c2:ns2) ln1 ln2 = c1==c2 && qnEq1 ns1 ns2 ln1 ln2 qnEq1 [] ns2 ln1@(_:_) ln2 = qnEq1 ln1 ns2 [] ln2 qnEq1 ns1 [] ln1 ln2@(_:_) = qnEq1 ns1 ln2 ln1 [] qnEq1 [] [] [] [] = True qnEq1 _ _ _ _ = False--{---- Define equality of (Maybe QName)-maybeQnEq :: (Maybe QName) -> (Maybe QName) -> Bool-maybeQnEq Nothing Nothing = True-maybeQnEq (Just q1) (Just q2) = q1 == q2-maybeQnEq _ _ = False -} --- Separate URI string into namespace URI and local name-splitURI :: String -> ( String, String )- -- splitQname "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")- -- splitQname "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")- -- splitQname "http://example.org/aaa/" = ("http://example.org/aaa/","")-splitURI qn = splitAt (scanURI qn (-1) 0) qn---- helper function for splitQName--- Takes 3 arguments:--- QName to scan--- index of last name-start char, or (-1)--- number of characters scanned so far--- Returns index of start of name, or length of list----scanURI :: String -> Int -> Int -> Int-scanURI (nextch:more) (-1) nc- | isNameStartChar nextch = scanURI more nc (nc+1)- | otherwise = scanURI more (-1) (nc+1)-scanURI (nextch:more) ns nc- | not (isNameChar nextch) = scanURI more (-1) (nc+1)- | otherwise = scanURI more ns (nc+1)-scanURI "" (-1) nc = nc-scanURI "" ns _ = ns--- -- Definitions here per XML namespaces, NCName production, -- restricted to characters used in URIs. -- cf. http://www.w3.org/TR/REC-xml-names/ +{- isNameStartChar :: Char -> Bool isNameStartChar c = isAlpha c || c == '_' isNameChar :: Char -> Bool isNameChar c = isAlphaNum c || c `elem` ".-_"+-} {-| Convert a filepath to a file: URI stored in a QName. If the@@ -135,24 +195,49 @@ to convert it into an absolute path. If the input represents a directory then it *must* end in -the directory separator - e.g. @\"\/foo\/bar\/\"@ rather than -@\"\/foo\/bar\"@-for Posix systems.+the directory separator - so for Posix systems use +@\"\/foo\/bar\/\"@ rather than +@\"\/foo\/bar\"@. This has not been tested on Windows. -}++{-+NOTE: not sure what I say directories should end in the path+seperator since++ghci> System.Directory.canonicalizePath "/Users/dburke/haskell/swish-text"+"/Users/dburke/haskell/swish-text"+ghci> System.Directory.canonicalizePath "/Users/dburke/haskell/swish-text/"+"/Users/dburke/haskell/swish-text"++-}++-- since we build up the URI manually we could+-- create the QName directly, but leave that +-- for now.+ qnameFromFilePath :: FilePath -> IO QName qnameFromFilePath = fmap qnameFromURI . filePathToURI -filePathToURI :: FilePath -> IO String+emptyAuth :: Maybe URIAuth+emptyAuth = Just $ URIAuth "" "" ""++filePathToURI :: FilePath -> IO URI filePathToURI fname = do ipath <- canonicalizePath fname+ + {- let paths = splitDirectories ipath txt = intercalate "/" $ case paths of "/":rs -> rs _ -> paths+ -} - return $ "file:///" ++ txt+ -- Is manually creating the URI sensible?+ -- return $ fromJust $ parseURI $ "file:///" ++ txt+ -- return $ URI "file:" emptyAuth txt "" ""+ return $ URI "file:" emptyAuth ipath "" "" -------------------------------------------------------------------------------- --
Swish/Utils/ShowM.hs view
@@ -23,17 +23,7 @@ -- -------------------------------------------------------------------------------- -module Swish.Utils.ShowM- ( ShowM(..), - - -- * Deprecated routine- --- -- | This routine will be removed at the next minor release of- -- of Swish (@0.3.3@).- --- showm- )-where+module Swish.Utils.ShowM (ShowM(..)) where ------------------------------------------------------------ -- ShowM framework@@ -59,11 +49,6 @@ -- (3) no newline is output following the final line of text. showms :: String -> sh -> ShowS showms _ = shows---- |Return a string representation of a ShowM value.-showm :: (ShowM sh) => String -> sh -> String-showm linebreak val = showms linebreak val ""- -------------------------------------------------------------------------------- --
− Swish/Utils/TraceHelpers.hs
@@ -1,55 +0,0 @@------------------------------------------------------------------------------------ See end of this file for licence information.------------------------------------------------------------------------------------ |--- Module : TraceHelpers--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke--- License : GPL V2------ Maintainer : Douglas Burke--- Stability : experimental--- Portability : H98------ This module is deprecated and will be removed in the next minor--- release of Swish (@0.3.3@).--------------------------------------------------------------------------------------module Swish.Utils.TraceHelpers- ( trace, traceShow- )-where--import Debug.Trace- ( trace )----------------------------------------------------------------- traceShow function from older Hugs trace module---------------------------------------------------------------traceShow :: Show a => String -> a -> a-traceShow msg x = trace (msg ++ show x) x---------------------------------------------------------------------------------------- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 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------------------------------------------------------------------------------------
scripts/SwishExample.ss view
@@ -21,6 +21,13 @@ # file, and to graphs created by scripted inferences, # but are not applied to any graphs read in from an external source. +# NOTE: the automatic prefix declarations are no-longer provided by+# Swish+#+@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .+@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> .+@prefix rdfd: <http://id.ninebynine.org/2003/rdfext/rdfd#> .+ @prefix ex: <http://id.ninebynine.org/wip/2003/swishtest/> . @prefix pv: <http://id.ninebynine.org/wip/2003/swishtest/pv/> . @prefix xsd: <http://www.w3.org/2001/XMLSchema#> .@@ -28,14 +35,6 @@ @prefix rs_rdf: <http://id.ninebynine.org/2003/Ruleset/rdf#> . @prefix rs_rdfs: <http://id.ninebynine.org/2003/Ruleset/rdfs#> . @prefix : <http://id.ninebynine.org/default/> .--# Additionally, prefix declarations are provided automatically for:-# @prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .-# @prefix rdfs: <file:///E:/Download/www.w3.org/2000/01/rdf-schema#> .-# @prefix rdfd: <http://id.ninebynine.org/2003/rdfext/rdfd#> .-# @prefix rdfo: <http://id.ninebynine.org/2003/rdfext/rdfo#> .-# @prefix owl: <http://www.w3.org/2002/07/owl#> .- # -- Simple named graph declarations --
scripts/SwishTest.ss view
@@ -4,10 +4,14 @@ # # --------+---------+---------+---------+---------+---------+---------+--------- +@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> . +@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . + @prefix ex: <http://id.ninebynine.org/wip/2003/swishtest/> . @prefix pv: <http://id.ninebynine.org/wip/2003/swishtest/pv/> . @prefix xsd: <http://www.w3.org/2001/XMLSchema#> . @prefix xsd_integer: <http://id.ninebynine.org/2003/XMLSchema/integer#> . +@prefix rdfd: <http://id.ninebynine.org/2003/rdfext/rdfd#> . @prefix rs_rdf: <http://id.ninebynine.org/2003/Ruleset/rdf#> . @prefix rs_rdfs: <http://id.ninebynine.org/2003/Ruleset/rdfs#> . @prefix : <http://id.ninebynine.org/default/> .
scripts/VehicleCapacity.ss view
@@ -8,8 +8,7 @@ @prefix pv: <http://id.ninebynine.org/wip/2003/swishtest/pv/> . @prefix xsd: <http://www.w3.org/2001/XMLSchema#> . @prefix xsd_integer: <http://id.ninebynine.org/2003/XMLSchema/integer#> . -@prefix rs_rdf: <http://id.ninebynine.org/2003/Ruleset/rdf#> . -@prefix rs_rdfs: <http://id.ninebynine.org/2003/Ruleset/rdfs#> . +@prefix rdfd: <http://id.ninebynine.org/2003/rdfext/rdfd#> . @prefix : <http://id.ninebynine.org/default/> .
swish.cabal view
@@ -1,5 +1,5 @@ Name: swish-Version: 0.3.2.1+Version: 0.4.0.0 Stability: experimental License: LGPL License-file: LICENSE @@ -46,6 +46,14 @@ . Changes: .+ [Version 0.4.0.0] Moving to using polyparse for parsing and @Text@ rather than+ @String@ where appropriate. Use of @URI@ and @Maybe Text@ rather than @String@ in the @Namespace@+ type. Removed the Swish.Utils.DateTime and Swish.Utils.TraceHelpers+ modules. Symbols have been removed from the export lists of the following modules:+ Swish.Utils.LookupMap, Swish.Utils.ListHelpers, Swish.Utils.MiscHelpers,+ Swish.Utils.ShowM. Some significant improvements to parsing speed, but no+ concerted effort or checks made yet.+ . [Version 0.3.2.1] Marked a number of routines from the Swish.Utils modules as deprecated. Use foldl' rather than foldl. .@@ -138,14 +146,17 @@ Library Build-Depends: base >=3 && < 5,+ text == 0.11.*,+ -- text-format == 0.2.*,+ -- split == 0.1.*, binary == 0.5.*, bytestring == 0.9.*, containers == 0.3.*, array == 0.3.*, parallel == 2.2.*,- parsec == 2.1.*,+ polyparse >= 1.6 && < 1.8, random == 1.0.*,- old-time == 1.0.*, old-locale == 1.0.*, time == 1.1.*,+ old-locale == 1.0.*, time == 1.1.*, mtl >= 1 && < 3, HUnit == 1.2.*, network >= 2.2 && < 2.4,@@ -188,7 +199,6 @@ Swish.RDF.SwishScript Swish.RDF.VarBinding Swish.RDF.Vocabulary- Swish.Utils.DateTime Swish.Utils.ListHelpers Swish.Utils.LookupMap Swish.Utils.MiscHelpers@@ -196,7 +206,6 @@ Swish.Utils.PartOrderedCollection Swish.Utils.QName Swish.Utils.ShowM- Swish.Utils.TraceHelpers other-modules: -- Paths_swish
tests/BuiltInMapTest.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module contains test cases for accessing built-in variable -- binding modifiers.
tests/GraphTest.hs view
@@ -42,10 +42,7 @@ graphLabels, assignLabelMap, newGenerationMap, graphMatch1, equivalenceClasses )-import Swish.Utils.LookupMap- ( LookupEntryClass(..), makeLookupMap- , mapSortByVal- )+import Swish.Utils.LookupMap (LookupEntryClass(..), makeLookupMap) default ( Int ) @@ -96,9 +93,6 @@ makeEntries :: (Label lb) => [(lb,LabelIndex)] -> [LabelEntry lb] makeEntries = map newEntry -labelMapSortByVal :: (Label lb) => LabelMap lb -> LabelMap lb-labelMapSortByVal (LabelMap gen lm) = LabelMap gen (mapSortByVal lm)- ------------------------------------------------------------ -- Graph helper function tests ------------------------------------------------------------@@ -129,23 +123,6 @@ testSelect01, testSelect02, testSelect03, testSelect04 ] --- mapset--mf :: Int -> Char-mf n = "_abcde" !! n--testMapset :: String -> [Int] -> String -> Test-testMapset lab l1s l2s = testeq ("Mapset"++lab ) l2s (mapset mf l1s)--testMapsetSuite :: Test-testMapsetSuite = TestList- [ testMapset "01" [0,1,2,3,4,5] "_abcde"- , testMapset "02" [1,1,3,3,5,5] "ace"- , testMapset "03" [5,4,3,2,1,0] "edcba_"- , testMapset "04" [] []- , testMapset "05" [1,2,3,4,5,0] "abcde_"- ]- -- subset testSubset :: String -> Bool -> [Int] -> [Int] -> Test@@ -1753,7 +1730,6 @@ allTests :: Test allTests = TestList [ testSelectSuite- , testMapsetSuite , testSubsetSuite , testHashSuite , testLabSuite
tests/N3FormatterTest.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This Module defines test cases for module Parse parsing functions. --@@ -17,11 +19,10 @@ module Main where import Swish.RDF.N3Formatter- ( formatGraphAsStringNl- , formatGraphAsString+ ( formatGraphAsLazyText , formatGraphDiag ) -import Swish.RDF.N3Parser (parseN3fromString)+import Swish.RDF.N3Parser (parseN3) import Swish.RDF.RDFGraph ( RDFGraph, RDFTriple@@ -30,11 +31,11 @@ , NamespaceMap , LookupFormula(..) , emptyRDFGraph, toRDFGraph, toRDFTriple- , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil- , res_owl_sameAs+ , resRdfType, resRdfFirst, resRdfRest, resRdfNil+ , resOwlSameAs ) -import Swish.Utils.Namespace (Namespace(..), ScopedName(..))+import Swish.Utils.Namespace (Namespace(..), ScopedName(..), namespaceToBuilder) import Swish.Utils.LookupMap ( LookupMap(..)@@ -45,9 +46,17 @@ import Swish.RDF.Vocabulary (langName, namespaceRDF, namespaceXSD) +import Network.URI (URI, parseURI)+ import Data.Monoid (Monoid(..))+import Data.Maybe (fromJust)+ import Data.String (IsString(..)) +import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Builder as B+ import Test.HUnit ( Test(TestCase,TestList) , assertEqual, runTestTT )@@ -68,17 +77,37 @@ -- Define some common values ------------------------------------------------------------ -base1, base2, base3, base4 :: Namespace-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"+toURI :: String -> URI+toURI = fromJust . parseURI -s1, s2, s3 :: RDFLabel-s1 = Res $ ScopedName base1 "s1"-s2 = Res $ ScopedName base2 "s2"-s3 = Res $ ScopedName base3 "s3"+toNS :: T.Text -> String -> Namespace+toNS p = Namespace (Just p) . toURI +toRes :: Namespace -> T.Text -> RDFLabel+toRes ns = Res . ScopedName ns++base1, base2, base3, base4, basef, baseu, basem :: Namespace+base1 = toNS "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node#"+base2 = toNS "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node/"+base3 = toNS "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"+base4 = toNS "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"+basef = toNS "fbase" "file:///home/swish/photos/"+baseu = toNS "ubase" "urn:one:two:3.14"+basem = toNS "me" "http://example.com/ns#"+ +s1, s2, s3, sf, su :: RDFLabel+s1 = toRes base1 "s1"+s2 = toRes base2 "s2"+s3 = toRes base3 "s3"++sf = toRes basef "me.png"+su = toRes baseu ""++meDepicts, meMe, meHasURN :: RDFLabel+meDepicts = toRes basem "depicts"+meMe = toRes basem "me"+meHasURN = toRes basem "hasURN"+ b1, b2, b3, b4, b5, b6, b7, b8 :: RDFLabel b1 = Blank "b1" b2 = Blank "b2"@@ -113,7 +142,7 @@ o2 = Res $ ScopedName base2 "o2" o3 = Res $ ScopedName base3 "o3" -l1txt, l2txt, l3txt, l11txt, l12txt, l13txt, l14txt :: String+l1txt, l2txt, l3txt, l11txt, l12txt, l13txt, l14txt :: B.Builder l1txt = "l1" l2txt = "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'" l3txt = "l3--\r\"'\\--\x0020\&--\x00A0\&--"@@ -122,14 +151,17 @@ l13txt = "lx13" l14txt = "lx14" +toL :: B.Builder -> RDFLabel+toL = flip Lit Nothing . L.toStrict . B.toLazyText+ l1, l2, l3, l11, l12, l13, l14 :: RDFLabel-l1 = Lit l1txt Nothing-l2 = Lit l2txt Nothing-l3 = Lit l3txt Nothing-l11 = Lit l11txt Nothing-l12 = Lit l12txt Nothing-l13 = Lit l13txt Nothing-l14 = Lit l14txt Nothing+l1 = toL l1txt+l2 = toL l2txt+l3 = toL l3txt+l11 = toL l11txt+l12 = toL l12txt+l13 = toL l13txt+l14 = toL l14txt lfr, lfoobar :: RDFLabel lfr = Lit "chat et chien" (Just (langName "fr"))@@ -210,6 +242,13 @@ f02 = arc s1 p1 b3 formb3g1f2 = LookupMap [Formula b3 g1f2] +g1fu1 :: RDFGraph+g1fu1 =+ mempty+ { namespaces = makeLookupMap [basem, Namespace Nothing (toURI "file:///home/swish/photos/")]+ , statements = [arc sf meDepicts meMe, arc sf meHasURN su]+ }+ ---- g2, g3, g4, g5, g6, g7 :: RDFGraph@@ -221,8 +260,8 @@ g7 = toGraph [t01,t07] t801, t802, t807, t808, t809, t810 :: Arc RDFLabel-t801 = arc s1 res_rdf_type o1-t802 = arc s2 res_owl_sameAs o2+t801 = arc s1 resRdfType o1+t802 = arc s2 resOwlSameAs o2 t807 = arc o1 p1 s1 t808 = arc s2 p1 o2 t809 = arc s1 p2 o1@@ -282,8 +321,8 @@ tx101, tx102, tx111, tx112, tx113, tx114, tx121, tx122, tx123, tx124, tx125, tx126, tx127, tx128 :: Arc RDFLabel-tx101 = arc b1 res_owl_sameAs s1-tx102 = arc s2 res_owl_sameAs b2+tx101 = arc b1 resOwlSameAs s1+tx102 = arc s2 resOwlSameAs b2 tx111 = arc b1 p1 o1 tx112 = arc b1 p1 o2 tx113 = arc b1 p2 o2@@ -306,8 +345,8 @@ tx201, tx202, tx211, tx212, tx213, tx214, tx221, tx222, tx223, tx224, tx225, tx226, tx227 :: Arc RDFLabel-tx201 = arc b1 res_owl_sameAs s1-tx202 = arc s2 res_owl_sameAs b2+tx201 = arc b1 resOwlSameAs s1+tx202 = arc s2 resOwlSameAs b2 tx211 = arc b1 p1 o1 tx212 = arc o2 p1 b1 tx213 = arc b1 p2 o2@@ -350,15 +389,15 @@ tx401, tx402, tx403, tx404, tx405, tx406, tx407, tx408, tx409 :: Arc RDFLabel-tx401 = arc s1 res_owl_sameAs b1-tx402 = arc b1 res_rdf_first o1-tx403 = arc b1 res_rdf_rest b2-tx404 = arc b2 res_rdf_first o2-tx405 = arc b2 res_rdf_rest b3-tx406 = arc b3 res_rdf_first o3-tx407 = arc b3 res_rdf_rest b4-tx408 = arc b4 res_rdf_first l1-tx409 = arc b4 res_rdf_rest res_rdf_nil+tx401 = arc s1 resOwlSameAs b1+tx402 = arc b1 resRdfFirst o1+tx403 = arc b1 resRdfRest b2+tx404 = arc b2 resRdfFirst o2+tx405 = arc b2 resRdfRest b3+tx406 = arc b3 resRdfFirst o3+tx407 = arc b3 resRdfRest b4+tx408 = arc b4 resRdfFirst l1+tx409 = arc b4 resRdfRest resRdfNil x4 :: RDFGraph x4 = toGraph [tx401,tx402,tx403,tx404,@@ -366,15 +405,15 @@ tx409] x5 :: RDFGraph-x5 = toGraph [ arc b1 res_owl_sameAs s1- , arc b1 res_rdf_first o1- , arc b1 res_rdf_rest b2- , arc b2 res_rdf_first o2- , arc b2 res_rdf_rest b3- , arc b3 res_rdf_first o3- , arc b3 res_rdf_rest b4- , arc b4 res_rdf_first l1- , arc b4 res_rdf_rest res_rdf_nil+x5 = toGraph [ arc b1 resOwlSameAs s1+ , arc b1 resRdfFirst o1+ , arc b1 resRdfRest b2+ , arc b2 resRdfFirst o2+ , arc b2 resRdfRest b3+ , arc b3 resRdfFirst o3+ , arc b3 resRdfRest b4+ , arc b4 resRdfFirst l1+ , arc b4 resRdfRest resRdfNil ] {-@@ -396,14 +435,14 @@ -} x6 :: RDFGraph-x6 = toGraph [ arc s1 res_rdf_first o1- , arc s1 res_rdf_rest b2- , arc b2 res_rdf_first o2- , arc b2 res_rdf_rest b3- , arc b3 res_rdf_first o3- , arc b3 res_rdf_rest b4- , arc b4 res_rdf_first l1- , arc b4 res_rdf_rest res_rdf_nil+x6 = toGraph [ arc s1 resRdfFirst o1+ , arc s1 resRdfRest b2+ , arc b2 resRdfFirst o2+ , arc b2 resRdfRest b3+ , arc b3 resRdfFirst o3+ , arc b3 resRdfRest b4+ , arc b4 resRdfFirst l1+ , arc b4 resRdfRest resRdfNil ] x7 :: RDFGraph@@ -448,12 +487,12 @@ -- List of simple anon nodes x13 :: RDFGraph-x13 = toGraph [ arc s1 res_rdf_first b1- , arc s1 res_rdf_rest c1- , arc c1 res_rdf_first b2- , arc c1 res_rdf_rest c2- , arc c2 res_rdf_first b3- , arc c2 res_rdf_rest res_rdf_nil+x13 = toGraph [ arc s1 resRdfFirst b1+ , arc s1 resRdfRest c1+ , arc c1 resRdfFirst b2+ , arc c1 resRdfRest c2+ , arc c2 resRdfFirst b3+ , arc c2 resRdfRest resRdfNil , arc b1 p1 o1 , arc b2 p1 o2 , arc b3 p1 o3@@ -462,12 +501,12 @@ -- List of simple anon nodes using autogenerated bnodes x13a :: RDFGraph-x13a = toGraph [ arc s1 res_rdf_first b_1- , arc s1 res_rdf_rest c_1- , arc c_1 res_rdf_first b_2- , arc c_1 res_rdf_rest c_2- , arc c_2 res_rdf_first b_3- , arc c_2 res_rdf_rest res_rdf_nil+x13a = toGraph [ arc s1 resRdfFirst b_1+ , arc s1 resRdfRest c_1+ , arc c_1 resRdfFirst b_2+ , arc c_1 resRdfRest c_2+ , arc c_2 resRdfFirst b_3+ , arc c_2 resRdfRest resRdfNil , arc b_1 p1 o1 , arc b_2 p1 o2 , arc b_3 p1 o3@@ -482,12 +521,12 @@ -- List of more complex anon nodes x14 :: RDFGraph-x14 = toGraph [ arc s1 res_rdf_first b1- , arc s1 res_rdf_rest c1- , arc c1 res_rdf_first b2- , arc c1 res_rdf_rest c2- , arc c2 res_rdf_first b3- , arc c2 res_rdf_rest res_rdf_nil+x14 = toGraph [ arc s1 resRdfFirst b1+ , arc s1 resRdfRest c1+ , arc c1 resRdfFirst b2+ , arc c1 resRdfRest c2+ , arc c2 resRdfFirst b3+ , arc c2 resRdfRest resRdfNil , arc b1 p1 o1 , arc b1 p2 o1 , arc b2 p1 o2@@ -499,22 +538,22 @@ -- List with nested list x15 :: RDFGraph-x15 = toGraph [ arc s1 res_rdf_first b1- , arc s1 res_rdf_rest c1- , arc c1 res_rdf_first b2- , arc c1 res_rdf_rest c2- , arc c2 res_rdf_first b3- , arc c2 res_rdf_rest res_rdf_nil+x15 = toGraph [ arc s1 resRdfFirst b1+ , arc s1 resRdfRest c1+ , arc c1 resRdfFirst b2+ , arc c1 resRdfRest c2+ , arc c2 resRdfFirst b3+ , arc c2 resRdfRest resRdfNil , arc b1 p1 o1 , arc b2 p2 c3 , arc b3 p1 o3 - , arc c3 res_rdf_first b4- , arc c3 res_rdf_rest c4- , arc c4 res_rdf_first b5- , arc c4 res_rdf_rest c5- , arc c5 res_rdf_first b6- , arc c5 res_rdf_rest res_rdf_nil+ , arc c3 resRdfFirst b4+ , arc c3 resRdfRest c4+ , arc c4 resRdfFirst b5+ , arc c4 resRdfRest c5+ , arc c5 resRdfFirst b6+ , arc c5 resRdfRest resRdfNil , arc b4 p1 o1 , arc b5 p1 o2 , arc b6 p1 o3@@ -523,24 +562,24 @@ -- More complex list with nested list x16 :: RDFGraph-x16 = toGraph [ arc s1 res_rdf_first b1- , arc s1 res_rdf_rest c1- , arc c1 res_rdf_first b2- , arc c1 res_rdf_rest c2- , arc c2 res_rdf_first b3- , arc c2 res_rdf_rest res_rdf_nil+x16 = toGraph [ arc s1 resRdfFirst b1+ , arc s1 resRdfRest c1+ , arc c1 resRdfFirst b2+ , arc c1 resRdfRest c2+ , arc c2 resRdfFirst b3+ , arc c2 resRdfRest resRdfNil , arc b1 p1 o1 , arc b1 p2 o1 , arc b2 p2 c3 , arc b3 p1 o3 , arc b3 p2 o3 - , arc c3 res_rdf_first b4- , arc c3 res_rdf_rest c4- , arc c4 res_rdf_first b5- , arc c4 res_rdf_rest c5- , arc c5 res_rdf_first b6- , arc c5 res_rdf_rest res_rdf_nil+ , arc c3 resRdfFirst b4+ , arc c3 resRdfRest c4+ , arc c4 resRdfFirst b5+ , arc c4 resRdfRest c5+ , arc c5 resRdfFirst b6+ , arc c5 resRdfRest resRdfNil , arc b4 p1 o1 , arc b4 p2 o1 , arc b5 p1 o2@@ -552,11 +591,11 @@ -- Troublesome example x17 :: RDFGraph-x17 = toGraph [ arc s1 res_rdf_type o1- , arc s1 res_rdf_first b1- , arc s1 res_rdf_rest c1- , arc c1 res_rdf_first b2- , arc c1 res_rdf_rest res_rdf_nil+x17 = toGraph [ arc s1 resRdfType o1+ , arc s1 resRdfFirst b1+ , arc s1 resRdfRest c1+ , arc c1 resRdfFirst b2+ , arc c1 resRdfRest resRdfNil , arc b1 p21 o2 , arc b1 p22 c2@@ -564,10 +603,10 @@ , arc b2 p24 o3 , arc b2 p25 l13 - , arc c2 res_rdf_first b3- , arc c2 res_rdf_rest c3- , arc c3 res_rdf_first l12- , arc c3 res_rdf_rest res_rdf_nil+ , arc c2 resRdfFirst b3+ , arc c2 resRdfRest c3+ , arc c3 resRdfFirst l12+ , arc c3 resRdfRest resRdfNil , arc b3 p23 l11 ]@@ -576,36 +615,36 @@ graph_c1, graph_c1rev, graph_c2, graph_c2rev, graph_c3 :: RDFGraph-graph_c1 = toGraph [arc s1 p1 res_rdf_nil]-graph_c1rev = toGraph [arc res_rdf_nil p1 o1]+graph_c1 = toGraph [arc s1 p1 resRdfNil]+graph_c1rev = toGraph [arc resRdfNil p1 o1] graph_c2 = toGraph [arc s1 p1 b1,- arc b1 res_rdf_first l1,- arc b1 res_rdf_rest b2,- arc b2 res_rdf_first o2,- arc b2 res_rdf_rest b3,- arc b3 res_rdf_first l2,- arc b3 res_rdf_rest b4,- arc b4 res_rdf_first o3,- arc b4 res_rdf_rest res_rdf_nil]-graph_c2rev = toGraph [arc b1 res_rdf_first l1,- arc b1 res_rdf_rest b2,- arc b2 res_rdf_first o2,- arc b2 res_rdf_rest b3,- arc b3 res_rdf_first l2,- arc b3 res_rdf_rest b4,- arc b4 res_rdf_first o3,- arc b4 res_rdf_rest res_rdf_nil,+ arc b1 resRdfFirst l1,+ arc b1 resRdfRest b2,+ arc b2 resRdfFirst o2,+ arc b2 resRdfRest b3,+ arc b3 resRdfFirst l2,+ arc b3 resRdfRest b4,+ arc b4 resRdfFirst o3,+ arc b4 resRdfRest resRdfNil]+graph_c2rev = toGraph [arc b1 resRdfFirst l1,+ arc b1 resRdfRest b2,+ arc b2 resRdfFirst o2,+ arc b2 resRdfRest b3,+ arc b3 resRdfFirst l2,+ arc b3 resRdfRest b4,+ arc b4 resRdfFirst o3,+ arc b4 resRdfRest resRdfNil, arc b1 p1 o1] graph_c3 = toGraph [arc s1 p1 b1,- arc b1 res_rdf_first l1,- arc b1 res_rdf_rest b2,- arc b2 res_rdf_first o2,- arc b2 res_rdf_rest b3,- arc b3 res_rdf_first l2,- arc b3 res_rdf_rest b4,- arc b4 res_rdf_first o3,- arc b4 res_rdf_rest res_rdf_nil,- arc s1 p2 res_rdf_nil,+ arc b1 resRdfFirst l1,+ arc b1 resRdfRest b2,+ arc b2 resRdfFirst o2,+ arc b2 resRdfRest b3,+ arc b3 resRdfFirst l2,+ arc b3 resRdfRest b4,+ arc b4 resRdfFirst o3,+ arc b4 resRdfRest resRdfNil,+ arc s1 p2 resRdfNil, arc s2 p2 o2] -- bnode graphs@@ -625,11 +664,11 @@ arc b1 o2 o3, arc s1 p2 b2, arc s2 p2 o2]-graph_b4 = toRDFGraph [arc b1 res_rdf_type o1,- arc b2 res_rdf_type o2]-graph_b5 = toRDFGraph [arc b1 res_rdf_type o1,+graph_b4 = toRDFGraph [arc b1 resRdfType o1,+ arc b2 resRdfType o2]+graph_b5 = toRDFGraph [arc b1 resRdfType o1, arc b2 p2 o2,- arc b3 res_rdf_type o3]+ arc b3 resRdfType o3] -- datatype/literal graphs @@ -656,7 +695,7 @@ -} in toRDFGraph arcs -graph_l4 = toGraph [ toRDFTriple s1 p1 "A string with \"quotes\""+graph_l4 = toGraph [ toRDFTriple s1 p1 ("A string with \"quotes\"" :: RDFLabel) , toRDFTriple s2 p2 (Lit "A typed string with \"quotes\"" (Just (fromString "urn:a#b"))) ] @@ -667,97 +706,91 @@ -- These are very basic tests that confirm that output for a -- simple graph corresponds exactly to some supplied string. -formatTest :: String -> RDFGraph -> String -> Test+formatTest :: String -> RDFGraph -> B.Builder -> Test formatTest lab gr out = TestList- [ TestCase ( assertEqual ("formatTest:"++lab) out res )+ [ TestCase ( assertEqual ("formatTest:"++lab) outTxt res ) ] where- res = formatGraphAsStringNl gr+ outTxt = B.toLazyText out+ res = formatGraphAsLazyText gr -diagTest :: String -> RDFGraph -> String -> Test+diagTest :: String -> RDFGraph -> L.Text -> Test diagTest lab gr out = TestList- [ TestCase ( assertEqual ("diag:text:"++lab) out (res "") )+ [ TestCase ( assertEqual ("diag:text:"++lab) out resTxt ) , TestCase ( assertEqual ("diag:map:"++lab) emptyLookupMap nmap ) , TestCase ( assertEqual ("diag:gen:"++lab) 0 ngen ) , TestCase ( assertEqual ("diag:trc:"++lab) [] trc ) ] where- (res,nmap,ngen,trc) = formatGraphDiag gr+ (res,nmap,ngen,trc) = formatGraphDiag "\n" True gr+ resTxt = B.toLazyText res -mkPrefix :: String -> Namespace -> String-mkPrefix lbl ns = "@prefix " ++ lbl ++ ": <" ++ nsURI ns ++ "> .\n"+mkPrefix :: Namespace -> B.Builder+mkPrefix = namespaceToBuilder -prefixList :: [String]+prefixList :: [B.Builder] prefixList = - [ mkPrefix "base1" base1- , mkPrefix "base2" base2- , mkPrefix "base3" base3- , mkPrefix "base4" base4- , mkPrefix "rdf" namespaceRDF- , mkPrefix "xsd" namespaceXSD+ [ mkPrefix base1+ , mkPrefix base2+ , mkPrefix base3+ , mkPrefix base4+ , mkPrefix namespaceRDF+ , mkPrefix namespaceXSD ] -commonPrefixes :: String-commonPrefixes = commonPrefixesN [0..3]--commonPrefixesN :: [Int] -> String-commonPrefixesN = concatMap (prefixList !!)--commonPrefixes21 :: String-commonPrefixes21 = concatMap (prefixList !!) [1, 0]+commonPrefixesN :: [Int] -> B.Builder+commonPrefixesN = mconcat . map (prefixList !!) -commonPrefixes321 :: String-commonPrefixes321 = concatMap (prefixList !!) [2, 1, 0]+commonPrefixes :: B.Builder+commonPrefixes = commonPrefixesN [0..3] -commonPrefixes132 :: String-commonPrefixes132 = concatMap (prefixList !!) [0, 2, 1]+commonPrefixes21, commonPrefixes321, commonPrefixes132 :: B.Builder+commonPrefixes21 = commonPrefixesN [1,0]+commonPrefixes321 = commonPrefixesN [2,1,0]+commonPrefixes132 = commonPrefixesN [0,2,1] -- Single statement using <uri> form -simpleN3Graph_g1_01 :: String+simpleN3Graph_g1_01 :: B.Builder simpleN3Graph_g1_01 =- "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> " ++- "<http://id.ninebynine.org/wip/2003/test/graph1/node#p1> " ++- "<http://id.ninebynine.org/wip/2003/test/graph1/node#o1> .\n"+ "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> <http://id.ninebynine.org/wip/2003/test/graph1/node#p1> <http://id.ninebynine.org/wip/2003/test/graph1/node#o1> .\n" -- Single statement using prefix:name form-simpleN3Graph_g1_02 :: String+simpleN3Graph_g1_02 :: B.Builder simpleN3Graph_g1_02 =- commonPrefixes +++ commonPrefixes `mappend` "base1:s1 base1:p1 base1:o1 .\n" -- Single blank node-simpleN3Graph_g1_03 :: String+simpleN3Graph_g1_03 :: B.Builder simpleN3Graph_g1_03 =- commonPrefixes +++ commonPrefixes `mappend` "[\n base1:p1 base1:o1\n] .\n"- -- "_:b1 base1:p1 base1:o1 .\n" -- Single auto-allocated blank node-simpleN3Graph_g1_04 :: String+simpleN3Graph_g1_04 :: B.Builder simpleN3Graph_g1_04 =- commonPrefixes +++ commonPrefixes `mappend` "[\n base1:p1 base1:o1\n] .\n"- -- "_:_1 base1:p1 base1:o1 .\n" -- Single literal object-simpleN3Graph_g1_05 :: String+simpleN3Graph_g1_05 :: B.Builder simpleN3Graph_g1_05 =- commonPrefixes +++ commonPrefixes `mappend` "base1:s1 base1:p1 \"l1\" .\n" -- Single multiline literal object-simpleN3Graph_g1_06 :: String+simpleN3Graph_g1_06 :: B.Builder simpleN3Graph_g1_06 =- commonPrefixes +++ commonPrefixes `mappend` "base1:s1 base1:p1 \"l2-'\\\"line1\\\"'\\n\\nl2-'\\\"\\\"line2\\\"\\\"'\" .\n" -- this 'round trips' into a triple-quoted string-simpleN3Graph_g1_06_rt :: String+simpleN3Graph_g1_06_rt :: B.Builder simpleN3Graph_g1_06_rt =- commonPrefixes +++ commonPrefixes `mappend` "base1:s1 base1:p1 \"\"\"l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'\"\"\" .\n" {-@@ -773,39 +806,57 @@ -} -- Single statement with formula blank node-simpleN3Graph_g1_08 :: String+simpleN3Graph_g1_08 :: B.Builder simpleN3Graph_g1_08 =- commonPrefixes ++- "base1:s1 base1:p1 { \n"++- " base1:s1 base1:p1 base1:o1\n"++- " } .\n"- + mconcat+ [ commonPrefixes+ , "base1:s1 base1:p1 { \n"+ , " base1:s1 base1:p1 base1:o1\n"+ , " } .\n"+ ]+ -- Three blank nodes (or is that blind mice?)-simpleN3Graph_g1_09 :: String+simpleN3Graph_g1_09 :: B.Builder simpleN3Graph_g1_09 =- commonPrefixes +++ commonPrefixes `mappend` "[\n _:b2 []\n] .\n"- -- "_:b1 _:b2 _:b3 .\n" -- Simple nested formula case-simpleN3Graph_g1_10 :: String+simpleN3Graph_g1_10 :: B.Builder simpleN3Graph_g1_10 =- commonPrefixes ++- "base1:s1 base1:p1 { \n" ++- " base1:s1 base1:p1 { \n" ++- " base1:s1 base1:p1 base1:o1\n" ++- " } \n" ++- " } .\n"+ mconcat+ [ commonPrefixes + , "base1:s1 base1:p1 { \n" + , " base1:s1 base1:p1 { \n" + , " base1:s1 base1:p1 base1:o1\n" + , " } \n" + , " } .\n"+ ] +-- try out URIs that do not use the http scheme+simpleN3Graph_g1_fu1 :: B.Builder+simpleN3Graph_g1_fu1 =+ mconcat+ [ "@prefix me: <http://example.com/ns#> .\n"+ , "@prefix : <file:///home/swish/photos/> .\n"+ -- , ":me.png me:depicts me:me ;\n"+ , "<file:///home/swish/photos/me.png> me:depicts me:me ;\n"+ , " me:hasURN <urn:one:two:3.14> .\n"+ ]+ {- Simple troublesome case -} -simpleN3Graph_x13a :: String+simpleN3Graph_x13a :: B.Builder simpleN3Graph_x13a =- commonPrefixes ++- "base1:s1 <http://www.w3.org/1999/02/22-rdf-syntax-ns#first> " ++ b1s ++ " ;\n"++- " <http://www.w3.org/1999/02/22-rdf-syntax-ns#rest> ( " ++ b2s ++ " " ++ b3s ++ " ) .\n"+ mconcat+ [ commonPrefixes + , "base1:s1 <http://www.w3.org/1999/02/22-rdf-syntax-ns#first> " + , b1s+ , " ;\n"+ , " <http://www.w3.org/1999/02/22-rdf-syntax-ns#rest> ( ", b2s, " ", b3s, " ) .\n"+ ] where b1s = "[\n base1:p1 base1:o1\n]" b2s = "[\n base1:p1 base2:o2\n]"@@ -816,108 +867,127 @@ previous tests. -} -simpleN3Graph_c1 :: String+simpleN3Graph_c1 :: B.Builder simpleN3Graph_c1 =- commonPrefixes +++ commonPrefixes `mappend` "base1:s1 base1:p1 () .\n" -simpleN3Graph_c1rev :: String+simpleN3Graph_c1rev :: B.Builder simpleN3Graph_c1rev =- commonPrefixes +++ commonPrefixes `mappend` "() base1:p1 base1:o1 .\n" -collItems :: String-collItems = "( \"l1\" base2:o2 \"\"\"" ++ l2txt ++ "\"\"\" base3:o3 )"+collItems :: B.Builder+collItems = + mconcat+ [ "( \"l1\" base2:o2 \"\"\""+ , l2txt+ , "\"\"\" base3:o3 )" ] -simpleN3Graph_c2 :: String+simpleN3Graph_c2 :: B.Builder simpleN3Graph_c2 =- commonPrefixes ++- "base1:s1 base1:p1 " ++ collItems ++ " .\n"+ mconcat+ [ commonPrefixes+ , "base1:s1 base1:p1 "+ , collItems+ , " .\n" ] -simpleN3Graph_c2rev :: String+simpleN3Graph_c2rev :: B.Builder simpleN3Graph_c2rev =- commonPrefixes ++- collItems ++ " base1:p1 base1:o1 .\n"+ mconcat+ [ commonPrefixes + , collItems, " base1:p1 base1:o1 .\n" ] -simpleN3Graph_c3 :: String+simpleN3Graph_c3 :: B.Builder simpleN3Graph_c3 =- commonPrefixes ++- "base1:s1 base1:p1 " ++ collItems ++ " ;\n" ++- " base2:p2 () .\n" ++- "base2:s2 base2:p2 base2:o2 .\n"+ mconcat+ [ commonPrefixes+ , "base1:s1 base1:p1 ", collItems, " ;\n"+ , " base2:p2 () .\n"+ , "base2:s2 base2:p2 base2:o2 .\n" ] {- Simple bnode tests; may replicate some of the previous tests. -} -simpleN3Graph_b1 :: String+simpleN3Graph_b1 :: B.Builder simpleN3Graph_b1 =- head prefixList +++ commonPrefixesN [0] `mappend` "base1:s1 base1:p1 [] .\n" -simpleN3Graph_b1rev :: String+simpleN3Graph_b1rev :: B.Builder simpleN3Graph_b1rev =- head prefixList ++- "[\n base1:p1 base1:o1\n] .\n"+ commonPrefixesN [0] `mappend`+ "[\n base1:p1 base1:o1\n] .\n" -simpleN3Graph_b2 :: String+simpleN3Graph_b2 :: B.Builder simpleN3Graph_b2 =- commonPrefixesN [2,1,0] ++- "base1:s1 base1:p1 [\n base2:o2 base3:o3 ;\n base2:p2 \"l1\"\n] .\n"+ commonPrefixesN [2,1,0] `mappend`+ "base1:s1 base1:p1 [\n base2:o2 base3:o3 ;\n base2:p2 \"l1\"\n] .\n" -simpleN3Graph_b2rev :: String+simpleN3Graph_b2rev :: B.Builder simpleN3Graph_b2rev =- commonPrefixesN [0,2,1] ++- "[\n base1:p1 base1:o1 ;\n base2:o2 base3:o3 ;\n base2:p2 \"l1\"\n] .\n"+ commonPrefixesN [0,2,1] `mappend`+ "[\n base1:p1 base1:o1 ;\n base2:o2 base3:o3 ;\n base2:p2 \"l1\"\n] .\n" -simpleN3Graph_b3 :: String+simpleN3Graph_b3 :: B.Builder simpleN3Graph_b3 =- commonPrefixesN [2,1,0] ++- "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"+ mconcat+ [ commonPrefixesN [2,1,0]+ , "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_b4 :: String+simpleN3Graph_b4 :: B.Builder simpleN3Graph_b4 =- commonPrefixesN [1,0,4] ++- "[\n a base1:o1\n] .\n" ++ - "[\n a base2:o2\n] .\n"+ mconcat+ [ commonPrefixesN [1,0,4]+ , "[\n a base1:o1\n] .\n"+ , "[\n a base2:o2\n] .\n" ] -simpleN3Graph_b5 :: String+simpleN3Graph_b5 :: B.Builder simpleN3Graph_b5 =- commonPrefixesN [2,1,0,4] ++- "[\n a base1:o1\n] .\n" ++ - "[\n base2:p2 base2:o2\n] .\n" ++- "[\n a base3:o3\n] .\n"+ mconcat+ [ commonPrefixesN [2,1,0,4]+ , "[\n a base1:o1\n] .\n"+ , "[\n base2:p2 base2:o2\n] .\n"+ , "[\n a base3:o3\n] .\n" ] {- Simple datatype/language tests; may replicate some of the previous tests. -}-simpleN3Graph_l1 :: String+simpleN3Graph_l1 :: B.Builder simpleN3Graph_l1 =- commonPrefixes +++ commonPrefixes `mappend` "base1:s1 base1:p1 \"chat et chien\"@fr .\n" -simpleN3Graph_l2 :: String+simpleN3Graph_l2 :: B.Builder simpleN3Graph_l2 =- commonPrefixes +++ commonPrefixes `mappend` "base1:s1 base1:p1 \"foo bar\"^^base1:o1 .\n" -simpleN3Graph_l3 :: String+simpleN3Graph_l3 :: B.Builder simpleN3Graph_l3 =- commonPrefixesN [5,0] ++- "\n" ++ -- TODO: why do we need this newline?- "base1:s1 base1:p1 \"2.34E1\"^^xsd:float,\n" ++ + mconcat+ [ commonPrefixesN [5,0]+ , "\n" -- TODO: why do we need this newline?+ , "base1:s1 base1:p1 \"2.34E1\"^^xsd:float,\n"+ , " -2.304e-108,\n" + , " 12, true .\n" ]++{- " -2.304e-108,\n" ++ " 12, true .\n"+-} -simpleN3Graph_l4 :: String+simpleN3Graph_l4 :: B.Builder simpleN3Graph_l4 =- commonPrefixes ++- "base1:s1 base1:p1 \"\"\"A string with \"quotes\\\"\"\"\" .\n" ++- "base2:s2 base2:p2 \"\"\"A typed string with \"quotes\\\"\"\"\"^^<urn:a#b> .\n"+ mconcat + [ commonPrefixes+ , "base1:s1 base1:p1 \"\"\"A string with \"quotes\\\"\"\"\" .\n" + , "base2:s2 base2:p2 \"\"\"A typed string with \"quotes\\\"\"\"\"^^<urn:a#b> .\n" ] trivialTestSuite :: Test trivialTestSuite = TestList@@ -932,6 +1002,7 @@ , formatTest "trivialTest09" g1b3 simpleN3Graph_g1_09 , formatTest "trivialTest10" g1f3 simpleN3Graph_g1_10 , formatTest "trivialTest13a" x13a simpleN3Graph_x13a+ , formatTest "trivialTestfu1" g1fu1 simpleN3Graph_g1_fu1 , formatTest "trivialTestc1" graph_c1 simpleN3Graph_c1 , formatTest "trivialTestc2" graph_c2 simpleN3Graph_c2@@ -962,16 +1033,16 @@ -- Parser tests to cross-check round-trip testing ------------------------------------------------------------ -parseTest :: String -> String -> RDFGraph -> String -> Test+parseTest :: String -> B.Builder -> RDFGraph -> String -> Test parseTest lab inp gr er = TestList [ TestCase ( assertEqual ("parseTestError:"++lab) er pe ) , TestCase ( assertEqual ("parseTestGraph:"++lab) gr pg ) ] where- (pe,pg) = case parseN3fromString inp of- Right g -> ("",g)- Left s -> (s,emptyRDFGraph)+ (pe,pg) = case parseN3 (B.toLazyText inp) Nothing of+ Right g -> ("", g)+ Left s -> (s, emptyRDFGraph) noError, errorText :: String noError = ""@@ -1007,15 +1078,15 @@ -- , TestCase ( assertEqual ("Formatted:"++lab) "" out ) ] where- out = formatGraphAsString gr- (pe,pg) = case parseN3fromString out of+ out = formatGraphAsLazyText gr+ (pe,pg) = case parseN3 out Nothing of Right g -> ("", g) Left s -> (s, mempty) -- Full round trip from graph source. This test may pick up some errors -- the bnode generation logic that are not tested by hand-assembled graph -- data structures.-fullRoundTripTest :: String -> String -> Test+fullRoundTripTest :: String -> B.Builder -> Test fullRoundTripTest lab grstr = TestList [ TestCase ( assertEqual ("FullRoundTrip:gr:"++lab) gr pg )@@ -1023,13 +1094,16 @@ -- , TestCase ( assertEqual ("FullRoundTrip:"++lab) "" out ) ] where- (_,gr) = case parseN3fromString grstr of- Right g -> ("", g)- Left s -> (s, mempty)- out = formatGraphAsString gr- (pe,pg) = case parseN3fromString out of- Right g -> ("", g)- Left s -> (s, mempty)+ grtxt = B.toLazyText grstr+ + (_,gr) = case parseN3 grtxt Nothing of+ Right g -> ("", g)+ Left s -> (s, mempty)+ + out = formatGraphAsLazyText gr+ (pe,pg) = case parseN3 out Nothing of+ Right g -> ("", g)+ Left s -> (s, mempty) roundTripTestSuite :: Test roundTripTestSuite = TestList@@ -1055,6 +1129,7 @@ , fullRoundTripTest "16rt" simpleN3Graph_g1_06_rt -- roundTripTest17 = fullRoundTripTest "17" simpleN3Graph_g1_07 -- TODO: :- with named node for formula , fullRoundTripTest "18" simpleN3Graph_g1_08+ , fullRoundTripTest "fu1" simpleN3Graph_g1_fu1 , fullRoundTripTest "l1" simpleN3Graph_l1 , fullRoundTripTest "l2" simpleN3Graph_l2@@ -1108,46 +1183,49 @@ -- , TestCase ( assertEqual ("ExoticTest:"++lab) "" out ) ] where- out = formatGraphAsString gr- (pe,pg) = case parseN3fromString out of- Right g -> ("",g)- Left s -> (s,emptyRDFGraph)+ out = formatGraphAsLazyText gr+ (pe,pg) = case parseN3 out Nothing of+ Right g -> ("", g)+ Left s -> (s, mempty) -- Simple anon nodes, with semicolons and commas-exoticN3Graph_x1 :: String+exoticN3Graph_x1 :: B.Builder exoticN3Graph_x1 =- commonPrefixes ++- " [ base1:p1 base1:o1 ; \n" ++- " base1:p1 base2:o2 ; \n" ++- " base2:p2 base2:o2 ; \n" ++- " base2:p2 base3:o3 ] = base1:s1 . \n" ++- " base2:s2 = \n" ++- " [ base1:p1 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ; \n" ++- " base2:p2 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"\"\"" ++ l2txt ++ "\"\"\" ] . \n"+ mconcat+ [ commonPrefixes+ , " [ base1:p1 base1:o1 ; \n"+ , " base1:p1 base2:o2 ; \n"+ , " base2:p2 base2:o2 ; \n"+ , " base2:p2 base3:o3 ] = base1:s1 . \n"+ , " base2:s2 = \n"+ , " [ base1:p1 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ; \n"+ , " base2:p2 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"\"\"", l2txt, "\"\"\" ] . \n"+ ] -- Simple anon nodes, with 'is ... of' and semicolons and commas-exoticN3Graph_x2 :: String+exoticN3Graph_x2 :: B.Builder exoticN3Graph_x2 =- commonPrefixes ++- " [ @has base1:p1 base1:o1 ; \n" ++- " @is base1:p1 @of base2:o2 ; \n" ++- " @has base2:p2 base2:o2 ; \n" ++- " @is base2:p2 @of base3:o3 ] = base1:s1 . \n" ++- " base2:s2 = \n" ++- " [ @has base1:p1 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ; \n" ++- " @is base2:p2 @of base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 ] . \n"- -- " \"l1\" ] . \n"+ mconcat+ [ commonPrefixes+ , " [ @has base1:p1 base1:o1 ; \n"+ , " @is base1:p1 @of base2:o2 ; \n"+ , " @has base2:p2 base2:o2 ; \n"+ , " @is base2:p2 @of base3:o3 ] = base1:s1 . \n"+ , " base2:s2 = \n"+ , " [ @has base1:p1 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ; \n"+ , " @is base2:p2 @of base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 ] . \n"+ ] -- Simple anon nodes, attached to identified node {-@@ -1171,14 +1249,14 @@ -- List nodes, with and without :- -exoticN3Graph_x4 :: String+exoticN3Graph_x4 :: B.Builder exoticN3Graph_x4 =- commonPrefixes +++ commonPrefixes `mappend` "base1:s1 = ( base1:o1 base2:o2 base3:o3 \"l1\" ) .\n" -exoticN3Graph_x5 :: String+exoticN3Graph_x5 :: B.Builder exoticN3Graph_x5 =- commonPrefixes +++ commonPrefixes `mappend` "( base1:o1 base2:o2 base3:o3 \"l1\" ) = base1:s1 .\n" {-@@ -1189,24 +1267,28 @@ -- Formula nodes -exoticN3Graph_x7 :: String+exoticN3Graph_x7 :: B.Builder exoticN3Graph_x7 =- commonPrefixes ++- " { \n" ++- " base1:s1 base1:p1 base1:o1 .\n" ++- " base2:s2 base1:p1 base2:o2 .\n" ++- " base3:s3 base1:p1 base3:o3\n" ++- " } base2:p2 base2:f2 .\n"-+ mconcat+ [ commonPrefixes+ , " { \n"+ , " base1:s1 base1:p1 base1:o1 .\n"+ , " base2:s2 base1:p1 base2:o2 .\n"+ , " base3:s3 base1:p1 base3:o3\n"+ , " } base2:p2 base2:f2 .\n"+ ]+ -- as above with the trailing . in the formula-exoticN3Graph_x7a :: String+exoticN3Graph_x7a :: B.Builder exoticN3Graph_x7a =- commonPrefixes ++- " { \n" ++- " base1:s1 base1:p1 base1:o1 .\n" ++- " base2:s2 base1:p1 base2:o2 .\n" ++- " base3:s3 base1:p1 base3:o3 .\n" ++- " } base2:p2 base2:f2 ."+ mconcat + [ commonPrefixes + , " { \n"+ , " base1:s1 base1:p1 base1:o1 .\n"+ , " base2:s2 base1:p1 base2:o2 .\n"+ , " base3:s3 base1:p1 base3:o3 .\n"+ , " } base2:p2 base2:f2 ."+ ] {- exoticN3Graph_x8 =@@ -1227,14 +1309,16 @@ -} -- Test allocation of bnodes over a nested formula-exoticN3Graph_x12 :: String+exoticN3Graph_x12 :: B.Builder exoticN3Graph_x12 =- commonPrefixes ++- " base1:s1 base1:p1 [ base1:p1 base1:o1 ] . \n" ++- " { base2:s2 base2:p2 [ base2:p2 base2:o2 ] . } \n" ++- " base2:p2 base2:f2 . \n" ++- " base3:s3 base3:p3 [ base3:p3 base3:o3 ] ."-+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 [ base1:p1 base1:o1 ] . \n"+ , " { base2:s2 base2:p2 [ base2:p2 base2:o2 ] . } \n"+ , " base2:p2 base2:f2 . \n"+ , " base3:s3 base3:p3 [ base3:p3 base3:o3 ] ."+ ]+ -- List of bnodes {- exoticN3Graph_x13 =@@ -1267,14 +1351,16 @@ " [base1:p1 base2:o2; base2:p2 base2:o2] \n" ++ " [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n" -}-exoticN3Graph_x14 :: String+exoticN3Graph_x14 :: B.Builder exoticN3Graph_x14 =- commonPrefixes ++- " base1:s1 = \n" ++- " ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" ++- " [base1:p1 base2:o2; base2:p2 base2:o2] \n" ++- " [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"-+ mconcat+ [ commonPrefixes+ , " base1:s1 = \n"+ , " ( [base1:p1 base1:o1; base2:p2 base1:o1] \n"+ , " [base1:p1 base2:o2; base2:p2 base2:o2] \n"+ , " [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"+ ]+ -- List with nested list {- exoticN3Graph_x15 =
tests/N3ParserTest.hs view
@@ -1,1409 +1,1489 @@------------------------------------------------------------------------------------ See end of this file for licence information.------------------------------------------------------------------------------------ |--- Module : N3ParserTest--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke--- License : GPL V2------ Maintainer : Douglas Burke--- Stability : experimental--- Portability : H98------ This Module contains test cases for module "N3Parser".--------------------------------------------------------------------------------------module Main where--import Swish.RDF.N3Parser- ( parseN3fromString, parseN3- , parseTextFromString, parseAltFromString- , parseNameFromString, parsePrefixFromString- , parseAbsURIrefFromString, parseLexURIrefFromString- , parseURIref2FromString- )--import Swish.RDF.RDFGraph- ( RDFGraph, RDFLabel(..), NSGraph(..)- , LookupFormula(..)- , emptyRDFGraph, toRDFGraph- , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil- , res_owl_sameAs, res_log_implies- )--import Swish.Utils.Namespace- ( Namespace(..)- , nullNamespace- , ScopedName(..)- , makeScopedName- , nullScopedName- , makeUriScopedName- )--import Swish.RDF.Vocabulary- ( namespaceRDF- , langName- , rdf_XMLLiteral- , xsd_boolean - , xsd_integer- , xsd_decimal - , xsd_double - )--import Swish.Utils.QName (QName, qnameFromURI)-import Swish.Utils.LookupMap (LookupMap(..))--import Swish.RDF.GraphClass (Arc, arc) --import Test.HUnit (Test(TestCase,TestList), assertEqual, runTestTT)--import Data.Monoid (Monoid(..))-import Data.List (intercalate)----------------------------------------------------------------- Generic item parsing test wrapper---------------------------------------------------------------type ParseFromString a = String -> Either String a--parseItemTest :: (Eq a, Show a) => ParseFromString a -> a- -> String -> String -> a -> String -> Test-parseItemTest ifroms def lab inp val err =- TestList- [ TestCase ( assertEqual ("parseItemError:"++lab) fixerr pe )- , TestCase ( assertEqual ("parseItemValue:"++lab) val pv )- ]- where- (pe,pv) = case ifroms inp of- Left e -> (e,def)- Right v -> (noError,v)- fixerr = if err /= noError then pe else noError--noError, errorText :: String-noError = ""-errorText = "*"----------------------------------------------------------------- Common test wrappers---------------------------------------------------------------testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test-testLabelEq lab eq n1 n2 =- TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )--testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test-testGraphEq lab eq gg1 gg2 =- TestCase ( assertEqual ("testGraphEq:"++lab) eq (gg1==gg2) )--parseTest :: String -> String -> RDFGraph -> String -> Test-parseTest lab inp gr er =- TestList- [ TestCase ( assertEqual ("parseTestError:"++lab) er pe )- , TestCase ( assertEqual ("parseTestGraph:"++lab) gr pg )- ]- where- (pe,pg) = case parseN3fromString inp of- Right g -> ("",g)- Left s -> (s,emptyRDFGraph)--parseTestB :: QName -> String -> String -> RDFGraph -> String -> Test-parseTestB base lab inp gr er =- TestList- [ TestCase ( assertEqual ("parseTestError<base>:"++lab) er pe )- , TestCase ( assertEqual ("parseTestGraph<base>:"++lab) gr pg )- ]- where- (pe,pg) = case parseN3 inp (Just base) of- Right g -> ("",g)- Left s -> (s,emptyRDFGraph)----------------------------------------------------------------- Test simple character parsing---------------------------------------------------------------parseCharTest :: String -> String- -> String -> String -> String -> Test-parseCharTest c = parseItemTest (parseTextFromString c) ""--parseAltTest :: String -> String- -> String -> String -> String -> String -> Test-parseAltTest cc1 cc2 = parseItemTest (parseAltFromString cc1 cc2) ""--charInp01, char01 :: String-charInp01 = ":"-char01 = ":"--charInp02, char02 :: String-charInp02 = "<>"-char02 = "<>"--charInp03 :: String-charInp03 = "<="--charTestSuite :: Test-charTestSuite = TestList- [ parseCharTest char01 "parseCharTest01" charInp01 char01 noError- , parseCharTest char02 "parseCharTest02" charInp02 char02 noError- , parseAltTest char01 char02 "parseCharTest03" charInp01 char01 noError- , parseAltTest char01 char02 "parseCharTest04" charInp02 char02 noError- , parseAltTest char01 char02 "parseCharTest04" charInp03 "" errorText- ]----------------------------------------------------------------- Test simple name parsing---------------------------------------------------------------parseNameTest :: String -> String -> String -> String -> Test-parseNameTest = parseItemTest parseNameFromString ""--nameTestSuite :: Test-nameTestSuite = TestList- [ parseNameTest "parseNameTest01" "name" "name" ""- , parseNameTest "parseNameTest02" "rdf" "rdf" ""- ]----------------------------------------------------------------- Test simple prefix parsing---------------------------------------------------------------parsePrefixTest :: String -> String -> Namespace -> String -> Test-parsePrefixTest = parseItemTest parsePrefixFromString nullNamespace--prefix01, prefix02 :: Namespace-prefix01 = Namespace "pref" "pref:"-prefix02 = Namespace "rdf" $ nsURI namespaceRDF--prefixTestSuite :: Test-prefixTestSuite = TestList- [ parsePrefixTest "parsePrefixTest01" "pref" prefix01 ""- , parsePrefixTest "parsePrefixTest02" "rdf" prefix02 ""- ]----------------------------------------------------------------- Test absolute URIref parsing---------------------------------------------------------------parseAbsUriRefTest :: String -> String -> String -> String -> Test-parseAbsUriRefTest = parseItemTest parseAbsURIrefFromString ""--parseLexUriRefTest :: String -> String -> String -> String -> Test-parseLexUriRefTest = parseItemTest parseLexURIrefFromString ""--absUriRefInp01, absUriRefInp01s, absUriRef01 :: String-absUriRefInp01 = "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>"-absUriRefInp01s = "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type> "-absUriRef01 = "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"--absUriRefInp02, absUriRefInp02s, absUriRef02 :: String-absUriRefInp02 = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1>"-absUriRefInp02s = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "-absUriRef02 = "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"--absUriRefTestSuite :: Test-absUriRefTestSuite = TestList- [ parseAbsUriRefTest "parseAbsUriRefTest01" absUriRefInp01 absUriRef01 ""- , parseAbsUriRefTest "parseAbsUriRefTest02" absUriRefInp02 absUriRef02 ""- , parseLexUriRefTest "parseAbsUriRefTest03" absUriRefInp01s absUriRef01 ""- , parseLexUriRefTest "parseAbsUriRefTest04" absUriRefInp02s absUriRef02 ""- ]----------------------------------------------------------------- Test simple URIref parsing---------------------------------------------------------------parseUriRef2Test :: String -> String -> ScopedName -> String -> Test-parseUriRef2Test = parseItemTest parseURIref2FromString nullScopedName--uriRef01 :: String-uriRef01 = "rdf:type "--sname01 :: ScopedName-sname01 = ScopedName namespaceRDF "type"--uriRef02 :: String-uriRef02 = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "--sname02 :: ScopedName-sname02 =- makeScopedName "" "http://id.ninebynine.org/wip/2003/test/graph1/node#" "s1"--uriRef2TestSuite :: Test-uriRef2TestSuite = TestList- [ parseUriRef2Test "parseUriRef2Test01" uriRef01 sname01 ""- , parseUriRef2Test "parseUriRef2Test02" uriRef02 sname02 ""- ]----------------------------------------------------------------- Define some common values---------------------------------------------------------------baseFile :: String-baseFile = "file:///dev/null"--dqn :: QName-dqn = qnameFromURI baseFile--dbase, base1, base2, base3, base4, basea :: Namespace-dbase = Namespace "" (baseFile ++ "#")-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"-basea = Namespace "a" "http://example.org/basea#"--xsdNS :: Namespace-xsdNS = Namespace "xsd" "http://www.w3.org/2001/XMLSchema#"--u1 :: RDFLabel-u1 = Res $ ScopedName base1 ""--ds1, ds2, ds3 :: RDFLabel-ds1 = Res $ ScopedName dbase "s1"-ds2 = Res $ ScopedName dbase "s2"-ds3 = Res $ ScopedName dbase "s3"--dp1, dp2, dp3 :: RDFLabel-dp1 = Res $ ScopedName dbase "p1"-dp2 = Res $ ScopedName dbase "p2"-dp3 = Res $ ScopedName dbase "p3"--do1, do2, do3 :: RDFLabel-do1 = Res $ ScopedName dbase "o1"-do2 = Res $ ScopedName dbase "o2"-do3 = Res $ ScopedName dbase "o3"--s1, s2, s3, sa :: RDFLabel-s1 = Res $ ScopedName base1 "s1"-s2 = Res $ ScopedName base2 "s2"-s3 = Res $ ScopedName base3 "s3"-sa = Res $ ScopedName basea "a"--b1, b2, b3, b4, b5, b6, b7, b8 :: RDFLabel-b1 = Blank "b1"-b2 = Blank "b2"-b3 = Blank "b3"-b4 = Blank "b4"-b5 = Blank "b5"-b6 = Blank "b6"-b7 = Blank "b7"-b8 = Blank "b8"--c1, c2, c3, c4, c5, c6 :: RDFLabel-c1 = Blank "c1"-c2 = Blank "c2"-c3 = Blank "c3"-c4 = Blank "c4"-c5 = Blank "c5"-c6 = Blank "c6"--p1, p2, p3, pa :: RDFLabel-p1 = Res $ ScopedName base1 "p1" -p2 = Res $ ScopedName base2 "p2" -p3 = Res $ ScopedName base3 "p3" -pa = Res $ ScopedName basea "b" --o1, o2, o3, oa :: RDFLabel-o1 = Res $ ScopedName base1 "o1"-o2 = Res $ ScopedName base2 "o2"-o3 = Res $ ScopedName base3 "o3"-oa = Res $ ScopedName basea "c"--l1, l2, l3 :: RDFLabel-l1 = Lit "l1" Nothing-l2 = Lit "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'" Nothing-l3 = Lit "l3--\r\"'\\--\x0020\&--\x00A0\&--" Nothing--lfr, lxml, lfrxml :: RDFLabel-lfr = Lit "chat" $ Just $ langName "fr"-lxml = Lit "<br/>" $ Just rdf_XMLLiteral-lfrxml = Lit "<em>chat</em>" $ Just rdf_XMLLiteral--bTrue, bFalse :: RDFLabel-bTrue = Lit "true" $ Just xsd_boolean-bFalse = Lit "false" $ Just xsd_boolean--f1, f2 :: RDFLabel-f1 = Res $ ScopedName base1 "f1"-f2 = Res $ ScopedName base2 "f2" --v1, v2, v3, v4 :: RDFLabel-v1 = Var "var1"-v2 = Var "var2"-v3 = Var "var3"-v4 = Var "var4"----------------------------------------------------------------- Construct graphs for testing---------------------------------------------------------------t01 , t01b, t02, t03, t04, t05, t06, t07 :: Arc RDFLabel-t01 = arc s1 p1 o1-t01b = arc b1 b2 b3-t02 = arc s2 p1 o2-t03 = arc s3 p1 o3-t04 = arc s1 p1 l1-t05 = arc s2 p1 b1-t06 = arc s3 p1 l2-t07 = arc s3 p2 l3--makeNewPrefixNamespace :: (String,Namespace) -> Namespace-makeNewPrefixNamespace (pre,ns) = Namespace pre (nsURI ns)--dg1 :: RDFGraph-dg1 = toRDFGraph [arc ds1 dp1 do1]--dg2 :: RDFGraph-dg2 = toRDFGraph- [ arc xa1 xb1 xc1- , arc xa2 xb2 xc2- , arc xa3 xb3 xc3- , arc xa4 xb4 xc4- , arc xa5 xb5 xc5- ]- where- -- the document base is set to file:///dev/null to begin with- mU = Res . makeUriScopedName - xa1 = mU "file:///dev/a1"- xb1 = mU "file:///dev/b1"- xc1 = mU "file:///dev/c1"- xa2 = mU "http://example.org/ns/a2"- xb2 = mU "http://example.org/ns/b2"- xc2 = mU "http://example.org/ns/c2"- xa3 = mU "http://example.org/ns/foo/a3"- xb3 = mU "http://example.org/ns/foo/b3"- xc3 = mU "http://example.org/ns/foo/c3"- - ns4 = Namespace "" "http://example.org/ns/foo/bar#"- ns5 = Namespace "" "http://example.org/ns2#"- mUN a b = Res (ScopedName a b)- xa4 = mUN ns4 "a4"- xb4 = mUN ns4 "b4"- xc4 = mUN ns4 "c4"- xa5 = mUN ns5 "a5"- xb5 = mUN ns5 "b5"- xc5 = mUN ns5 "c5"--nslist, xnslist :: LookupMap Namespace-nslist = LookupMap $ map makeNewPrefixNamespace- [ ("base1",base1)- , ("base2",base2)- , ("base3",base3)- , ("base4",base4)- ]-xnslist = LookupMap $ map makeNewPrefixNamespace- [ ("base1",base1)- , ("base2",base2)- , ("base3",base3)- , ("base4",base4)- , ("xsd", xsdNS)- ]--toGraph :: [Arc RDFLabel] -> RDFGraph-toGraph stmts = mempty { namespaces = nslist- , statements = stmts- }--g1 :: RDFGraph-g1 = toGraph [t01]--g1a :: RDFGraph-g1a = toGraph [arc sa pa oa] --g1_31 :: RDFGraph-g1_31 = toGraph [arc u1 u1 u1]--g1b :: RDFGraph-g1b = toGraph [t01b]--g1b_1 :: RDFGraph-g1b_1 = toGraph [arc b1 p1 o1]--g2 :: RDFGraph-g2 = toGraph [t01,t02,t03]--g3 :: RDFGraph-g3 = toGraph [t01,t04]--g4 :: RDFGraph-g4 = toGraph [t01,t05]--g4_1 :: RDFGraph-g4_1 = toGraph [arc b1 p1 o1, arc b2 p2 o2]--g4_2 :: RDFGraph-g4_2 = toGraph [arc b1 res_rdf_type o1, arc b2 res_rdf_type o2]--g5 :: RDFGraph-g5 = toGraph [t01,t02,t03,t04,t05]--g6 :: RDFGraph-g6 = toGraph [t01,t06]--g7 :: RDFGraph-g7 = toGraph [t01,t07]--t801, t802, t807, t808, t811, t812 :: Arc RDFLabel-t801 = arc s1 res_rdf_type o1-t802 = arc s2 res_owl_sameAs o2-t807 = arc o1 p1 s1-t808 = arc s2 p1 o2-t811 = arc s1 res_log_implies o1-t812 = arc o2 res_log_implies s2--g8 :: RDFGraph-g8 = toGraph [t801,t802,t807,t808,t811,t812]--g81 :: RDFGraph-g81 = toGraph [t801,t802]--g83 :: RDFGraph-g83 = toGraph [t807,t808,t811,t812]--t911, t912, t913, t914, t921, t922, t923, t924,- t925, t926, t927, t928 :: Arc RDFLabel-t911 = arc s1 p1 o1-t912 = arc s1 p1 o2-t913 = arc s1 p2 o2-t914 = arc s1 p2 o3-t921 = arc s2 p1 o1-t922 = arc s2 p1 o2-t923 = arc s2 p1 o3-t924 = arc s2 p1 l1-t925 = arc s2 p2 o1-t926 = arc s2 p2 o2-t927 = arc s2 p2 o3-t928 = arc s2 p2 l1--g9 :: RDFGraph-g9 = toGraph [t911,t912,t913,t914,- t921,t922,t923,t924,- t925,t926,t927,t928]--t1011, t1012, t1013, t1014, t1021, t1022, t1023, t1024,- t1025, t1026, t1027, t1028 :: Arc RDFLabel-t1011 = arc s1 p1 o1-t1012 = arc o2 p1 s1-t1013 = arc s1 p2 o2-t1014 = arc o3 p2 s1-t1021 = arc s2 p1 o1-t1022 = arc s2 p1 o2-t1023 = arc s2 p1 o3-t1024 = arc s2 p1 l1-t1025 = arc o1 p2 s2-t1026 = arc o2 p2 s2-t1027 = arc o3 p2 s2-t1028 = arc l1 p2 s2--g10 :: RDFGraph-g10 = toGraph [t1011,t1012,t1013,t1014,- t1021,t1022,t1023,t1024,- t1025,t1026,t1027,t1028]--t1111, t1112, t1113 :: Arc RDFLabel-t1111 = arc s1 p1 v1-t1112 = arc v2 p1 o1-t1113 = arc v3 p1 v4--g11 :: RDFGraph-g11 = toGraph [t1111,t1112,t1113]--t1211, t1221, t1222, t1223, t1224 :: Arc RDFLabel-t1211 = arc b1 p1 o1-t1221 = arc b2 res_rdf_first v1-t1222 = arc b2 res_rdf_rest b3-t1223 = arc b3 res_rdf_first v2-t1224 = arc b3 res_rdf_rest res_rdf_nil--g12 :: RDFGraph-g12 = toGraph [t1211,t1221,t1222,t1223,t1224]--t1711, t1722, t1733 :: Arc RDFLabel-t1711 = arc s1 p1 lfr-t1722 = arc s2 p2 lxml-t1733 = arc s3 p3 lfrxml--g17 :: RDFGraph-g17 = toGraph [t1711,t1722,t1733]--tx101, tx102, tx111, tx112, tx113, tx114, tx121, tx122, tx123,- tx124, tx125, tx126, tx127, tx128 :: Arc RDFLabel-tx101 = arc b1 res_owl_sameAs s1-tx102 = arc s2 res_owl_sameAs b2-tx111 = arc b1 p1 o1-tx112 = arc b1 p1 o2-tx113 = arc b1 p2 o2-tx114 = arc b1 p2 o3-tx121 = arc b2 p1 o1-tx122 = arc b2 p1 o2-tx123 = arc b2 p1 o3-tx124 = arc b2 p1 l1-tx125 = arc b2 p2 o1-tx126 = arc b2 p2 o2-tx127 = arc b2 p2 o3-tx128 = arc b2 p2 l1--x1 :: RDFGraph-x1 = toGraph [tx101,tx102,- tx111,tx112,tx113,tx114,- tx121,tx122,tx123,tx124,- tx125,tx126,tx127,tx128]--tx201, tx202, tx211, tx212, tx213, tx214, tx221, tx222, tx223,- tx224, tx225, tx226, tx227, tx228 :: Arc RDFLabel-tx201 = arc b1 res_owl_sameAs s1-tx202 = arc s2 res_owl_sameAs b2-tx211 = arc b1 p1 o1-tx212 = arc o2 p1 b1-tx213 = arc b1 p2 o2-tx214 = arc o3 p2 b1-tx221 = arc b2 p1 o1-tx222 = arc b2 p1 o2-tx223 = arc b2 p1 o3-tx224 = arc b2 p1 l1-tx225 = arc o1 p2 b2-tx226 = arc o2 p2 b2-tx227 = arc o3 p2 b2-tx228 = arc l1 p2 b2--x2 :: RDFGraph-x2 = toGraph [tx201,tx202,- tx211,tx212,tx213,tx214,- tx221,tx222,tx223,tx224,- tx225,tx226,tx227,tx228]--tx311, tx312, tx313, tx314, tx321, tx322, tx323,- tx324, tx325, tx326, tx327, tx328 :: Arc RDFLabel-tx311 = arc s1 p1 o1-tx312 = arc o2 p1 s1-tx313 = arc s1 p2 o2-tx314 = arc o3 p2 s1-tx321 = arc s2 p1 o1-tx322 = arc s2 p1 o2-tx323 = arc s2 p1 o3-tx324 = arc s2 p1 l1-tx325 = arc o1 p2 s2-tx326 = arc o2 p2 s2-tx327 = arc o3 p2 s2-tx328 = arc l1 p2 s2--x3 :: RDFGraph-x3 = toGraph [tx311,tx312,tx313,tx314,- tx321,tx322,tx323,tx324,- tx325,tx326,tx327,tx328]--tx401, tx402, tx403, tx404, tx405, tx406, tx407,- tx408, tx409 :: Arc RDFLabel-tx401 = arc s1 res_owl_sameAs b1-tx402 = arc b1 res_rdf_first o1-tx403 = arc b1 res_rdf_rest b2-tx404 = arc b2 res_rdf_first o2-tx405 = arc b2 res_rdf_rest b3-tx406 = arc b3 res_rdf_first o3-tx407 = arc b3 res_rdf_rest b4-tx408 = arc b4 res_rdf_first l1-tx409 = arc b4 res_rdf_rest res_rdf_nil--x4 :: RDFGraph-x4 = toGraph [tx401,tx402,tx403,tx404,- tx405,tx406,tx407,tx408,- tx409]--tx501, tx502, tx503, tx504, tx505, tx506, tx507,- tx508, tx509 :: Arc RDFLabel-tx501 = arc b1 res_owl_sameAs s1-tx502 = arc b1 res_rdf_first o1-tx503 = arc b1 res_rdf_rest b2-tx504 = arc b2 res_rdf_first o2-tx505 = arc b2 res_rdf_rest b3-tx506 = arc b3 res_rdf_first o3-tx507 = arc b3 res_rdf_rest b4-tx508 = arc b4 res_rdf_first l1-tx509 = arc b4 res_rdf_rest res_rdf_nil--x5 :: RDFGraph-x5 = toGraph [tx501,tx502,tx503,tx504,- tx505,tx506,tx507,tx508,- tx509]--tx601, tx602, tx603, tx604, tx605, tx606, tx607,- tx608 :: Arc RDFLabel-tx601 = arc s1 res_rdf_first o1-tx602 = arc s1 res_rdf_rest b2-tx603 = arc b2 res_rdf_first o2-tx604 = arc b2 res_rdf_rest b3-tx605 = arc b3 res_rdf_first o3-tx606 = arc b3 res_rdf_rest b4-tx607 = arc b4 res_rdf_first l1-tx608 = arc b4 res_rdf_rest res_rdf_nil--x6 :: RDFGraph-x6 = toGraph [tx601,tx602,tx603,tx604,- tx605,tx606,tx607,tx608]--tx701 :: Arc RDFLabel-tx701 = arc b1 p2 f2--x7 :: RDFGraph-x7 = NSGraph- { namespaces = nslist- , formulae = LookupMap [Formula b1 g2]- , statements = [tx701]- }--tx801 :: Arc RDFLabel-tx801 = arc f1 p2 f2--x8 :: RDFGraph-x8 = NSGraph- { namespaces = nslist- , formulae = LookupMap [Formula f1 g2]- , statements = [tx801]- }--x9 :: RDFGraph-x9 = NSGraph- { namespaces = nslist- , formulae = LookupMap [Formula f1 g1]- , statements = [tx801]- }---- Test allocation of bnodes carries over a nested formula--tx1201, tx1202, tx1203, tx1204, tx1205, - tx1211, tx1212 :: Arc RDFLabel-tx1201 = arc s1 p1 b1-tx1202 = arc b1 p1 o1-tx1203 = arc b2 p2 f2-tx1204 = arc s3 p3 b3-tx1205 = arc b3 p3 o3-tx1211 = arc s2 p2 b4-tx1212 = arc b4 p2 o2--x12fg :: RDFGraph-x12fg = mempty { statements = [tx1211,tx1212] }-{--x12fg = NSGraph- { namespaces = emptyNamespaceMap- , formulae = emptyFormulaMap- , statements = [tx1211,tx1212]- }--}- -x12 :: RDFGraph-x12 = NSGraph- { namespaces = nslist- , formulae = LookupMap [Formula b2 x12fg]- , statements = [tx1201,tx1202,tx1203,tx1204,tx1205]- }---- List of simple anon nodes--tx1301, tx1302, tx1303, tx1304, tx1305, tx1306, tx1307,- tx1308, tx1309 :: Arc RDFLabel-tx1301 = arc s1 res_rdf_first b1-tx1302 = arc s1 res_rdf_rest c1-tx1303 = arc c1 res_rdf_first b2-tx1304 = arc c1 res_rdf_rest c2-tx1305 = arc c2 res_rdf_first b3-tx1306 = arc c2 res_rdf_rest res_rdf_nil-tx1307 = arc b1 p1 o1-tx1308 = arc b2 p1 o2-tx1309 = arc b3 p1 o3--x13 :: RDFGraph-x13 = toGraph [tx1301,tx1302,tx1303,tx1304,tx1305,tx1306,- tx1307,tx1308,tx1309]---- List of more complex anon nodes--tx1401, tx1402, tx1403, tx1404, tx1405, tx1406, tx1407,- tx1408, tx1409, tx1410, tx1411, tx1412 :: Arc RDFLabel-tx1401 = arc s1 res_rdf_first b1-tx1402 = arc s1 res_rdf_rest c1-tx1403 = arc c1 res_rdf_first b2-tx1404 = arc c1 res_rdf_rest c2-tx1405 = arc c2 res_rdf_first b3-tx1406 = arc c2 res_rdf_rest res_rdf_nil-tx1407 = arc b1 p1 o1-tx1408 = arc b1 p2 o1-tx1409 = arc b2 p1 o2-tx1410 = arc b2 p2 o2-tx1411 = arc b3 p1 o3-tx1412 = arc b3 p2 o3--x14 :: RDFGraph-x14 = toGraph [tx1401,tx1402,tx1403,tx1404,tx1405,tx1406,- tx1407,tx1408,tx1409,tx1410,tx1411,tx1412]---- List with nested list--tx1501, tx1502, tx1503, tx1504, tx1505, tx1506, tx1507,- tx1508, tx1509 :: Arc RDFLabel-tx1501 = arc s1 res_rdf_first b1-tx1502 = arc s1 res_rdf_rest c1-tx1503 = arc c1 res_rdf_first b2-tx1504 = arc c1 res_rdf_rest c2-tx1505 = arc c2 res_rdf_first b3-tx1506 = arc c2 res_rdf_rest res_rdf_nil-tx1507 = arc b1 p1 o1-tx1508 = arc b2 p2 c3-tx1509 = arc b3 p1 o3--tx1521, tx1522, tx1523, tx1524, tx1525, tx1526, tx1527,- tx1528, tx1529 :: Arc RDFLabel-tx1521 = arc c3 res_rdf_first b4-tx1522 = arc c3 res_rdf_rest c4-tx1523 = arc c4 res_rdf_first b5-tx1524 = arc c4 res_rdf_rest c5-tx1525 = arc c5 res_rdf_first b6-tx1526 = arc c5 res_rdf_rest res_rdf_nil-tx1527 = arc b4 p1 o1-tx1528 = arc b5 p1 o2-tx1529 = arc b6 p1 o3--x15 :: RDFGraph-x15 = toGraph [tx1501,tx1502,tx1503,tx1504,tx1505,tx1506,- tx1507,tx1508,tx1509,- tx1521,tx1522,tx1523,tx1524,tx1525,tx1526,- tx1527,tx1528,tx1529]---- More complex list with nested list--tx1601, tx1602, tx1603, tx1604, tx1605, tx1606, tx1607,- tx1608, tx1609, tx1610, tx1611 :: Arc RDFLabel-tx1601 = arc s1 res_rdf_first b1-tx1602 = arc s1 res_rdf_rest c1-tx1603 = arc c1 res_rdf_first b2-tx1604 = arc c1 res_rdf_rest c2-tx1605 = arc c2 res_rdf_first b3-tx1606 = arc c2 res_rdf_rest res_rdf_nil-tx1607 = arc b1 p1 o1-tx1608 = arc b1 p2 o1-tx1609 = arc b2 p2 c3-tx1610 = arc b3 p1 o3-tx1611 = arc b3 p2 o3--tx1621, tx1622, tx1623, tx1624, tx1625, tx1626, tx1627,- tx1628, tx1629, tx1630, tx1631, tx1632 :: Arc RDFLabel-tx1621 = arc c3 res_rdf_first b4-tx1622 = arc c3 res_rdf_rest c4-tx1623 = arc c4 res_rdf_first b5-tx1624 = arc c4 res_rdf_rest c5-tx1625 = arc c5 res_rdf_first b6-tx1626 = arc c5 res_rdf_rest res_rdf_nil-tx1627 = arc b4 p1 o1-tx1628 = arc b4 p2 o1-tx1629 = arc b5 p1 o2-tx1630 = arc b5 p2 o2-tx1631 = arc b6 p1 o3-tx1632 = arc b6 p2 o3--x16 :: RDFGraph-x16 = toGraph [tx1601,tx1602,tx1603,tx1604,tx1605,tx1606,- tx1607,tx1608,tx1609,tx1610,tx1611,- tx1621,tx1622,tx1623,tx1624,tx1625,tx1626,- tx1627,tx1628,tx1629,tx1630,tx1631,tx1632]--kg1 :: RDFGraph-kg1 = toRDFGraph- [ arc b a c ]- where- -- the document base is set to file:///dev/null to begin with- ns = Namespace "" (baseFile ++ "#")- mUN = Res . ScopedName ns- a = mUN "a"- b = mUN "b"- c = mUN "c"----------------------------------------------------------------- Simple parser tests----------------------------------------------------------------- check default base-simpleN3Graph_dg_01 :: String-simpleN3Graph_dg_01 =- ":s1 :p1 :o1 ."---- from the turtle documentation-simpleN3Graph_dg_02 :: String-simpleN3Graph_dg_02 =- "# this is a complete turtle document\n" ++- "# In-scope base URI is the document URI at this point\n" ++- "<a1> <b1> <c1> .\n" ++- "@base <http://example.org/ns/> .\n" ++- "# In-scope base URI is http://example.org/ns/ at this point\n" ++- "<a2> <http://example.org/ns/b2> <c2> .\n" ++- "@base <foo/> .\n" ++- "# In-scope base URI is http://example.org/ns/foo/ at this point\n" ++- "<a3> <b3> <c3> .\n" ++- "@prefix : <bar#> .\n" ++- ":a4 :b4 :c4 .\n" ++- "@prefix : <http://example.org/ns2#> .\n" ++- ":a5 :b5 :c5 .\n"--commonPrefixes :: String-commonPrefixes =- "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" ++- "@prefix base2 : <" ++ nsURI base2 ++ "> . \n" ++- "@prefix base3 : <" ++ nsURI base3 ++ "> . \n"--rdfPrefix :: String-rdfPrefix = "@prefix rdf: <" ++ nsURI namespaceRDF ++ ">.\n"---- Single statement using <uri> form-simpleN3Graph_g1_01 :: String-simpleN3Graph_g1_01 =- " <http://id.ninebynine.org/wip/2003/test/graph1/node/s1> " ++- " <http://id.ninebynine.org/wip/2003/test/graph1/node/p1> " ++- " <http://id.ninebynine.org/wip/2003/test/graph1/node/o1> . "---- Single statement using prefix:name form-simpleN3Graph_g1_02 :: String-simpleN3Graph_g1_02 =- "@prefix base1 : <" ++ nsURI base1 ++ "> ." ++- " base1:s1 base1:p1 base1:o1 . "---- Single statement using prefix:name form--- (this was added to check that the parser did not--- think we meant 'a:a a :b .' here)----simpleN3Graph_g1_02a :: String-simpleN3Graph_g1_02a =- "@prefix a: <" ++ nsURI basea ++ "> ." ++- "a:a a:b a:c ."---- Single statement using :name form-simpleN3Graph_g1_03 :: String-simpleN3Graph_g1_03 =- "@prefix : <" ++ nsURI base1 ++ "> .\n" ++- " :s1 :p1 :o1 . "---- Check we can handle ':' and 'prefix:' forms.----simpleN3Graph_g1_03_1 :: String-simpleN3Graph_g1_03_1 =- "@prefix : <" ++ nsURI base1 ++ "> .\n" ++- " : : :."--simpleN3Graph_g1_03_2 :: String-simpleN3Graph_g1_03_2 =- "@prefix b: <" ++ nsURI base1 ++ "> .\n" ++- "b: b: b:. "---- Single statement using relative URI form-simpleN3Graph_g1_04 :: String-simpleN3Graph_g1_04 =- "@base <" ++ nsURI base1 ++ "> .\n" ++- " <s1> <p1> <o1> . "---- Single statement using blank nodes-simpleN3Graph_g1_05 :: String-simpleN3Graph_g1_05 =- "@base <" ++ nsURI base1 ++ "> .\n" ++- " _:b1 _:b2 _:b3 . "--simpleN3Graph_g1_05_1 :: String-simpleN3Graph_g1_05_1 =- commonPrefixes ++- " _:b1 base1:p1 base1:o1 . "---- Single statement with junk following-simpleN3Graph_g1_06 :: String-simpleN3Graph_g1_06 =- "@prefix base1 : <" ++ nsURI base1 ++ "> ." ++- " base1:s1 base1:p1 base1:o1 . " ++- " **** "---- Multiple statements-simpleN3Graph_g2 :: String-simpleN3Graph_g2 =- commonPrefixes ++- " base1:s1 base1:p1 base1:o1 . \n" ++- " base2:s2 base1:p1 base2:o2 . \n" ++- " base3:s3 base1:p1 base3:o3 . \n"---- Graph with literal-simpleN3Graph_g3 :: String-simpleN3Graph_g3 =- commonPrefixes ++- " base1:s1 base1:p1 base1:o1 . \n" ++- " base1:s1 base1:p1 \"l1\" . \n"---- Graph with nodeid-simpleN3Graph_g4 :: String-simpleN3Graph_g4 =- commonPrefixes ++- " base1:s1 base1:p1 base1:o1 . \n" ++- " base2:s2 base1:p1 _:b1 . \n"--simpleN3Graph_g4_1 :: String-simpleN3Graph_g4_1 =- commonPrefixes ++- " _:b1 base1:p1 base1:o1._:b2 base2:p2 base2:o2."--simpleN3Graph_g4_2 :: String-simpleN3Graph_g4_2 =- commonPrefixes ++- " _:foo1 a base1:o1. _:bar2 a base2:o2."---- same graph as g4_2-simpleN3Graph_g4_3 :: String-simpleN3Graph_g4_3 =- commonPrefixes ++- " [] a base1:o1.[a base2:o2]."---- Graph with literal and nodeid-simpleN3Graph_g5 :: String-simpleN3Graph_g5 =- commonPrefixes ++- " base1:s1 base1:p1 base1:o1 . \n" ++- " base2:s2 base1:p1 base2:o2 . \n" ++- " base3:s3 base1:p1 base3:o3 . \n" ++- " base1:s1 base1:p1 \"l1\" . \n" ++- " base2:s2 base1:p1 _:b1 . \n"---- Triple-quoted literal-simpleN3Graph_g6 :: String-simpleN3Graph_g6 =- commonPrefixes ++- " base1:s1 base1:p1 base1:o1 . \n" ++- " base3:s3 base1:p1 \"\"\"l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'\"\"\" . \n"---- String escapes-simpleN3Graph_g7 :: String-simpleN3Graph_g7 =- commonPrefixes ++- " base1:s1 base1:p1 base1:o1 . \n" ++- " base3:s3 base2:p2 " ++- " \"l3--\\r\\\"\\'\\\\--\\u0020--\\U000000A0--\" " ++- " . \n"---- Different verb forms-simpleN3Graph_g8 :: String-simpleN3Graph_g8 =- commonPrefixes ++- " base1:s1 a base1:o1 . \n" ++- " base2:s2 = base2:o2 . \n" ++- " base1:s1 @is base1:p1 @of base1:o1 . \n" ++- " base2:s2 @has base1:p1 base2:o2 . \n" ++- " base1:s1 => base1:o1 . \n" ++- " base2:s2 <= base2:o2 . \n"--simpleN3Graph_g8b :: String-simpleN3Graph_g8b =- commonPrefixes ++- " base1:s1 a base1:o1 . \n" ++- " base2:s2 = base2:o2 . \n" ++- " base1:s1 is base1:p1 of base1:o1 . \n" ++- " base2:s2 @has base1:p1 base2:o2 . \n" ++- " base1:s1 => base1:o1 . \n" ++- " base2:s2 <= base2:o2 . \n"--simpleN3Graph_g81 :: String-simpleN3Graph_g81 =- commonPrefixes ++- " base1:s1 a base1:o1 . \n" ++- " base2:s2 = base2:o2 . \n"--simpleN3Graph_g83 :: String-simpleN3Graph_g83 =- commonPrefixes ++- " base1:s1 @is base1:p1 @of base1:o1 . \n" ++- " base2:s2 @has base1:p1 base2:o2 . \n" ++- " base1:s1 => base1:o1 . \n" ++- " base2:s2 <= base2:o2 . \n"--simpleN3Graph_g83b :: String-simpleN3Graph_g83b =- commonPrefixes ++- " base1:s1 is base1:p1 of base1:o1 . \n" ++- " base2:s2 @has base1:p1 base2:o2 . \n" ++- " base1:s1 => base1:o1 . \n" ++- " base2:s2 <= base2:o2 . \n"---- Semicolons and commas-simpleN3Graph_g9 :: String-simpleN3Graph_g9 =- commonPrefixes ++- " base1:s1 base1:p1 base1:o1 ; \n" ++- " base1:p1 base2:o2 ; \n" ++- " base2:p2 base2:o2 ; \n" ++- " base2:p2 base3:o3 . \n" ++- " base2:s2 base1:p1 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ; \n" ++- " base2:p2 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" . \n"---- ensure you can end a property list with a semicolon-simpleN3Graph_g9b :: String-simpleN3Graph_g9b =- commonPrefixes ++- " base1:s1 base1:p1 base1:o1 ; \n" ++- " base1:p1 base2:o2 ; \n" ++- " base2:p2 base2:o2 ; \n" ++- " base2:p2 base3:o3;. \n" ++- " base2:s2 base1:p1 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ; \n" ++- " base2:p2 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ;. \n"---- 'is ... of' and semicolons and commas-simpleN3Graph_g10 :: String-simpleN3Graph_g10 =- commonPrefixes ++- " base1:s1 @has base1:p1 base1:o1 ; \n" ++- " @is base1:p1 @of base2:o2 ; \n" ++- " @has base2:p2 base2:o2 ; \n" ++- " @is base2:p2 @of base3:o3 . \n" ++- " base2:s2 @has base1:p1 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ; \n" ++- " @is base2:p2 @of base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" . \n"---- Simple statements using ?var form-simpleN3Graph_g11 :: String-simpleN3Graph_g11 =- "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" ++- " base1:s1 base1:p1 ?var1 . \n" ++- " ?var2 base1:p1 base1:o1 . \n" ++- " ?var3 base1:p1 ?var4 . \n"---- Bare anonymous nodes-simpleN3Graph_g12 :: String-simpleN3Graph_g12 =- "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" ++- " [ base1:p1 base1:o1 ] . \n" ++- " ( ?var1 ?var2 ) . \n"---- Literals with dataype and language-simpleN3Graph_g17 :: String-simpleN3Graph_g17 =- commonPrefixes ++ rdfPrefix ++ - " base1:s1 base1:p1 \"chat\"@fr . \n " ++- " base2:s2 base2:p2 \"<br/>\"^^rdf:XMLLiteral . \n " ++- " base3:s3 base3:p3 \"<em>chat</em>\"^^rdf:XMLLiteral . \n "--emsg16 :: String-emsg16 = intercalate "\n" [- "",- "@prefix base1 : <http://id.ninebynine.org/wip/2003/test/graph1/node/> . base1:s1 base1:p1 base1:o1 . **** ",- " ^",- "(line 1, column 103 indicated by the '^' sign above):",- "",- "unexpected \"*\"",- "expecting declaration, \"@\", pathitem or end of input"- ]---simpleTestSuite :: Test-simpleTestSuite = TestList- [ parseTestB dqn "simpleTestd01" simpleN3Graph_dg_01 dg1 noError- , parseTestB dqn "simpleTestd02" simpleN3Graph_dg_02 dg2 noError- , parseTest "simpleTest011" simpleN3Graph_g1_01 g1 noError- , parseTest "simpleTest012" simpleN3Graph_g1_02 g1 noError- , parseTest "simpleTest012a" simpleN3Graph_g1_02a g1a noError- , parseTest "simpleTest013" simpleN3Graph_g1_03 g1 noError- , parseTest "simpleTest013_1" simpleN3Graph_g1_03_1 g1_31 noError- , parseTest "simpleTest013_2" simpleN3Graph_g1_03_2 g1_31 noError- , parseTest "simpleTest014" simpleN3Graph_g1_04 g1 noError- , parseTest "simpleTest015" simpleN3Graph_g1_05 g1b noError- , parseTest "simpleTest015_1" simpleN3Graph_g1_05_1 g1b_1 noError- , parseTest "simpleTest016" simpleN3Graph_g1_06 emptyRDFGraph emsg16- , parseTest "simpleTest03" simpleN3Graph_g2 g2 noError- , parseTest "simpleTest04" simpleN3Graph_g3 g3 noError- , parseTest "simpleTest05" simpleN3Graph_g4 g4 noError- , parseTest "simpleTest05_1" simpleN3Graph_g4_1 g4_1 noError- , parseTest "simpleTest05_2" simpleN3Graph_g4_2 g4_2 noError- , parseTest "simpleTest05_3" simpleN3Graph_g4_3 g4_2 noError- , parseTest "simpleTest06" simpleN3Graph_g5 g5 noError- , parseTest "simpleTest07" simpleN3Graph_g6 g6 noError- , parseTest "simpleTest08" simpleN3Graph_g7 g7 noError- , parseTest "simpleTest09" simpleN3Graph_g8 g8 noError- , parseTest "simpleTest09b" simpleN3Graph_g8b g8 noError- , parseTest "simpleTest10" simpleN3Graph_g81 g81 noError- , parseTest "simpleTest12" simpleN3Graph_g83 g83 noError- , parseTest "simpleTest12b" simpleN3Graph_g83b g83 noError- , parseTest "simpleTest13" simpleN3Graph_g9 g9 noError- , parseTest "simpleTest13b" simpleN3Graph_g9b g9 noError- , parseTest "simpleTest14" simpleN3Graph_g10 g10 noError- , parseTest "simpleTest15" simpleN3Graph_g11 g11 noError- , parseTest "simpleTest16" simpleN3Graph_g12 g12 noError- , parseTest "simpleTest17" simpleN3Graph_g17 g17 noError- ]----------------------------------------------------------------- Literal parser tests------------------------------------------------------------------- Expand upon the literal testing done above-----litN3Graph_g1 :: String-litN3Graph_g1 =- commonPrefixes ++- " base1:s1 base1:p1 \"true\"^^<http://www.w3.org/2001/XMLSchema#boolean>.\n" ++- " base2:s2 base2:p2 \"false\"^^<http://www.w3.org/2001/XMLSchema#boolean>.\n" ++- " base3:s3 base3:p3 \"true\"^^<http://www.w3.org/2001/XMLSchema#boolean>.\n"- -litN3Graph_g2 :: String-litN3Graph_g2 =- commonPrefixes ++- "@prefix xsd: <" ++ nsURI xsdNS ++ "> . \n" ++- " base1:s1 base1:p1 \"true\"^^xsd:boolean.\n" ++- " base2:s2 base2:p2 \"false\"^^xsd:boolean.\n" ++- " base3:s3 base3:p3 \"true\"^^xsd:boolean.\n"--litN3Graph_g3 :: String-litN3Graph_g3 =- commonPrefixes ++- " base1:s1 base1:p1 @true.\n" ++- " base2:s2 base2:p2 @false.\n" ++- " base3:s3 base3:p3 true.\n"- -litN3Graph_g4 :: String-litN3Graph_g4 =- commonPrefixes ++- " base1:s1 base1:p1 ( true 1 2.0 -2.21 -2.3e-4 ).\n"--lit_g1 :: RDFGraph-lit_g1 = toGraph [ arc s1 p1 bTrue- , arc s2 p2 bFalse- , arc s3 p3 bTrue- ]---- at the moment we could use lit_g1 rather than lit_g2, since--- the namespace map isn't used in the comparison.----lit_g2 :: RDFGraph-lit_g2 = lit_g1 { namespaces = xnslist }--bOne, b20, b221, b23e4 :: RDFLabel-bOne = Lit "1" $ Just xsd_integer-b20 = Lit "2.0" $ Just xsd_decimal-b221 = Lit "-2.21" $ Just xsd_decimal-b23e4 = Lit "-2.3E-4" $ Just xsd_double--lit_g4 :: RDFGraph-lit_g4 = mempty {- namespaces = xnslist- , statements = [- arc s1 p1 b1- , arc b1 res_rdf_first bTrue- , arc b1 res_rdf_rest b2- , arc b2 res_rdf_first bOne- , arc b2 res_rdf_rest b3- , arc b3 res_rdf_first b20- , arc b3 res_rdf_rest b4- , arc b4 res_rdf_first b221- , arc b4 res_rdf_rest b5- , arc b5 res_rdf_first b23e4- , arc b5 res_rdf_rest res_rdf_nil- ]- }--litTestSuite :: Test-litTestSuite = TestList- [ parseTest "litTest01" litN3Graph_g1 lit_g1 noError- , parseTest "litTest02" litN3Graph_g2 lit_g2 noError- , parseTest "litTest03" litN3Graph_g3 lit_g2 noError- , parseTest "litTest04" litN3Graph_g4 lit_g4 noError- ]----------------------------------------------------------------- Exotic parser tests------------------------------------------------------------------- These tests cover various forms of anonymous nodes--- [...], lists and formula. together with uses of ':-'------- Simple anon nodes, with semicolons and commas-exoticN3Graph_x1 :: String-exoticN3Graph_x1 =- commonPrefixes ++- " [ base1:p1 base1:o1 ; \n" ++- " base1:p1 base2:o2 ; \n" ++- " base2:p2 base2:o2 ; \n" ++- " base2:p2 base3:o3 ] = base1:s1 . \n" ++- " base2:s2 = \n" ++- " [ base1:p1 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ; \n" ++- " base2:p2 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ] . \n"---- check semi-colons at end of property list-exoticN3Graph_x1b :: String-exoticN3Graph_x1b =- commonPrefixes ++- " [ base1:p1 base1:o1 ; \n" ++- " base1:p1 base2:o2 ; \n" ++- " base2:p2 base2:o2 ; \n" ++- " base2:p2 base3:o3; ] = base1:s1 . \n" ++- " base2:s2 = \n" ++- " [ base1:p1 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ; \n" ++- " base2:p2 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ; ] ;. \n"---- Simple anon nodes, with 'is ... of' and semicolons and commas-exoticN3Graph_x2 :: String-exoticN3Graph_x2 =- commonPrefixes ++- " [ @has base1:p1 base1:o1 ; \n" ++- " @is base1:p1 @of base2:o2 ; \n" ++- " @has base2:p2 base2:o2 ; \n" ++- " @is base2:p2 @of base3:o3 ] = base1:s1 . \n" ++- " base2:s2 = \n" ++- " [ @has base1:p1 base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ; \n" ++- " @is base2:p2 @of base1:o1 , \n" ++- " base2:o2 , \n" ++- " base3:o3 , \n" ++- " \"l1\" ] . \n"----- List nodes--exoticN3Graph_x4 :: String-exoticN3Graph_x4 =- commonPrefixes ++- " base1:s1 = (base1:o1 base2:o2 base3:o3 \"l1\") .\n"--exoticN3Graph_x5 :: String-exoticN3Graph_x5 =- commonPrefixes ++- " (base1:o1 base2:o2 base3:o3 \"l1\") = base1:s1 .\n"---- Formula nodes, with and without :---exoticN3Graph_x7 :: String-exoticN3Graph_x7 =- commonPrefixes ++- " { base1:s1 base1:p1 base1:o1 . \n" ++- " base2:s2 base1:p1 base2:o2 . \n" ++- " base3:s3 base1:p1 base3:o3 . } \n" ++- " base2:p2 base2:f2 . "---- Test allocation of bnodes carries over a nested formula-exoticN3Graph_x12 :: String-exoticN3Graph_x12 =- commonPrefixes ++- " base1:s1 base1:p1 [ base1:p1 base1:o1 ] . \n" ++- " { base2:s2 base2:p2 [ base2:p2 base2:o2 ] . } \n" ++- " base2:p2 base2:f2 . \n" ++- " base3:s3 base3:p3 [ base3:p3 base3:o3 ] ."--exoticTestSuite :: Test-exoticTestSuite = - TestList- [ parseTest "exoticTest01" exoticN3Graph_x1 x1 noError- , parseTest "exoticTest01b" exoticN3Graph_x1b x1 noError- , parseTest "exoticTest02" exoticN3Graph_x2 x2 noError- , parseTest "exoticTest04" exoticN3Graph_x4 x4 noError- , parseTest "exoticTest05" exoticN3Graph_x5 x5 noError- , parseTest "exoticTest07" exoticN3Graph_x7 x7 noError- , parseTest "exoticTest12" exoticN3Graph_x12 x12 noError- , testGraphEq "exoticTest20" False x7 x8- , testGraphEq "exoticTest21" False x8 x9- ]--keywordN3Graph_01 :: String-keywordN3Graph_01 = - "@keywords .\n" ++- "b a c . "---- a modification of simpleN3Graph_g8-keywordN3Graph_02 :: String-keywordN3Graph_02 = - commonPrefixes ++- "@keywords a , is, of ,has.\n" ++- " base1:s1 a base1:o1 . \n" ++- " base2:s2 = base2:o2 . \n" ++- " base1:s1 is base1:p1 of base1:o1 . \n" ++- " base2:s2 has base1:p1 base2:o2 . \n" ++- " base1:s1 => base1:o1 . \n" ++- " base2:s2 <= base2:o2 . \n"---- a modification of simpleN3Graph_g83-keywordN3Graph_03 :: String-keywordN3Graph_03 = - commonPrefixes ++- "@keywords of.\n" ++- " base1:s1 @is base1:p1 of base1:o1 . \n" ++- " base2:s2 @has base1:p1 base2:o2 . \n" ++- " base1:s1 => base1:o1 . \n" ++- " base2:s2 <= base2:o2 . \n"--keywordTestSuite :: Test-keywordTestSuite = TestList- [ parseTestB dqn "keywordTest01" keywordN3Graph_01 kg1 noError- , parseTest "keywordTest02" keywordN3Graph_02 g8 noError- , parseTest "keywordTest03" keywordN3Graph_03 g83 noError- ]- ---------------------------------------------------------------- Test parser failure------------------------------------------------------------------- Very limited at the moment.-----failTest :: String -> String -> String -> Test-failTest lbl gr = parseTest lbl gr emptyRDFGraph --failN3Graph_g1 :: String-failN3Graph_g1 =- commonPrefixes ++- " base1:s1 base2:p2 unknown3:o3 . "--fail1 :: String-fail1 = intercalate "\n" [- "",- "@prefix base3 : <http://id.ninebynine.org/wip/2003/test/graph3/node> . ",- " base1:s1 base2:p2 unknown3:o3 . ",- " ^",- "(line 4, column 29 indicated by the '^' sign above):",- "",- "unexpected Prefix 'unknown3:' not bound."- ]--failTestSuite :: Test-failTestSuite = TestList- [ failTest "failTest01" failN3Graph_g1 fail1- ]----------------------------------------------------------------- All tests---------------------------------------------------------------allTests :: Test-allTests = TestList- [ charTestSuite- , nameTestSuite- , prefixTestSuite+{-# LANGUAGE OverloadedStrings #-}++--------------------------------------------------------------------------------+-- See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+-- Module : N3ParserTest+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+-- License : GPL V2+--+-- Maintainer : Douglas Burke+-- Stability : experimental+-- Portability : OverloadedStrings+--+-- This Module contains test cases for module "N3Parser".+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.N3Parser+ ( parseN3+ , parseTextFromText, parseAltFromText+ , parseNameFromText -- , parsePrefixFromText+ , parseAbsURIrefFromText, parseLexURIrefFromText+ , parseURIref2FromText+ )++import Swish.RDF.RDFGraph+ ( RDFGraph, RDFLabel(..), NSGraph(..)+ , LookupFormula(..)+ , emptyRDFGraph, toRDFGraph+ , resRdfType, resRdfFirst, resRdfRest, resRdfNil+ , resOwlSameAs, resLogImplies+ )++import Swish.Utils.Namespace (+ Namespace(..)+ , ScopedName(..)+ , makeScopedName+ , nullScopedName+ -- , makeUriScopedName+ , namespaceToBuilder+ )++import Swish.RDF.Vocabulary+ ( namespaceRDF+ , langName+ , rdfXMLLiteral+ , xsdBoolean + , xsdInteger+ , xsdDecimal + , xsdDouble + )++import Swish.RDF.GraphClass (Arc, arc) ++import Swish.Utils.QName (QName, qnameFromURI)+import Swish.Utils.LookupMap (LookupMap(..))++import Test.HUnit (Test(TestCase,TestList), assertEqual, runTestTT)++import Network.URI (URI, nullURI, parseURIReference)++import Data.Monoid (Monoid(..))+import Data.Maybe (fromMaybe)++import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Data.Text.Lazy.Builder as B++toURI :: String -> URI+toURI s = fromMaybe (error ("Internal error: invalid uri=" ++ s)) (parseURIReference s)++------------------------------------------------------------+-- Generic item parsing test wrapper+------------------------------------------------------------++type ParseFromText a = L.Text -> Either String a++parseItemTest :: (Eq a, Show a) => ParseFromText a -> a+ -> String -> L.Text -> a -> String -> Test+parseItemTest ifroms def lab inp val err =+ TestList+ [ TestCase ( assertEqual ("parseItemError:"++lab) fixerr pe )+ , TestCase ( assertEqual ("parseItemValue:"++lab) val pv )+ ]+ where+ (pe,pv) = case ifroms inp of+ Left e -> (e,def)+ Right v -> (noError,v)+ fixerr = if err /= noError then pe else noError++noError, errorText :: String+noError = ""+errorText = "*"++------------------------------------------------------------+-- Common test wrappers+------------------------------------------------------------++testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test+testLabelEq lab eq n1 n2 =+ TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )++testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test+testGraphEq lab eq gg1 gg2 =+ TestCase ( assertEqual ("testGraphEq:"++lab) eq (gg1==gg2) )++parseTestBase :: String -> Maybe QName -> String -> B.Builder -> RDFGraph -> String -> Test+parseTestBase lbl1 mbase lbl2 inp gr er =+ TestList+ [ TestCase ( assertEqual ("parseTestError:"++lbl1++lbl2) er pe )+ , TestCase ( assertEqual ("parseTestGraph:"++lbl1++lbl2) gr pg )+ ]+ where+ (pe,pg) = case parseN3 (B.toLazyText inp) mbase of+ Right g -> ("", g)+ Left s -> (s, mempty)++parseTest :: String -> B.Builder -> RDFGraph -> String -> Test+parseTest = parseTestBase "<nobase>" Nothing++parseTestB :: QName -> String -> B.Builder -> RDFGraph -> String -> Test+parseTestB base = parseTestBase "<base>" (Just base)++------------------------------------------------------------+-- Test simple character parsing+------------------------------------------------------------++parseCharTest :: String -> String+ -> L.Text -> String -> String -> Test+parseCharTest c = parseItemTest (parseTextFromText c) ""++parseAltTest :: String -> String+ -> String -> L.Text -> String -> String -> Test+parseAltTest cc1 cc2 = parseItemTest (parseAltFromText cc1 cc2) ""++charTestSuite :: Test+charTestSuite = TestList+ [ parseCharTest ":" "parseCharTest01" ":" ":" noError+ , parseCharTest "<>" "parseCharTest02" "<>" "<>" noError+ , parseAltTest ":" "<>" "parseCharTest03" ":" ":" noError+ , parseAltTest ":" "<>" "parseCharTest04" "<>" "<>" noError+ , parseAltTest ":" "<>" "parseCharTest04" "<=" "" errorText+ ]++------------------------------------------------------------+-- Test simple name parsing+------------------------------------------------------------++parseNameTest :: String -> L.Text -> String -> String -> Test+parseNameTest = parseItemTest parseNameFromText ""++nameTestSuite :: Test+nameTestSuite = TestList+ [ parseNameTest "parseNameTest01" "name" "name" ""+ , parseNameTest "parseNameTest02" "rdf" "rdf" ""+ ]++{-++Not convinced it's worth testing this piece separately, so removing for now.++------------------------------------------------------------+-- Test simple prefix parsing+------------------------------------------------------------++parsePrefixTest :: String -> L.Text -> Namespace -> String -> Test+parsePrefixTest = parseItemTest parsePrefixFromText (Namespace Nothing nullURI)++prefixTestSuite :: Test+prefixTestSuite = TestList+ [ parsePrefixTest "parsePrefixTest01" "pref" (Namespace (Just "pref") (toURI "pref:")) ""+ , parsePrefixTest "parsePrefixTest02" "rdf" namespaceRDF ""+ ]++-}++------------------------------------------------------------+-- Test absolute URIref parsing+------------------------------------------------------------++parseAbsUriRefTest :: String -> L.Text -> URI -> String -> Test+parseAbsUriRefTest = parseItemTest parseAbsURIrefFromText nullURI++parseLexUriRefTest :: String -> L.Text -> URI -> String -> Test+parseLexUriRefTest = parseItemTest parseLexURIrefFromText nullURI++absUriRefInp01, absUriRefInp01s, absUriRefInp02, absUriRefInp02s :: L.Text++absUriRefInp01 = "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>"+absUriRefInp01s = "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type> "+absUriRefInp02 = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1>"+absUriRefInp02s = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "++absUriRef01, absUriRef02 :: URI++absUriRef01 = toURI "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"+absUriRef02 = toURI "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"++absUriRefTestSuite :: Test+absUriRefTestSuite = TestList+ [ parseAbsUriRefTest "parseAbsUriRefTest01" absUriRefInp01 absUriRef01 ""+ , parseAbsUriRefTest "parseAbsUriRefTest02" absUriRefInp02 absUriRef02 ""+ , parseLexUriRefTest "parseAbsUriRefTest03" absUriRefInp01s absUriRef01 ""+ , parseLexUriRefTest "parseAbsUriRefTest04" absUriRefInp02s absUriRef02 ""+ ]++------------------------------------------------------------+-- Test simple URIref parsing+------------------------------------------------------------++parseUriRef2Test :: String -> L.Text -> ScopedName -> String -> Test+parseUriRef2Test = parseItemTest parseURIref2FromText nullScopedName++sname01 :: ScopedName+sname01 = ScopedName namespaceRDF "type"++uriRef02 :: L.Text+uriRef02 = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "++sname02 :: ScopedName+sname02 =+ makeScopedName Nothing (toURI "http://id.ninebynine.org/wip/2003/test/graph1/node#") "s1"++uriRef2TestSuite :: Test+uriRef2TestSuite = TestList+ [ parseUriRef2Test "parseUriRef2Test01" "rdf:type" sname01 ""+ , parseUriRef2Test "parseUriRef2Test02" uriRef02 sname02 ""+ ]++------------------------------------------------------------+-- Define some common values+------------------------------------------------------------++baseFile :: String+baseFile = "file:///dev/null"++dqn :: QName+dqn = (qnameFromURI . toURI) baseFile++toNS :: T.Text -> String -> Namespace+toNS p = Namespace (Just p) . toURI++dbase, base1, base2, base3, base4, basea :: Namespace+dbase = Namespace Nothing $ toURI "#"+base1 = toNS "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node/"+base2 = toNS "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node#"+base3 = toNS "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"+base4 = toNS "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"+basea = toNS "a" "http://example.org/basea#"++xsdNS :: Namespace+xsdNS = toNS "xsd" "http://www.w3.org/2001/XMLSchema#"++u1 :: RDFLabel+u1 = Res $ ScopedName base1 ""++ds1, ds2, ds3 :: RDFLabel+ds1 = Res $ ScopedName dbase "s1"+ds2 = Res $ ScopedName dbase "s2"+ds3 = Res $ ScopedName dbase "s3"++dp1, dp2, dp3 :: RDFLabel+dp1 = Res $ ScopedName dbase "p1"+dp2 = Res $ ScopedName dbase "p2"+dp3 = Res $ ScopedName dbase "p3"++do1, do2, do3 :: RDFLabel+do1 = Res $ ScopedName dbase "o1"+do2 = Res $ ScopedName dbase "o2"+do3 = Res $ ScopedName dbase "o3"++s1, s2, s3, sa :: RDFLabel+s1 = Res $ ScopedName base1 "s1"+s2 = Res $ ScopedName base2 "s2"+s3 = Res $ ScopedName base3 "s3"+sa = Res $ ScopedName basea "a"++b1, b2, b3, b4, b5, b6, b7, b8 :: RDFLabel+b1 = Blank "b1"+b2 = Blank "b2"+b3 = Blank "b3"+b4 = Blank "b4"+b5 = Blank "b5"+b6 = Blank "b6"+b7 = Blank "b7"+b8 = Blank "b8"++c1, c2, c3, c4, c5, c6 :: RDFLabel+c1 = Blank "c1"+c2 = Blank "c2"+c3 = Blank "c3"+c4 = Blank "c4"+c5 = Blank "c5"+c6 = Blank "c6"++p1, p2, p3, pa :: RDFLabel+p1 = Res $ ScopedName base1 "p1" +p2 = Res $ ScopedName base2 "p2" +p3 = Res $ ScopedName base3 "p3" +pa = Res $ ScopedName basea "b" ++o1, o2, o3, oa :: RDFLabel+o1 = Res $ ScopedName base1 "o1"+o2 = Res $ ScopedName base2 "o2"+o3 = Res $ ScopedName base3 "o3"+oa = Res $ ScopedName basea "c"++l1, l2, l3 :: RDFLabel+l1 = Lit "l1" Nothing+l2 = Lit "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'" Nothing+l3 = Lit "l3--\r\"'\\--\x0020\&--\x00A0\&--" Nothing++lfr, lxml, lfrxml :: RDFLabel+lfr = Lit "chat" $ Just $ langName "fr"+lxml = Lit "<br/>" $ Just rdfXMLLiteral+lfrxml = Lit "<em>chat</em>" $ Just rdfXMLLiteral++bTrue, bFalse :: RDFLabel+bTrue = Lit "true" $ Just xsdBoolean+bFalse = Lit "false" $ Just xsdBoolean++f1, f2 :: RDFLabel+f1 = Res $ ScopedName base1 "f1"+f2 = Res $ ScopedName base2 "f2" ++v1, v2, v3, v4 :: RDFLabel+v1 = Var "var1"+v2 = Var "var2"+v3 = Var "var3"+v4 = Var "var4"++------------------------------------------------------------+-- Construct graphs for testing+------------------------------------------------------------++t01 , t01b, t02, t03, t04, t05, t06, t07 :: Arc RDFLabel+t01 = arc s1 p1 o1+t01b = arc b1 b2 b3+t02 = arc s2 p1 o2+t03 = arc s3 p1 o3+t04 = arc s1 p1 l1+t05 = arc s2 p1 b1+t06 = arc s3 p1 l2+t07 = arc s3 p2 l3++makeNewPrefixNamespace :: (T.Text,Namespace) -> Namespace+makeNewPrefixNamespace (pre,ns) = Namespace (Just pre) (nsURI ns)++dg1, dg2, dg3 :: RDFGraph+dg1 = toRDFGraph [arc ds1 dp1 do1]+dg2 = toRDFGraph+ [ arc xa1 xb1 xc1+ , arc xa2 xb2 xc2+ , arc xa3 xb3 xc3+ , arc xa4 xb4 xc4+ , arc xa5 xb5 xc5+ ]+ where+ -- the document base is set to file:///dev/null to begin with+ xa1 = Res "file:///dev/a1"+ xb1 = Res "file:///dev/b1"+ xc1 = Res "file:///dev/c1"+ xa2 = Res "http://example.org/ns/a2"+ xb2 = Res "http://example.org/ns/b2"+ xc2 = Res "http://example.org/ns/c2"+ xa3 = Res "http://example.org/ns/foo/a3"+ xb3 = Res "http://example.org/ns/foo/b3"+ xc3 = Res "http://example.org/ns/foo/c3"+ + ns4 = Namespace Nothing $ toURI "http://example.org/ns/foo/bar#"+ ns5 = Namespace Nothing $ toURI "http://example.org/ns2#"+ mUN a b = Res (ScopedName a b)+ xa4 = mUN ns4 "a4"+ xb4 = mUN ns4 "b4"+ xc4 = mUN ns4 "c4"+ xa5 = mUN ns5 "a5"+ xb5 = mUN ns5 "b5"+ xc5 = mUN ns5 "c5"++dg3 = -- TODO: add in prefixes ?+ toRDFGraph [ arc (Res "file:///home/swish/photos/myphoto") (Res "http://example.com/ns#photoOf") (Res "http://example.com/ns#me")]+ +nslist, xnslist :: LookupMap Namespace+nslist = LookupMap $ map makeNewPrefixNamespace+ [ ("base1",base1)+ , ("base2",base2)+ , ("base3",base3)+ , ("base4",base4)+ ]+xnslist = LookupMap $ map makeNewPrefixNamespace+ [ ("base1",base1)+ , ("base2",base2)+ , ("base3",base3)+ , ("base4",base4)+ , ("xsd", xsdNS)+ ]++toGraph :: [Arc RDFLabel] -> RDFGraph+toGraph stmts = mempty { namespaces = nslist+ , statements = stmts+ }++g1 :: RDFGraph+g1 = toGraph [t01]++g1a :: RDFGraph+g1a = toGraph [arc sa pa oa] ++g1_31 :: RDFGraph+g1_31 = toGraph [arc u1 u1 u1]++g1b :: RDFGraph+g1b = toGraph [t01b]++g1b_1 :: RDFGraph+g1b_1 = toGraph [arc b1 p1 o1]++g2 :: RDFGraph+g2 = toGraph [t01,t02,t03]++g3 :: RDFGraph+g3 = toGraph [t01,t04]++g4 :: RDFGraph+g4 = toGraph [t01,t05]++g4_1 :: RDFGraph+g4_1 = toGraph [arc b1 p1 o1, arc b2 p2 o2]++g4_2 :: RDFGraph+g4_2 = toGraph [arc b1 resRdfType o1, arc b2 resRdfType o2]++g5 :: RDFGraph+g5 = toGraph [t01,t02,t03,t04,t05]++g6 :: RDFGraph+g6 = toGraph [t01,t06]++g7 :: RDFGraph+g7 = toGraph [t01,t07]++t801, t802, t807, t808, t811, t812 :: Arc RDFLabel+t801 = arc s1 resRdfType o1+t802 = arc s2 resOwlSameAs o2+t807 = arc o1 p1 s1+t808 = arc s2 p1 o2+t811 = arc s1 resLogImplies o1+t812 = arc o2 resLogImplies s2++g8 :: RDFGraph+g8 = toGraph [t801,t802,t807,t808,t811,t812]++g81 :: RDFGraph+g81 = toGraph [t801,t802]++g83 :: RDFGraph+g83 = toGraph [t807,t808,t811,t812]++t911, t912, t913, t914, t921, t922, t923, t924,+ t925, t926, t927, t928 :: Arc RDFLabel+t911 = arc s1 p1 o1+t912 = arc s1 p1 o2+t913 = arc s1 p2 o2+t914 = arc s1 p2 o3+t921 = arc s2 p1 o1+t922 = arc s2 p1 o2+t923 = arc s2 p1 o3+t924 = arc s2 p1 l1+t925 = arc s2 p2 o1+t926 = arc s2 p2 o2+t927 = arc s2 p2 o3+t928 = arc s2 p2 l1++g9 :: RDFGraph+g9 = toGraph [t911,t912,t913,t914,+ t921,t922,t923,t924,+ t925,t926,t927,t928]++t1011, t1012, t1013, t1014, t1021, t1022, t1023, t1024,+ t1025, t1026, t1027, t1028 :: Arc RDFLabel+t1011 = arc s1 p1 o1+t1012 = arc o2 p1 s1+t1013 = arc s1 p2 o2+t1014 = arc o3 p2 s1+t1021 = arc s2 p1 o1+t1022 = arc s2 p1 o2+t1023 = arc s2 p1 o3+t1024 = arc s2 p1 l1+t1025 = arc o1 p2 s2+t1026 = arc o2 p2 s2+t1027 = arc o3 p2 s2+t1028 = arc l1 p2 s2++g10 :: RDFGraph+g10 = toGraph [t1011,t1012,t1013,t1014,+ t1021,t1022,t1023,t1024,+ t1025,t1026,t1027,t1028]++t1111, t1112, t1113 :: Arc RDFLabel+t1111 = arc s1 p1 v1+t1112 = arc v2 p1 o1+t1113 = arc v3 p1 v4++g11 :: RDFGraph+g11 = toGraph [t1111,t1112,t1113]++t1211, t1221, t1222, t1223, t1224 :: Arc RDFLabel+t1211 = arc b1 p1 o1+t1221 = arc b2 resRdfFirst v1+t1222 = arc b2 resRdfRest b3+t1223 = arc b3 resRdfFirst v2+t1224 = arc b3 resRdfRest resRdfNil++g12 :: RDFGraph+g12 = toGraph [t1211,t1221,t1222,t1223,t1224]++t1711, t1722, t1733 :: Arc RDFLabel+t1711 = arc s1 p1 lfr+t1722 = arc s2 p2 lxml+t1733 = arc s3 p3 lfrxml++g17 :: RDFGraph+g17 = toGraph [t1711,t1722,t1733]++tx101, tx102, tx111, tx112, tx113, tx114, tx121, tx122, tx123,+ tx124, tx125, tx126, tx127, tx128 :: Arc RDFLabel+tx101 = arc b1 resOwlSameAs s1+tx102 = arc s2 resOwlSameAs b2+tx111 = arc b1 p1 o1+tx112 = arc b1 p1 o2+tx113 = arc b1 p2 o2+tx114 = arc b1 p2 o3+tx121 = arc b2 p1 o1+tx122 = arc b2 p1 o2+tx123 = arc b2 p1 o3+tx124 = arc b2 p1 l1+tx125 = arc b2 p2 o1+tx126 = arc b2 p2 o2+tx127 = arc b2 p2 o3+tx128 = arc b2 p2 l1++x1 :: RDFGraph+x1 = toGraph [tx101,tx102,+ tx111,tx112,tx113,tx114,+ tx121,tx122,tx123,tx124,+ tx125,tx126,tx127,tx128]++tx201, tx202, tx211, tx212, tx213, tx214, tx221, tx222, tx223,+ tx224, tx225, tx226, tx227, tx228 :: Arc RDFLabel+tx201 = arc b1 resOwlSameAs s1+tx202 = arc s2 resOwlSameAs b2+tx211 = arc b1 p1 o1+tx212 = arc o2 p1 b1+tx213 = arc b1 p2 o2+tx214 = arc o3 p2 b1+tx221 = arc b2 p1 o1+tx222 = arc b2 p1 o2+tx223 = arc b2 p1 o3+tx224 = arc b2 p1 l1+tx225 = arc o1 p2 b2+tx226 = arc o2 p2 b2+tx227 = arc o3 p2 b2+tx228 = arc l1 p2 b2++x2 :: RDFGraph+x2 = toGraph [tx201,tx202,+ tx211,tx212,tx213,tx214,+ tx221,tx222,tx223,tx224,+ tx225,tx226,tx227,tx228]++tx311, tx312, tx313, tx314, tx321, tx322, tx323,+ tx324, tx325, tx326, tx327, tx328 :: Arc RDFLabel+tx311 = arc s1 p1 o1+tx312 = arc o2 p1 s1+tx313 = arc s1 p2 o2+tx314 = arc o3 p2 s1+tx321 = arc s2 p1 o1+tx322 = arc s2 p1 o2+tx323 = arc s2 p1 o3+tx324 = arc s2 p1 l1+tx325 = arc o1 p2 s2+tx326 = arc o2 p2 s2+tx327 = arc o3 p2 s2+tx328 = arc l1 p2 s2++x3 :: RDFGraph+x3 = toGraph [tx311,tx312,tx313,tx314,+ tx321,tx322,tx323,tx324,+ tx325,tx326,tx327,tx328]++tx401, tx402, tx403, tx404, tx405, tx406, tx407,+ tx408, tx409 :: Arc RDFLabel+tx401 = arc s1 resOwlSameAs b1+tx402 = arc b1 resRdfFirst o1+tx403 = arc b1 resRdfRest b2+tx404 = arc b2 resRdfFirst o2+tx405 = arc b2 resRdfRest b3+tx406 = arc b3 resRdfFirst o3+tx407 = arc b3 resRdfRest b4+tx408 = arc b4 resRdfFirst l1+tx409 = arc b4 resRdfRest resRdfNil++x4 :: RDFGraph+x4 = toGraph [tx401,tx402,tx403,tx404,+ tx405,tx406,tx407,tx408,+ tx409]++tx501, tx502, tx503, tx504, tx505, tx506, tx507,+ tx508, tx509 :: Arc RDFLabel+tx501 = arc b1 resOwlSameAs s1+tx502 = arc b1 resRdfFirst o1+tx503 = arc b1 resRdfRest b2+tx504 = arc b2 resRdfFirst o2+tx505 = arc b2 resRdfRest b3+tx506 = arc b3 resRdfFirst o3+tx507 = arc b3 resRdfRest b4+tx508 = arc b4 resRdfFirst l1+tx509 = arc b4 resRdfRest resRdfNil++x5 :: RDFGraph+x5 = toGraph [tx501,tx502,tx503,tx504,+ tx505,tx506,tx507,tx508,+ tx509]++tx601, tx602, tx603, tx604, tx605, tx606, tx607,+ tx608 :: Arc RDFLabel+tx601 = arc s1 resRdfFirst o1+tx602 = arc s1 resRdfRest b2+tx603 = arc b2 resRdfFirst o2+tx604 = arc b2 resRdfRest b3+tx605 = arc b3 resRdfFirst o3+tx606 = arc b3 resRdfRest b4+tx607 = arc b4 resRdfFirst l1+tx608 = arc b4 resRdfRest resRdfNil++x6 :: RDFGraph+x6 = toGraph [tx601,tx602,tx603,tx604,+ tx605,tx606,tx607,tx608]++tx701 :: Arc RDFLabel+tx701 = arc b1 p2 f2++x7 :: RDFGraph+x7 = NSGraph+ { namespaces = nslist+ , formulae = LookupMap [Formula b1 g2]+ , statements = [tx701]+ }++tx801 :: Arc RDFLabel+tx801 = arc f1 p2 f2++x8 :: RDFGraph+x8 = NSGraph+ { namespaces = nslist+ , formulae = LookupMap [Formula f1 g2]+ , statements = [tx801]+ }++x9 :: RDFGraph+x9 = NSGraph+ { namespaces = nslist+ , formulae = LookupMap [Formula f1 g1]+ , statements = [tx801]+ }++-- Test allocation of bnodes carries over a nested formula++tx1201, tx1202, tx1203, tx1204, tx1205, + tx1211, tx1212 :: Arc RDFLabel+tx1201 = arc s1 p1 b1+tx1202 = arc b1 p1 o1+tx1203 = arc b2 p2 f2+tx1204 = arc s3 p3 b3+tx1205 = arc b3 p3 o3+tx1211 = arc s2 p2 b4+tx1212 = arc b4 p2 o2++x12fg :: RDFGraph+x12fg = mempty { statements = [tx1211,tx1212] }+{-+x12fg = NSGraph+ { namespaces = emptyNamespaceMap+ , formulae = emptyFormulaMap+ , statements = [tx1211,tx1212]+ }+-}+ +x12 :: RDFGraph+x12 = NSGraph+ { namespaces = nslist+ , formulae = LookupMap [Formula b2 x12fg]+ , statements = [tx1201,tx1202,tx1203,tx1204,tx1205]+ }++-- List of simple anon nodes++tx1301, tx1302, tx1303, tx1304, tx1305, tx1306, tx1307,+ tx1308, tx1309 :: Arc RDFLabel+tx1301 = arc s1 resRdfFirst b1+tx1302 = arc s1 resRdfRest c1+tx1303 = arc c1 resRdfFirst b2+tx1304 = arc c1 resRdfRest c2+tx1305 = arc c2 resRdfFirst b3+tx1306 = arc c2 resRdfRest resRdfNil+tx1307 = arc b1 p1 o1+tx1308 = arc b2 p1 o2+tx1309 = arc b3 p1 o3++x13 :: RDFGraph+x13 = toGraph [tx1301,tx1302,tx1303,tx1304,tx1305,tx1306,+ tx1307,tx1308,tx1309]++-- List of more complex anon nodes++tx1401, tx1402, tx1403, tx1404, tx1405, tx1406, tx1407,+ tx1408, tx1409, tx1410, tx1411, tx1412 :: Arc RDFLabel+tx1401 = arc s1 resRdfFirst b1+tx1402 = arc s1 resRdfRest c1+tx1403 = arc c1 resRdfFirst b2+tx1404 = arc c1 resRdfRest c2+tx1405 = arc c2 resRdfFirst b3+tx1406 = arc c2 resRdfRest resRdfNil+tx1407 = arc b1 p1 o1+tx1408 = arc b1 p2 o1+tx1409 = arc b2 p1 o2+tx1410 = arc b2 p2 o2+tx1411 = arc b3 p1 o3+tx1412 = arc b3 p2 o3++x14 :: RDFGraph+x14 = toGraph [tx1401,tx1402,tx1403,tx1404,tx1405,tx1406,+ tx1407,tx1408,tx1409,tx1410,tx1411,tx1412]++-- List with nested list++tx1501, tx1502, tx1503, tx1504, tx1505, tx1506, tx1507,+ tx1508, tx1509 :: Arc RDFLabel+tx1501 = arc s1 resRdfFirst b1+tx1502 = arc s1 resRdfRest c1+tx1503 = arc c1 resRdfFirst b2+tx1504 = arc c1 resRdfRest c2+tx1505 = arc c2 resRdfFirst b3+tx1506 = arc c2 resRdfRest resRdfNil+tx1507 = arc b1 p1 o1+tx1508 = arc b2 p2 c3+tx1509 = arc b3 p1 o3++tx1521, tx1522, tx1523, tx1524, tx1525, tx1526, tx1527,+ tx1528, tx1529 :: Arc RDFLabel+tx1521 = arc c3 resRdfFirst b4+tx1522 = arc c3 resRdfRest c4+tx1523 = arc c4 resRdfFirst b5+tx1524 = arc c4 resRdfRest c5+tx1525 = arc c5 resRdfFirst b6+tx1526 = arc c5 resRdfRest resRdfNil+tx1527 = arc b4 p1 o1+tx1528 = arc b5 p1 o2+tx1529 = arc b6 p1 o3++x15 :: RDFGraph+x15 = toGraph [tx1501,tx1502,tx1503,tx1504,tx1505,tx1506,+ tx1507,tx1508,tx1509,+ tx1521,tx1522,tx1523,tx1524,tx1525,tx1526,+ tx1527,tx1528,tx1529]++-- More complex list with nested list++tx1601, tx1602, tx1603, tx1604, tx1605, tx1606, tx1607,+ tx1608, tx1609, tx1610, tx1611 :: Arc RDFLabel+tx1601 = arc s1 resRdfFirst b1+tx1602 = arc s1 resRdfRest c1+tx1603 = arc c1 resRdfFirst b2+tx1604 = arc c1 resRdfRest c2+tx1605 = arc c2 resRdfFirst b3+tx1606 = arc c2 resRdfRest resRdfNil+tx1607 = arc b1 p1 o1+tx1608 = arc b1 p2 o1+tx1609 = arc b2 p2 c3+tx1610 = arc b3 p1 o3+tx1611 = arc b3 p2 o3++tx1621, tx1622, tx1623, tx1624, tx1625, tx1626, tx1627,+ tx1628, tx1629, tx1630, tx1631, tx1632 :: Arc RDFLabel+tx1621 = arc c3 resRdfFirst b4+tx1622 = arc c3 resRdfRest c4+tx1623 = arc c4 resRdfFirst b5+tx1624 = arc c4 resRdfRest c5+tx1625 = arc c5 resRdfFirst b6+tx1626 = arc c5 resRdfRest resRdfNil+tx1627 = arc b4 p1 o1+tx1628 = arc b4 p2 o1+tx1629 = arc b5 p1 o2+tx1630 = arc b5 p2 o2+tx1631 = arc b6 p1 o3+tx1632 = arc b6 p2 o3++x16 :: RDFGraph+x16 = toGraph [tx1601,tx1602,tx1603,tx1604,tx1605,tx1606,+ tx1607,tx1608,tx1609,tx1610,tx1611,+ tx1621,tx1622,tx1623,tx1624,tx1625,tx1626,+ tx1627,tx1628,tx1629,tx1630,tx1631,tx1632]++kg1 :: RDFGraph+kg1 = toRDFGraph+ [ arc b a c ]+ where+ -- the document base is set to file:///dev/null to begin with+ mUN = Res . ScopedName dbase+ a = mUN "a"+ b = mUN "b"+ c = mUN "c"++------------------------------------------------------------+-- Simple parser tests+------------------------------------------------------------++-- check default base+simpleN3Graph_dg_01 :: B.Builder+simpleN3Graph_dg_01 = ":s1 :p1 :o1 ."++-- from the turtle documentation+simpleN3Graph_dg_02 :: B.Builder+simpleN3Graph_dg_02 =+ mconcat+ [ "# this is a complete turtle document\n"+ , "# In-scope base URI is the document URI at this point\n"+ , "<a1> <b1> <c1> .\n"+ , "@base <http://example.org/ns/> .\n"+ , "# In-scope base URI is http://example.org/ns/ at this point\n"+ , "<a2> <http://example.org/ns/b2> <c2> .\n"+ , "@base <foo/> .\n"+ , "# In-scope base URI is http://example.org/ns/foo/ at this point\n"+ , "<a3> <b3> <c3> .\n"+ , "@prefix : <bar#> .\n"+ , ":a4 :b4 :c4 .\n"+ , "@prefix : <http://example.org/ns2#> .\n"+ , ":a5 :b5 :c5 .\n"+ ]+ +-- try out file prefixes+simpleN3Graph_dg_03 :: B.Builder +simpleN3Graph_dg_03 = + mconcat+ [ "@prefix : <file:///home/swish/photos/>.\n"+ , "@prefix me: <http://example.com/ns#>.\n"+ , ":myphoto me:photoOf me:me."+ ]+ +commonPrefixes :: B.Builder+commonPrefixes =+ mconcat $ map namespaceToBuilder [base1, base2, base3]++rdfPrefix :: B.Builder+rdfPrefix = namespaceToBuilder namespaceRDF++-- Single statement using <uri> form+simpleN3Graph_g1_01 :: B.Builder+simpleN3Graph_g1_01 =+ "<http://id.ninebynine.org/wip/2003/test/graph1/node/s1> <http://id.ninebynine.org/wip/2003/test/graph1/node/p1> <http://id.ninebynine.org/wip/2003/test/graph1/node/o1> . "++-- Single statement using prefix:name form+simpleN3Graph_g1_02 :: B.Builder+simpleN3Graph_g1_02 =+ namespaceToBuilder base1 `mappend`+ " base1:s1 base1:p1 base1:o1 . "++-- Single statement using prefix:name form+-- (this was added to check that the parser did not+-- think we meant 'a:a a :b .' here)+--+simpleN3Graph_g1_02a :: B.Builder+simpleN3Graph_g1_02a =+ namespaceToBuilder basea `mappend`+ "a:a a:b a:c ."++nToB :: Namespace -> B.Builder+nToB = B.fromString . show . nsURI++-- Single statement using :name form+simpleN3Graph_g1_03 :: B.Builder+simpleN3Graph_g1_03 =+ mconcat+ [ "@prefix : <", nToB base1, "> .\n"+ , " :s1 :p1 :o1 . "+ ]+ +-- Check we can handle ':' and 'prefix:' forms.+--+simpleN3Graph_g1_03_1 :: B.Builder+simpleN3Graph_g1_03_1 =+ mconcat+ [ "@prefix : <", nToB base1, "> .\n"+ , " : : :."+ ]++simpleN3Graph_g1_03_2 :: B.Builder+simpleN3Graph_g1_03_2 =+ mconcat+ [ "@prefix b: <", nToB base1, "> .\n"+ , "b: b: b:. "+ ]++-- Single statement using relative URI form+simpleN3Graph_g1_04 :: B.Builder+simpleN3Graph_g1_04 =+ mconcat+ [ "@base <", nToB base1, "> .\n"+ , " <s1> <p1> <o1> . "+ ]++-- Single statement using blank nodes+simpleN3Graph_g1_05 :: B.Builder+simpleN3Graph_g1_05 =+ mconcat+ [ "@base <", nToB base1, "> .\n"+ , " _:b1 _:b2 _:b3 . "+ ]++simpleN3Graph_g1_05_1 :: B.Builder+simpleN3Graph_g1_05_1 =+ commonPrefixes `mappend`+ " _:b1 base1:p1 base1:o1 . "++-- Single statement with junk following+simpleN3Graph_g1_06 :: B.Builder+simpleN3Graph_g1_06 =+ mconcat+ [ namespaceToBuilder base1+ , " base1:s1 base1:p1 base1:o1 . " + , " **** "+ ]++-- Multiple statements+simpleN3Graph_g2 :: B.Builder+simpleN3Graph_g2 =+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 base1:o1 . \n"+ , " base2:s2 base1:p1 base2:o2 . \n"+ , " base3:s3 base1:p1 base3:o3 . \n"+ ]++-- Graph with literal+simpleN3Graph_g3 :: B.Builder+simpleN3Graph_g3 =+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 base1:o1 . \n"+ , " base1:s1 base1:p1 \"l1\" . \n"+ ]+ +-- Graph with nodeid+simpleN3Graph_g4 :: B.Builder+simpleN3Graph_g4 =+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 base1:o1 . \n"+ , " base2:s2 base1:p1 _:b1 . \n"+ ]+ +simpleN3Graph_g4_1 :: B.Builder+simpleN3Graph_g4_1 =+ commonPrefixes `mappend`+ " _:b1 base1:p1 base1:o1._:b2 base2:p2 base2:o2."++simpleN3Graph_g4_2 :: B.Builder+simpleN3Graph_g4_2 =+ commonPrefixes `mappend`+ " _:foo1 a base1:o1. _:bar2 a base2:o2."++-- same graph as g4_2+simpleN3Graph_g4_3 :: B.Builder+simpleN3Graph_g4_3 =+ commonPrefixes `mappend`+ " [] a base1:o1.[a base2:o2]."++-- Graph with literal and nodeid+simpleN3Graph_g5 :: B.Builder+simpleN3Graph_g5 =+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 base1:o1 . \n"+ , " base2:s2 base1:p1 base2:o2 . \n"+ , " base3:s3 base1:p1 base3:o3 . \n"+ , " base1:s1 base1:p1 \"l1\" . \n" + , " base2:s2 base1:p1 _:b1 . \n"+ ]++-- Triple-quoted literal+simpleN3Graph_g6 :: B.Builder +simpleN3Graph_g6 =+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 base1:o1 . \n"+ , " base3:s3 base1:p1 \"\"\"l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'\"\"\" . \n"+ ]++-- String escapes+simpleN3Graph_g7 :: B.Builder+simpleN3Graph_g7 =+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 base1:o1 . \n"+ , " base3:s3 base2:p2 "+ , " \"l3--\\r\\\"\\'\\\\--\\u0020--\\U000000A0--\" "+ , " . \n"+ ]++-- Different verb forms+simpleN3Graph_g8 :: B.Builder+simpleN3Graph_g8 =+ mconcat+ [ commonPrefixes+ , " base1:s1 a base1:o1 . \n"+ , " base2:s2 = base2:o2 . \n"+ , " base1:s1 @is base1:p1 @of base1:o1 . \n"+ , " base2:s2 @has base1:p1 base2:o2 . \n"+ , " base1:s1 => base1:o1 . \n"+ , " base2:s2 <= base2:o2 . \n"+ ]+ +simpleN3Graph_g8b :: B.Builder+simpleN3Graph_g8b =+ mconcat+ [ commonPrefixes+ , " base1:s1 a base1:o1 . \n"+ , " base2:s2 = base2:o2 . \n"+ , " base1:s1 is base1:p1 of base1:o1 . \n"+ , " base2:s2 @has base1:p1 base2:o2 . \n"+ , " base1:s1 => base1:o1 . \n"+ , " base2:s2 <= base2:o2 . \n"+ ]+ +simpleN3Graph_g81 :: B.Builder+simpleN3Graph_g81 =+ mconcat+ [ commonPrefixes+ , " base1:s1 a base1:o1 . \n"+ , " base2:s2 = base2:o2 . \n"+ ]++simpleN3Graph_g83 :: B.Builder+simpleN3Graph_g83 =+ mconcat+ [ commonPrefixes+ , " base1:s1 @is base1:p1 @of base1:o1 . \n"+ , " base2:s2 @has base1:p1 base2:o2 . \n"+ , " base1:s1 => base1:o1 . \n"+ , " base2:s2 <= base2:o2 . \n"+ ]++simpleN3Graph_g83b :: B.Builder+simpleN3Graph_g83b =+ mconcat+ [ commonPrefixes+ , " base1:s1 is base1:p1 of base1:o1 . \n"+ , " base2:s2 @has base1:p1 base2:o2 . \n"+ , " base1:s1 => base1:o1 . \n"+ , " base2:s2 <= base2:o2 . \n"+ ]+ +-- Semicolons and commas+simpleN3Graph_g9 :: B.Builder+simpleN3Graph_g9 =+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 base1:o1 ; \n"+ , " base1:p1 base2:o2 ; \n"+ , " base2:p2 base2:o2 ; \n"+ , " base2:p2 base3:o3 . \n"+ , " base2:s2 base1:p1 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ; \n"+ , " base2:p2 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" . \n"+ ]++-- ensure you can end a property list with a semicolon+simpleN3Graph_g9b :: B.Builder+simpleN3Graph_g9b =+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 base1:o1 ; \n"+ , " base1:p1 base2:o2 ; \n"+ , " base2:p2 base2:o2 ; \n"+ , " base2:p2 base3:o3;. \n"+ , " base2:s2 base1:p1 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ; \n"+ , " base2:p2 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ;. \n"+ ]+ +-- 'is ... of' and semicolons and commas+simpleN3Graph_g10 :: B.Builder+simpleN3Graph_g10 =+ mconcat+ [ commonPrefixes + , " base1:s1 @has base1:p1 base1:o1 ; \n"+ , " @is base1:p1 @of base2:o2 ; \n"+ , " @has base2:p2 base2:o2 ; \n"+ , " @is base2:p2 @of base3:o3 . \n"+ , " base2:s2 @has base1:p1 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ; \n"+ , " @is base2:p2 @of base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" . \n"+ ]+ +-- Simple statements using ?var form+simpleN3Graph_g11 :: B.Builder+simpleN3Graph_g11 =+ mconcat+ [ namespaceToBuilder base1+ , " base1:s1 base1:p1 ?var1 . \n" + , " ?var2 base1:p1 base1:o1 . \n" + , " ?var3 base1:p1 ?var4 . \n"+ ]+ +-- Bare anonymous nodes+simpleN3Graph_g12 :: B.Builder+simpleN3Graph_g12 =+ mconcat+ [ namespaceToBuilder base1+ , " [ base1:p1 base1:o1 ] . \n" + , " ( ?var1 ?var2 ) . \n"+ ]+ +-- Literals with dataype and language+simpleN3Graph_g17 :: B.Builder+simpleN3Graph_g17 =+ mconcat+ [ commonPrefixes+ , rdfPrefix+ , " base1:s1 base1:p1 \"chat\"@fr . \n " + , " base2:s2 base2:p2 \"<br/>\"^^rdf:XMLLiteral . \n " + , " base3:s3 base3:p3 \"<em>chat</em>\"^^rdf:XMLLiteral . \n "+ ]+ +emsg16 :: String+{- parsec error+emsg16 = intercalate "\n" [+ "",+ "@prefix base1 : <http://id.ninebynine.org/wip/2003/test/graph1/node/> . base1:s1 base1:p1 base1:o1 . **** ",+ " ^",+ "(line 1, column 103 indicated by the '^' sign above):",+ "",+ "unexpected \"*\"",+ "expecting declaration, \"@\", pathitem or end of input"+ ]+-}+emsg16 = "Expected end of input (EOF)"++simpleTestSuite :: Test+simpleTestSuite = TestList+ [ parseTestB dqn "simpleTestd01" simpleN3Graph_dg_01 dg1 noError+ , parseTestB dqn "simpleTestd02" simpleN3Graph_dg_02 dg2 noError+ , parseTestB dqn "simpleTestd03" simpleN3Graph_dg_03 dg3 noError+ , parseTest "simpleTest011" simpleN3Graph_g1_01 g1 noError+ , parseTest "simpleTest012" simpleN3Graph_g1_02 g1 noError+ , parseTest "simpleTest012a" simpleN3Graph_g1_02a g1a noError+ , parseTest "simpleTest013" simpleN3Graph_g1_03 g1 noError+ , parseTest "simpleTest013_1" simpleN3Graph_g1_03_1 g1_31 noError+ , parseTest "simpleTest013_2" simpleN3Graph_g1_03_2 g1_31 noError+ , parseTest "simpleTest014" simpleN3Graph_g1_04 g1 noError+ , parseTest "simpleTest015" simpleN3Graph_g1_05 g1b noError+ , parseTest "simpleTest015_1" simpleN3Graph_g1_05_1 g1b_1 noError+ , parseTest "simpleTest016" simpleN3Graph_g1_06 emptyRDFGraph emsg16+ , parseTest "simpleTest03" simpleN3Graph_g2 g2 noError+ , parseTest "simpleTest04" simpleN3Graph_g3 g3 noError+ , parseTest "simpleTest05" simpleN3Graph_g4 g4 noError+ , parseTest "simpleTest05_1" simpleN3Graph_g4_1 g4_1 noError+ , parseTest "simpleTest05_2" simpleN3Graph_g4_2 g4_2 noError+ , parseTest "simpleTest05_3" simpleN3Graph_g4_3 g4_2 noError+ , parseTest "simpleTest06" simpleN3Graph_g5 g5 noError+ , parseTest "simpleTest07" simpleN3Graph_g6 g6 noError+ , parseTest "simpleTest08" simpleN3Graph_g7 g7 noError+ , parseTest "simpleTest09" simpleN3Graph_g8 g8 noError+ , parseTest "simpleTest09b" simpleN3Graph_g8b g8 noError+ , parseTest "simpleTest10" simpleN3Graph_g81 g81 noError+ , parseTest "simpleTest12" simpleN3Graph_g83 g83 noError+ , parseTest "simpleTest12b" simpleN3Graph_g83b g83 noError+ , parseTest "simpleTest13" simpleN3Graph_g9 g9 noError+ , parseTest "simpleTest13b" simpleN3Graph_g9b g9 noError+ , parseTest "simpleTest14" simpleN3Graph_g10 g10 noError+ , parseTest "simpleTest15" simpleN3Graph_g11 g11 noError+ , parseTest "simpleTest16" simpleN3Graph_g12 g12 noError+ , parseTest "simpleTest17" simpleN3Graph_g17 g17 noError+ ]++------------------------------------------------------------+-- Literal parser tests+------------------------------------------------------------+--+-- Expand upon the literal testing done above+--++litN3Graph_g1 :: B.Builder+litN3Graph_g1 =+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 \"true\"^^<http://www.w3.org/2001/XMLSchema#boolean>.\n"+ , " base2:s2 base2:p2 \"false\"^^<http://www.w3.org/2001/XMLSchema#boolean>.\n"+ , " base3:s3 base3:p3 \"true\"^^<http://www.w3.org/2001/XMLSchema#boolean>.\n"+ ]+ +litN3Graph_g2 :: B.Builder+litN3Graph_g2 =+ mconcat+ [ commonPrefixes+ , namespaceToBuilder xsdNS+ , " base1:s1 base1:p1 \"true\"^^xsd:boolean.\n"+ , " base2:s2 base2:p2 \"false\"^^xsd:boolean.\n"+ , " base3:s3 base3:p3 \"true\"^^xsd:boolean.\n"+ ]+ +litN3Graph_g3 :: B.Builder+litN3Graph_g3 =+ mconcat+ [ commonPrefixes+ , " base1:s1 base1:p1 @true.\n"+ , " base2:s2 base2:p2 @false.\n"+ , " base3:s3 base3:p3 true.\n"+ ]+ +litN3Graph_g4 :: B.Builder+litN3Graph_g4 =+ commonPrefixes `mappend`+ " base1:s1 base1:p1 ( true 1 2.0 -2.21 -2.3e-4 ).\n"++lit_g1 :: RDFGraph+lit_g1 = toGraph [ arc s1 p1 bTrue+ , arc s2 p2 bFalse+ , arc s3 p3 bTrue+ ]++-- at the moment we could use lit_g1 rather than lit_g2, since+-- the namespace map isn't used in the comparison.+--+lit_g2 :: RDFGraph+lit_g2 = lit_g1 { namespaces = xnslist }++bOne, b20, b221, b23e4 :: RDFLabel+bOne = Lit "1" $ Just xsdInteger+b20 = Lit "2.0" $ Just xsdDecimal+b221 = Lit "-2.21" $ Just xsdDecimal+b23e4 = Lit "-2.3E-4" $ Just xsdDouble++lit_g4 :: RDFGraph+lit_g4 = mempty {+ namespaces = xnslist+ , statements = [+ arc s1 p1 b1+ , arc b1 resRdfFirst bTrue+ , arc b1 resRdfRest b2+ , arc b2 resRdfFirst bOne+ , arc b2 resRdfRest b3+ , arc b3 resRdfFirst b20+ , arc b3 resRdfRest b4+ , arc b4 resRdfFirst b221+ , arc b4 resRdfRest b5+ , arc b5 resRdfFirst b23e4+ , arc b5 resRdfRest resRdfNil+ ]+ }++litTestSuite :: Test+litTestSuite = TestList+ [ parseTest "litTest01" litN3Graph_g1 lit_g1 noError+ , parseTest "litTest02" litN3Graph_g2 lit_g2 noError+ , parseTest "litTest03" litN3Graph_g3 lit_g2 noError+ , parseTest "litTest04" litN3Graph_g4 lit_g4 noError+ ]++------------------------------------------------------------+-- Exotic parser tests+------------------------------------------------------------+--+-- These tests cover various forms of anonymous nodes+-- [...], lists and formula. together with uses of ':-'+--++-- Simple anon nodes, with semicolons and commas+exoticN3Graph_x1 :: B.Builder+exoticN3Graph_x1 =+ mconcat+ [ commonPrefixes+ , " [ base1:p1 base1:o1 ; \n"+ , " base1:p1 base2:o2 ; \n"+ , " base2:p2 base2:o2 ; \n"+ , " base2:p2 base3:o3 ] = base1:s1 . \n"+ , " base2:s2 = \n"+ , " [ base1:p1 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ; \n"+ , " base2:p2 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ] . \n"+ ]+ +-- check semi-colons at end of property list+exoticN3Graph_x1b :: B.Builder+exoticN3Graph_x1b =+ mconcat+ [ commonPrefixes+ , " [ base1:p1 base1:o1 ; \n"+ , " base1:p1 base2:o2 ; \n"+ , " base2:p2 base2:o2 ; \n"+ , " base2:p2 base3:o3; ] = base1:s1 . \n"+ , " base2:s2 = \n"+ , " [ base1:p1 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ; \n"+ , " base2:p2 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ; ] ;. \n"+ ]+ +-- Simple anon nodes, with 'is ... of' and semicolons and commas+exoticN3Graph_x2 :: B.Builder+exoticN3Graph_x2 =+ mconcat+ [ commonPrefixes+ , " [ @has base1:p1 base1:o1 ; \n"+ , " @is base1:p1 @of base2:o2 ; \n"+ , " @has base2:p2 base2:o2 ; \n"+ , " @is base2:p2 @of base3:o3 ] = base1:s1 . \n"+ , " base2:s2 = \n"+ , " [ @has base1:p1 base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ; \n"+ , " @is base2:p2 @of base1:o1 , \n"+ , " base2:o2 , \n"+ , " base3:o3 , \n"+ , " \"l1\" ] . \n"+ ]++-- List nodes++exoticN3Graph_x4 :: B.Builder+exoticN3Graph_x4 =+ commonPrefixes `mappend`+ " base1:s1 = (base1:o1 base2:o2 base3:o3 \"l1\") .\n"++exoticN3Graph_x5 :: B.Builder+exoticN3Graph_x5 =+ commonPrefixes `mappend`+ " (base1:o1 base2:o2 base3:o3 \"l1\") = base1:s1 .\n"++-- Formula nodes, with and without :-++exoticN3Graph_x7 :: B.Builder+exoticN3Graph_x7 =+ mconcat+ [ commonPrefixes + , " { base1:s1 base1:p1 base1:o1 . \n"+ , " base2:s2 base1:p1 base2:o2 . \n"+ , " base3:s3 base1:p1 base3:o3 . } \n"+ , " base2:p2 base2:f2 . "+ ]+ +-- Test allocation of bnodes carries over a nested formula+exoticN3Graph_x12 :: B.Builder+exoticN3Graph_x12 =+ mconcat+ [ commonPrefixes + , " base1:s1 base1:p1 [ base1:p1 base1:o1 ] . \n"+ , " { base2:s2 base2:p2 [ base2:p2 base2:o2 ] . } \n"+ , " base2:p2 base2:f2 . \n"+ , " base3:s3 base3:p3 [ base3:p3 base3:o3 ] ."+ ]++exoticTestSuite :: Test+exoticTestSuite = + TestList+ [ parseTest "exoticTest01" exoticN3Graph_x1 x1 noError+ , parseTest "exoticTest01b" exoticN3Graph_x1b x1 noError+ , parseTest "exoticTest02" exoticN3Graph_x2 x2 noError+ , parseTest "exoticTest04" exoticN3Graph_x4 x4 noError+ , parseTest "exoticTest05" exoticN3Graph_x5 x5 noError+ , parseTest "exoticTest07" exoticN3Graph_x7 x7 noError+ , parseTest "exoticTest12" exoticN3Graph_x12 x12 noError+ , testGraphEq "exoticTest20" False x7 x8+ , testGraphEq "exoticTest21" False x8 x9+ ]++keywordN3Graph_01 :: B.Builder+keywordN3Graph_01 = + "@keywords .\n" `mappend`+ "b a c . "++-- a modification of simpleN3Graph_g8+keywordN3Graph_02 :: B.Builder+keywordN3Graph_02 = + mconcat+ [ commonPrefixes + , "@prefix : <http://id.ninebynine.org/wip/2003/test/graph1/node/>." + , "@keywords is,has.\n"+ , " s1 @a o1 . \n"+ , " base2:s2 = base2:o2 . \n"+ , " s1 is base1:p1 @of o1 . \n"+ , " base2:s2 has p1 base2:o2 . \n"+ , " s1 => o1 . \n"+ , " base2:s2 <= <http://id.ninebynine.org/wip/2003/test/graph2/node#o2> . \n" -- object is base2:o2+ ]+ +-- a modification of simpleN3Graph_g83+keywordN3Graph_03 :: B.Builder+keywordN3Graph_03 = + mconcat+ [ commonPrefixes+ , "@keywords of.\n"+ , " base1:s1 @is base1:p1 of base1:o1 . \n"+ , " base2:s2 @has base1:p1 base2:o2 . \n"+ , " base1:s1 => base1:o1 . \n"+ , " base2:s2 <= base2:o2 . \n"+ ]++keywordTestSuite :: Test+keywordTestSuite = TestList+ [ parseTestB dqn "keywordTest01" keywordN3Graph_01 kg1 noError+ , parseTest "keywordTest02" keywordN3Graph_02 g8 noError+ , parseTest "keywordTest03" keywordN3Graph_03 g83 noError+ ]+ +------------------------------------------------------------+-- Test parser failure+------------------------------------------------------------+--+-- Very limited at the moment.+--++failTest :: String -> B.Builder -> String -> Test+failTest lbl gr = parseTest lbl gr emptyRDFGraph ++failN3Graph_g1 :: B.Builder+failN3Graph_g1 =+ commonPrefixes `mappend`+ " base1:s1 base2:p2 unknown3:o3 . "++fail1 :: String+{- parsec error+fail1 = intercalate "\n" [+ "",+ "@prefix base3 : <http://id.ninebynine.org/wip/2003/test/graph3/node> . ",+ " base1:s1 base2:p2 unknown3:o3 . ",+ " ^",+ "(line 4, column 29 indicated by the '^' sign above):",+ "",+ "unexpected Prefix 'unknown3:' not bound."+ ]+-}+fail1 = "When looking for a non-empty sequence with separators:\n\tPrefix 'unknown3:' not bound."++failTestSuite :: Test+failTestSuite = TestList+ [ failTest "failTest01" failN3Graph_g1 fail1+ ]++------------------------------------------------------------+-- All tests+------------------------------------------------------------++allTests :: Test+allTests = TestList+ [ charTestSuite+ , nameTestSuite+ -- , prefixTestSuite , absUriRefTestSuite , uriRef2TestSuite , simpleTestSuite
tests/NTTest.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedString -- -- This Module contains test cases for the NTriples modules: -- "NTParser" and "NTFormatter".@@ -18,7 +20,7 @@ module Main where import Swish.RDF.NTParser (parseNT)-import Swish.RDF.NTFormatter (formatGraphAsString)+import Swish.RDF.NTFormatter (formatGraphAsLazyText) import Swish.RDF.RDFGraph ( RDFGraph, RDFLabel(..)@@ -26,9 +28,9 @@ , toRDFGraph ) -import Swish.Utils.Namespace (makeUriScopedName)+-- import Swish.Utils.Namespace (makeURIScopedName) -import Swish.RDF.Vocabulary (langName, rdf_XMLLiteral)+import Swish.RDF.Vocabulary (langName, rdfXMLLiteral) import Swish.RDF.GraphClass (arc) @@ -36,13 +38,15 @@ ( Test(TestCase,TestList) , assertEqual, runTestTT ) +import qualified Data.Text.Lazy as T+ ------------------------------------------------------------ -- Parser tests ------------------------------------------------------------ -- check that parsing the input creates the expected graph -checkGraph :: String -> String -> RDFGraph -> Test+checkGraph :: String -> T.Text -> RDFGraph -> Test checkGraph lab inp gr = TestList [ TestCase ( assertEqual ("parse-failed:"++lab) noError pe )@@ -59,13 +63,13 @@ -- check that the -- parseNT input == parseNT (formatGraph (parse NT input)) ---roundTrip :: String -> String -> Test+roundTrip :: String -> T.Text -> Test roundTrip lbl inp = let (pErr1, pGr1) = case parseNT inp of Right g -> (noError, g) Left s -> (s, emptyRDFGraph) - inp2 = formatGraphAsString pGr1+ inp2 = formatGraphAsLazyText pGr1 (pErr2, pGr2) = case parseNT inp2 of Right g -> (noError, g)@@ -88,7 +92,7 @@ -- ------------------------------------------------------------ -w3cTest :: String+w3cTest :: T.Text w3cTest = "#\n# Copyright World Wide Web Consortium, (Massachusetts Institute of\n# Technology, Institut National de Recherche en Informatique et en\n# Automatique, Keio University).\n#\n# All Rights Reserved.\n#\n# Please see the full Copyright clause at\n# <http://www.w3.org/Consortium/Legal/copyright-software.html>\n#\n# Test file with a variety of legal N-Triples\n#\n# Dave Beckett - http://purl.org/net/dajobe/\n# \n# $Id: test.nt,v 1.7 2003/10/06 15:52:19 dbeckett2 Exp $\n# \n#####################################################################\n\n# comment lines\n \t \t # comment line after whitespace\n# empty blank line, then one with spaces and tabs\n\n \t\n<http://example.org/resource1> <http://example.org/property> <http://example.org/resource2> .\n_:anon <http://example.org/property> <http://example.org/resource2> .\n<http://example.org/resource2> <http://example.org/property> _:anon .\n# spaces and tabs throughout:\n \t <http://example.org/resource3> \t <http://example.org/property>\t <http://example.org/resource2> \t.\t \n\n# line ending with CR NL (ASCII 13, ASCII 10)\n<http://example.org/resource4> <http://example.org/property> <http://example.org/resource2> .\r\n\n# 2 statement lines separated by single CR (ASCII 10)\n<http://example.org/resource5> <http://example.org/property> <http://example.org/resource2> .\r<http://example.org/resource6> <http://example.org/property> <http://example.org/resource2> .\n\n\n# All literal escapes\n<http://example.org/resource7> <http://example.org/property> \"simple literal\" .\n<http://example.org/resource8> <http://example.org/property> \"backslash:\\\\\" .\n<http://example.org/resource9> <http://example.org/property> \"dquote:\\\"\" .\n<http://example.org/resource10> <http://example.org/property> \"newline:\\n\" .\n<http://example.org/resource11> <http://example.org/property> \"return\\r\" .\n<http://example.org/resource12> <http://example.org/property> \"tab:\\t\" .\n\n# Space is optional before final .\n<http://example.org/resource13> <http://example.org/property> <http://example.org/resource2>.\n<http://example.org/resource14> <http://example.org/property> \"x\".\n<http://example.org/resource15> <http://example.org/property> _:anon.\n\n# \\u and \\U escapes\n# latin small letter e with acute symbol \\u00E9 - 3 UTF-8 bytes #xC3 #A9\n<http://example.org/resource16> <http://example.org/property> \"\\u00E9\" .\n# Euro symbol \\u20ac - 3 UTF-8 bytes #xE2 #x82 #xAC\n<http://example.org/resource17> <http://example.org/property> \"\\u20AC\" .\n# resource18 test removed\n# resource19 test removed\n# resource20 test removed\n\n# XML Literals as Datatyped Literals\n<http://example.org/resource21> <http://example.org/property> \"\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource22> <http://example.org/property> \" \"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource23> <http://example.org/property> \"x\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource23> <http://example.org/property> \"\\\"\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource24> <http://example.org/property> \"<a></a>\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource25> <http://example.org/property> \"a <b></b>\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource26> <http://example.org/property> \"a <b></b> c\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource26> <http://example.org/property> \"a\\n<b></b>\\nc\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n<http://example.org/resource27> <http://example.org/property> \"chat\"^^<http://www.w3.org/2000/01/rdf-schema#XMLLiteral> .\n# resource28 test removed 2003-08-03\n# resource29 test removed 2003-08-03\n\n# Plain literals with languages\n<http://example.org/resource30> <http://example.org/property> \"chat\"@fr .\n<http://example.org/resource31> <http://example.org/property> \"chat\"@en .\n\n# Typed Literals\n<http://example.org/resource32> <http://example.org/property> \"abc\"^^<http://example.org/datatype1> .\n# resource33 test removed 2003-08-03\n" ------------------------------------------------------------@@ -96,22 +100,29 @@ ------------------------------------------------------------ s1, p1, p2, o1 :: RDFLabel-s1 = Res $ makeUriScopedName "urn:b#s1"-p1 = Res $ makeUriScopedName "urn:b#p1"-p2 = Res $ makeUriScopedName "http://example.com/pred2"-o1 = Res $ makeUriScopedName "urn:b#o1"+s1 = Res $ "urn:b#s1" -- rely on IsString to convert to ScopedName+p1 = Res $ "urn:b#p1"+p2 = Res $ "http://example.com/pred2"+o1 = Res $ "urn:b#o1"+{-+s1 = Res $ makeURIScopedName "urn:b#s1"+p1 = Res $ makeURIScopedName "urn:b#p1"+p2 = Res $ makeURIScopedName "http://example.com/pred2"+o1 = Res $ makeURIScopedName "urn:b#o1"+-} -l0, l1, l2, l3 :: RDFLabel+l0, l1, l2, l3, l4 :: RDFLabel l0 = Lit "" Nothing l1 = Lit "l1" Nothing l2 = Lit "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'" Nothing l3 = Lit "l3--\r\"'\\--\x20&--\x17A&--" Nothing+l4 = Lit "l4 \\" Nothing lfr, lgben, lxml1, lxml2 :: RDFLabel lfr = Lit "chat" (Just $ langName "fr") lgben = Lit "football" (Just $ langName "en-gb")-lxml1 = Lit "<br/>" (Just rdf_XMLLiteral)-lxml2 = Lit "<em>chat</em>" (Just rdf_XMLLiteral)+lxml1 = Lit "<br/>" (Just rdfXMLLiteral)+lxml2 = Lit "<em>chat</em>" (Just rdfXMLLiteral) b1 , b2 :: RDFLabel b1 = Blank "x1"@@ -127,7 +138,7 @@ mkGr1 :: RDFLabel -> RDFLabel -> RDFLabel -> RDFGraph mkGr1 s p o = toRDFGraph [arc s p o] -g1, g2, g3, g4, g5, g6, g7, g8, g9, g10, g11 :: RDFGraph+g1, g2, g3, g4, g5, g6, g7, g8, g9, g10, g11, g12 :: RDFGraph g1 = mkGr1 s1 p1 o1 g2 = mkGr1 s1 p1 l0 g3 = mkGr1 s1 p1 l1@@ -139,6 +150,7 @@ g9 = mkGr1 s1 p1 lxml2 g10 = mkGr1 s1 p1 b1 g11 = mkGr1 b2 p1 b1+g12 = mkGr1 s1 p1 l4 gm1 :: RDFGraph gm1 = toRDFGraph [arc b2 p2 b1, arc b2 p1 o1]@@ -147,7 +159,7 @@ -- Input documents ------------------------------------------------------------ -empty1, empty2, empty3, empty4, empty5 :: String+empty1, empty2, empty3, empty4, empty5 :: T.Text {- empty3 and empty4 are not valid NTriple documents since they do@@ -160,7 +172,7 @@ empty5 = "\n # a comment\n " graph1, graph2, graph3, graph4, graph5, graph6, graph7, graph8,- graph9, graph10, graph11 :: String+ graph9, graph10, graph11, graph12 :: T.Text graph1 = "<urn:b#s1> <urn:b#p1> <urn:b#o1>." graph2 = "<urn:b#s1> <urn:b#p1> \"\"."@@ -173,8 +185,9 @@ graph9 = "<urn:b#s1> <urn:b#p1> \"<em>chat</em>\"^^<http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral>." graph10 = "<urn:b#s1> <urn:b#p1> _:x1 . " graph11 = "_:genid23 <urn:b#p1> _:x1 . "+graph12 = "<urn:b#s1> <urn:b#p1> \"l4 \\\\\" ." -graphm1, graphm1r :: String+graphm1, graphm1r :: T.Text graphm1 = "_:genid23 <urn:b#p1> <urn:b#o1> .\n\n # test \n_:genid23 <http://example.com/pred2> _:x1 .\n\n" graphm1r = "_:genid23 <http://example.com/pred2> _:x1.\n_:genid23 <urn:b#p1> <urn:b#o1>.\n"@@ -201,6 +214,7 @@ , roundTrip "graph9" graph9 , roundTrip "graph10" graph10 , roundTrip "graph11" graph11 + , roundTrip "graph12" graph12 , roundTrip "graphm1" graphm1 , roundTrip "graphm1r" graphm1r , roundTrip "W3C test" w3cTest@@ -228,6 +242,7 @@ , checkGraph "graph9" graph9 g9 , checkGraph "graph10" graph10 g10 , checkGraph "graph11" graph11 g11+ , checkGraph "graph12" graph12 g12 , checkGraph "graphm1" graphm1 gm1 , checkGraph "graphm1r" graphm1r gm1 ]
tests/QNameTest.hs view
@@ -10,65 +10,74 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings ----- This module defines test cases for QName data+-- This module defines test cases for QName data. It also throws in a few+-- tests for the Namespace module. -- -------------------------------------------------------------------------------- module Main where import Swish.Utils.QName- ( QName(..)- , newQName, qnameFromPair, qnameFromURI- , getNamespace, getLocalName, getQNameURI- , splitURI- )--import Test.HUnit- ( Test(TestCase,TestList)- , assertEqual- , runTestTT+ ( QName+ , newQName+ , qnameFromURI+ , getNamespace+ , getLocalName+ , getQNameURI ) +import Swish.Utils.Namespace (makeQNameScopedName, getQName, getScopedNameURI)+import Test.HUnit (Test(TestCase,TestList), assertEqual, runTestTT) +import Network.URI (URI, parseURIReference)+import Data.Maybe (fromJust) +import qualified Data.Text as T ------------------------------------------------------------ -- Define some common values ------------------------------------------------------------ -base1, base2, base3, base4, base5 :: String-base1 = "http://id.ninebynine.org/wip/2003/test/graph1/node#"-base2 = "http://id.ninebynine.org/wip/2003/test/graph2/node/"-base3 = "http://id.ninebynine.org/wip/2003/test/graph3/node"-base4 = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"-base5 = "http://id.ninebynine.org/wip/2003/test/graph5/"--qb1s1, qb2s2, qb3s3, qb3, qb3bm, qb4m :: QName-qb1s1 = QName base1 "s1"-qb2s2 = QName base2 "s2"-qb3s3 = QName base3 "s3"-qb3 = QName base3 ""-qb3bm = QName base3 "basemore"-qb4m = QName base4 "more"+toURI :: String -> URI+toURI = fromJust . parseURIReference -qb5, qb5s5 :: QName-qb5 = QName base5 ""-qb5s5 = QName base5 "s5"+base1, base2, base3, base4, base5, base6, base7 :: URI+base1 = toURI "http://id.ninebynine.org/wip/2003/test/graph1/node#"+base2 = toURI "http://id.ninebynine.org/wip/2003/test/graph2/node/"+base3 = toURI "http://id.ninebynine.org/wip/2003/test/graph3/node"+base4 = toURI "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"+base5 = toURI "http://id.ninebynine.org/wip/2003/test/graph5/"+base6 = toURI "file://home/swish/"+base7 = toURI "urn:long:separator:path" -- should this really be "urn:"?+ +qb1s1, qb2s2, qb3s3, qb3, qb3bm, qb4m, qb5, qb5s5, qb6, qb7 :: QName+qb1s1 = newQName base1 "s1"+qb2s2 = newQName base2 "s2"+qb3s3 = newQName base3 "s3"+qb3 = newQName base3 ""+qb3bm = newQName base3 "basemore"+qb4m = newQName base4 "more"+qb5 = newQName base5 ""+qb5s5 = newQName base5 "s5"+qb6 = newQName base6 "file.dat"+qb7 = newQName base7 "" qb1st1, qb2st2, qb3st3 :: QName-qb1st1 = QName base1 "st1"-qb2st2 = QName base2 "st2"-qb3st3 = QName base3 "st3"+qb1st1 = newQName base1 "st1"+qb2st2 = newQName base2 "st2"+qb3st3 = newQName base3 "st3" +testIsEq :: (Show a, Eq a) => String -> String -> a -> a -> Test+testIsEq lbl1 lbl2 a b = TestCase (assertEqual (lbl1++":"++lbl2) a b)+ ------------------------------------------------------------ -- QName equality tests ------------------------------------------------------------ testQNameEq :: String -> Bool -> QName -> QName -> Test-testQNameEq lab eq n1 n2 =- TestCase ( assertEqual ("testQNameEq:"++lab) eq (n1==n2) )+testQNameEq lbl eq n1 n2 = testIsEq "QNameEq" lbl eq (n1==n2) qnlist :: [(String, QName)] qnlist =@@ -108,29 +117,27 @@ nq1 = newQName base1 "s1" nq2 = newQName base1 "s2" -qp1, qp2 :: QName-qp1 = qnameFromPair (base1,"s1")-qp2 = qnameFromPair (base1,"s2")--qu1, qu2, qu3, qu4, qu5 :: QName-qu1 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"-qu2 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph2/node/s2"+qu1, qu2, qu3, qu4, qu5, qu6, qu7 :: QName+qu1 = qnameFromURI (toURI "http://id.ninebynine.org/wip/2003/test/graph1/node#s1")+qu2 = qnameFromURI (toURI "http://id.ninebynine.org/wip/2003/test/graph2/node/s2") qu3 = "http://id.ninebynine.org/wip/2003/test/graph3/node" qu4 = "http://id.ninebynine.org/wip/2003/test/graph5/" qu5 = "http://id.ninebynine.org/wip/2003/test/graph5/s5"+qu6 = "file://home/swish/file.dat"+qu7 = "urn:long:separator:path" testMakeQNameSuite :: Test testMakeQNameSuite = TestList [ testQNameEq "testnq01" True nq1 qb1s1 , testQNameEq "testnq02" False nq2 qb1s1- , testQNameEq "testqp01" True qp1 qb1s1- , testQNameEq "testqp02" False qp2 qb1s1 , testQNameEq "testqu01" True qb1s1 qu1 , testQNameEq "testqu02" True qb2s2 qu2 , testQNameEq "testqu03" True qb3 qu3 , testQNameEq "testqu04" True qb5 qu4 , testQNameEq "testqu05" True qb5s5 qu5+ , testQNameEq "testqu06" True qb6 qu6+ , testQNameEq "testqu07" True qb7 qu7 ] ------------------------------------------------------------@@ -138,42 +145,47 @@ ------------------------------------------------------------ testStringEq :: String -> String -> String -> Test-testStringEq lab s1 s2 =- TestCase ( assertEqual ("testStringEq:"++lab) s1 s2 )+testStringEq = testIsEq "StringEq" +testTextEq :: String -> T.Text -> T.Text -> Test+testTextEq = testIsEq "TextEq"++testURIEq :: String -> String -> URI -> Test+testURIEq lbl uri = testIsEq "URIEq" lbl (toURI uri)+ testPartQNameSuite :: Test testPartQNameSuite = TestList- [ testStringEq "testGetNamespace01"+ [ testURIEq "testGetNamespace01" "http://id.ninebynine.org/wip/2003/test/graph1/node#" (getNamespace qb1s1)- , testStringEq "testGetNamespace02"+ , testURIEq "testGetNamespace02" "http://id.ninebynine.org/wip/2003/test/graph2/node/" (getNamespace qb2s2)- , testStringEq "testGetNamespace03"+ , testURIEq "testGetNamespace03" "http://id.ninebynine.org/wip/2003/test/graph3/node" (getNamespace qb3s3)- , testStringEq "testGetNamespace04"+ , testURIEq "testGetNamespace04" "http://id.ninebynine.org/wip/2003/test/graph3/node" (getNamespace qb3)- , testStringEq "testGetLocalName01"+ , testTextEq "testGetLocalName01" "s1" (getLocalName qb1s1)- , testStringEq "testGetLocalName02"+ , testTextEq "testGetLocalName02" "s2" (getLocalName qb2s2)- , testStringEq "testGetLocalName03"+ , testTextEq "testGetLocalName03" "s3" (getLocalName qb3s3)- , testStringEq "testGetLocalName04"+ , testTextEq "testGetLocalName04" "" (getLocalName qb3)- , testStringEq "testGetQNameURI01"+ , testURIEq "testGetQNameURI01" "http://id.ninebynine.org/wip/2003/test/graph1/node#s1" (getQNameURI qb1s1)- , testStringEq "testGetQNameURI02"+ , testURIEq "testGetQNameURI02" "http://id.ninebynine.org/wip/2003/test/graph2/node/s2" (getQNameURI qb2s2)- , testStringEq "testGetQNameURI03"+ , testURIEq "testGetQNameURI03" "http://id.ninebynine.org/wip/2003/test/graph3/nodes3" (getQNameURI qb3s3)- , testStringEq "testGetQNameURI04"+ , testURIEq "testGetQNameURI04" "http://id.ninebynine.org/wip/2003/test/graph3/node" (getQNameURI qb3) ]@@ -183,8 +195,7 @@ ------------------------------------------------------------ testMaybeQNameEq :: String -> Bool -> Maybe QName -> Maybe QName -> Test-testMaybeQNameEq lab eq n1 n2 =- TestCase ( assertEqual ("testMaybeQNameEq:"++lab) eq (n1==n2) )+testMaybeQNameEq lbl eq n1 n2 = testIsEq "MaybeQName" lbl eq (n1==n2) testMaybeQNameEqSuite :: Test testMaybeQNameEqSuite = @@ -206,8 +217,7 @@ ------------------------------------------------------------ testQNameLe :: String -> Bool -> QName -> QName -> Test-testQNameLe lab le n1 n2 =- TestCase ( assertEqual ("testQNameLe:"++lab) le (n1<=n2) )+testQNameLe lbl le n1 n2 = testIsEq "QNameLE" lbl le (n1 <= n2) testQNameLeSuite :: Test testQNameLeSuite = @@ -237,6 +247,12 @@ , testStringEq "testShowQName04" "<http://id.ninebynine.org/wip/2003/test/graph5/>" (show qb5)+ , testStringEq "testShowQName06"+ "<file://home/swish/file.dat>"+ (show qb6)+ , testStringEq "testShowQName07"+ "<urn:long:separator:path>"+ (show qb7) ] ------------------------------------------------------------@@ -248,10 +264,25 @@ -- splitURI "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb") -- splitURI "http://example.org/aaa/" = ("http://example.org/aaa/","") +{- testSplitURI :: String -> String -> ( String, String ) -> Test testSplitURI label input ans = TestCase ( assertEqual label ans ( splitURI input ) ) +as splitURI has now been moved into qnameFromURI we change the+test somewhat and also include a check of the+URI combination done by newQName (may be tested elsewhere).+-}++testSplitURI :: String -> String -> (String,T.Text) -> Test+testSplitURI lbl input (a,b) =+ let qn = newQName (toURI a) b+ in + TestList+ [ testIsEq lbl ":split" qn ((qnameFromURI . toURI) input)+ , testIsEq lbl ":show" input (show (getQNameURI qn))+ ]+ testSplitURISuite :: Test testSplitURISuite = TestList@@ -267,6 +298,10 @@ , testSplitURI "testSplitURI04" "http://example.org/aaa/" ( "http://example.org/aaa/", "" )+ + {- REMOVE the relative URI tests since it is not clear they make sense+ for QNames.+ , testSplitURI "testSplitURI05" "//example.org/aaa#bbb" ( "//example.org/aaa#", "bbb" )@@ -282,9 +317,50 @@ , testSplitURI "testSplitURI08" "mortal" ( "", "mortal" )+ + -} ] ------------------------------------------------------------+-- Scoped Name tests, via QName and URI+-- In reality this is testing qnameFromURI (or at least+-- that was the original motivation).+------------------------------------------------------------++-- simple round-trip tests+testSQRoundTrip :: String -> String -> Test+testSQRoundTrip lbl uri = + let u = (fromJust . parseURIReference) uri+ qn = qnameFromURI u+ sn = makeQNameScopedName qn+ in TestList+ [ testIsEq "SQ:URI" lbl u (getScopedNameURI sn)+ , testIsEq "SQ:Qname" lbl qn (getQName sn)+ ]++testSNameTTSuite :: Test+testSNameTTSuite =+ TestList+ [ testSQRoundTrip "null" ""+ , testSQRoundTrip "frag1" "/" -- Should relative fragments be supported?+ , testSQRoundTrip "frag2a" "/foo"+ , testSQRoundTrip "frag2b" "/foo/"+ , testSQRoundTrip "frag3" "/foo/bar"+ , testSQRoundTrip "frag4a" "/foo/bar#"+ , testSQRoundTrip "frag4b" "/foo/bar#fragid"+ , testSQRoundTrip "http1a" "http://example.com"+ , testSQRoundTrip "http1b" "http://example.com/"+ , testSQRoundTrip "http2" "http://example.com/foo/bar/"+ , testSQRoundTrip "http3" "http://example.com/foo/bar/bar"+ , testSQRoundTrip "http4a" "http://example.com/foo/bar/bar#"+ , testSQRoundTrip "http4b" "http://example.com/foo/bar/bar#fragid"+ , testSQRoundTrip "https1" "https://joeuser@example.com/foo/bar"+ , testSQRoundTrip "file1" "file:///dev/null"+ , testSQRoundTrip "urn1" "URN:foo:a123,456"+ , testSQRoundTrip "urn2" "urn:foo:a123%2C456"+ ]++------------------------------------------------------------ -- All tests ------------------------------------------------------------ @@ -297,6 +373,7 @@ , testQNameLeSuite , testShowQNameSuite , testSplitURISuite+ , testSNameTTSuite ] main :: IO ()
tests/RDFDatatypeXsdIntegerTest.hs view
@@ -1,1792 +1,1394 @@------------------------------------------------------------------------------------ See end of this file for licence information.------------------------------------------------------------------------------------ |--- Module : RDFDatatypeXsdIntegerTest--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke--- License : GPL V2------ Maintainer : Douglas Burke--- Stability : experimental--- Portability : H98------ This module contains test cases for variable binding values and--- variable binding modifier values.--------------------------------------------------------------------------------------module Main where--import Swish.RDF.RDFDatatypeXsdInteger- ( rdfDatatypeXsdInteger- , rdfDatatypeValXsdInteger- , typeNameXsdInteger, namespaceXsdInteger- , axiomsXsdInteger, rulesXsdInteger- , prefixXsdInteger- )--import Swish.RDF.RDFVarBinding- ( RDFVarBinding )--import Swish.RDF.RDFRuleset- ( RDFRule - , makeRDFGraphFromN3String- )--import Swish.RDF.RDFDatatype- ( RDFDatatypeMod- , applyRDFDatatypeMod- )--import Swish.RDF.RDFGraph- ( RDFLabel(..), RDFGraph- )--import Swish.RDF.ClassRestrictionRule (falseGraphStr)--import Swish.RDF.Datatype- ( typeName, typeRules, typeMkRules- , getTypeAxiom, getTypeRule- , DatatypeVal(..)- , getDTMod- , DatatypeMap(..)- , DatatypeMod(..)- , nullDatatypeMod- )--import Swish.RDF.Ruleset- ( Ruleset(..)- , getRulesetRule- )--import Swish.RDF.Rule- ( Formula(..), Rule(..)- , nullFormula, nullRule- )--import Swish.RDF.VarBinding (makeVarBinding)--import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..)- , makeScopedName- )--import Swish.RDF.Vocabulary (namespaceDefault)--import Swish.Utils.LookupMap- ( LookupMap(..)- , mapFindMaybe- )--import Swish.Utils.ListHelpers- ( equiv )--import Test.HUnit- ( Test(TestCase,TestList)- , Assertion- , assertBool, assertEqual, assertFailure- , runTestTT- )--import Control.Monad (unless)--import Data.Maybe (isJust, isNothing, fromMaybe)------------------------------------------------------------------ Test case helpers---------------------------------------------------------------assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion-assertMember preface expected actual =- unless (expected `elem` actual ) (assertFailure msg)- where msg = (if null preface then "" else preface ++ "\n") ++- "expected: " ++ show expected ++ "\nbut got: " ++ show actual--test :: String -> Bool -> Test-test lab bv =- TestCase ( assertBool ("test:"++lab) bv )--testEq :: (Eq a, Show a) => String -> a -> a -> Test-testEq lab a1 a2 =- TestCase ( assertEqual ("testEq:"++lab) a1 a2 )--testElem :: (Eq a, Show a) => String -> a -> [a] -> Test-testElem lab a1 as =- TestCase ( assertMember ("testElem:"++lab) a1 as )--testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test-testLe lab eq a1 a2 =- TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )---- Test for Just x or Nothing--testJust :: String -> Maybe a -> Test-testJust lab av =- TestCase ( assertBool ("testJust:"++lab) (isJust av) )--testNothing :: String -> Maybe a -> Test-testNothing lab av =- TestCase ( assertBool ("testJust:"++lab) (isNothing av) )---- Compare lists and lists of lists and Maybe lists for set equivalence:--data ListTest a = ListTest [a]--instance (Eq a) => Eq (ListTest a) where- (ListTest a1) == (ListTest a2) = a1 `equiv` a2--instance (Show a) => Show (ListTest a) where- show (ListTest a) = show a--data MaybeListTest a = MaybeListTest (Maybe [a])--instance (Eq a) => Eq (MaybeListTest a) where- MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2- MaybeListTest Nothing == MaybeListTest Nothing = True- _ == _ = False--instance (Show a) => Show (MaybeListTest a) where- show (MaybeListTest a) = show a--testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test-testEqv lab a1 a2 =- TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )--testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test-testEqvEqv lab a1 a2 =- TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )- where- ma1 = ListTest $ map ListTest a1- ma2 = ListTest $ map ListTest a2--testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test-testHasEqv lab a1 a2 =- TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )- where- ma1 = ListTest a1- ma2 = map ListTest a2--testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test-testMaybeEqv lab a1 a2 =- TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )- where- ma1 = MaybeListTest a1- ma2 = MaybeListTest a2----------------------------------------------------------------- Misc values---------------------------------------------------------------xsd_int_name :: String -> ScopedName-xsd_int_name = ScopedName namespaceXsdInteger --axiomXsdIntegerDT :: ScopedName-axiomXsdIntegerDT = xsd_int_name "dt"--ruleXsdIntegerAbs, ruleXsdIntegerNeg, ruleXsdIntegerSum,- ruleXsdIntegerDiff, ruleXsdIntegerProd, ruleXsdIntegerDivMod,- ruleXsdIntegerPower, ruleXsdIntegerEq, ruleXsdIntegerNe, - ruleXsdIntegerLt, ruleXsdIntegerLe, ruleXsdIntegerGt,- ruleXsdIntegerGe :: ScopedName-ruleXsdIntegerAbs = xsd_int_name "Abs"-ruleXsdIntegerNeg = xsd_int_name "Neg"-ruleXsdIntegerSum = xsd_int_name "Sum"-ruleXsdIntegerDiff = xsd_int_name "Diff"-ruleXsdIntegerProd = xsd_int_name "Prod"-ruleXsdIntegerDivMod = xsd_int_name "DivMod"-ruleXsdIntegerPower = xsd_int_name "Power"-ruleXsdIntegerEq = xsd_int_name "Eq"-ruleXsdIntegerNe = xsd_int_name "Ne"-ruleXsdIntegerLt = xsd_int_name "Lt"-ruleXsdIntegerLe = xsd_int_name "Le"-ruleXsdIntegerGt = xsd_int_name "Gt"-ruleXsdIntegerGe = xsd_int_name "Ge"----------------------------------------------------------------- Basic rdfDatatypeXsdInteger tests---------------------------------------------------------------getXsdIntegerAxiom :: ScopedName -> Formula RDFGraph-getXsdIntegerAxiom scopnam =- fromMaybe nullFormula $ getTypeAxiom scopnam rdfDatatypeXsdInteger--getXsdIntegerRule :: ScopedName -> Rule RDFGraph-getXsdIntegerRule scopnam =- fromMaybe nullRule $ getTypeRule scopnam rdfDatatypeXsdInteger--getXsdIntegerDTmod :: ScopedName -> DatatypeMod Integer RDFLabel RDFLabel-getXsdIntegerDTmod scopnam =- fromMaybe nullDatatypeMod $ getDTMod scopnam rdfDatatypeValXsdInteger--testDatatypeSuite :: Test-testDatatypeSuite = - TestList- [ testEq "testDatatype01" typeNameXsdInteger $- typeName rdfDatatypeXsdInteger- , testEq "testDatatype02" namespaceXsdInteger $- rsNamespace xsdIntRules- , testEqv "testDatatype03" axiomsXsdInteger $- rsAxioms xsdIntRules- , testEqv "testDatatype04" rulesXsdInteger $- rsRules xsdIntRules- , testEq "testDatatype05" axiomXsdIntegerDT $- formName (getXsdIntegerAxiom axiomXsdIntegerDT)- , testEq "testDatatype06" ruleXsdIntegerAbs $- ruleName (getXsdIntegerRule ruleXsdIntegerAbs)- ]- ---------------------------------------------------------------- Basic rdfDatatypeValXsdInteger tests---------------------------------------------------------------testDatatypeValSuite :: Test-testDatatypeValSuite = - TestList- [ testEq "testDatatypeVal01" (Just 123) $- mapL2V (tvalMap rdfDatatypeValXsdInteger) "123"- , testEq "testDatatypeVal02" (Just 0) $- mapL2V (tvalMap rdfDatatypeValXsdInteger) "0"- , testEq "testDatatypeVal03" (Just 456) $- mapL2V (tvalMap rdfDatatypeValXsdInteger) "+000456"- , testEq "testDatatypeVal04" (Just (-987)) $- mapL2V (tvalMap rdfDatatypeValXsdInteger) "-0987"- , testEq "testDatatypeVal05" Nothing $- mapL2V (tvalMap rdfDatatypeValXsdInteger) "11x2"- , testEq "testDatatypeVal06" Nothing $- mapL2V (tvalMap rdfDatatypeValXsdInteger) " 321"- , testEq "testDatatypeVal07" Nothing $- mapL2V (tvalMap rdfDatatypeValXsdInteger) "321 "-- , testEq "testDatatypeVal11" (Just "123") $- mapV2L (tvalMap rdfDatatypeValXsdInteger) 123- , testEq "testDatatypeVal12" (Just "-987") $- mapV2L (tvalMap rdfDatatypeValXsdInteger) (-987)-- , testElem "testDatatypeVal21" dmodXsdIntegerAbs $- map dmName (tvalMod rdfDatatypeValXsdInteger)- , testEq "testDatatypeVal22" dmodXsdIntegerAbs $- dmName (getXsdIntegerDTmod dmodXsdIntegerAbs)- ]----------------------------------------------------------------- Variable binding modifier tests---------------------------------------------------------------dmodXsdIntegerAbs, dmodXsdIntegerNeg, dmodXsdIntegerSum, - dmodXsdIntegerDiff, dmodXsdIntegerProd, dmodXsdIntegerDivMod, - dmodXsdIntegerPower, dmodXsdIntegerEq, dmodXsdIntegerNe, - dmodXsdIntegerLt, dmodXsdIntegerLe, dmodXsdIntegerGt, - dmodXsdIntegerGe :: ScopedName--dmodXsdIntegerAbs = xsd_int_name "abs"-dmodXsdIntegerNeg = xsd_int_name "neg"-dmodXsdIntegerSum = xsd_int_name "sum"-dmodXsdIntegerDiff = xsd_int_name "diff"-dmodXsdIntegerProd = xsd_int_name "prod"-dmodXsdIntegerDivMod = xsd_int_name "divmod"-dmodXsdIntegerPower = xsd_int_name "power"-dmodXsdIntegerEq = xsd_int_name "eq"-dmodXsdIntegerNe = xsd_int_name "ne"-dmodXsdIntegerLt = xsd_int_name "lt"-dmodXsdIntegerLe = xsd_int_name "le"-dmodXsdIntegerGt = xsd_int_name "gt"-dmodXsdIntegerGe = xsd_int_name "ge"--testVmodN :: [RDFLabel]- -> String -> Maybe (RDFDatatypeMod Integer)- -> [RDFVarBinding] -> [RDFVarBinding]- -> Test-testVmodN vars lab (Just dmod) ibinds obinds =- testEqv lab obinds $- applyRDFDatatypeMod rdfDatatypeValXsdInteger dmod vars ibinds-testVmodN _ lab Nothing _ _ = TestCase $- assertFailure $ "testVmodN:"++lab++", null variable binding modifier"--testVmod2, testVmod3, testVmod4 :: - String -> Maybe (RDFDatatypeMod Integer)- -> [RDFVarBinding] -> [RDFVarBinding]- -> Test-testVmod2 = testVmodN [Var "a", Var "b"]-testVmod3 = testVmodN [Var "a", Var "b", Var "c"]-testVmod4 = testVmodN [Var "a", Var "b", Var "c", Var "d"]---- make various kinds of RDF variable bindings--rdfVR :: (String, ScopedName) -> (RDFLabel, RDFLabel)-rdfVR (v,u) = (Var v,Res u) -- (Variable,Resource)--rdfVB :: (String, String) -> (RDFLabel, RDFLabel)-rdfVB (v,b) = (Var v,Blank b) -- (Variable,Blank)--rdfVL :: (String, String) -> (RDFLabel, RDFLabel)-rdfVL (v,l) = (Var v,Lit l Nothing) -- (Variable,Untyped literal)--rdfVI :: (String, String) -> (RDFLabel, RDFLabel)-rdfVI (v,l) = (Var v,Lit l (Just typeNameXsdInteger))- -- (Variable,Integer literal)--makeBVR :: [(String,ScopedName)] -> RDFVarBinding-makeBVR nls = makeVarBinding $ map rdfVR nls--makeBVB :: [(String,String)] -> RDFVarBinding-makeBVB nls = makeVarBinding $ map rdfVB nls--makeBVI :: [(String,String)] -> RDFVarBinding-makeBVI nls = makeVarBinding $ map rdfVI nls--makeBVL :: [(String,String)] -> RDFVarBinding-makeBVL nls = makeVarBinding $ map rdfVL nls---- Test null modifier--testVarModify00 :: Test-testVarModify00 = testVmod2 "testVarModify00"- (Just nullDatatypeMod)- [makeBVI [("a","123")]]- [makeBVI [("a","123")]]---- Tests for xsd_integer:abs--testVarModifyAbs01, testVarModifyAbs02, testVarModifyAbs03,- testVarModifyAbs04, testVarModifyAbs05, testVarModifyAbs06,- testVarModifyAbs07, testVarModifyAbs08, testVarModifyAbs09,- testVarModifyAbs10 :: Test-testVarModifyAbs01 = testVmod2 "testVarModifyAbs01"- (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)- [makeBVI [("b","123")]]- [makeBVI [("a","123"),("b","123")]]--testVarModifyAbs02 = testVmod2 "testVarModifyAbs02"- (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)- [makeBVI [("b","-123")]]- [makeBVI [("a","123"),("b","-123")]]--testVarModifyAbs03 = testVmod2 "testVarModifyAbs03"- (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)- [makeBVI [("a","123"),("b","123")]]- [makeBVI [("a","123"),("b","123")]]--testVarModifyAbs04 = testVmod2 "testVarModifyAbs04"- (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)- [makeBVI [("a","123"),("b","-123")]]- [makeBVI [("a","123"),("b","-123")]]--testVarModifyAbs05 = testVmod2 "testVarModifyAbs05"- (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)- [makeBVI [("a","-123"),("b","123")]]- []--testVarModifyAbs06 = testVmod2 "testVarModifyAbs06"- (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)- [makeBVI [("a","123"),("b","456")]]- []--testVarModifyAbs07 = testVmod2 "testVarModifyAbs07"- (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)- [makeBVI [("c","123")]]- []--testVarModifyAbs08 = testVmod2 "testVarModifyAbs08"- (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)- [makeBVL [("b","123")]]- []--testVarModifyAbs09 = testVmod2 "testVarModifyAbs09"- (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)- [makeBVR [("b",makeScopedName "" "http://ex.org/" "123")]]- []--testVarModifyAbs10 = testVmod2 "testVarModifyAbs10"- (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)- [makeBVB [("b","123")]]- []---- Tests for xsd_integer:neg--testVarModifyNeg01, testVarModifyNeg02, testVarModifyNeg03,- testVarModifyNeg04, testVarModifyNeg05 :: Test--testVarModifyNeg01 = testVmod2 "testVarModifyNeg01"- (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)- [makeBVI [("a","123"),("b","-123")]]- [makeBVI [("a","123"),("b","-123")]]--testVarModifyNeg02 = testVmod2 "testVarModifyNeg02"- (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)- [makeBVI [("a","-123"),("b","123")]]- [makeBVI [("a","-123"),("b","123")]]--testVarModifyNeg03 = testVmod2 "testVarModifyNeg03"- (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)- [makeBVI [("a","123"),("b","123")]]- []--testVarModifyNeg04 = testVmod2 "testVarModifyNeg04"- (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)- [makeBVI [("b","123")]]- [makeBVI [("a","-123"),("b","123")]]--testVarModifyNeg05 = testVmod2 "testVarModifyNeg05"- (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)- [makeBVI [("a","-123")]]- [makeBVI [("a","-123"),("b","123")]]---- Tests for xsd_integer:sum--testVarModifySum01, testVarModifySum02, testVarModifySum03,- testVarModifySum04, testVarModifySum05 :: Test--testVarModifySum01 = testVmod3 "testVarModifySum01"- (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)- [makeBVI [("a","33"),("b","22"),("c","11")]]- [makeBVI [("a","33"),("b","22"),("c","11")]]--testVarModifySum02 = testVmod3 "testVarModifySum02"- (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)- [makeBVI [("b","22"),("c","11")]]- [makeBVI [("a","33"),("b","22"),("c","11")]]--testVarModifySum03 = testVmod3 "testVarModifySum03"- (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)- [makeBVI [("a","33"),("c","11")]]- [makeBVI [("a","33"),("b","22"),("c","11")]]--testVarModifySum04 = testVmod3 "testVarModifySum04"- (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)- [makeBVI [("a","33"),("b","22")]]- [makeBVI [("a","33"),("b","22"),("c","11")]]--testVarModifySum05 = testVmod3 "testVarModifySum05"- (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)- [makeBVI [("a","44"),("b","22"),("c","11")]]- []---- Tests for xsd_integer:diff--testVarModifyDiff01, testVarModifyDiff02, testVarModifyDiff03,- testVarModifyDiff04, testVarModifyDiff05 :: Test--testVarModifyDiff01 = testVmod3 "testVarModifyDiff01"- (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)- [makeBVI [("a","11"),("b","33"),("c","22")]]- [makeBVI [("a","11"),("b","33"),("c","22")]]--testVarModifyDiff02 = testVmod3 "testVarModifyDiff02"- (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)- [makeBVI [("b","33"),("c","22")]]- [makeBVI [("a","11"),("b","33"),("c","22")]]--testVarModifyDiff03 = testVmod3 "testVarModifyDiff03"- (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)- [makeBVI [("a","11"),("c","22")]]- [makeBVI [("a","11"),("b","33"),("c","22")]]--testVarModifyDiff04 = testVmod3 "testVarModifyDiff04"- (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)- [makeBVI [("a","11"),("b","33")]]- [makeBVI [("a","11"),("b","33"),("c","22")]]--testVarModifyDiff05 = testVmod3 "testVarModifyDiff05"- (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)- [makeBVI [("a","11"),("b","44"),("c","22")]]- []---- Tests for xsd_integer:prod------ Note: product can also be used to test if a value is--- an exact multiple of some other.--testVarModifyProd01, testVarModifyProd02, testVarModifyProd03,- testVarModifyProd04, testVarModifyProd05,- testVarModifyProd06 :: Test--testVarModifyProd01 = testVmod3 "testVarModifyProd01"- (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)- [makeBVI [("a","6"),("b","2"),("c","3")]]- [makeBVI [("a","6"),("b","2"),("c","3")]]--testVarModifyProd02 = testVmod3 "testVarModifyProd02"- (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)- [makeBVI [("b","2"),("c","3")]]- [makeBVI [("a","6"),("b","2"),("c","3")]]--testVarModifyProd03 = testVmod3 "testVarModifyProd03"- (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)- [makeBVI [("a","6"),("c","3")]]- [makeBVI [("a","6"),("b","2"),("c","3")]]--testVarModifyProd04 = testVmod3 "testVarModifyProd04"- (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)- [makeBVI [("a","6"),("c","3")]]- [makeBVI [("a","6"),("b","2"),("c","3")]]--testVarModifyProd05 = testVmod3 "testVarModifyProd05"- (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)- [makeBVI [("a","7"),("b","2"),("c","3")]]- []--testVarModifyProd06 = testVmod3 "testVarModifyProd06"- (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)- [makeBVI [("a","7"),("b","2")]]- []---- Tests for xsd_integer:divmod------ Note: truncates downwards, so remainder is same sign as divisor--- cf. Haskell divMod function.--testVarModifyDivMod01, testVarModifyDivMod02, testVarModifyDivMod03,- testVarModifyDivMod04, testVarModifyDivMod05,- testVarModifyDivMod06, testVarModifyDivMod07 :: Test--testVarModifyDivMod01 = testVmod4 "testVarModifyDivMod01"- (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)- [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]- [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]--testVarModifyDivMod02 = testVmod4 "testVarModifyDivMod02"- (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)- [makeBVI [("c","7"),("d","3")]]- [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]--testVarModifyDivMod03 = testVmod4 "testVarModifyDivMod03"- (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)- [makeBVI [("c","-7"),("d","3")]]- [makeBVI [("a","-3"),("b","2"),("c","-7"),("d","3")]]--testVarModifyDivMod04 = testVmod4 "testVarModifyDivMod04"- (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)- [makeBVI [("c","7"),("d","-3")]]- [makeBVI [("a","-3"),("b","-2"),("c","7"),("d","-3")]]--testVarModifyDivMod05 = testVmod4 "testVarModifyDivMod05"- (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)- [makeBVI [("c","-7"),("d","-3")]]- [makeBVI [("a","2"),("b","-1"),("c","-7"),("d","-3")]]--testVarModifyDivMod06 = testVmod4 "testVarModifyDivMod06"- (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)- [makeBVI [("a","2"),("b","5"),("c","7"),("d","3")]]- []--testVarModifyDivMod07 = testVmod4 "testVarModifyDivMod07"- (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)- [makeBVI [("a","2"),("b","1"),("d","3")]]- []---- Tests for xsd_integer:power--testVarModifyPower01, testVarModifyPower02, testVarModifyPower03,- testVarModifyPower04, testVarModifyPower05,- testVarModifyPower06, testVarModifyPower07,- testVarModifyPower08 :: Test--testVarModifyPower01 = testVmod3 "testVarModifyPower01"- (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)- [makeBVI [("a","8"),("b","2"),("c","3")]]- [makeBVI [("a","8"),("b","2"),("c","3")]]--testVarModifyPower02 = testVmod3 "testVarModifyPower02"- (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)- [makeBVI [("b","2"),("c","3")]]- [makeBVI [("a","8"),("b","2"),("c","3")]]--testVarModifyPower03 = testVmod3 "testVarModifyPower03"- (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)- [makeBVI [("a","8"),("c","3")]]- []--testVarModifyPower04 = testVmod3 "testVarModifyPower04"- (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)- [makeBVI [("a","8"),("b","2")]]- []--testVarModifyPower05 = testVmod3 "testVarModifyPower05"- (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)- [makeBVI [("a","8"),("b","3"),("c","2")]]- []--testVarModifyPower06 = testVmod3 "testVarModifyPower06"- (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)- [makeBVI [("b","55"),("c","0")]]- [makeBVI [("a","1"),("b","55"),("c","0")]]--testVarModifyPower07 = testVmod3 "testVarModifyPower07"- (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)- [makeBVI [("b","-2"),("c","3")]]- [makeBVI [("a","-8"),("b","-2"),("c","3")]]--testVarModifyPower08 = testVmod3 "testVarModifyPower08"- (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)- [makeBVI [("b","55"),("c","-2")]]- []---- Tests for xsd_integer:eq--testVarModifyEq01, testVarModifyEq02, testVarModifyEq03,- testVarModifyEq04, testVarModifyEq05 :: Test--testVarModifyEq01 = testVmod2 "testVarModifyEq01"- (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)- [makeBVI [("a","100"),("b","100")]]- [makeBVI [("a","100"),("b","100")]]--testVarModifyEq02 = testVmod2 "testVarModifyEq02"- (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)- [makeBVI [("a","99"),("b","100")]]- []--testVarModifyEq03 = testVmod2 "testVarModifyEq03"- (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)- [makeBVI [("a","-99"),("b","-100")]]- []--testVarModifyEq04 = testVmod2 "testVarModifyEq04"- (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)- [makeBVI [("b","100")]]- []--testVarModifyEq05 = testVmod2 "testVarModifyEq05"- (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)- [makeBVI [("a","100")]]- []---- Tests for xsd_integer:ne--testVarModifyNe01, testVarModifyNe02, testVarModifyNe03,- testVarModifyNe04, testVarModifyNe05 :: Test--testVarModifyNe01 = testVmod2 "testVarModifyNe01"- (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)- [makeBVI [("a","100"),("b","100")]]- []--testVarModifyNe02 = testVmod2 "testVarModifyNe02"- (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)- [makeBVI [("a","99"),("b","100")]]- [makeBVI [("a","99"),("b","100")]]--testVarModifyNe03 = testVmod2 "testVarModifyNe03"- (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)- [makeBVI [("a","-99"),("b","-100")]]- [makeBVI [("a","-99"),("b","-100")]]--testVarModifyNe04 = testVmod2 "testVarModifyNe04"- (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)- [makeBVI [("b","100")]]- []--testVarModifyNe05 = testVmod2 "testVarModifyNe05"- (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)- [makeBVI [("a","100")]]- []---- Tests for xsd_integer:lt--testVarModifyLt01, testVarModifyLt02, testVarModifyLt03,- testVarModifyLt04, testVarModifyLt05 :: Test--testVarModifyLt01 = testVmod2 "testVarModifyLt01"- (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)- [makeBVI [("a","100"),("b","100")]]- []--testVarModifyLt02 = testVmod2 "testVarModifyLt02"- (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)- [makeBVI [("a","99"),("b","100")]]- [makeBVI [("a","99"),("b","100")]]--testVarModifyLt03 = testVmod2 "testVarModifyLt03"- (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)- [makeBVI [("a","-99"),("b","-100")]]- []--testVarModifyLt04 = testVmod2 "testVarModifyLt04"- (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)- [makeBVI [("b","100")]]- []--testVarModifyLt05 = testVmod2 "testVarModifyLt05"- (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)- [makeBVI [("a","100")]]- []---- Tests for xsd_integer:le--testVarModifyLe01, testVarModifyLe02, testVarModifyLe03,- testVarModifyLe04, testVarModifyLe05 :: Test--testVarModifyLe01 = testVmod2 "testVarModifyLe01"- (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)- [makeBVI [("a","100"),("b","100")]]- [makeBVI [("a","100"),("b","100")]]--testVarModifyLe02 = testVmod2 "testVarModifyLe02"- (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)- [makeBVI [("a","99"),("b","100")]]- [makeBVI [("a","99"),("b","100")]]--testVarModifyLe03 = testVmod2 "testVarModifyLe03"- (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)- [makeBVI [("a","-99"),("b","-100")]]- []--testVarModifyLe04 = testVmod2 "testVarModifyLe04"- (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)- [makeBVI [("b","100")]]- []--testVarModifyLe05 = testVmod2 "testVarModifyLe05"- (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)- [makeBVI [("a","100")]]- []---- Tests for xsd_integer:gt--testVarModifyGt01, testVarModifyGt02, testVarModifyGt03,- testVarModifyGt04, testVarModifyGt05 :: Test--testVarModifyGt01 = testVmod2 "testVarModifyGt01"- (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)- [makeBVI [("a","100"),("b","100")]]- []--testVarModifyGt02 = testVmod2 "testVarModifyGt02"- (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)- [makeBVI [("a","99"),("b","100")]]- []--testVarModifyGt03 = testVmod2 "testVarModifyGt03"- (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)- [makeBVI [("a","-99"),("b","-100")]]- [makeBVI [("a","-99"),("b","-100")]]--testVarModifyGt04 = testVmod2 "testVarModifyGt04"- (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)- [makeBVI [("b","100")]]- []--testVarModifyGt05 = testVmod2 "testVarModifyGt05"- (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)- [makeBVI [("a","100")]]- []---- Tests for xsd_integer:ge--testVarModifyGe01, testVarModifyGe02, testVarModifyGe03,- testVarModifyGe04, testVarModifyGe05 :: Test--testVarModifyGe01 = testVmod2 "testVarModifyGe01"- (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)- [makeBVI [("a","100"),("b","100")]]- [makeBVI [("a","100"),("b","100")]]--testVarModifyGe02 = testVmod2 "testVarModifyGe02"- (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)- [makeBVI [("a","99"),("b","100")]]- []--testVarModifyGe03 = testVmod2 "testVarModifyGe03"- (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)- [makeBVI [("a","-99"),("b","-100")]]- [makeBVI [("a","-99"),("b","-100")]]--testVarModifyGe04 = testVmod2 "testVarModifyGe04"- (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)- [makeBVI [("b","100")]]- []--testVarModifyGe05 = testVmod2 "testVarModifyGe05"- (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)- [makeBVI [("a","100")]]- []---- Full suite for variable binding modifier tests--testVarModifySuite :: Test-testVarModifySuite = TestList- [ testVarModify00- , testVarModifyAbs01, testVarModifyAbs02, testVarModifyAbs03- , testVarModifyAbs04, testVarModifyAbs05, testVarModifyAbs06- , testVarModifyAbs07, testVarModifyAbs08, testVarModifyAbs09- , testVarModifyAbs10- , testVarModifyNeg01, testVarModifyNeg02, testVarModifyNeg03- , testVarModifyNeg04, testVarModifyNeg05- , testVarModifySum01, testVarModifySum02, testVarModifySum03- , testVarModifySum04, testVarModifySum05- , testVarModifyDiff01, testVarModifyDiff02, testVarModifyDiff03- , testVarModifyDiff04, testVarModifyDiff05- , testVarModifyProd01, testVarModifyProd02, testVarModifyProd03- , testVarModifyProd04, testVarModifyProd05, testVarModifyProd06- , testVarModifyDivMod01, testVarModifyDivMod02, testVarModifyDivMod03- , testVarModifyDivMod04, testVarModifyDivMod05, testVarModifyDivMod06- , testVarModifyDivMod07- , testVarModifyPower01, testVarModifyPower02, testVarModifyPower03- , testVarModifyPower04, testVarModifyPower05, testVarModifyPower06- , testVarModifyPower07, testVarModifyPower08- , testVarModifyEq01, testVarModifyEq02, testVarModifyEq03- , testVarModifyEq04, testVarModifyEq05- , testVarModifyNe01, testVarModifyNe02, testVarModifyNe03- , testVarModifyNe04, testVarModifyNe05- , testVarModifyLt01, testVarModifyLt02, testVarModifyLt03- , testVarModifyLt04, testVarModifyLt05- , testVarModifyLe01, testVarModifyLe02, testVarModifyLe03- , testVarModifyLe04, testVarModifyLe05- , testVarModifyGt01, testVarModifyGt02, testVarModifyGt03- , testVarModifyGt04, testVarModifyGt05- , testVarModifyGe01, testVarModifyGe02, testVarModifyGe03- , testVarModifyGe04, testVarModifyGe05- ]----------------------------------------------------------------- Test rules defined for datatype---------------------------------------------------------------mkGraph :: String -> RDFGraph-mkGraph grstr = makeRDFGraphFromN3String (prefixXsdInteger++base++grstr)- where- base = "@prefix : <"++nsURI namespaceDefault++"> . \n"--testRuleFwd :: String -> Maybe (Rule RDFGraph) -> String -> [String] -> Test-testRuleFwd lab (Just rule) antstr constrs =- let- antgr = mkGraph antstr- congrs = map mkGraph constrs- in- testEqv lab congrs $ fwdApply rule [antgr]-testRuleFwd lab Nothing _ _ = TestCase $- assertFailure $ "testRuleFwd:"++lab++", null rule supplied"--testRuleBwd :: String -> Maybe (Rule RDFGraph) -> String -> [[String]] -> Test-testRuleBwd lab (Just rule) antstr prestrss =- let- antgr = mkGraph antstr- pregrss = map (map mkGraph) prestrss- in- testEqvEqv lab pregrss $ bwdApply rule antgr-testRuleBwd lab Nothing _ _ = TestCase $- assertFailure $ "testRuleBwd:"++lab++", null rule supplied"--testRuleChk :: String -> Maybe (Rule RDFGraph) -> String -> String -> Test-testRuleChk lab (Just rule) antstr constr =- let- antgr = mkGraph antstr- congr = mkGraph constr- in- test lab $ checkInference rule [antgr] congr-testRuleChk lab Nothing _ _ = TestCase $- assertFailure $ "testRuleChk:"++lab++", null rule supplied"--xsdIntRules :: Ruleset RDFGraph-xsdIntRules = typeRules rdfDatatypeXsdInteger--{--axdt :: Maybe (Formula RDFGraph)-axdt = getRulesetAxiom axiomXsdIntegerDT xsdIntRules--}--ruleabs, ruleneg, rulesum, rulediff, ruleprod,- ruledivmod, rulepower, ruleeq, rulene, rulelt, rulele,- rulegt, rulege :: Maybe (Rule RDFGraph)-ruleabs = getRulesetRule ruleXsdIntegerAbs xsdIntRules-ruleneg = getRulesetRule ruleXsdIntegerNeg xsdIntRules-rulesum = getRulesetRule ruleXsdIntegerSum xsdIntRules-rulediff = getRulesetRule ruleXsdIntegerDiff xsdIntRules-ruleprod = getRulesetRule ruleXsdIntegerProd xsdIntRules-ruledivmod = getRulesetRule ruleXsdIntegerDivMod xsdIntRules-rulepower = getRulesetRule ruleXsdIntegerPower xsdIntRules-ruleeq = getRulesetRule ruleXsdIntegerEq xsdIntRules-rulene = getRulesetRule ruleXsdIntegerNe xsdIntRules-rulelt = getRulesetRule ruleXsdIntegerLt xsdIntRules-rulele = getRulesetRule ruleXsdIntegerLe xsdIntRules-rulegt = getRulesetRule ruleXsdIntegerGt xsdIntRules-rulege = getRulesetRule ruleXsdIntegerGe xsdIntRules---- Test cases for the arithmetic functions---- abs--abs01inp :: String-abs01inp =- "_:a a xsd_integer:Abs ; "- +++ " rdf:_2 \"1\"^^xsd:integer . "- -abs01fwd :: [String]-abs01fwd =- [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]--abs01bwd :: [[String]]-abs01bwd = []--abs02inp :: String-abs02inp =- "_:a a xsd_integer:Abs ; "- +++ " rdf:_2 \"-1\"^^xsd:integer . "- -abs02fwd :: [String]-abs02fwd =- [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]--abs02bwd :: [[String]]-abs02bwd =- []--abs03inp :: String-abs03inp =- "_:a a xsd_integer:Abs ; "- +++ " rdf:_1 \"1\"^^xsd:integer . "--abs03fwd :: [String]-abs03fwd = []--abs03bwd :: [[String]]-abs03bwd =- [ [ "_:a a xsd_integer:Abs . "- , "_:a rdf:_2 \"1\"^^xsd:integer . "- ]- , [ "_:a a xsd_integer:Abs . "- , "_:a rdf:_2 \"-1\"^^xsd:integer . "- ]- ]--abs04inp :: String-abs04inp =- "_:a a xsd_integer:Abs ; "- +++ " rdf:_1 \"-1\"^^xsd:integer . "--abs04fwd :: [String]-abs04fwd =- [ falseGraphStr- ]--abs04bwd :: [[String]]-abs04bwd =- [ [ falseGraphStr- ]- ]---- neg--neg01inp :: String-neg01inp =- "_:a a xsd_integer:Neg ; "- +++ " rdf:_2 \"1\"^^xsd:integer . "- -neg01fwd :: [String]-neg01fwd =- [ "_:a rdf:_1 \"-1\"^^xsd:integer . " ]--neg01bwd :: [[String]]-neg01bwd =- [ [ "_:a a xsd_integer:Neg . "- , "_:a rdf:_1 \"-1\"^^xsd:integer . "- ]- ]--neg02inp :: String-neg02inp =- "_:a a xsd_integer:Neg ; "- +++ " rdf:_2 \"-2\"^^xsd:integer . "- -neg02fwd :: [String]-neg02fwd =- [ "_:a rdf:_1 \"2\"^^xsd:integer . " ]--neg02bwd :: [[String]]-neg02bwd =- [ [ "_:a a xsd_integer:Neg . "- , "_:a rdf:_1 \"2\"^^xsd:integer . "- ]- ]---- sum--sum01inp :: String-sum01inp =- "_:a a xsd_integer:Sum ; "- +++ " rdf:_2 \"31\"^^xsd:integer ; "- +++ " rdf:_3 \"20\"^^xsd:integer . "--sum01fwd :: [String]-sum01fwd =- [ "_:a rdf:_1 \"51\"^^xsd:integer . " ]--sum01bwd :: [[String]]-sum01bwd =- [ [ "_:a a xsd_integer:Sum . "- , "_:a rdf:_1 \"51\"^^xsd:integer . "- , "_:a rdf:_2 \"31\"^^xsd:integer . "- ]- , [ "_:a a xsd_integer:Sum . "- , "_:a rdf:_1 \"51\"^^xsd:integer . "- , "_:a rdf:_3 \"20\"^^xsd:integer . "- ]- ]--sum02inp :: String-sum02inp =- "_:a a xsd_integer:Sum ; "- +++ " rdf:_1 \"52\"^^xsd:integer ; "- +++ " rdf:_3 \"21\"^^xsd:integer . "- -sum02fwd :: [String] -sum02fwd =- [ "_:a rdf:_2 \"31\"^^xsd:integer . " ]--sum02bwd :: [[String]]-sum02bwd =- [ [ "_:a a xsd_integer:Sum . "- , "_:a rdf:_1 \"52\"^^xsd:integer . "- , "_:a rdf:_2 \"31\"^^xsd:integer . "- ]- , [ "_:a a xsd_integer:Sum . "- , "_:a rdf:_2 \"31\"^^xsd:integer . "- , "_:a rdf:_3 \"21\"^^xsd:integer . "- ]- ]--sum03inp :: String-sum03inp =- "_:a a xsd_integer:Sum ; "- +++ " rdf:_1 \"53\"^^xsd:integer ; "- +++ " rdf:_2 \"32\"^^xsd:integer . "--sum03fwd :: [String]-sum03fwd =- [ "_:a rdf:_3 \"21\"^^xsd:integer . " ]--sum03bwd :: [[String]]-sum03bwd =- [ [ "_:a a xsd_integer:Sum . "- , "_:a rdf:_1 \"53\"^^xsd:integer . "- , "_:a rdf:_3 \"21\"^^xsd:integer . "- ]- , [ "_:a a xsd_integer:Sum . "- , "_:a rdf:_2 \"32\"^^xsd:integer . "- , "_:a rdf:_3 \"21\"^^xsd:integer . "- ]- ]---- diff--diff01inp :: String-diff01inp =- "_:a a xsd_integer:Diff ; "- +++ " rdf:_2 \"222\"^^xsd:integer ; "- +++ " rdf:_3 \"333\"^^xsd:integer . "- -diff01fwd :: [String]-diff01fwd =- [ "_:a rdf:_1 \"-111\"^^xsd:integer . " ]--diff01bwd :: [[String]]-diff01bwd =- [ [ "_:a a xsd_integer:Diff . "- , "_:a rdf:_1 \"-111\"^^xsd:integer . "- , "_:a rdf:_2 \"222\"^^xsd:integer . "- ]- , [ "_:a a xsd_integer:Diff . "- , "_:a rdf:_1 \"-111\"^^xsd:integer . "- , "_:a rdf:_3 \"333\"^^xsd:integer . "- ]- ]--diff02inp :: String-diff02inp =- "_:a a xsd_integer:Diff ; "- +++ " rdf:_1 \"-111\"^^xsd:integer ; "- +++ " rdf:_3 \"333\"^^xsd:integer . "--diff02fwd :: [String]-diff02fwd =- [ "_:a rdf:_2 \"222\"^^xsd:integer . " ]--diff02bwd :: [[String]]-diff02bwd =- [ [ "_:a a xsd_integer:Diff . "- , "_:a rdf:_1 \"-111\"^^xsd:integer . "- , "_:a rdf:_2 \"222\"^^xsd:integer . "- ]- , [ "_:a a xsd_integer:Diff . "- , "_:a rdf:_2 \"222\"^^xsd:integer . "- , "_:a rdf:_3 \"333\"^^xsd:integer . "- ]- ]--diff03inp :: String-diff03inp =- "_:a a xsd_integer:Diff ; "- +++ " rdf:_1 \"-111\"^^xsd:integer ; "- +++ " rdf:_2 \"222\"^^xsd:integer . "--diff03fwd :: [String]-diff03fwd =- [ "_:a rdf:_3 \"333\"^^xsd:integer . " ]--diff03bwd :: [[String]]-diff03bwd =- [ [ "_:a a xsd_integer:Diff . "- , "_:a rdf:_1 \"-111\"^^xsd:integer . "- , "_:a rdf:_3 \"333\"^^xsd:integer . "- ]- , [ "_:a a xsd_integer:Diff . "- , "_:a rdf:_2 \"222\"^^xsd:integer . "- , "_:a rdf:_3 \"333\"^^xsd:integer . "- ]- ]---- prod--prod01inp :: String-prod01inp =- "_:a a xsd_integer:Prod ; "- +++ " rdf:_2 \"222\"^^xsd:integer ; "- +++ " rdf:_3 \"3\"^^xsd:integer . "--prod01fwd :: [String]-prod01fwd =- [ "_:a rdf:_1 \"666\"^^xsd:integer . " ]--prod01bwd :: [[String]]-prod01bwd =- [ [ "_:a a xsd_integer:Prod . "- , "_:a rdf:_1 \"666\"^^xsd:integer . "- , "_:a rdf:_2 \"222\"^^xsd:integer . "- ]- , [ "_:a a xsd_integer:Prod . "- , "_:a rdf:_1 \"666\"^^xsd:integer . "- , "_:a rdf:_3 \"3\"^^xsd:integer . "- ]- ]--prod02inp :: String-prod02inp =- "_:a a xsd_integer:Prod ; "- +++ " rdf:_1 \"666\"^^xsd:integer ; "- +++ " rdf:_3 \"3\"^^xsd:integer . "--prod02fwd :: [String]-prod02fwd =- [ "_:a rdf:_2 \"222\"^^xsd:integer . " ]--prod02bwd :: [[String]]-prod02bwd =- [ [ "_:a a xsd_integer:Prod . "- , "_:a rdf:_1 \"666\"^^xsd:integer . "- , "_:a rdf:_2 \"222\"^^xsd:integer . "- ]- , [ "_:a a xsd_integer:Prod . "- , "_:a rdf:_2 \"222\"^^xsd:integer . "- , "_:a rdf:_3 \"3\"^^xsd:integer . "- ]- ]--prod03inp :: String-prod03inp =- "_:a a xsd_integer:Prod ; "- +++ " rdf:_1 \"666\"^^xsd:integer ; "- +++ " rdf:_2 \"222\"^^xsd:integer . "--prod03fwd :: [String]-prod03fwd =- [ "_:a rdf:_3 \"3\"^^xsd:integer . " ]--prod03bwd :: [[String]]-prod03bwd =- [ [ "_:a a xsd_integer:Prod . "- , "_:a rdf:_1 \"666\"^^xsd:integer . "- , "_:a rdf:_3 \"3\"^^xsd:integer . "- ]- , [ "_:a a xsd_integer:Prod . "- , "_:a rdf:_2 \"222\"^^xsd:integer . "- , "_:a rdf:_3 \"3\"^^xsd:integer . "- ]- ]---- divmod--divmod01inp :: String-divmod01inp =- "_:a a xsd_integer:DivMod ; "- +++ " rdf:_3 \"33\"^^xsd:integer ; "- +++ " rdf:_4 \"5\"^^xsd:integer . "--divmod01fwd :: [String]-divmod01fwd =- [ "_:a rdf:_1 \"6\"^^xsd:integer . "- +++ "_:a rdf:_2 \"3\"^^xsd:integer . "- ]--divmod01bwd :: [[String]]-divmod01bwd =- [ {- "_:a a xsd_integer:DivMod . "- , "_:a rdf:_1 \"6\"^^xsd:integer . "- , "_:a rdf:_2 \"3\"^^xsd:integer . "- , "_:a rdf:_4 \"5\"^^xsd:integer . "- -}- ]--divmod02inp :: String-divmod02inp =- "_:a a xsd_integer:DivMod ; "- +++ " rdf:_1 \"6\"^^xsd:integer ; "- +++ " rdf:_2 \"3\"^^xsd:integer ; "- +++ " rdf:_4 \"5\"^^xsd:integer . "--divmod02fwd :: [String]-divmod02fwd =- [ ]--divmod02bwd :: [[String]]-divmod02bwd =- [ {- "_:a a xsd_integer:DivMod . "- , "_:a rdf:_3 \"33\"^^xsd:integer . "- , "_:a rdf:_4 \"5\"^^xsd:integer . "- -}- ]--divmod03inp :: String-divmod03inp =- "_:a a xsd_integer:DivMod ; "- +++ " rdf:_3 \"-33\"^^xsd:integer ; "- +++ " rdf:_4 \"5\"^^xsd:integer . "--divmod03fwd :: [String]-divmod03fwd =- [ "_:a rdf:_1 \"-7\"^^xsd:integer . "- +++ "_:a rdf:_2 \"2\"^^xsd:integer . "- ]--divmod03bwd :: [[String]]-divmod03bwd =- [ ]---- power--power01inp :: String-power01inp =- "_:a a xsd_integer:Power ; "- +++ " rdf:_2 \"2\"^^xsd:integer ; "- +++ " rdf:_3 \"5\"^^xsd:integer . "--power01fwd :: [String]-power01fwd =- [ "_:a rdf:_1 \"32\"^^xsd:integer . " ]--power01bwd :: [[String]]-power01bwd =- [ ]--power02inp :: String-power02inp =- "_:a a xsd_integer:Power ; "- +++ " rdf:_2 \"111\"^^xsd:integer ; "- +++ " rdf:_3 \"0\"^^xsd:integer . "--power02fwd :: [String]-power02fwd =- [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]--power02bwd :: [[String]]-power02bwd =- [ ]--power03inp :: String-power03inp =- "_:a a xsd_integer:Power ; "- +++ " rdf:_2 \"22\"^^xsd:integer ; "- +++ " rdf:_3 \"-33\"^^xsd:integer . "--power03fwd :: [String]-power03fwd =- [ falseGraphStr ]--power03bwd :: [[String]]-power03bwd =- [ [ falseGraphStr ]- ]---- eq--eq01inp :: String-eq01inp =- "_:a a xsd_integer:Eq ; "- +++ " rdf:_1 \"11\"^^xsd:integer ; "- +++ " rdf:_2 \"11\"^^xsd:integer . "--eq01fwd :: [String]-eq01fwd = [ ]--eq01bwd :: [[String]]-eq01bwd = [ ]--eq02inp :: String-eq02inp =- "_:a a xsd_integer:Eq ; "- +++ " rdf:_1 \"21\"^^xsd:integer ; "- +++ " rdf:_2 \"22\"^^xsd:integer . "--eq02fwd :: [String]-eq02fwd = [ falseGraphStr ]--eq02bwd :: [[String]]-eq02bwd = [ [falseGraphStr] ]--eq03inp :: String-eq03inp =- "_:a a xsd_integer:Eq ; "- +++ " rdf:_1 \"31\"^^xsd:integer ; "- +++ " rdf:_2 \"-32\"^^xsd:integer . "--eq03fwd :: [String]-eq03fwd = [ falseGraphStr ]--eq03bwd :: [[String]]-eq03bwd = [ [falseGraphStr] ]---- ne--ne01inp :: String-ne01inp =- "_:a a xsd_integer:Ne ; "- +++ " rdf:_1 \"11\"^^xsd:integer ; "- +++ " rdf:_2 \"11\"^^xsd:integer . "--ne01fwd :: [String]-ne01fwd = [ falseGraphStr ]--ne01bwd :: [[String]]-ne01bwd = [ [falseGraphStr] ]--ne02inp :: String-ne02inp =- "_:a a xsd_integer:Ne ; "- +++ " rdf:_1 \"21\"^^xsd:integer ; "- +++ " rdf:_2 \"22\"^^xsd:integer . "--ne02fwd :: [String]-ne02fwd = [ ]--ne02bwd :: [[String]]-ne02bwd = [ ]--ne03inp :: String-ne03inp =- "_:a a xsd_integer:Ne ; "- +++ " rdf:_1 \"31\"^^xsd:integer ; "- +++ " rdf:_2 \"-32\"^^xsd:integer . "--ne03fwd :: [String]-ne03fwd = [ ]--ne03bwd :: [[String]]-ne03bwd = [ ]---- lt--lt01inp :: String-lt01inp =- "_:a a xsd_integer:Lt ; "- +++ " rdf:_1 \"11\"^^xsd:integer ; "- +++ " rdf:_2 \"11\"^^xsd:integer . "--lt01fwd :: [String]-lt01fwd = [ falseGraphStr ]--lt01bwd :: [[String]]-lt01bwd = [ [falseGraphStr] ]--lt02inp :: String-lt02inp =- "_:a a xsd_integer:Lt ; "- +++ " rdf:_1 \"21\"^^xsd:integer ; "- +++ " rdf:_2 \"22\"^^xsd:integer . "--lt02fwd :: [String]-lt02fwd = [ ]--lt02bwd :: [[String]]-lt02bwd = [ ]--lt03inp :: String-lt03inp =- "_:a a xsd_integer:Lt ; "- +++ " rdf:_1 \"31\"^^xsd:integer ; "- +++ " rdf:_2 \"-32\"^^xsd:integer . "--lt03fwd :: [String]-lt03fwd = [ falseGraphStr ]--lt03bwd :: [[String]]-lt03bwd = [ [falseGraphStr] ]---- le--le01inp :: String-le01inp =- "_:a a xsd_integer:Le ; "- +++ " rdf:_1 \"11\"^^xsd:integer ; "- +++ " rdf:_2 \"11\"^^xsd:integer . "--le01fwd :: [String]-le01fwd = [ ]--le01bwd :: [[String]]-le01bwd = [ ]--le02inp :: String-le02inp =- "_:a a xsd_integer:Le ; "- +++ " rdf:_1 \"21\"^^xsd:integer ; "- +++ " rdf:_2 \"22\"^^xsd:integer . "--le02fwd :: [String]-le02fwd = [ ]--le02bwd :: [[String]]-le02bwd = [ ]--le03inp :: String-le03inp =- "_:a a xsd_integer:Le ; "- +++ " rdf:_1 \"31\"^^xsd:integer ; "- +++ " rdf:_2 \"-32\"^^xsd:integer . "--le03fwd :: [String]-le03fwd = [ falseGraphStr ]--le03bwd :: [[String]]-le03bwd = [ [falseGraphStr] ]---- gt--gt01inp :: String-gt01inp =- "_:a a xsd_integer:Gt ; "- +++ " rdf:_1 \"11\"^^xsd:integer ; "- +++ " rdf:_2 \"11\"^^xsd:integer . "--gt01fwd :: [String]-gt01fwd = [ falseGraphStr ]--gt01bwd :: [[String]]-gt01bwd = [ [falseGraphStr] ]--gt02inp :: String-gt02inp =- "_:a a xsd_integer:Gt ; "- +++ " rdf:_1 \"21\"^^xsd:integer ; "- +++ " rdf:_2 \"22\"^^xsd:integer . "--gt02fwd :: [String]-gt02fwd = [ falseGraphStr ]--gt02bwd :: [[String]]-gt02bwd = [ [falseGraphStr] ]--gt03inp :: String-gt03inp =- "_:a a xsd_integer:Gt ; "- +++ " rdf:_1 \"31\"^^xsd:integer ; "- +++ " rdf:_2 \"-32\"^^xsd:integer . "--gt03fwd :: [String]-gt03fwd = [ ]--gt03bwd :: [[String]]-gt03bwd = [ ]---- ge--ge01inp :: String-ge01inp =- "_:a a xsd_integer:Ge ; "- +++ " rdf:_1 \"11\"^^xsd:integer ; "- +++ " rdf:_2 \"11\"^^xsd:integer . "--ge01fwd :: [String]-ge01fwd = [ ]--ge01bwd :: [[String]]-ge01bwd = [ ]--ge02inp :: String-ge02inp =- "_:a a xsd_integer:Ge ; "- +++ " rdf:_1 \"21\"^^xsd:integer ; "- +++ " rdf:_2 \"22\"^^xsd:integer . "--ge02fwd :: [String]-ge02fwd = [ falseGraphStr ]--ge02bwd :: [[String]]-ge02bwd = [ [falseGraphStr] ]--ge03inp :: String-ge03inp =- "_:a a xsd_integer:Ge ; "- +++ " rdf:_1 \"31\"^^xsd:integer ; "- +++ " rdf:_2 \"-32\"^^xsd:integer . "--ge03fwd :: [String]-ge03fwd = [ ]--ge03bwd :: [[String]]-ge03bwd = [ ]---- Test cases from design notes--infixr 5 +++-(+++) :: String -> ShowS-(+++) str = ((str++"\n")++)---- Make a vector of rules using the graph string below--pvRules :: [RDFRule]--- pvRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr-pvRules = typeMkRules rdfDatatypeXsdInteger gr- where- gr = mkGraph pvRulesStr--pvRulesStr :: String-pvRulesStr =- ":PassengerVehicle a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; "- +++ " rdfd:constraint xsd_integer:sum . "- +++ ":PassengerVehicle1 a rdfd:GeneralRestriction ; "- +++ " rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; "- +++ " rdfd:constraint xsd_integer:sum ; "- +++ " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "---- Now the test cases that use the rules created above.--pvRule0, pvRule1 :: Maybe (Rule RDFGraph)-pvRule0 = mapFindMaybe- (ScopedName namespaceDefault "PassengerVehicle")- (LookupMap pvRules)-pvRule1 = mapFindMaybe- (ScopedName namespaceDefault "PassengerVehicle1")- (LookupMap pvRules)--pv01inp :: String-pv01inp =- "_:a a :PassengerVehicle ; "- +++ " :seatedCapacity \"30\"^^xsd:integer ; "- +++ " :standingCapacity \"20\"^^xsd:integer . "--pv01fwd :: [String]-pv01fwd =- [ "_:a :totalCapacity \"50\"^^xsd:integer . " ]--pv01bwd :: [[String]]-pv01bwd =- [ [ "_:a a :PassengerVehicle . "- , "_:a :totalCapacity \"50\"^^xsd:integer . "- , "_:a :seatedCapacity \"30\"^^xsd:integer . "- ]- , [ "_:a a :PassengerVehicle . "- , "_:a :totalCapacity \"50\"^^xsd:integer . "- , "_:a :standingCapacity \"20\"^^xsd:integer . "- ]- ]--pv02inp :: String-pv02inp =- "_:a a :PassengerVehicle ; "- +++ " :seatedCapacity \"30\"^^xsd:integer ; "- +++ " :totalCapacity \"51\"^^xsd:integer . "- +++ "_:b a :PassengerVehicle ; "- +++ " :standingCapacity \"20\"^^xsd:integer ; "- +++ " :totalCapacity \"52\"^^xsd:integer . "--pv02fwd :: [String]-pv02fwd =- [ "_:a :standingCapacity \"21\"^^xsd:integer . "- , "_:b :seatedCapacity \"32\"^^xsd:integer . "- ]--pv02bwd :: [[String]]-pv02bwd =- [ [ "_:a a :PassengerVehicle . "- , "_:a :standingCapacity \"21\"^^xsd:integer . "- , "_:a :totalCapacity \"51\"^^xsd:integer . "- , "_:b a :PassengerVehicle . "- , "_:b :seatedCapacity \"32\"^^xsd:integer . "- , "_:b :totalCapacity \"52\"^^xsd:integer . "- ]- , [ "_:a a :PassengerVehicle . "- , "_:a :seatedCapacity \"30\"^^xsd:integer . "- , "_:a :standingCapacity \"21\"^^xsd:integer . "- , "_:b a :PassengerVehicle . "- , "_:b :seatedCapacity \"32\"^^xsd:integer . "- , "_:b :totalCapacity \"52\"^^xsd:integer . "- ]- , [ "_:a a :PassengerVehicle . "- , "_:a :standingCapacity \"21\"^^xsd:integer . "- , "_:a :totalCapacity \"51\"^^xsd:integer . "- , "_:b a :PassengerVehicle . "- , "_:b :seatedCapacity \"32\"^^xsd:integer . "- , "_:b :standingCapacity \"20\"^^xsd:integer . "- ]- , [ "_:a a :PassengerVehicle . "- , "_:a :seatedCapacity \"30\"^^xsd:integer . "- , "_:a :standingCapacity \"21\"^^xsd:integer . "- , "_:b a :PassengerVehicle . "- , "_:b :seatedCapacity \"32\"^^xsd:integer . "- , "_:b :standingCapacity \"20\"^^xsd:integer . "- ]- ]--pv03inp :: String-pv03inp =- "_:a a :PassengerVehicle ; "- +++ " :seatedCapacity \"30\"^^xsd:integer ; "- +++ " :standingCapacity \"23\"^^xsd:integer ; "- +++ " :totalCapacity \"53\"^^xsd:integer . "--pv03fwd :: [String]-pv03fwd = []--pv04inp :: String-pv04inp =- "_:a a :PassengerVehicle ; "- +++ " :seatedCapacity \"30\"^^xsd:integer ; "- +++ " :standingCapacity \"20\"^^xsd:integer ; "- +++ " :totalCapacity \"54\"^^xsd:integer . "--pv04fwd :: [String]-pv04fwd =- [ "_:a :standingCapacity \"24\"^^xsd:integer . "- +++ "_:a :seatedCapacity \"34\"^^xsd:integer . "- +++ "_:a :totalCapacity \"50\"^^xsd:integer . "- ]--pv05inp :: String-pv05inp =- "_:a a :PassengerVehicle1 ; "- +++ " :seatedCapacity \"30\"^^xsd:integer ; "- +++ " :standingCapacity \"25\"^^xsd:integer ; "- +++ " :totalCapacity \"55\"^^xsd:integer . "--pv05fwd :: [String]-pv05fwd = []--pv06inp :: String-pv06inp =- "_:a a :PassengerVehicle1 ; "- +++ " :seatedCapacity \"30\"^^xsd:integer ; "- +++ " :standingCapacity \"20\"^^xsd:integer ; "- +++ " :totalCapacity \"56\"^^xsd:integer . "--pv06fwd :: [String]-pv06fwd =- [ falseGraphStr- ]--pv06bwd :: [[String]]-pv06bwd =- [ [ falseGraphStr- ]- ]--pv07inp :: String-pv07inp =- "_:a a :PassengerVehicle ; "- +++ " :totalCapacity \"57\"^^xsd:integer . "--pv07fwd :: [String]-pv07fwd = []---- how come this isn't [[String]] ?-pv07bwd :: [String]-pv07bwd = []---- Full suite for datatype rule tests--testDatatypeRuleSuite :: Test-testDatatypeRuleSuite = TestList- [ testRuleFwd "testRuleFwdAbs01" ruleabs abs01inp abs01fwd- , testRuleFwd "testRuleFwdAbs02" ruleabs abs02inp abs02fwd- , testRuleFwd "testRuleFwdAbs03" ruleabs abs03inp abs03fwd- , testRuleFwd "testRuleFwdAbs04" ruleabs abs04inp abs04fwd- , testRuleFwd "testRuleFwdNeg01" ruleneg neg01inp neg01fwd- , testRuleFwd "testRuleFwdNeg02" ruleneg neg02inp neg02fwd- , testRuleFwd "testRuleFwdSum01" rulesum sum01inp sum01fwd- , testRuleFwd "testRuleFwdSum02" rulesum sum02inp sum02fwd- , testRuleFwd "testRuleFwdSum03" rulesum sum03inp sum03fwd- , testRuleFwd "testRuleFwdDiff01" rulediff diff01inp diff01fwd- , testRuleFwd "testRuleFwdDiff02" rulediff diff02inp diff02fwd- , testRuleFwd "testRuleFwdDiff03" rulediff diff03inp diff03fwd- , testRuleFwd "testRuleFwdProd01" ruleprod prod01inp prod01fwd- , testRuleFwd "testRuleFwdProd02" ruleprod prod02inp prod02fwd- , testRuleFwd "testRuleFwdProd03" ruleprod prod03inp prod03fwd- , testRuleFwd "testRuleFwdDivMod01" ruledivmod divmod01inp divmod01fwd- , testRuleFwd "testRuleFwdDivMod02" ruledivmod divmod02inp divmod02fwd- , testRuleFwd "testRuleFwdDivMod03" ruledivmod divmod03inp divmod03fwd- , testRuleFwd "testRuleFwdPower01" rulepower power01inp power01fwd- , testRuleFwd "testRuleFwdPower02" rulepower power02inp power02fwd- , testRuleFwd "testRuleFwdPower03" rulepower power03inp power03fwd- , testRuleFwd "testRuleFwdEq01" ruleeq eq01inp eq01fwd- , testRuleFwd "testRuleFwdEq02" ruleeq eq02inp eq02fwd- , testRuleFwd "testRuleFwdEq03" ruleeq eq03inp eq03fwd- , testRuleFwd "testRuleFwdNe01" rulene ne01inp ne01fwd- , testRuleFwd "testRuleFwdNe02" rulene ne02inp ne02fwd- , testRuleFwd "testRuleFwdNe03" rulene ne03inp ne03fwd- , testRuleFwd "testRuleFwdLt01" rulelt lt01inp lt01fwd- , testRuleFwd "testRuleFwdLt02" rulelt lt02inp lt02fwd- , testRuleFwd "testRuleFwdLt03" rulelt lt03inp lt03fwd- , testRuleFwd "testRuleFwdLe01" rulele le01inp le01fwd- , testRuleFwd "testRuleFwdLe02" rulele le02inp le02fwd- , testRuleFwd "testRuleFwdLe03" rulele le03inp le03fwd- , testRuleFwd "testRuleFwdGt01" rulegt gt01inp gt01fwd- , testRuleFwd "testRuleFwdGt02" rulegt gt02inp gt02fwd- , testRuleFwd "testRuleFwdGt03" rulegt gt03inp gt03fwd- , testRuleFwd "testRuleFwdGe01" rulege ge01inp ge01fwd- , testRuleFwd "testRuleFwdGe02" rulege ge02inp ge02fwd- , testRuleFwd "testRuleFwdGe03" rulege ge03inp ge03fwd- - -- backard chaining tests- , testRuleBwd "testRuleBwdAbs01" ruleabs abs01inp abs01bwd- , testRuleBwd "testRuleBwdAbs02" ruleabs abs02inp abs02bwd- , testRuleBwd "testRuleBwdAbs03" ruleabs abs03inp abs03bwd- , testRuleBwd "testRuleBwdAbs04" ruleabs abs04inp abs04bwd- , testRuleBwd "testRuleBwdNeg01" ruleneg neg01inp neg01bwd- , testRuleBwd "testRuleBwdNeg02" ruleneg neg02inp neg02bwd- , testRuleBwd "testRuleBwdSum01" rulesum sum01inp sum01bwd- , testRuleBwd "testRuleBwdSum02" rulesum sum02inp sum02bwd- , testRuleBwd "testRuleBwdSum03" rulesum sum03inp sum03bwd- , testRuleBwd "testRuleBwdDiff01" rulediff diff01inp diff01bwd- , testRuleBwd "testRuleBwdDiff02" rulediff diff02inp diff02bwd- , testRuleBwd "testRuleBwdDiff03" rulediff diff03inp diff03bwd- , testRuleBwd "testRuleBwdProd01" ruleprod prod01inp prod01bwd- , testRuleBwd "testRuleBwdProd02" ruleprod prod02inp prod02bwd- , testRuleBwd "testRuleBwdProd03" ruleprod prod03inp prod03bwd- , testRuleBwd "testRuleBwdDivMod01" ruledivmod divmod01inp divmod01bwd- , testRuleBwd "testRuleBwdDivMod02" ruledivmod divmod02inp divmod02bwd- , testRuleBwd "testRuleBwdDivMod03" ruledivmod divmod03inp divmod03bwd- , testRuleBwd "testRuleBwdPower01" rulepower power01inp power01bwd- , testRuleBwd "testRuleBwdPower02" rulepower power02inp power02bwd- , testRuleBwd "testRuleBwdPower03" rulepower power03inp power03bwd- , testRuleBwd "testRuleBwdEq01" ruleeq eq01inp eq01bwd- , testRuleBwd "testRuleBwdEq02" ruleeq eq02inp eq02bwd- , testRuleBwd "testRuleBwdEq03" ruleeq eq03inp eq03bwd- , testRuleBwd "testRuleBwdNe01" rulene ne01inp ne01bwd- , testRuleBwd "testRuleBwdNe02" rulene ne02inp ne02bwd- , testRuleBwd "testRuleBwdNe03" rulene ne03inp ne03bwd- , testRuleBwd "testRuleBwdLt01" rulelt lt01inp lt01bwd- , testRuleBwd "testRuleBwdLt02" rulelt lt02inp lt02bwd- , testRuleBwd "testRuleBwdLt03" rulelt lt03inp lt03bwd- , testRuleBwd "testRuleBwdLe01" rulele le01inp le01bwd- , testRuleBwd "testRuleBwdLe02" rulele le02inp le02bwd- , testRuleBwd "testRuleBwdLe03" rulele le03inp le03bwd- , testRuleBwd "testRuleBwdGt01" rulegt gt01inp gt01bwd- , testRuleBwd "testRuleBwdGt02" rulegt gt02inp gt02bwd- , testRuleBwd "testRuleBwdGt03" rulegt gt03inp gt03bwd- , testRuleBwd "testRuleBwdGe01" rulege ge01inp ge01bwd- , testRuleBwd "testRuleBwdGe02" rulege ge02inp ge02bwd- , testRuleBwd "testRuleBwdGe03" rulege ge03inp ge03bwd+{-# LANGUAGE OverloadedStrings #-}++--------------------------------------------------------------------------------+-- See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+-- Module : RDFDatatypeXsdIntegerTest+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+-- License : GPL V2+--+-- Maintainer : Douglas Burke+-- Stability : experimental+-- Portability : OverloadedStrings+--+-- This module contains test cases for variable binding values and+-- variable binding modifier values.+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.RDFDatatypeXsdInteger+ ( rdfDatatypeXsdInteger+ , rdfDatatypeValXsdInteger+ , typeNameXsdInteger, namespaceXsdInteger+ , axiomsXsdInteger, rulesXsdInteger+ , prefixXsdInteger+ )++import Swish.RDF.RDFVarBinding (RDFVarBinding)++import Swish.RDF.RDFRuleset+ ( RDFRule + , makeRDFGraphFromN3Builder+ )++import Swish.RDF.RDFDatatype (RDFDatatypeMod, applyRDFDatatypeMod)+import Swish.RDF.RDFGraph (RDFLabel(..), RDFGraph)+import Swish.RDF.ClassRestrictionRule (falseGraphStr)++import Swish.RDF.Datatype+ ( typeName, typeRules, typeMkRules+ , getTypeAxiom, getTypeRule+ , DatatypeVal(..)+ , getDTMod+ , DatatypeMap(..)+ , DatatypeMod(..)+ , nullDatatypeMod+ )++import Swish.RDF.Ruleset (Ruleset(..), getRulesetRule)+import Swish.RDF.Rule (Formula(..), Rule(..), nullFormula, nullRule)+import Swish.RDF.VarBinding (makeVarBinding)+import Swish.Utils.Namespace (Namespace(..), ScopedName(..), makeScopedName)+import Swish.RDF.Vocabulary (namespaceDefault)+import Swish.Utils.LookupMap (LookupMap(..), mapFindMaybe)+import Swish.Utils.ListHelpers (equiv)++import Test.HUnit+ ( Test(TestCase,TestList)+ , Assertion+ , assertBool, assertEqual, assertFailure+ , runTestTT+ )++import Network.URI (URI, parseURI)++import Control.Monad (unless)+import Data.Monoid (Monoid(..))+import Data.Maybe (isJust, isNothing, fromMaybe, fromJust)+import Data.List (intersperse)++import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as B++------------------------------------------------------------+-- Test case helpers+------------------------------------------------------------++assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion+assertMember preface expected actual =+ unless (expected `elem` actual ) (assertFailure msg)+ where msg = (if null preface then "" else preface ++ "\n") +++ "expected: " ++ show expected ++ "\nbut got: " ++ show actual++test :: String -> Bool -> Test+test lab bv =+ TestCase ( assertBool ("test:"++lab) bv )++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab a1 a2 =+ TestCase ( assertEqual ("testEq:"++lab) a1 a2 )++testElem :: (Eq a, Show a) => String -> a -> [a] -> Test+testElem lab a1 as =+ TestCase ( assertMember ("testElem:"++lab) a1 as )++testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test+testLe lab eq a1 a2 =+ TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )++-- Test for Just x or Nothing++testJust :: String -> Maybe a -> Test+testJust lab av =+ TestCase ( assertBool ("testJust:"++lab) (isJust av) )++testNothing :: String -> Maybe a -> Test+testNothing lab av =+ TestCase ( assertBool ("testJust:"++lab) (isNothing av) )++-- Compare lists and lists of lists and Maybe lists for set equivalence:++data ListTest a = ListTest [a]++instance (Eq a) => Eq (ListTest a) where+ (ListTest a1) == (ListTest a2) = a1 `equiv` a2++instance (Show a) => Show (ListTest a) where+ show (ListTest a) = show a++data MaybeListTest a = MaybeListTest (Maybe [a])++instance (Eq a) => Eq (MaybeListTest a) where+ MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2+ MaybeListTest Nothing == MaybeListTest Nothing = True+ _ == _ = False++instance (Show a) => Show (MaybeListTest a) where+ show (MaybeListTest a) = show a++testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test+testEqv lab a1 a2 =+ TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )++testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test+testEqvEqv lab a1 a2 =+ TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )+ where+ ma1 = ListTest $ map ListTest a1+ ma2 = ListTest $ map ListTest a2++testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test+testHasEqv lab a1 a2 =+ TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )+ where+ ma1 = ListTest a1+ ma2 = map ListTest a2++testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test+testMaybeEqv lab a1 a2 =+ TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )+ where+ ma1 = MaybeListTest a1+ ma2 = MaybeListTest a2++------------------------------------------------------------+-- Misc values+------------------------------------------------------------++toURI :: String -> URI+toURI = fromJust . parseURI++xsdIntName :: T.Text -> ScopedName+xsdIntName = ScopedName namespaceXsdInteger ++axiomXsdIntegerDT :: ScopedName+axiomXsdIntegerDT = xsdIntName "dt"++ruleXsdIntegerAbs, ruleXsdIntegerNeg, ruleXsdIntegerSum,+ ruleXsdIntegerDiff, ruleXsdIntegerProd, ruleXsdIntegerDivMod,+ ruleXsdIntegerPower, ruleXsdIntegerEq, ruleXsdIntegerNe, + ruleXsdIntegerLt, ruleXsdIntegerLe, ruleXsdIntegerGt,+ ruleXsdIntegerGe :: ScopedName+ruleXsdIntegerAbs = xsdIntName "Abs"+ruleXsdIntegerNeg = xsdIntName "Neg"+ruleXsdIntegerSum = xsdIntName "Sum"+ruleXsdIntegerDiff = xsdIntName "Diff"+ruleXsdIntegerProd = xsdIntName "Prod"+ruleXsdIntegerDivMod = xsdIntName "DivMod"+ruleXsdIntegerPower = xsdIntName "Power"+ruleXsdIntegerEq = xsdIntName "Eq"+ruleXsdIntegerNe = xsdIntName "Ne"+ruleXsdIntegerLt = xsdIntName "Lt"+ruleXsdIntegerLe = xsdIntName "Le"+ruleXsdIntegerGt = xsdIntName "Gt"+ruleXsdIntegerGe = xsdIntName "Ge"++------------------------------------------------------------+-- Basic rdfDatatypeXsdInteger tests+------------------------------------------------------------++getXsdIntegerAxiom :: ScopedName -> Formula RDFGraph+getXsdIntegerAxiom scopnam =+ fromMaybe nullFormula $ getTypeAxiom scopnam rdfDatatypeXsdInteger++getXsdIntegerRule :: ScopedName -> Rule RDFGraph+getXsdIntegerRule scopnam =+ fromMaybe nullRule $ getTypeRule scopnam rdfDatatypeXsdInteger++getXsdIntegerDTmod :: ScopedName -> DatatypeMod Integer RDFLabel RDFLabel+getXsdIntegerDTmod scopnam =+ fromMaybe nullDatatypeMod $ getDTMod scopnam rdfDatatypeValXsdInteger++testDatatypeSuite :: Test+testDatatypeSuite = + TestList+ [ testEq "testDatatype01" typeNameXsdInteger $+ typeName rdfDatatypeXsdInteger+ , testEq "testDatatype02" namespaceXsdInteger $+ rsNamespace xsdIntRules+ , testEqv "testDatatype03" axiomsXsdInteger $+ rsAxioms xsdIntRules+ , testEqv "testDatatype04" rulesXsdInteger $+ rsRules xsdIntRules+ , testEq "testDatatype05" axiomXsdIntegerDT $+ formName (getXsdIntegerAxiom axiomXsdIntegerDT)+ , testEq "testDatatype06" ruleXsdIntegerAbs $+ ruleName (getXsdIntegerRule ruleXsdIntegerAbs)+ ]+ +------------------------------------------------------------+-- Basic rdfDatatypeValXsdInteger tests+------------------------------------------------------------++testDatatypeValSuite :: Test+testDatatypeValSuite = + TestList+ [ testEq "testDatatypeVal01" (Just 123) $+ mapL2V (tvalMap rdfDatatypeValXsdInteger) "123"+ , testEq "testDatatypeVal02" (Just 0) $+ mapL2V (tvalMap rdfDatatypeValXsdInteger) "0"+ , testEq "testDatatypeVal03" (Just 456) $+ mapL2V (tvalMap rdfDatatypeValXsdInteger) "+000456"+ , testEq "testDatatypeVal04" (Just (-987)) $+ mapL2V (tvalMap rdfDatatypeValXsdInteger) "-0987"+ , testEq "testDatatypeVal05" Nothing $+ mapL2V (tvalMap rdfDatatypeValXsdInteger) "11x2"+ , testEq "testDatatypeVal06" Nothing $+ mapL2V (tvalMap rdfDatatypeValXsdInteger) " 321"+ , testEq "testDatatypeVal07" Nothing $+ mapL2V (tvalMap rdfDatatypeValXsdInteger) "321 "++ , testEq "testDatatypeVal11" (Just "123") $+ mapV2L (tvalMap rdfDatatypeValXsdInteger) 123+ , testEq "testDatatypeVal12" (Just "-987") $+ mapV2L (tvalMap rdfDatatypeValXsdInteger) (-987)++ , testElem "testDatatypeVal21" dmodXsdIntegerAbs $+ map dmName (tvalMod rdfDatatypeValXsdInteger)+ , testEq "testDatatypeVal22" dmodXsdIntegerAbs $+ dmName (getXsdIntegerDTmod dmodXsdIntegerAbs)+ ]++------------------------------------------------------------+-- Variable binding modifier tests+------------------------------------------------------------++dmodXsdIntegerAbs, dmodXsdIntegerNeg, dmodXsdIntegerSum, + dmodXsdIntegerDiff, dmodXsdIntegerProd, dmodXsdIntegerDivMod, + dmodXsdIntegerPower, dmodXsdIntegerEq, dmodXsdIntegerNe, + dmodXsdIntegerLt, dmodXsdIntegerLe, dmodXsdIntegerGt, + dmodXsdIntegerGe :: ScopedName++dmodXsdIntegerAbs = xsdIntName "abs"+dmodXsdIntegerNeg = xsdIntName "neg"+dmodXsdIntegerSum = xsdIntName "sum"+dmodXsdIntegerDiff = xsdIntName "diff"+dmodXsdIntegerProd = xsdIntName "prod"+dmodXsdIntegerDivMod = xsdIntName "divmod"+dmodXsdIntegerPower = xsdIntName "power"+dmodXsdIntegerEq = xsdIntName "eq"+dmodXsdIntegerNe = xsdIntName "ne"+dmodXsdIntegerLt = xsdIntName "lt"+dmodXsdIntegerLe = xsdIntName "le"+dmodXsdIntegerGt = xsdIntName "gt"+dmodXsdIntegerGe = xsdIntName "ge"++testVmodN :: [RDFLabel]+ -> String -> Maybe (RDFDatatypeMod Integer)+ -> [RDFVarBinding] -> [RDFVarBinding]+ -> Test+testVmodN vars lab (Just dmod) ibinds obinds =+ testEqv lab obinds $+ applyRDFDatatypeMod rdfDatatypeValXsdInteger dmod vars ibinds+testVmodN _ lab Nothing _ _ = TestCase $+ assertFailure $ "testVmodN:"++lab++", null variable binding modifier"++testVmod2, testVmod3, testVmod4 :: + String -> Maybe (RDFDatatypeMod Integer)+ -> [RDFVarBinding] -> [RDFVarBinding]+ -> Test+testVmod2 = testVmodN [Var "a", Var "b"]+testVmod3 = testVmodN [Var "a", Var "b", Var "c"]+testVmod4 = testVmodN [Var "a", Var "b", Var "c", Var "d"]++-- make various kinds of RDF variable bindings++rdfVR :: (String, ScopedName) -> (RDFLabel, RDFLabel)+rdfVR (v,u) = (Var v,Res u) -- (Variable,Resource)++rdfVB :: (String, String) -> (RDFLabel, RDFLabel)+rdfVB (v,b) = (Var v,Blank b) -- (Variable,Blank)++rdfVL :: (String, String) -> (RDFLabel, RDFLabel)+rdfVL (v,l) = (Var v,Lit (T.pack l) Nothing) -- (Variable,Untyped literal)++rdfVI :: (String, String) -> (RDFLabel, RDFLabel)+rdfVI (v,l) = (Var v,Lit (T.pack l) (Just typeNameXsdInteger))+ -- (Variable,Integer literal)++makeBVR :: [(String,ScopedName)] -> RDFVarBinding+makeBVR nls = makeVarBinding $ map rdfVR nls++makeBVB :: [(String,String)] -> RDFVarBinding+makeBVB nls = makeVarBinding $ map rdfVB nls++makeBVI :: [(String,String)] -> RDFVarBinding+makeBVI nls = makeVarBinding $ map rdfVI nls++makeBVL :: [(String,String)] -> RDFVarBinding+makeBVL nls = makeVarBinding $ map rdfVL nls++-- Test null modifier++testVarModify00 :: Test+testVarModify00 = testVmod2 "testVarModify00"+ (Just nullDatatypeMod)+ [makeBVI [("a","123")]]+ [makeBVI [("a","123")]]++-- Tests for xsd_integer:abs++testVarModifyAbs01, testVarModifyAbs02, testVarModifyAbs03,+ testVarModifyAbs04, testVarModifyAbs05, testVarModifyAbs06,+ testVarModifyAbs07, testVarModifyAbs08, testVarModifyAbs09,+ testVarModifyAbs10 :: Test+testVarModifyAbs01 = testVmod2 "testVarModifyAbs01"+ (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+ [makeBVI [("b","123")]]+ [makeBVI [("a","123"),("b","123")]]++testVarModifyAbs02 = testVmod2 "testVarModifyAbs02"+ (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+ [makeBVI [("b","-123")]]+ [makeBVI [("a","123"),("b","-123")]]++testVarModifyAbs03 = testVmod2 "testVarModifyAbs03"+ (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+ [makeBVI [("a","123"),("b","123")]]+ [makeBVI [("a","123"),("b","123")]]++testVarModifyAbs04 = testVmod2 "testVarModifyAbs04"+ (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+ [makeBVI [("a","123"),("b","-123")]]+ [makeBVI [("a","123"),("b","-123")]]++testVarModifyAbs05 = testVmod2 "testVarModifyAbs05"+ (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+ [makeBVI [("a","-123"),("b","123")]]+ []++testVarModifyAbs06 = testVmod2 "testVarModifyAbs06"+ (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+ [makeBVI [("a","123"),("b","456")]]+ []++testVarModifyAbs07 = testVmod2 "testVarModifyAbs07"+ (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+ [makeBVI [("c","123")]]+ []++testVarModifyAbs08 = testVmod2 "testVarModifyAbs08"+ (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+ [makeBVL [("b","123")]]+ []++testVarModifyAbs09 = testVmod2 "testVarModifyAbs09"+ (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+ [makeBVR [("b",makeScopedName Nothing (toURI "http://ex.org/") "123")]]+ []++testVarModifyAbs10 = testVmod2 "testVarModifyAbs10"+ (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)+ [makeBVB [("b","123")]]+ []++-- Tests for xsd_integer:neg++testVarModifyNeg01, testVarModifyNeg02, testVarModifyNeg03,+ testVarModifyNeg04, testVarModifyNeg05 :: Test++testVarModifyNeg01 = testVmod2 "testVarModifyNeg01"+ (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)+ [makeBVI [("a","123"),("b","-123")]]+ [makeBVI [("a","123"),("b","-123")]]++testVarModifyNeg02 = testVmod2 "testVarModifyNeg02"+ (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)+ [makeBVI [("a","-123"),("b","123")]]+ [makeBVI [("a","-123"),("b","123")]]++testVarModifyNeg03 = testVmod2 "testVarModifyNeg03"+ (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)+ [makeBVI [("a","123"),("b","123")]]+ []++testVarModifyNeg04 = testVmod2 "testVarModifyNeg04"+ (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)+ [makeBVI [("b","123")]]+ [makeBVI [("a","-123"),("b","123")]]++testVarModifyNeg05 = testVmod2 "testVarModifyNeg05"+ (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)+ [makeBVI [("a","-123")]]+ [makeBVI [("a","-123"),("b","123")]]++-- Tests for xsd_integer:sum++testVarModifySum01, testVarModifySum02, testVarModifySum03,+ testVarModifySum04, testVarModifySum05 :: Test++testVarModifySum01 = testVmod3 "testVarModifySum01"+ (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)+ [makeBVI [("a","33"),("b","22"),("c","11")]]+ [makeBVI [("a","33"),("b","22"),("c","11")]]++testVarModifySum02 = testVmod3 "testVarModifySum02"+ (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)+ [makeBVI [("b","22"),("c","11")]]+ [makeBVI [("a","33"),("b","22"),("c","11")]]++testVarModifySum03 = testVmod3 "testVarModifySum03"+ (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)+ [makeBVI [("a","33"),("c","11")]]+ [makeBVI [("a","33"),("b","22"),("c","11")]]++testVarModifySum04 = testVmod3 "testVarModifySum04"+ (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)+ [makeBVI [("a","33"),("b","22")]]+ [makeBVI [("a","33"),("b","22"),("c","11")]]++testVarModifySum05 = testVmod3 "testVarModifySum05"+ (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)+ [makeBVI [("a","44"),("b","22"),("c","11")]]+ []++-- Tests for xsd_integer:diff++testVarModifyDiff01, testVarModifyDiff02, testVarModifyDiff03,+ testVarModifyDiff04, testVarModifyDiff05 :: Test++testVarModifyDiff01 = testVmod3 "testVarModifyDiff01"+ (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)+ [makeBVI [("a","11"),("b","33"),("c","22")]]+ [makeBVI [("a","11"),("b","33"),("c","22")]]++testVarModifyDiff02 = testVmod3 "testVarModifyDiff02"+ (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)+ [makeBVI [("b","33"),("c","22")]]+ [makeBVI [("a","11"),("b","33"),("c","22")]]++testVarModifyDiff03 = testVmod3 "testVarModifyDiff03"+ (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)+ [makeBVI [("a","11"),("c","22")]]+ [makeBVI [("a","11"),("b","33"),("c","22")]]++testVarModifyDiff04 = testVmod3 "testVarModifyDiff04"+ (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)+ [makeBVI [("a","11"),("b","33")]]+ [makeBVI [("a","11"),("b","33"),("c","22")]]++testVarModifyDiff05 = testVmod3 "testVarModifyDiff05"+ (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)+ [makeBVI [("a","11"),("b","44"),("c","22")]]+ []++-- Tests for xsd_integer:prod+--+-- Note: product can also be used to test if a value is+-- an exact multiple of some other.++testVarModifyProd01, testVarModifyProd02, testVarModifyProd03,+ testVarModifyProd04, testVarModifyProd05,+ testVarModifyProd06 :: Test++testVarModifyProd01 = testVmod3 "testVarModifyProd01"+ (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+ [makeBVI [("a","6"),("b","2"),("c","3")]]+ [makeBVI [("a","6"),("b","2"),("c","3")]]++testVarModifyProd02 = testVmod3 "testVarModifyProd02"+ (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+ [makeBVI [("b","2"),("c","3")]]+ [makeBVI [("a","6"),("b","2"),("c","3")]]++testVarModifyProd03 = testVmod3 "testVarModifyProd03"+ (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+ [makeBVI [("a","6"),("c","3")]]+ [makeBVI [("a","6"),("b","2"),("c","3")]]++testVarModifyProd04 = testVmod3 "testVarModifyProd04"+ (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+ [makeBVI [("a","6"),("c","3")]]+ [makeBVI [("a","6"),("b","2"),("c","3")]]++testVarModifyProd05 = testVmod3 "testVarModifyProd05"+ (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+ [makeBVI [("a","7"),("b","2"),("c","3")]]+ []++testVarModifyProd06 = testVmod3 "testVarModifyProd06"+ (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)+ [makeBVI [("a","7"),("b","2")]]+ []++-- Tests for xsd_integer:divmod+--+-- Note: truncates downwards, so remainder is same sign as divisor+-- cf. Haskell divMod function.++testVarModifyDivMod01, testVarModifyDivMod02, testVarModifyDivMod03,+ testVarModifyDivMod04, testVarModifyDivMod05,+ testVarModifyDivMod06, testVarModifyDivMod07 :: Test++testVarModifyDivMod01 = testVmod4 "testVarModifyDivMod01"+ (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+ [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]+ [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]++testVarModifyDivMod02 = testVmod4 "testVarModifyDivMod02"+ (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+ [makeBVI [("c","7"),("d","3")]]+ [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]++testVarModifyDivMod03 = testVmod4 "testVarModifyDivMod03"+ (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+ [makeBVI [("c","-7"),("d","3")]]+ [makeBVI [("a","-3"),("b","2"),("c","-7"),("d","3")]]++testVarModifyDivMod04 = testVmod4 "testVarModifyDivMod04"+ (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+ [makeBVI [("c","7"),("d","-3")]]+ [makeBVI [("a","-3"),("b","-2"),("c","7"),("d","-3")]]++testVarModifyDivMod05 = testVmod4 "testVarModifyDivMod05"+ (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+ [makeBVI [("c","-7"),("d","-3")]]+ [makeBVI [("a","2"),("b","-1"),("c","-7"),("d","-3")]]++testVarModifyDivMod06 = testVmod4 "testVarModifyDivMod06"+ (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+ [makeBVI [("a","2"),("b","5"),("c","7"),("d","3")]]+ []++testVarModifyDivMod07 = testVmod4 "testVarModifyDivMod07"+ (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)+ [makeBVI [("a","2"),("b","1"),("d","3")]]+ []++-- Tests for xsd_integer:power++testVarModifyPower01, testVarModifyPower02, testVarModifyPower03,+ testVarModifyPower04, testVarModifyPower05,+ testVarModifyPower06, testVarModifyPower07,+ testVarModifyPower08 :: Test++testVarModifyPower01 = testVmod3 "testVarModifyPower01"+ (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+ [makeBVI [("a","8"),("b","2"),("c","3")]]+ [makeBVI [("a","8"),("b","2"),("c","3")]]++testVarModifyPower02 = testVmod3 "testVarModifyPower02"+ (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+ [makeBVI [("b","2"),("c","3")]]+ [makeBVI [("a","8"),("b","2"),("c","3")]]++testVarModifyPower03 = testVmod3 "testVarModifyPower03"+ (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+ [makeBVI [("a","8"),("c","3")]]+ []++testVarModifyPower04 = testVmod3 "testVarModifyPower04"+ (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+ [makeBVI [("a","8"),("b","2")]]+ []++testVarModifyPower05 = testVmod3 "testVarModifyPower05"+ (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+ [makeBVI [("a","8"),("b","3"),("c","2")]]+ []++testVarModifyPower06 = testVmod3 "testVarModifyPower06"+ (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+ [makeBVI [("b","55"),("c","0")]]+ [makeBVI [("a","1"),("b","55"),("c","0")]]++testVarModifyPower07 = testVmod3 "testVarModifyPower07"+ (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+ [makeBVI [("b","-2"),("c","3")]]+ [makeBVI [("a","-8"),("b","-2"),("c","3")]]++testVarModifyPower08 = testVmod3 "testVarModifyPower08"+ (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)+ [makeBVI [("b","55"),("c","-2")]]+ []++-- Tests for xsd_integer:eq++testVarModifyEq01, testVarModifyEq02, testVarModifyEq03,+ testVarModifyEq04, testVarModifyEq05 :: Test++testVarModifyEq01 = testVmod2 "testVarModifyEq01"+ (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)+ [makeBVI [("a","100"),("b","100")]]+ [makeBVI [("a","100"),("b","100")]]++testVarModifyEq02 = testVmod2 "testVarModifyEq02"+ (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)+ [makeBVI [("a","99"),("b","100")]]+ []++testVarModifyEq03 = testVmod2 "testVarModifyEq03"+ (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)+ [makeBVI [("a","-99"),("b","-100")]]+ []++testVarModifyEq04 = testVmod2 "testVarModifyEq04"+ (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)+ [makeBVI [("b","100")]]+ []++testVarModifyEq05 = testVmod2 "testVarModifyEq05"+ (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)+ [makeBVI [("a","100")]]+ []++-- Tests for xsd_integer:ne++testVarModifyNe01, testVarModifyNe02, testVarModifyNe03,+ testVarModifyNe04, testVarModifyNe05 :: Test++testVarModifyNe01 = testVmod2 "testVarModifyNe01"+ (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)+ [makeBVI [("a","100"),("b","100")]]+ []++testVarModifyNe02 = testVmod2 "testVarModifyNe02"+ (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)+ [makeBVI [("a","99"),("b","100")]]+ [makeBVI [("a","99"),("b","100")]]++testVarModifyNe03 = testVmod2 "testVarModifyNe03"+ (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)+ [makeBVI [("a","-99"),("b","-100")]]+ [makeBVI [("a","-99"),("b","-100")]]++testVarModifyNe04 = testVmod2 "testVarModifyNe04"+ (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)+ [makeBVI [("b","100")]]+ []++testVarModifyNe05 = testVmod2 "testVarModifyNe05"+ (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)+ [makeBVI [("a","100")]]+ []++-- Tests for xsd_integer:lt++testVarModifyLt01, testVarModifyLt02, testVarModifyLt03,+ testVarModifyLt04, testVarModifyLt05 :: Test++testVarModifyLt01 = testVmod2 "testVarModifyLt01"+ (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)+ [makeBVI [("a","100"),("b","100")]]+ []++testVarModifyLt02 = testVmod2 "testVarModifyLt02"+ (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)+ [makeBVI [("a","99"),("b","100")]]+ [makeBVI [("a","99"),("b","100")]]++testVarModifyLt03 = testVmod2 "testVarModifyLt03"+ (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)+ [makeBVI [("a","-99"),("b","-100")]]+ []++testVarModifyLt04 = testVmod2 "testVarModifyLt04"+ (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)+ [makeBVI [("b","100")]]+ []++testVarModifyLt05 = testVmod2 "testVarModifyLt05"+ (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)+ [makeBVI [("a","100")]]+ []++-- Tests for xsd_integer:le++testVarModifyLe01, testVarModifyLe02, testVarModifyLe03,+ testVarModifyLe04, testVarModifyLe05 :: Test++testVarModifyLe01 = testVmod2 "testVarModifyLe01"+ (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)+ [makeBVI [("a","100"),("b","100")]]+ [makeBVI [("a","100"),("b","100")]]++testVarModifyLe02 = testVmod2 "testVarModifyLe02"+ (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)+ [makeBVI [("a","99"),("b","100")]]+ [makeBVI [("a","99"),("b","100")]]++testVarModifyLe03 = testVmod2 "testVarModifyLe03"+ (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)+ [makeBVI [("a","-99"),("b","-100")]]+ []++testVarModifyLe04 = testVmod2 "testVarModifyLe04"+ (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)+ [makeBVI [("b","100")]]+ []++testVarModifyLe05 = testVmod2 "testVarModifyLe05"+ (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)+ [makeBVI [("a","100")]]+ []++-- Tests for xsd_integer:gt++testVarModifyGt01, testVarModifyGt02, testVarModifyGt03,+ testVarModifyGt04, testVarModifyGt05 :: Test++testVarModifyGt01 = testVmod2 "testVarModifyGt01"+ (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)+ [makeBVI [("a","100"),("b","100")]]+ []++testVarModifyGt02 = testVmod2 "testVarModifyGt02"+ (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)+ [makeBVI [("a","99"),("b","100")]]+ []++testVarModifyGt03 = testVmod2 "testVarModifyGt03"+ (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)+ [makeBVI [("a","-99"),("b","-100")]]+ [makeBVI [("a","-99"),("b","-100")]]++testVarModifyGt04 = testVmod2 "testVarModifyGt04"+ (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)+ [makeBVI [("b","100")]]+ []++testVarModifyGt05 = testVmod2 "testVarModifyGt05"+ (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)+ [makeBVI [("a","100")]]+ []++-- Tests for xsd_integer:ge++testVarModifyGe01, testVarModifyGe02, testVarModifyGe03,+ testVarModifyGe04, testVarModifyGe05 :: Test++testVarModifyGe01 = testVmod2 "testVarModifyGe01"+ (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)+ [makeBVI [("a","100"),("b","100")]]+ [makeBVI [("a","100"),("b","100")]]++testVarModifyGe02 = testVmod2 "testVarModifyGe02"+ (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)+ [makeBVI [("a","99"),("b","100")]]+ []++testVarModifyGe03 = testVmod2 "testVarModifyGe03"+ (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)+ [makeBVI [("a","-99"),("b","-100")]]+ [makeBVI [("a","-99"),("b","-100")]]++testVarModifyGe04 = testVmod2 "testVarModifyGe04"+ (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)+ [makeBVI [("b","100")]]+ []++testVarModifyGe05 = testVmod2 "testVarModifyGe05"+ (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)+ [makeBVI [("a","100")]]+ []++-- Full suite for variable binding modifier tests++testVarModifySuite :: Test+testVarModifySuite = TestList+ [ testVarModify00+ , testVarModifyAbs01, testVarModifyAbs02, testVarModifyAbs03+ , testVarModifyAbs04, testVarModifyAbs05, testVarModifyAbs06+ , testVarModifyAbs07, testVarModifyAbs08, testVarModifyAbs09+ , testVarModifyAbs10+ , testVarModifyNeg01, testVarModifyNeg02, testVarModifyNeg03+ , testVarModifyNeg04, testVarModifyNeg05+ , testVarModifySum01, testVarModifySum02, testVarModifySum03+ , testVarModifySum04, testVarModifySum05+ , testVarModifyDiff01, testVarModifyDiff02, testVarModifyDiff03+ , testVarModifyDiff04, testVarModifyDiff05+ , testVarModifyProd01, testVarModifyProd02, testVarModifyProd03+ , testVarModifyProd04, testVarModifyProd05, testVarModifyProd06+ , testVarModifyDivMod01, testVarModifyDivMod02, testVarModifyDivMod03+ , testVarModifyDivMod04, testVarModifyDivMod05, testVarModifyDivMod06+ , testVarModifyDivMod07+ , testVarModifyPower01, testVarModifyPower02, testVarModifyPower03+ , testVarModifyPower04, testVarModifyPower05, testVarModifyPower06+ , testVarModifyPower07, testVarModifyPower08+ , testVarModifyEq01, testVarModifyEq02, testVarModifyEq03+ , testVarModifyEq04, testVarModifyEq05+ , testVarModifyNe01, testVarModifyNe02, testVarModifyNe03+ , testVarModifyNe04, testVarModifyNe05+ , testVarModifyLt01, testVarModifyLt02, testVarModifyLt03+ , testVarModifyLt04, testVarModifyLt05+ , testVarModifyLe01, testVarModifyLe02, testVarModifyLe03+ , testVarModifyLe04, testVarModifyLe05+ , testVarModifyGt01, testVarModifyGt02, testVarModifyGt03+ , testVarModifyGt04, testVarModifyGt05+ , testVarModifyGe01, testVarModifyGe02, testVarModifyGe03+ , testVarModifyGe04, testVarModifyGe05+ ]++------------------------------------------------------------+-- Test rules defined for datatype+------------------------------------------------------------++mkGraph :: B.Builder -> RDFGraph+mkGraph gr = + let base = "@prefix : <" `mappend` (ns `mappend` "> . \n")+ ns = B.fromString $ show $ nsURI namespaceDefault+ in makeRDFGraphFromN3Builder (prefixXsdInteger `mappend` (base `mappend` gr))++testRuleFwd :: String -> Maybe (Rule RDFGraph) -> B.Builder -> [B.Builder] -> Test+testRuleFwd lab (Just rule) antstr constrs =+ let+ antgr = mkGraph antstr+ congrs = map mkGraph constrs+ in+ testEqv lab congrs $ fwdApply rule [antgr]+testRuleFwd lab Nothing _ _ = TestCase $+ assertFailure $ "testRuleFwd:"++lab++", null rule supplied"++testRuleBwd :: String -> Maybe (Rule RDFGraph) -> B.Builder -> [[B.Builder]] -> Test+testRuleBwd lab (Just rule) antstr prestrss =+ let+ antgr = mkGraph antstr+ pregrss = map (map mkGraph) prestrss+ in+ testEqvEqv lab pregrss $ bwdApply rule antgr+testRuleBwd lab Nothing _ _ = TestCase $+ assertFailure $ "testRuleBwd:"++lab++", null rule supplied"++{-+testRuleChk :: String -> Maybe (Rule RDFGraph) -> String -> String -> Test+testRuleChk lab (Just rule) antstr constr =+ let+ antgr = mkGraph antstr+ congr = mkGraph constr+ in+ test lab $ checkInference rule [antgr] congr+testRuleChk lab Nothing _ _ = TestCase $+ assertFailure $ "testRuleChk:"++lab++", null rule supplied"+-}++xsdIntRules :: Ruleset RDFGraph+xsdIntRules = typeRules rdfDatatypeXsdInteger++{-+axdt :: Maybe (Formula RDFGraph)+axdt = getRulesetAxiom axiomXsdIntegerDT xsdIntRules+-}++ruleabs, ruleneg, rulesum, rulediff, ruleprod,+ ruledivmod, rulepower, ruleeq, rulene, rulelt, rulele,+ rulegt, rulege :: Maybe (Rule RDFGraph)+ruleabs = getRulesetRule ruleXsdIntegerAbs xsdIntRules+ruleneg = getRulesetRule ruleXsdIntegerNeg xsdIntRules+rulesum = getRulesetRule ruleXsdIntegerSum xsdIntRules+rulediff = getRulesetRule ruleXsdIntegerDiff xsdIntRules+ruleprod = getRulesetRule ruleXsdIntegerProd xsdIntRules+ruledivmod = getRulesetRule ruleXsdIntegerDivMod xsdIntRules+rulepower = getRulesetRule ruleXsdIntegerPower xsdIntRules+ruleeq = getRulesetRule ruleXsdIntegerEq xsdIntRules+rulene = getRulesetRule ruleXsdIntegerNe xsdIntRules+rulelt = getRulesetRule ruleXsdIntegerLt xsdIntRules+rulele = getRulesetRule ruleXsdIntegerLe xsdIntRules+rulegt = getRulesetRule ruleXsdIntegerGt xsdIntRules+rulege = getRulesetRule ruleXsdIntegerGe xsdIntRules++-- Test cases for the arithmetic functions++-- don't want to use text-format at present+qconv :: (Show a) => a -> B.Builder+qconv = B.fromString . show++-- abs++-- assume that vals is not empty+multiInp :: B.Builder -> [(Int, Int)] -> B.Builder+multiInp lbl vals = + let iConv (lval, val) = + mconcat+ [+ " rdf:_", qconv lval, " \"", qconv val, "\"^^xsd:integer "+ ]+ + in mconcat $+ [ "_:a a xsd_integer:"+ , lbl+ , " ;"+ ] ++ intersperse ";" (map iConv vals) ++ ["."]+ +singleInp :: B.Builder -> Int -> Int -> B.Builder+singleInp lbl lval val = multiInp lbl [(lval, val)]++abs01inp, abs02inp, abs03inp, abs04inp :: B.Builder+abs01inp = singleInp "Abs" 2 1+abs02inp = singleInp "Abs" 2 (-1)+abs03inp = singleInp "Abs" 1 1+abs04inp = singleInp "Abs" 1 (-1)+ +abs03bwd :: [[B.Builder]]+abs03bwd =+ [ [ "_:a a xsd_integer:Abs . "+ , "_:a rdf:_2 \"1\"^^xsd:integer . "+ ]+ , [ "_:a a xsd_integer:Abs . "+ , "_:a rdf:_2 \"-1\"^^xsd:integer . "+ ]+ ]++-- neg++neg01inp, neg02inp :: B.Builder+neg01inp = singleInp "Neg" 2 1+neg02inp = singleInp "Neg" 2 (-2)++-- sum++sum01inp :: B.Builder+sum01inp = multiInp "Sum" [(2, 31), (3, 20)]+ +sum01bwd :: [[B.Builder]]+sum01bwd =+ [ [ "_:a a xsd_integer:Sum . "+ , "_:a rdf:_1 \"51\"^^xsd:integer . "+ , "_:a rdf:_2 \"31\"^^xsd:integer . "+ ]+ , [ "_:a a xsd_integer:Sum . "+ , "_:a rdf:_1 \"51\"^^xsd:integer . "+ , "_:a rdf:_3 \"20\"^^xsd:integer . "+ ]+ ]++sum02inp :: B.Builder+sum02inp = multiInp "Sum" [(1, 52), (3, 21)]+ +sum02bwd :: [[B.Builder]]+sum02bwd =+ [ [ "_:a a xsd_integer:Sum . "+ , "_:a rdf:_1 \"52\"^^xsd:integer . "+ , "_:a rdf:_2 \"31\"^^xsd:integer . "+ ]+ , [ "_:a a xsd_integer:Sum . "+ , "_:a rdf:_2 \"31\"^^xsd:integer . "+ , "_:a rdf:_3 \"21\"^^xsd:integer . "+ ]+ ]++sum03inp :: B.Builder+sum03inp = multiInp "Sum" [(1, 53), (2, 32)]++sum03bwd :: [[B.Builder]]+sum03bwd =+ [ [ "_:a a xsd_integer:Sum . "+ , "_:a rdf:_1 \"53\"^^xsd:integer . "+ , "_:a rdf:_3 \"21\"^^xsd:integer . "+ ]+ , [ "_:a a xsd_integer:Sum . "+ , "_:a rdf:_2 \"32\"^^xsd:integer . "+ , "_:a rdf:_3 \"21\"^^xsd:integer . "+ ]+ ]++-- diff++diff01inp, diff02inp, diff03inp :: B.Builder+diff01inp = multiInp "Diff" [(2, 222), (3, 333)]+diff02inp = multiInp "Diff" [(1, -111), (3, 333)]+diff03inp = multiInp "Diff" [(1, -111), (2, 222)]+ +diff01bwd :: [[B.Builder]]+diff01bwd =+ [ [ "_:a a xsd_integer:Diff . "+ , "_:a rdf:_1 \"-111\"^^xsd:integer . "+ , "_:a rdf:_2 \"222\"^^xsd:integer . "+ ]+ , [ "_:a a xsd_integer:Diff . "+ , "_:a rdf:_1 \"-111\"^^xsd:integer . "+ , "_:a rdf:_3 \"333\"^^xsd:integer . "+ ]+ ]++diff02bwd :: [[B.Builder]]+diff02bwd =+ [ [ "_:a a xsd_integer:Diff . "+ , "_:a rdf:_1 \"-111\"^^xsd:integer . "+ , "_:a rdf:_2 \"222\"^^xsd:integer . "+ ]+ , [ "_:a a xsd_integer:Diff . "+ , "_:a rdf:_2 \"222\"^^xsd:integer . "+ , "_:a rdf:_3 \"333\"^^xsd:integer . "+ ]+ ]++diff03bwd :: [[B.Builder]]+diff03bwd =+ [ [ "_:a a xsd_integer:Diff . "+ , "_:a rdf:_1 \"-111\"^^xsd:integer . "+ , "_:a rdf:_3 \"333\"^^xsd:integer . "+ ]+ , [ "_:a a xsd_integer:Diff . "+ , "_:a rdf:_2 \"222\"^^xsd:integer . "+ , "_:a rdf:_3 \"333\"^^xsd:integer . "+ ]+ ]++-- prod++prod01inp, prod02inp, prod03inp :: B.Builder+prod01inp = multiInp "Prod" [(2, 222), (3, 3)]+prod02inp = multiInp "Prod" [(1, 666), (3, 3)]+prod03inp = multiInp "Prod" [(1, 666), (2, 222)]++prod01bwd :: [[B.Builder]]+prod01bwd =+ [ [ "_:a a xsd_integer:Prod . "+ , "_:a rdf:_1 \"666\"^^xsd:integer . "+ , "_:a rdf:_2 \"222\"^^xsd:integer . "+ ]+ , [ "_:a a xsd_integer:Prod . "+ , "_:a rdf:_1 \"666\"^^xsd:integer . "+ , "_:a rdf:_3 \"3\"^^xsd:integer . "+ ]+ ]++prod02bwd :: [[B.Builder]]+prod02bwd =+ [ [ "_:a a xsd_integer:Prod . "+ , "_:a rdf:_1 \"666\"^^xsd:integer . "+ , "_:a rdf:_2 \"222\"^^xsd:integer . "+ ]+ , [ "_:a a xsd_integer:Prod . "+ , "_:a rdf:_2 \"222\"^^xsd:integer . "+ , "_:a rdf:_3 \"3\"^^xsd:integer . "+ ]+ ]++prod03bwd :: [[B.Builder]]+prod03bwd =+ [ [ "_:a a xsd_integer:Prod . "+ , "_:a rdf:_1 \"666\"^^xsd:integer . "+ , "_:a rdf:_3 \"3\"^^xsd:integer . "+ ]+ , [ "_:a a xsd_integer:Prod . "+ , "_:a rdf:_2 \"222\"^^xsd:integer . "+ , "_:a rdf:_3 \"3\"^^xsd:integer . "+ ]+ ]++-- divmod++divmod01inp, divmod02inp, divmod03inp :: B.Builder+divmod01inp = multiInp "DivMod" [(3, 33), (4, 5)]+divmod02inp = multiInp "DivMod" [(1, 6), (2, 3), (4, 5)]+divmod03inp = multiInp "DivMod" [(3, -33), (4, 5)]++-- power++power01inp, power02inp, power03inp :: B.Builder+power01inp = multiInp "Power" [(2, 2), (3, 5)]+power02inp = multiInp "Power" [(2, 111), (3, 0)]+power03inp = multiInp "Power" [(2, 22), (3, -33)]++-- eq++eq01inp, eq02inp, eq03inp :: B.Builder+eq01inp = multiInp "Eq" [(1, 11), (2, 11)]+eq02inp = multiInp "Eq" [(1, 21), (2, 22)]+eq03inp = multiInp "Eq" [(1, 31), (2, -32)]++-- ne++ne01inp, ne02inp, ne03inp :: B.Builder+ne01inp = multiInp "Ne" [(1, 11), (2, 11)]+ne02inp = multiInp "Ne" [(1, 21), (2, 22)]+ne03inp = multiInp "Ne" [(1, 31), (2, -32)]++-- lt++lt01inp, lt02inp, lt03inp :: B.Builder+lt01inp = multiInp "Lt" [(1, 11), (2, 11)]+lt02inp = multiInp "Lt" [(1, 21), (2, 22)]+lt03inp = multiInp "Lt" [(1, 31), (2, -32)]++-- le++le01inp, le02inp, le03inp :: B.Builder+le01inp = multiInp "Le" [(1, 11), (2, 11)]+le02inp = multiInp "Le" [(1, 21), (2, 22)]+le03inp = multiInp "Le" [(1, 31), (2, -32)]++-- gt++gt01inp, gt02inp, gt03inp :: B.Builder+gt01inp = multiInp "Gt" [(1, 11), (2, 11)]+gt02inp = multiInp "Gt" [(1, 21), (2, 22)]+gt03inp = multiInp "Gt" [(1, 31), (2, -32)]++-- ge++ge01inp, ge02inp, ge03inp :: B.Builder+ge01inp = multiInp "Ge" [(1, 11), (2, 11)]+ge02inp = multiInp "Ge" [(1, 21), (2, 22)]+ge03inp = multiInp "Ge" [(1, 31), (2, -32)]++-- Test cases from design notes++-- Make a vector of rules using the graph string below++pvRules :: [RDFRule]+-- pvRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr+pvRules = typeMkRules rdfDatatypeXsdInteger gr+ where+ gr = mkGraph $+ mconcat+ [ ":PassengerVehicle a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; "+ , " rdfd:constraint xsd_integer:sum . "+ , ":PassengerVehicle1 a rdfd:GeneralRestriction ; "+ , " rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; "+ , " rdfd:constraint xsd_integer:sum ; "+ , " rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "+ ]+ +-- Now the test cases that use the rules created above.++pvRule0, pvRule1 :: Maybe (Rule RDFGraph)+pvRule0 = mapFindMaybe+ (ScopedName namespaceDefault "PassengerVehicle")+ (LookupMap pvRules)+pvRule1 = mapFindMaybe+ (ScopedName namespaceDefault "PassengerVehicle1")+ (LookupMap pvRules)++pv01inp :: B.Builder+pv01inp =+ mconcat+ [ "_:a a :PassengerVehicle ; "+ , " :seatedCapacity \"30\"^^xsd:integer ; "+ , " :standingCapacity \"20\"^^xsd:integer . "+ ]++pv01fwd :: [B.Builder]+pv01fwd = [ "_:a :totalCapacity \"50\"^^xsd:integer . " ]++pv01bwd :: [[B.Builder]]+pv01bwd =+ [ [ "_:a a :PassengerVehicle . "+ , "_:a :totalCapacity \"50\"^^xsd:integer . "+ , "_:a :seatedCapacity \"30\"^^xsd:integer . "+ ]+ , [ "_:a a :PassengerVehicle . "+ , "_:a :totalCapacity \"50\"^^xsd:integer . "+ , "_:a :standingCapacity \"20\"^^xsd:integer . "+ ]+ ]++pv02inp :: B.Builder+pv02inp =+ mconcat+ [ "_:a a :PassengerVehicle ; "+ , " :seatedCapacity \"30\"^^xsd:integer ; "+ , " :totalCapacity \"51\"^^xsd:integer . "+ , "_:b a :PassengerVehicle ; "+ , " :standingCapacity \"20\"^^xsd:integer ; "+ , " :totalCapacity \"52\"^^xsd:integer . "+ ]++pv02fwd :: [B.Builder]+pv02fwd =+ [ "_:a :standingCapacity \"21\"^^xsd:integer . "+ , "_:b :seatedCapacity \"32\"^^xsd:integer . "+ ]++pv02bwd :: [[B.Builder]]+pv02bwd =+ [ [ "_:a a :PassengerVehicle . "+ , "_:a :standingCapacity \"21\"^^xsd:integer . "+ , "_:a :totalCapacity \"51\"^^xsd:integer . "+ , "_:b a :PassengerVehicle . "+ , "_:b :seatedCapacity \"32\"^^xsd:integer . "+ , "_:b :totalCapacity \"52\"^^xsd:integer . "+ ]+ , [ "_:a a :PassengerVehicle . "+ , "_:a :seatedCapacity \"30\"^^xsd:integer . "+ , "_:a :standingCapacity \"21\"^^xsd:integer . "+ , "_:b a :PassengerVehicle . "+ , "_:b :seatedCapacity \"32\"^^xsd:integer . "+ , "_:b :totalCapacity \"52\"^^xsd:integer . "+ ]+ , [ "_:a a :PassengerVehicle . "+ , "_:a :standingCapacity \"21\"^^xsd:integer . "+ , "_:a :totalCapacity \"51\"^^xsd:integer . "+ , "_:b a :PassengerVehicle . "+ , "_:b :seatedCapacity \"32\"^^xsd:integer . "+ , "_:b :standingCapacity \"20\"^^xsd:integer . "+ ]+ , [ "_:a a :PassengerVehicle . "+ , "_:a :seatedCapacity \"30\"^^xsd:integer . "+ , "_:a :standingCapacity \"21\"^^xsd:integer . "+ , "_:b a :PassengerVehicle . "+ , "_:b :seatedCapacity \"32\"^^xsd:integer . "+ , "_:b :standingCapacity \"20\"^^xsd:integer . "+ ]+ ]++pv03inp :: B.Builder+pv03inp =+ mconcat+ [ "_:a a :PassengerVehicle ; "+ , " :seatedCapacity \"30\"^^xsd:integer ; "+ , " :standingCapacity \"23\"^^xsd:integer ; "+ , " :totalCapacity \"53\"^^xsd:integer . "+ ]++pv03fwd :: [B.Builder]+pv03fwd = []++pv04inp :: B.Builder+pv04inp =+ mconcat+ [ "_:a a :PassengerVehicle ; "+ , " :seatedCapacity \"30\"^^xsd:integer ; "+ , " :standingCapacity \"20\"^^xsd:integer ; "+ , " :totalCapacity \"54\"^^xsd:integer . "+ ]+ +pv04fwd :: [B.Builder]+pv04fwd =+ [ mconcat+ [ "_:a :standingCapacity \"24\"^^xsd:integer . "+ , "_:a :seatedCapacity \"34\"^^xsd:integer . "+ , "_:a :totalCapacity \"50\"^^xsd:integer . "+ ]+ ]++pv05inp :: B.Builder+pv05inp =+ mconcat + [ "_:a a :PassengerVehicle1 ; "+ , " :seatedCapacity \"30\"^^xsd:integer ; "+ , " :standingCapacity \"25\"^^xsd:integer ; "+ , " :totalCapacity \"55\"^^xsd:integer . "+ ]++pv05fwd :: [B.Builder]+pv05fwd = []++pv06inp :: B.Builder+pv06inp =+ mconcat+ [ "_:a a :PassengerVehicle1 ; "+ , " :seatedCapacity \"30\"^^xsd:integer ; "+ , " :standingCapacity \"20\"^^xsd:integer ; "+ , " :totalCapacity \"56\"^^xsd:integer . "+ ]+ +pv06fwd :: [B.Builder]+pv06fwd =+ [ falseGraphStr+ ]++pv06bwd :: [[B.Builder]]+pv06bwd =+ [ [ falseGraphStr+ ]+ ]++pv07inp :: B.Builder+pv07inp =+ "_:a a :PassengerVehicle ; " `mappend`+ " :totalCapacity \"57\"^^xsd:integer . "++pv07fwd :: [B.Builder]+pv07fwd = []++-- how come this isn't [[String]] ?+pv07bwd :: [B.Builder]+pv07bwd = []++-- Full suite for datatype rule tests++testDatatypeRuleSuite :: Test+testDatatypeRuleSuite = TestList+ [ testRuleFwd "testRuleFwdAbs01" ruleabs abs01inp [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdAbs02" ruleabs abs02inp [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdAbs03" ruleabs abs03inp []+ , testRuleFwd "testRuleFwdAbs04" ruleabs abs04inp [falseGraphStr]+ , testRuleFwd "testRuleFwdNeg01" ruleneg neg01inp [ "_:a rdf:_1 \"-1\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdNeg02" ruleneg neg02inp [ "_:a rdf:_1 \"2\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdSum01" rulesum sum01inp [ "_:a rdf:_1 \"51\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdSum02" rulesum sum02inp [ "_:a rdf:_2 \"31\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdSum03" rulesum sum03inp [ "_:a rdf:_3 \"21\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdDiff01" rulediff diff01inp [ "_:a rdf:_1 \"-111\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdDiff02" rulediff diff02inp [ "_:a rdf:_2 \"222\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdDiff03" rulediff diff03inp [ "_:a rdf:_3 \"333\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdProd01" ruleprod prod01inp [ "_:a rdf:_1 \"666\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdProd02" ruleprod prod02inp [ "_:a rdf:_2 \"222\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdProd03" ruleprod prod03inp [ "_:a rdf:_3 \"3\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdDivMod01" ruledivmod divmod01inp+ [ "_:a rdf:_1 \"6\"^^xsd:integer . " `mappend` "_:a rdf:_2 \"3\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdDivMod02" ruledivmod divmod02inp []+ , testRuleFwd "testRuleFwdDivMod03" ruledivmod divmod03inp + [ "_:a rdf:_1 \"-7\"^^xsd:integer . " `mappend` "_:a rdf:_2 \"2\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdPower01" rulepower power01inp [ "_:a rdf:_1 \"32\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdPower02" rulepower power02inp [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]+ , testRuleFwd "testRuleFwdPower03" rulepower power03inp [falseGraphStr]+ , testRuleFwd "testRuleFwdEq01" ruleeq eq01inp []+ , testRuleFwd "testRuleFwdEq02" ruleeq eq02inp [falseGraphStr]+ , testRuleFwd "testRuleFwdEq03" ruleeq eq03inp [falseGraphStr]+ , testRuleFwd "testRuleFwdNe01" rulene ne01inp [falseGraphStr]+ , testRuleFwd "testRuleFwdNe02" rulene ne02inp []+ , testRuleFwd "testRuleFwdNe03" rulene ne03inp []+ , testRuleFwd "testRuleFwdLt01" rulelt lt01inp [falseGraphStr]+ , testRuleFwd "testRuleFwdLt02" rulelt lt02inp []+ , testRuleFwd "testRuleFwdLt03" rulelt lt03inp [falseGraphStr]+ , testRuleFwd "testRuleFwdLe01" rulele le01inp []+ , testRuleFwd "testRuleFwdLe02" rulele le02inp []+ , testRuleFwd "testRuleFwdLe03" rulele le03inp [falseGraphStr]+ , testRuleFwd "testRuleFwdGt01" rulegt gt01inp [falseGraphStr]+ , testRuleFwd "testRuleFwdGt02" rulegt gt02inp [falseGraphStr]+ , testRuleFwd "testRuleFwdGt03" rulegt gt03inp []+ , testRuleFwd "testRuleFwdGe01" rulege ge01inp []+ , testRuleFwd "testRuleFwdGe02" rulege ge02inp [falseGraphStr]+ , testRuleFwd "testRuleFwdGe03" rulege ge03inp []+ + -- backard chaining tests+ , testRuleBwd "testRuleBwdAbs01" ruleabs abs01inp []+ , testRuleBwd "testRuleBwdAbs02" ruleabs abs02inp []+ , testRuleBwd "testRuleBwdAbs03" ruleabs abs03inp abs03bwd+ , testRuleBwd "testRuleBwdAbs04" ruleabs abs04inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdNeg01" ruleneg neg01inp+ [[ "_:a a xsd_integer:Neg . ", "_:a rdf:_1 \"-1\"^^xsd:integer . "]]+ , testRuleBwd "testRuleBwdNeg02" ruleneg neg02inp + [[ "_:a a xsd_integer:Neg . ", "_:a rdf:_1 \"2\"^^xsd:integer . "]]+ , testRuleBwd "testRuleBwdSum01" rulesum sum01inp sum01bwd+ , testRuleBwd "testRuleBwdSum02" rulesum sum02inp sum02bwd+ , testRuleBwd "testRuleBwdSum03" rulesum sum03inp sum03bwd+ , testRuleBwd "testRuleBwdDiff01" rulediff diff01inp diff01bwd+ , testRuleBwd "testRuleBwdDiff02" rulediff diff02inp diff02bwd+ , testRuleBwd "testRuleBwdDiff03" rulediff diff03inp diff03bwd+ , testRuleBwd "testRuleBwdProd01" ruleprod prod01inp prod01bwd+ , testRuleBwd "testRuleBwdProd02" ruleprod prod02inp prod02bwd+ , testRuleBwd "testRuleBwdProd03" ruleprod prod03inp prod03bwd+ , testRuleBwd "testRuleBwdDivMod01" ruledivmod divmod01inp []+ , testRuleBwd "testRuleBwdDivMod02" ruledivmod divmod02inp []+ , testRuleBwd "testRuleBwdDivMod03" ruledivmod divmod03inp []+ , testRuleBwd "testRuleBwdPower01" rulepower power01inp []+ , testRuleBwd "testRuleBwdPower02" rulepower power02inp []+ , testRuleBwd "testRuleBwdPower03" rulepower power03inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdEq01" ruleeq eq01inp []+ , testRuleBwd "testRuleBwdEq02" ruleeq eq02inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdEq03" ruleeq eq03inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdNe01" rulene ne01inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdNe02" rulene ne02inp []+ , testRuleBwd "testRuleBwdNe03" rulene ne03inp []+ , testRuleBwd "testRuleBwdLt01" rulelt lt01inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdLt02" rulelt lt02inp []+ , testRuleBwd "testRuleBwdLt03" rulelt lt03inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdLe01" rulele le01inp []+ , testRuleBwd "testRuleBwdLe02" rulele le02inp []+ , testRuleBwd "testRuleBwdLe03" rulele le03inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdGt01" rulegt gt01inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdGt02" rulegt gt02inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdGt03" rulegt gt03inp []+ , testRuleBwd "testRuleBwdGe01" rulege ge01inp []+ , testRuleBwd "testRuleBwdGe02" rulege ge02inp [[falseGraphStr]]+ , testRuleBwd "testRuleBwdGe03" rulege ge03inp [] -- test cases from design notes , testRuleFwd "testRuleFwdPv01" pvRule0 pv01inp pv01fwd
tests/RDFGraphTest.hs view
@@ -10,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module contains test cases for module RDFGraph. --@@ -47,22 +47,24 @@ import Swish.RDF.Vocabulary ( namespaceRDF , langName - , rdf_XMLLiteral- , xsd_boolean- , xsd_integer- , xsd_float- , xsd_double- , xsd_dateTime- , xsd_date+ , rdfXMLLiteral+ , xsdBoolean+ , xsdInteger+ , xsdFloat+ , xsdDouble+ , xsdDateTime+ , xsdDate ) -import qualified Data.Traversable as T-import qualified Data.Foldable as F+import qualified Data.Text as T +import qualified Data.Traversable as Traversable+import qualified Data.Foldable as Foldable+ import Network.URI (URI, parseURI) import Data.Monoid (Monoid(..)) import Data.List (elemIndex, intercalate)-import Data.Maybe (fromJust)+import Data.Maybe (fromJust, fromMaybe) import Data.Ord (comparing) import System.Locale (defaultTimeLocale)@@ -146,20 +148,29 @@ base1Str :: String base1Str = "http://id.ninebynine.org/wip/2003/test/graph1/node#" --- TODO: using a base of "" or "?" causes a fromJust failure somewhere+toURI :: String -> URI+toURI s = fromMaybe (error $ "Error: unable to parse URI " ++ s) (parseURI s)++toNS :: T.Text -> String -> Namespace+toNS p = Namespace (Just p) . toURI++-- TODO: basee and baseu had prefixes of "" and "?" before the conversion+-- to using Maybe String. Now both are Nothing; is this semantically+-- correct? Probably.+ basee, baseu, base1, base2, base3, base4 :: Namespace-basee = Namespace "" "http://example.com/a#"-baseu = Namespace "?" "http://example.com/"-base1 = Namespace "base1" base1Str-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"+basee = Namespace Nothing $ toURI "http://example.com/a#"+baseu = Namespace Nothing $ toURI "http://example.com/"+base1 = toNS "base1" base1Str+base2 = toNS "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node/"+base3 = toNS "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"+base4 = toNS "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase" qn1s1 :: QName-qn1s1 = qnameFromURI $ base1Str ++ "s1"+qn1s1 = qnameFromURI $ toURI $ base1Str ++ "s1" qu1s1 :: URI-qu1s1 = fromJust $ parseURI $ base1Str ++ "s1"+qu1s1 = toURI $ base1Str ++ "s1" qbes1, qbus1, qb1s1, qb2s2, qb3s3, qb3, qb3bm, qb4m :: ScopedName qbes1 = ScopedName basee "s1"@@ -251,21 +262,21 @@ l7 = Lit "l4" (Just qb1t2) l8 = Lit "l4" (Just qb1t2) l9 = Lit "l4" (Just qb1t2) -l10 = Lit "l10" (Just rdf_XMLLiteral) --- l11 = Lit "l11" (Just rdf_XMLLiteral) --- l12 = Lit "l12" (Just rdf_XMLLiteral) -l11 = Lit "l10" (Just rdf_XMLLiteral) -- are these meant to both be l10?-l12 = Lit "l10" (Just rdf_XMLLiteral) -- if you change them some tests fail+l10 = Lit "l10" (Just rdfXMLLiteral) +-- l11 = Lit "l11" (Just rdfXMLLiteral) +-- l12 = Lit "l12" (Just rdfXMLLiteral) +l11 = Lit "l10" (Just rdfXMLLiteral) -- are these meant to both be l10?+l12 = Lit "l10" (Just rdfXMLLiteral) -- if you change them some tests fail nanF, infF, ninfF :: RDFLabel-nanF = Lit "NaN" (Just xsd_float)-infF = Lit "INF" (Just xsd_float)-ninfF = Lit "-INF" (Just xsd_float)+nanF = Lit "NaN" (Just xsdFloat)+infF = Lit "INF" (Just xsdFloat)+ninfF = Lit "-INF" (Just xsdFloat) nanD, infD, ninfD :: RDFLabel-nanD = Lit "NaN" (Just xsd_double)-infD = Lit "INF" (Just xsd_double)-ninfD = Lit "-INF" (Just xsd_double)+nanD = Lit "NaN" (Just xsdDouble)+infD = Lit "INF" (Just xsdDouble)+ninfD = Lit "-INF" (Just xsdDouble) v1, v2, v3, v4, vb3, vb4 :: RDFLabel v1 = Var "v1" @@ -336,21 +347,21 @@ testToConv :: (ToRDFLabel a, Eq a, Show a) - => String -> String -> Maybe ScopedName -> a -> Test+ => String -> T.Text -> Maybe ScopedName -> a -> Test testToConv lbl sVal dtype hVal = let rdfVal = Lit sVal dtype in testEq (":tconv:" ++ lbl) rdfVal (toRDFLabel hVal) testFrConv :: (FromRDFLabel a, Eq a, Show a) - => String -> String -> Maybe ScopedName -> a -> Test+ => String -> T.Text -> Maybe ScopedName -> a -> Test testFrConv lbl sVal dtype hVal = let rdfVal = Lit sVal dtype in testEq (":fconv:" ++ lbl) (Just hVal) (fromRDFLabel rdfVal) testConv :: (ToRDFLabel a, FromRDFLabel a, Eq a, Show a) - => String -> String -> Maybe ScopedName -> a -> Test + => String -> T.Text -> Maybe ScopedName -> a -> Test testConv lbl sVal dtype hVal = TestList [ testToConv lbl sVal dtype hVal,@@ -367,17 +378,17 @@ -- failure case testEq "fconv:fail chr1" (Nothing :: Maybe Char) (fromRDFLabel l1) , testEq "fconv:fail chr2" (Nothing :: Maybe Char) (fromRDFLabel s1)- , testEq "fconv:fail str1" (Nothing :: Maybe String) (fromRDFLabel (Lit "1.23" (Just xsd_float)))+ , testEq "fconv:fail str1" (Nothing :: Maybe String) (fromRDFLabel (Lit "1.23" (Just xsdFloat))) , testEq "fconv:fail bool1" (Nothing :: Maybe Bool) (fromRDFLabel l1)- , testEq "fconv:fail bool2" (Nothing :: Maybe Bool) (fromRDFLabel (Lit "True" (Just xsd_boolean))) -- should we just let this be valid?- , testEq "fconv:fail bool3" (Nothing :: Maybe Bool) (fromRDFLabel (Lit "true" (Just xsd_float)))+ , testEq "fconv:fail bool2" (Nothing :: Maybe Bool) (fromRDFLabel (Lit "True" (Just xsdBoolean))) -- should we just let this be valid?+ , testEq "fconv:fail bool3" (Nothing :: Maybe Bool) (fromRDFLabel (Lit "true" (Just xsdFloat))) , testEq "fconv:fail int1" (Nothing :: Maybe Int) (fromRDFLabel l1)- , testEq "fconv:fail int2" (Nothing :: Maybe Int) (fromRDFLabel (Lit "123456789012345" (Just xsd_integer))) + , testEq "fconv:fail int2" (Nothing :: Maybe Int) (fromRDFLabel (Lit "123456789012345" (Just xsdInteger))) , testEq "fconv:fail float1" (Nothing :: Maybe Float) (fromRDFLabel l1)- , testEq "fconv:fail float2" (Nothing :: Maybe Float) (fromRDFLabel (Lit "1.234e101" (Just xsd_float))) -- invalid input - , testEq "fconv:fail float3" (Nothing :: Maybe Float) (fromRDFLabel (Lit "-1.234e101" (Just xsd_float))) -- invalid input - , testEq "fconv:fail float4" (Nothing :: Maybe Float) (fromRDFLabel (Lit "NaNs" (Just xsd_float))) -- invalid input - , testEq "fconv:fail dbl1" (Nothing :: Maybe Double) (fromRDFLabel (Lit "1.23" (Just xsd_float))) -- invalid input + , testEq "fconv:fail float2" (Nothing :: Maybe Float) (fromRDFLabel (Lit "1.234e101" (Just xsdFloat))) -- invalid input + , testEq "fconv:fail float3" (Nothing :: Maybe Float) (fromRDFLabel (Lit "-1.234e101" (Just xsdFloat))) -- invalid input + , testEq "fconv:fail float4" (Nothing :: Maybe Float) (fromRDFLabel (Lit "NaNs" (Just xsdFloat))) -- invalid input + , testEq "fconv:fail dbl1" (Nothing :: Maybe Double) (fromRDFLabel (Lit "1.23" (Just xsdFloat))) -- invalid input , testEq "fconv:fail sn1" (Nothing :: Maybe ScopedName) (fromRDFLabel l1) , testEq "fconv:fail qn1" (Nothing :: Maybe QName) (fromRDFLabel l1) , testEq "fconv:fail qu1" (Nothing :: Maybe URI) (fromRDFLabel l1)@@ -391,10 +402,10 @@ , testConv "l1-2" "l1" Nothing ("l1"::String) -- boolean- , testFrConv "True1" "1" (Just xsd_boolean) True- , testFrConv "False0" "0" (Just xsd_boolean) False- , testConv "True" "true" (Just xsd_boolean) True- , testConv "False" "false" (Just xsd_boolean) False+ , testFrConv "True1" "1" (Just xsdBoolean) True+ , testFrConv "False0" "0" (Just xsdBoolean) False+ , testConv "True" "true" (Just xsdBoolean) True+ , testConv "False" "false" (Just xsdBoolean) False {- For example, -1E4, 1267.43233E12, 12.78e-2, 12 , -0, 0 and INF are all legal literals for float.@@ -406,60 +417,60 @@ -} -- numeric types- , testConv "int 0" "0" (Just xsd_integer) (0::Int)- , testConv "int -10" "-10" (Just xsd_integer) ((-10)::Int)- , testConv "int 10" "10" (Just xsd_integer) (10::Int)- , testConv "integer 0" "0" (Just xsd_integer) (0::Integer)- , testConv "integer -10" "-10" (Just xsd_integer) ((-10)::Integer)- , testConv "integer 10" "10" (Just xsd_integer) (10::Integer)- , testFrConv "integer -0..05" "-0000000000000000000005" (Just xsd_integer) ((-5)::Integer)- , testConv "integer big" "123456789012345678901234567890" (Just xsd_integer) (123456789012345678901234567890::Integer)- , testConv "integer -big" "-123456789012345678901234567890" (Just xsd_integer) ((-123456789012345678901234567890)::Integer)+ , testConv "int 0" "0" (Just xsdInteger) (0::Int)+ , testConv "int -10" "-10" (Just xsdInteger) ((-10)::Int)+ , testConv "int 10" "10" (Just xsdInteger) (10::Int)+ , testConv "integer 0" "0" (Just xsdInteger) (0::Integer)+ , testConv "integer -10" "-10" (Just xsdInteger) ((-10)::Integer)+ , testConv "integer 10" "10" (Just xsdInteger) (10::Integer)+ , testFrConv "integer -0..05" "-0000000000000000000005" (Just xsdInteger) ((-5)::Integer)+ , testConv "integer big" "123456789012345678901234567890" (Just xsdInteger) (123456789012345678901234567890::Integer)+ , testConv "integer -big" "-123456789012345678901234567890" (Just xsdInteger) ((-123456789012345678901234567890)::Integer) - , testToConv "float NaN" "NaN" (Just xsd_float) ((0.0::Float)/0.0)- , testToConv "float INF" "INF" (Just xsd_float) ((1.0::Float)/0.0)- , testToConv "float -INF" "-INF" (Just xsd_float) (((-1.0)::Float)/0.0)+ , testToConv "float NaN" "NaN" (Just xsdFloat) ((0.0::Float)/0.0)+ , testToConv "float INF" "INF" (Just xsdFloat) ((1.0::Float)/0.0)+ , testToConv "float -INF" "-INF" (Just xsdFloat) (((-1.0)::Float)/0.0) , testEq ":fconv:float NaN" (Just True) (fmap isNaN (fromRDFLabel nanF :: Maybe Float)) , testEq ":fconv:float INF" (Just True) (fmap isInfinite (fromRDFLabel infF :: Maybe Float)) , testEq ":fconv:float -INF" (Just True) (fmap isInfinite (fromRDFLabel ninfF :: Maybe Float)) - , testToConv "double NaN" "NaN" (Just xsd_double) ((0.0::Double)/0.0)- , testToConv "double INF" "INF" (Just xsd_double) ((1.0::Double)/0.0)- , testToConv "double -INF" "-INF" (Just xsd_double) (((-1.0)::Double)/0.0)+ , testToConv "double NaN" "NaN" (Just xsdDouble) ((0.0::Double)/0.0)+ , testToConv "double INF" "INF" (Just xsdDouble) ((1.0::Double)/0.0)+ , testToConv "double -INF" "-INF" (Just xsdDouble) (((-1.0)::Double)/0.0) , testEq ":fconv:double NaN" (Just True) (fmap isNaN (fromRDFLabel nanD :: Maybe Double)) , testEq ":fconv:double INF" (Just True) (fmap isInfinite (fromRDFLabel infD :: Maybe Double)) , testEq ":fconv:double -INF" (Just True) (fmap isInfinite (fromRDFLabel ninfD :: Maybe Double)) - , testFrConv "float 0.0" "0.0" (Just xsd_float) (0::Float)- , testToConv "float 0.0" "0.0E0" (Just xsd_float) (0::Float)- , testFrConv "float 0." "0." (Just xsd_float) (0::Float)- , testFrConv "float -0" "-0" (Just xsd_float) (0::Float)- , testFrConv "float 0.2" "0.2" (Just xsd_float) (0.2::Float)- , testToConv "float 0.2" "2.0E-1" (Just xsd_float) (0.2::Float)- , testFrConv "float -0.2" "-0.2" (Just xsd_float) ((-0.2)::Float)- , testToConv "float -0.2" "-2.0E-1" (Just xsd_float) ((-0.2)::Float)- , testConv "float 2.01e-4" "2.01E-4" (Just xsd_float) (0.000201::Float)- , testConv "float -2.01e-4" "-2.01E-4" (Just xsd_float) ((-0.000201)::Float)- , testConv "float 2.01e38" "2.01E38" (Just xsd_float) (2.01e38::Float)- , testConv "float -2.01e38" "-2.01E38" (Just xsd_float) ((-2.01e38)::Float)+ , testFrConv "float 0.0" "0.0" (Just xsdFloat) (0::Float)+ , testToConv "float 0.0" "0.0E0" (Just xsdFloat) (0::Float)+ , testFrConv "float 0." "0." (Just xsdFloat) (0::Float)+ , testFrConv "float -0" "-0" (Just xsdFloat) (0::Float)+ , testFrConv "float 0.2" "0.2" (Just xsdFloat) (0.2::Float)+ , testToConv "float 0.2" "2.0E-1" (Just xsdFloat) (0.2::Float)+ , testFrConv "float -0.2" "-0.2" (Just xsdFloat) ((-0.2)::Float)+ , testToConv "float -0.2" "-2.0E-1" (Just xsdFloat) ((-0.2)::Float)+ , testConv "float 2.01e-4" "2.01E-4" (Just xsdFloat) (0.000201::Float)+ , testConv "float -2.01e-4" "-2.01E-4" (Just xsdFloat) ((-0.000201)::Float)+ , testConv "float 2.01e38" "2.01E38" (Just xsdFloat) (2.01e38::Float)+ , testConv "float -2.01e38" "-2.01E38" (Just xsdFloat) ((-2.01e38)::Float) - , testFrConv "double 0" "0.0" (Just xsd_double) (0::Double)- , testToConv "double 0" "0.0E0" (Just xsd_double) (0::Double)- , testFrConv "double 0." "0." (Just xsd_double) (0::Double)- , testFrConv "double -0" "-0" (Just xsd_double) (0::Double)- , testFrConv "double 0.2" "0.2" (Just xsd_double) (0.2::Double)- , testToConv "double 0.2" "2.0E-1" (Just xsd_double) (0.2::Double)- , testFrConv "double -0.2" "-0.2" (Just xsd_double) ((-0.2)::Double)- , testToConv "double -0.2" "-2.0E-1" (Just xsd_double) ((-0.2)::Double)- , testFrConv "double 2.01e-4" "2.01e-4" (Just xsd_double) (0.000201::Double)- , testToConv "double 2.01e-4" "2.01E-4" (Just xsd_double) (0.000201::Double)- , testFrConv "double -2.01e-4" "-2.01e-4" (Just xsd_double) ((-0.000201)::Double)- , testToConv "double -2.01e-4" "-2.01E-4" (Just xsd_double) ((-0.000201)::Double)- , testConv "double 2.01e38" "2.01E38" (Just xsd_double) (2.01e38::Double)- , testConv "double -2.01e38" "-2.01E38" (Just xsd_double) ((-2.01e38)::Double)- , testConv "double 2.01e108" "2.01E108" (Just xsd_double) (2.01e108::Double)- , testConv "double -2.01e108" "-2.01E108" (Just xsd_double) ((-2.01e108)::Double)- + , testFrConv "double 0" "0.0" (Just xsdDouble) (0::Double)+ , testToConv "double 0" "0.0E0" (Just xsdDouble) (0::Double)+ , testFrConv "double 0." "0." (Just xsdDouble) (0::Double)+ , testFrConv "double -0" "-0" (Just xsdDouble) (0::Double)+ , testFrConv "double 0.2" "0.2" (Just xsdDouble) (0.2::Double)+ , testToConv "double 0.2" "2.0E-1" (Just xsdDouble) (0.2::Double)+ , testFrConv "double -0.2" "-0.2" (Just xsdDouble) ((-0.2)::Double)+ , testToConv "double -0.2" "-2.0E-1" (Just xsdDouble) ((-0.2)::Double)+ , testFrConv "double 2.01e-4" "2.01e-4" (Just xsdDouble) (0.000201::Double)+ , testToConv "double 2.01e-4" "2.01E-4" (Just xsdDouble) (0.000201::Double)+ , testFrConv "double -2.01e-4" "-2.01e-4" (Just xsdDouble) ((-0.000201)::Double)+ , testToConv "double -2.01e-4" "-2.01E-4" (Just xsdDouble) ((-0.000201)::Double)+ , testConv "double 2.01e38" "2.01E38" (Just xsdDouble) (2.01e38::Double)+ , testConv "double -2.01e38" "-2.01E38" (Just xsdDouble) ((-2.01e38)::Double)+ , testConv "double 2.01e108" "2.01E108" (Just xsdDouble) (2.01e108::Double)+ , testConv "double -2.01e108" "-2.01E108" (Just xsdDouble) ((-2.01e108)::Double)+ -- URI related types , testEq "tconv:sname s1" s1 (toRDFLabel qb1s1) , testEq "fconv:sname s1" (Just qb1s1) (fromRDFLabel s1)@@ -471,18 +482,18 @@ , testEq "fconv:URI s1" (Just qu1s1) (fromRDFLabel s1) -- time values- , testConv "time1" "1970-01-01T00:00:00Z" (Just xsd_dateTime) utc1- , testToConv "time2" "2011-02-28T20:04:02.304Z" (Just xsd_dateTime) utc2- , testFrConv "time2a" "2011-02-28T20:04:02.304Z" (Just xsd_dateTime) utc2- , testFrConv "time2b" "2011-02-28T17:04:02.304-03:00" (Just xsd_dateTime) utc2- , testFrConv "time2c" "2011-03-01T00:04:02.304+04:00" (Just xsd_dateTime) utc2- , testFrConv "time2d" "2011-02-28T20:04:02.304" (Just xsd_dateTime) utc2- , testConv "time2Z" "2011-02-28T20:04:02.304Z" (Just xsd_dateTime) utc2+ , testConv "time1" "1970-01-01T00:00:00Z" (Just xsdDateTime) utc1+ , testToConv "time2" "2011-02-28T20:04:02.304Z" (Just xsdDateTime) utc2+ , testFrConv "time2a" "2011-02-28T20:04:02.304Z" (Just xsdDateTime) utc2+ , testFrConv "time2b" "2011-02-28T17:04:02.304-03:00" (Just xsdDateTime) utc2+ , testFrConv "time2c" "2011-03-01T00:04:02.304+04:00" (Just xsdDateTime) utc2+ , testFrConv "time2d" "2011-02-28T20:04:02.304" (Just xsdDateTime) utc2+ , testConv "time2Z" "2011-02-28T20:04:02.304Z" (Just xsdDateTime) utc2 - , testConv "day1a" "1970-01-01Z" (Just xsd_date) day1- , testFrConv "day1b" "1970-01-01" (Just xsd_date) day1- , testFrConv "day1c" "1970-01-01-03:00" (Just xsd_date) day1- , testFrConv "day1d" "1970-01-01+04:00" (Just xsd_date) day1+ , testConv "day1a" "1970-01-01Z" (Just xsdDate) day1+ , testFrConv "day1b" "1970-01-01" (Just xsdDate) day1+ , testFrConv "day1c" "1970-01-01-03:00" (Just xsdDate) day1+ , testFrConv "day1d" "1970-01-01+04:00" (Just xsdDate) day1 -- basic fromRDFTriple test @@ -510,7 +521,7 @@ testClass lab clsf nod eq = testCompare "testClass:" lab eq (clsf nod) altIsXmlLit :: RDFLabel -> Bool-altIsXmlLit = isDatatyped rdf_XMLLiteral+altIsXmlLit = isDatatyped rdfXMLLiteral testNodeClassSuite :: Test testNodeClassSuite = TestList@@ -840,8 +851,8 @@ tt05 = arc st2 p1 l4 tt06 = arc st3 p1 l10 -makeNewPrefixNamespace :: (String,Namespace) -> Namespace-makeNewPrefixNamespace (pre,ns) = Namespace pre (nsURI ns)+makeNewPrefixNamespace :: (T.Text,Namespace) -> Namespace+makeNewPrefixNamespace (pre,ns) = Namespace (Just pre) (nsURI ns) nslist :: LookupMap Namespace nslist = LookupMap $ map makeNewPrefixNamespace@@ -987,21 +998,21 @@ testGraphFoldSuite :: Test testGraphFoldSuite = TestList [ - testEq "fold0" (mempty :: RDFGraph) (F.fold [])- , testEq "foldE" (mempty :: RDFGraph) (F.fold [mempty])- , testEq "foldEE" (mempty :: RDFGraph) (F.fold [mempty,mempty])- , testEq "foldg1" g1 (F.fold [g1])- , testEq "foldg1E" g1 (F.fold [g1,mempty])- , testEq "foldEg1" g1 (F.fold [mempty,g1])- , testEq "foldg1g2" fg1g2 (F.fold [g1,g2])- , testEq "foldg2g1" fg1g2 (F.fold [g2,g1])- , testEq "foldMap0" "" (F.foldMap showLabel (mempty::RDFGraph))+ testEq "fold0" (mempty :: RDFGraph) (Foldable.fold [])+ , testEq "foldE" (mempty :: RDFGraph) (Foldable.fold [mempty])+ , testEq "foldEE" (mempty :: RDFGraph) (Foldable.fold [mempty,mempty])+ , testEq "foldg1" g1 (Foldable.fold [g1])+ , testEq "foldg1E" g1 (Foldable.fold [g1,mempty])+ , testEq "foldEg1" g1 (Foldable.fold [mempty,g1])+ , testEq "foldg1g2" fg1g2 (Foldable.fold [g1,g2])+ , testEq "foldg2g1" fg1g2 (Foldable.fold [g2,g1])+ , testEq "foldMap0" "" (Foldable.foldMap showLabel (mempty::RDFGraph)) , testEq "foldMapg1" (concatMap showLabel [s1,p1,o1])- (F.foldMap showLabel g1)+ (Foldable.foldMap showLabel g1) , testEq "foldMapg1f2" (concatMap showLabel $ s2 : concatMap (\(Arc s p o) -> [s,p,o]) g2Labels ++ [s1,p1,o1])- (F.foldMap showLabel g1f2)+ (Foldable.foldMap showLabel g1f2) ] ------------------------------------------------------------@@ -1249,14 +1260,14 @@ gt1f1aM, gt1f1bM, gt1f2aM, gt1f2bM, gt1f5M :: Maybe RDFGraph gt1f1aM = Just gt1-gt1f1bM = T.mapM translateM g1f1+gt1f1bM = Traversable.mapM translateM g1f1 gt1f2aM = Just gt1f2a-gt1f2bM = T.mapM translateM g1f2-gt1f5M = T.mapM translateM g1f5+gt1f2bM = Traversable.mapM translateM g1f2+gt1f5M = Traversable.mapM translateM g1f5 ft1M, ft2M :: FormulaMap RDFLabel-ft1M = getFormulae $ fromJust gt1f1bM-ft2M = getFormulae $ fromJust gt1f2bM+ft1M = getFormulae $ fromMaybe (error "Unexpected: gt1f1bM") gt1f1bM+ft2M = getFormulae $ fromMaybe (error "Unexpected: gt1f2bM") gt1f2bM testGraphTranslateSuite :: Test testGraphTranslateSuite = TestLabel "TestTranslate" $ TestList
tests/RDFProofContextTest.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module contains RDF proof-checking test cases based on the RDF -- semantics specifications, as capured in module RDFProofContext.@@ -17,45 +19,23 @@ module Main where -import Swish.RDF.BuiltInMap- ( rdfRulesetMap, allRulesets )--import Swish.RDF.RDFProofContext- ( rulesetRDF- , rulesetRDFS- , rulesetRDFD )--import Swish.RDF.RDFProof- ( RDFProof, RDFProofStep- , makeRDFProof, makeRDFProofStep )+import Swish.RDF.BuiltInMap (rdfRulesetMap, allRulesets)+import Swish.RDF.RDFProofContext (rulesetRDF, rulesetRDFS, rulesetRDFD)+import Swish.RDF.RDFProof (RDFProof, RDFProofStep, makeRDFProof, makeRDFProofStep ) import Swish.RDF.RDFRuleset ( RDFFormula, RDFRule, RDFRuleset , nullRDFFormula , makeRDFFormula ) -import Swish.RDF.RDFGraph- ( RDFGraph )--import Swish.RDF.RDFGraphShowM()--import Swish.RDF.Proof- ( Step(..)- , checkProof, checkStep- , explainProof)--import Swish.RDF.Ruleset- ( getContextAxiom, getContextRule )--import Swish.RDF.Rule- ( Formula(..), Rule(..)- , nullFormula, nullRule )--import Swish.Utils.Namespace- ( Namespace(..), ScopedName(..) )+import Swish.RDF.RDFGraph (RDFGraph)+import Swish.RDF.RDFGraphShowM ()+import Swish.RDF.Proof (Step(..), checkProof, checkStep, explainProof)+import Swish.RDF.Ruleset (getContextAxiom, getContextRule)+import Swish.RDF.Rule (Formula(..), Rule(..), nullFormula, nullRule) -import Swish.Utils.LookupMap- ( mapFindMaybe )+import Swish.Utils.Namespace (Namespace(..), ScopedName(..), namespaceToBuilder)+import Swish.Utils.LookupMap (mapFindMaybe) import Swish.RDF.Vocabulary ( namespaceRDF@@ -73,9 +53,14 @@ , assertBool, assertEqual , runTestTT ) -import Data.Maybe- ( isJust, isNothing, fromJust, fromMaybe )+import Network.URI (URI, parseURI) +import Data.Monoid (Monoid(..))+import Data.Maybe (isJust, isNothing, fromJust, fromMaybe)++import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as B+ -- misc helpers test :: String -> Bool -> Test@@ -122,9 +107,9 @@ -- Various support methods -makeFormula :: Namespace -> String -> String -> RDFFormula+makeFormula :: Namespace -> T.Text -> B.Builder -> RDFFormula makeFormula scope local gr =- makeRDFFormula scope local (prefix++gr)+ makeRDFFormula scope local (prefix `mappend` gr) getRule :: String -> RDFRule getRule nam = getContextRule (makeSName nam) nullRule $@@ -134,7 +119,7 @@ getAxiom nam = getContextAxiom (makeSName nam) nullRDFFormula rdfdContext makeSName :: String -> ScopedName-makeSName nam = ScopedName ns loc+makeSName nam = ScopedName ns (T.pack loc) where (pre,_:loc) = break (==':') nam ns = case pre of@@ -147,17 +132,28 @@ -- Common definitions -prefix :: String+toURI :: String -> URI+toURI = fromJust . parseURI++toNS :: Maybe T.Text -> String -> Namespace+toNS p = Namespace p . toURI++mkPrefix :: Namespace -> B.Builder+mkPrefix = namespaceToBuilder++prefix :: B.Builder prefix =- "@prefix rdf: <" ++ nsURI namespaceRDF ++ "> . \n" ++- "@prefix rdfs: <" ++ nsURI namespaceRDFS ++ "> . \n" ++- "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++- "@prefix xsd: <" ++ nsURI namespaceXSD ++ "> . \n" ++- "@prefix ex: <http://example.org/> . \n" ++- " \n"+ mconcat + [ mkPrefix namespaceRDF+ , mkPrefix namespaceRDFS+ , mkPrefix namespaceRDFD+ , mkPrefix namespaceXSD+ -- TODO: should the following use scopeex instead?+ , mkPrefix $ toNS (Just "ex") "http://example.org/"+ ] scopeex :: Namespace-scopeex = Namespace "ex" "http://id.ninebynine.org/wip/2003/RDFProofCheck#"+scopeex = toNS (Just "ex") "http://id.ninebynine.org/wip/2003/RDFProofCheck#" rdfContext, rdfsContext, rdfdContext, xsdintContext, xsdstrContext :: [RDFRuleset]@@ -192,10 +188,10 @@ ant01 = formExpr $ makeFormula scopeex "ant01" "ex:s ex:p1 ex:o1 ; ex:p2 ex:o2 ." con01 = formExpr $ makeFormula scopeex "con01" $- "ex:p1 rdf:type rdf:Property ." +++ "ex:p1 rdf:type rdf:Property ." `mappend` "ex:p2 rdf:type rdf:Property ." bwd01 = formExpr $ makeFormula scopeex "bwd01a" $- "_:s1 ex:p1 _:o1 . " +++ "_:s1 ex:p1 _:o1 . " `mappend` "_:s2 ex:p2 _:o2 . " -- Simple rule test - no match forward or backward@@ -234,15 +230,15 @@ ant03, con03lg, con03r2 :: RDFGraph ant03 = formExpr $ makeFormula scopeex "ant03" $- "ex:s ex:p1 \"lit1\"^^rdf:XMLLiteral ; " ++- " ex:p2a \"lit2\"^^rdf:XMLLiteral ; " +++ "ex:s ex:p1 \"lit1\"^^rdf:XMLLiteral ; " `mappend`+ " ex:p2a \"lit2\"^^rdf:XMLLiteral ; " `mappend` " ex:p2b \"lit2\"^^rdf:XMLLiteral ." con03lg = formExpr $ makeFormula scopeex "con03" $- "ex:s ex:p1 _:l1 ; ex:p2a _:l2; ex:p2b _:l2 ." ++- "_:l1 rdf:_allocatedTo \"lit1\"^^rdf:XMLLiteral ." +++ "ex:s ex:p1 _:l1 ; ex:p2a _:l2; ex:p2b _:l2 ." `mappend`+ "_:l1 rdf:_allocatedTo \"lit1\"^^rdf:XMLLiteral ." `mappend` "_:l2 rdf:_allocatedTo \"lit2\"^^rdf:XMLLiteral ." con03r2 = formExpr $ makeFormula scopeex "con03" $- "_:l1 rdf:type rdf:XMLLiteral ." +++ "_:l1 rdf:type rdf:XMLLiteral ." `mappend` "_:l2 rdf:type rdf:XMLLiteral ." -- Rule with member property test, match forwards and backwards@@ -256,13 +252,13 @@ ant04, con04, bwd04 :: RDFGraph ant04 = formExpr $ makeFormula scopeex "ant04" $- "ex:s rdf:_123 ex:o1 ; " +++ "ex:s rdf:_123 ex:o1 ; " `mappend` " rdf:_2 ex:o2 . " con04 = formExpr $ makeFormula scopeex "con04" $- "rdf:_123 rdf:type rdf:Property ." +++ "rdf:_123 rdf:type rdf:Property ." `mappend` "rdf:_2 rdf:type rdf:Property ." bwd04 = formExpr $ makeFormula scopeex "bwd04a" $- "_:s1 rdf:_123 _:o1 . " +++ "_:s1 rdf:_123 _:o1 . " `mappend` "_:s2 rdf:_2 _:o2 . " -- Rule with disjunction test, match forwards and backwards@@ -277,17 +273,17 @@ ant05, con05, bwd05 :: RDFGraph ant05 = formExpr $ makeFormula scopeex "ant05" $- "ex:s ex:p1 ex:o1 ; " ++- " ex:p2 _:o2 . " ++- "ex:p1 rdfs:range ex:pr1 . " +++ "ex:s ex:p1 ex:o1 ; " `mappend`+ " ex:p2 _:o2 . " `mappend`+ "ex:p1 rdfs:range ex:pr1 . " `mappend` "ex:p2 rdfs:range ex:pr2 . " con05 = formExpr $ makeFormula scopeex "con05" $- "ex:o1 rdf:type ex:pr1 ." +++ "ex:o1 rdf:type ex:pr1 ." `mappend` "_:o2 rdf:type ex:pr2 ." bwd05 = formExpr $ makeFormula scopeex "bwd05a" $- "_:s1 _:p1 ex:o1 . " ++- "_:s2 _:p2 _:o2 . " ++- "_:p1 rdfs:range ex:pr1 . " +++ "_:s1 _:p1 ex:o1 . " `mappend`+ "_:s2 _:p2 _:o2 . " `mappend`+ "_:p1 rdfs:range ex:pr1 . " `mappend` "_:p2 rdfs:range ex:pr2 . " -- Rule with disjunction test, fail forwards@@ -299,15 +295,15 @@ ant06, con06, bwd06, chk06 :: RDFGraph ant06 = formExpr $ makeFormula scopeex "ant06" $- "ex:s ex:p1 \"lit1\" . " +++ "ex:s ex:p1 \"lit1\" . " `mappend` "ex:p1 rdfs:range ex:pr1 . " con06 = formExpr $ makeFormula scopeex "con06" "_:o1 rdf:type ex:pr1 ." bwd06 = formExpr $ makeFormula scopeex "bwd06a" $- "_:s1 _:p1 _:o1 . " +++ "_:s1 _:p1 _:o1 . " `mappend` "_:p1 rdfs:range ex:pr1 . " chk06 = formExpr $ makeFormula scopeex "bwd06a" $- "_:s1 _:p1 \"lit1\" . " +++ "_:s1 _:p1 \"lit1\" . " `mappend` "_:p1 rdfs:range ex:pr1 . " -- Collected rule tests@@ -374,7 +370,7 @@ rdfBase02 = makeFormula scopeex "rdfBase02" "ex:s ex:p \"l1\"^^rdf:XMLLiteral ." rdfCon02a = makeFormula scopeex "rdfStep02a" $- "ex:s ex:p _:lll . " +++ "ex:s ex:p _:lll . " `mappend` "_:lll rdf:_allocatedTo \"l1\"^^rdf:XMLLiteral . " rdfGoal02 = makeFormula scopeex "rdfGoal02" "_:lll rdf:type rdf:XMLLiteral . "@@ -391,7 +387,7 @@ rdfBase03 = makeFormula scopeex "rdfBase03" "ex:s ex:p ex:o ." rdfCon03a = makeFormula scopeex "rdfStep03a" $- "ex:s ex:p _:lll . " +++ "ex:s ex:p _:lll . " `mappend` "_:lll rdf:_allocatedTo \"l1\"^^rdf:XMLLiteral . " rdfGoal03 = makeFormula scopeex "rdfGoal03" "_:lll rdf:type rdf:XMLLiteral . "@@ -433,8 +429,8 @@ rdfGoal05 :: RDFFormula rdfGoal05 = makeFormula scopeex "rdfGoal05" $- "ex:s _:p _:n ." ++- "_:p rdf:type rdf:Property ." +++ "ex:s _:p _:n ." `mappend`+ "_:p rdf:type rdf:Property ." `mappend` "_:n rdf:type rdf:List ." rdfProof05 :: RDFProof@@ -458,8 +454,8 @@ rdfBase07 :: RDFFormula rdfBase07 = makeFormula scopeex "rdfBase07" $- "ex:s1 ex:p1 \"lll\" ." ++- "ex:s2 ex:p2 \"lll\" ." +++ "ex:s1 ex:p1 \"lll\" ." `mappend`+ "ex:s2 ex:p2 \"lll\" ." `mappend` "ex:s3 ex:p3 \"mmm\" ." rdfStep07a :: RDFProofStep @@ -467,10 +463,10 @@ rdfCons07a :: RDFFormula rdfCons07a = makeFormula scopeex "rdfCons07a" $- "ex:s1 ex:p1 _:l ." ++- "ex:s2 ex:p2 _:l ." ++- "_:l rdf:_allocatedTo \"lll\" ." ++- "ex:s3 ex:p3 _:m ." +++ "ex:s1 ex:p1 _:l ." `mappend`+ "ex:s2 ex:p2 _:l ." `mappend`+ "_:l rdf:_allocatedTo \"lll\" ." `mappend`+ "ex:s3 ex:p3 _:m ." `mappend` "_:m rdf:_allocatedTo \"mmm\" ." rdfStep07b :: RDFProofStep @@ -478,7 +474,7 @@ rdfCons07b :: RDFFormula rdfCons07b = makeFormula scopeex "rdfCons07a" $- "_:l rdf:type rdfs:Literal ." +++ "_:l rdf:type rdfs:Literal ." `mappend` "_:m rdf:type rdfs:Literal ." rdfStep07c :: RDFProofStep@@ -487,8 +483,8 @@ rdfGoal07 :: RDFFormula rdfGoal07 = makeFormula scopeex "rdfGoal07" $- "ex:s1 ex:p1 _:l ." ++- "ex:s2 ex:p2 _:l ." +++ "ex:s1 ex:p1 _:l ." `mappend`+ "ex:s2 ex:p2 _:l ." `mappend` "_:l rdf:type rdfs:Literal ." rdfProof07 :: RDFProof@@ -556,7 +552,7 @@ rdfCons09b :: RDFFormula rdfCons09b = makeFormula scopeex "rdfCons09b" $- "ex:s ex:p _:l ." +++ "ex:s ex:p _:l ." `mappend` "_:l rdf:_allocatedTo \"10\"^^xsd:integer ." rdfStep09c :: RDFProofStep@@ -573,8 +569,8 @@ rdfGoal09 :: RDFFormula rdfGoal09 = makeFormula scopeex "rdfGoal09" $- "ex:s ex:p \"10\"^^xsd:integer ." ++- "_:l rdf:_allocatedTo \"10\"^^xsd:integer ." +++ "ex:s ex:p \"10\"^^xsd:integer ." `mappend`+ "_:l rdf:_allocatedTo \"10\"^^xsd:integer ." `mappend` "_:l rdf:type xsd:integer ." rdfProof09 :: RDFProof@@ -612,7 +608,7 @@ rdfBase10 :: RDFFormula rdfBase10 = makeFormula scopeex "rdfBase10" $- "ex:s ex:p \"abc\" . " +++ "ex:s ex:p \"abc\" . " `mappend` "ex:s ex:p \"def\"^^xsd:string . " rdfStep10a :: RDFProofStep @@ -637,8 +633,8 @@ rdfGoal10 :: RDFFormula rdfGoal10 = makeFormula scopeex "rdfGoal10" $- "ex:s ex:p \"abc\"^^xsd:string . " ++- "ex:s ex:p \"def\" . " +++ "ex:s ex:p \"abc\"^^xsd:string . " `mappend`+ "ex:s ex:p \"def\" . " `mappend` "xsd:string rdf:type rdfs:Datatype . " rdfProof10 :: RDFProof
tests/RDFProofTest.hs view
@@ -1,1171 +1,1040 @@------------------------------------------------------------------------------------ See end of this file for licence information.------------------------------------------------------------------------------------ |--- Module : RDFProofTest--- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke--- License : GPL V2------ Maintainer : Douglas Burke--- Stability : experimental--- Portability : H98------ This module tests the RDFproof module, which instantiates the proof--- rule class over RDF graphs.--------------------------------------------------------------------------------------module Main where--import Swish.RDF.RDFProof- ( makeRdfInstanceEntailmentRule- , makeRdfSubgraphEntailmentRule- , makeRdfSimpleEntailmentRule- )--import Swish.RDF.RDFQuery- ( rdfQueryFind, rdfQuerySubs )--import Swish.RDF.RDFVarBinding- ( RDFVarBinding, RDFVarBindingModify )--import Swish.RDF.RDFRuleset- ( RDFRule- , makeRDFGraphFromN3String- , makeN3ClosureAllocatorRule- , makeN3ClosureRule- , makeN3ClosureSimpleRule- , makeNodeAllocTo- )--import Swish.RDF.RDFGraph- ( Label(..), RDFLabel(..), RDFGraph- , add, allLabels, allNodes )--import Swish.RDF.VarBinding- ( VarBinding(..) - , VarBindingModify(..)- , makeVarFilterModify- , varBindingId -- , varFilterDisjunction, varFilterConjunction- , varFilterNE- )--import Swish.RDF.Rule (Rule(..))--import Swish.Utils.Namespace- ( Namespace(..), ScopedName(..) )--import Test.HUnit- ( Test(TestCase,TestList)- , assertBool, assertEqual- , runTestTT )--import Data.Maybe (isJust, fromJust)---- misc helpers--test :: String -> Bool -> Test-test lab tst = TestCase $ assertBool lab tst--testEq :: (Eq a, Show a) => String -> a -> a -> Test-testEq lab e a = TestCase $ assertEqual lab e a--testJe :: (Eq a, Show a) => String -> a -> Maybe a -> Test-testJe lab e a = TestList- [ TestCase $ assertBool lab (isJust a)- , TestCase $ assertEqual lab e (fromJust a)- ]--testJl :: (Eq a, Show a) => String -> Int -> Maybe [a] -> Test-testJl lab e a = TestList- [ TestCase $ assertBool lab (isJust a)- , TestCase $ assertEqual lab e (length (fromJust a))- ]--testNo :: (Eq a, Show a) => String -> [[a]] -> Test-testNo lab a =- TestCase $ assertBool lab (null a)--testIn :: (Eq a, Show a) => String -> a -> [a] -> Test-testIn lab eg a = TestCase $ assertBool lab (eg `elem` a)---- test1: simple query with URI, literal and blank nodes.--scope1 :: Namespace-scope1 = Namespace "scope1"- "http://id.ninebynine.org/wip/2003/rdfprooftest/scope1"--prefix1 :: String-prefix1 =- "@prefix ex: <http://example.org/> . \n" ++- " \n"--graph1 :: RDFGraph-graph1 = makeRDFGraphFromN3String graph1str--graph1str :: String-graph1str = prefix1 ++- "ex:s1 ex:p ex:o1 . \n" ++- "ex:s2 ex:p \"lit1\" . \n" ++- "[ ex:p ex:o3 ] . \n"--query11 :: RDFGraph-query11 = makeRDFGraphFromN3String query11str--query11str :: String-query11str = prefix1 ++- "?s ex:p ?o . \n"--result11 :: RDFGraph-result11 = makeRDFGraphFromN3String result11str--result11str :: String-result11str = prefix1 ++- "?s ex:r ?o . \n"--result11a :: RDFGraph-result11a = makeRDFGraphFromN3String result11astr--result11astr :: String-result11astr = prefix1 ++- "ex:s1 ex:r ex:o1 . \n" ++- "ex:s2 ex:r \"lit1\" . \n" ++- "[ ex:r ex:o3 ] . \n"--result11b :: RDFGraph-result11b = makeRDFGraphFromN3String result11bstr--result11bstr :: String-result11bstr = prefix1 ++- "ex:s1 ex:r ex:o1 . \n"--result11c :: RDFGraph-result11c = makeRDFGraphFromN3String result11cstr--result11cstr :: String-result11cstr = prefix1 ++- "ex:s2 ex:r \"lit1\" . \n"--backsub11a :: RDFGraph-backsub11a = makeRDFGraphFromN3String backsub11astr--backsub11astr :: String-backsub11astr = prefix1 ++- "ex:s1 ex:p ex:o1 . \n" ++- "ex:s2 ex:p \"lit1\" . \n"--backsub11b :: RDFGraph-backsub11b = makeRDFGraphFromN3String backsub11bstr--backsub11bstr :: String-backsub11bstr = prefix1 ++- "ex:s2 ex:p \"lit1\" . \n"--rul11 :: RDFRule-rul11 = makeN3ClosureSimpleRule scope1 "rul11" query11str result11str--fwd11 :: [RDFGraph]-fwd11 = fwdApply rul11 [graph1]--bwd11 :: [[RDFGraph]]-bwd11 = bwdApply rul11 (add result11b result11c)--test1 :: Test-test1 = - TestList- [ testEq "testFwd11" 1 (length fwd11)- , testIn "testFwd11a" result11a fwd11- , testEq "testBwd11" 1 (length (head bwd11))- , testIn "testBwd11a" backsub11a (head bwd11)- ]---- test2: a range of more complex queries based on a--- single relationship graph.--scope2 :: Namespace-scope2 = Namespace "scope2"- "http://id.ninebynine.org/wip/2003/rdfprooftest/scope2"--prefix2 :: String-prefix2 =- "@prefix pers: <urn:pers:> . \n" ++- "@prefix rel: <urn:rel:> . \n" ++- " \n"--graph2 :: RDFGraph-graph2 = makeRDFGraphFromN3String graph2str--graph2str :: String-graph2str = prefix2 ++- "pers:St1 rel:wife pers:Do1 ; \n" ++- " rel:daughter pers:Ma2 ; \n" ++- " rel:daughter pers:An2 . \n" ++- "pers:Pa2 rel:wife pers:Ma2 ; \n" ++- " rel:son pers:Gr3 ; \n" ++- " rel:son pers:La3 ; \n" ++- " rel:son pers:Si3 ; \n" ++- " rel:son pers:Al3 . \n" ++- "pers:Br2 rel:wife pers:Ri2 ; \n" ++- " rel:daughter pers:Ma3 ; \n" ++- " rel:son pers:Wi3 . \n" ++- "pers:Gr3 rel:wife pers:Ma3 ; \n" ++- " rel:son pers:Ro4 ; \n" ++- " rel:daughter pers:Rh4 . \n" ++- "pers:Si3 rel:wife pers:Jo3 ; \n" ++- " rel:son pers:Ol4 ; \n" ++- " rel:son pers:Lo4 . \n" ++- "pers:Al3 rel:wife pers:Su3 ; \n" ++- " rel:son pers:Ha4 ; \n" ++- " rel:son pers:El4 . \n"--query21 :: RDFGraph-query21 = makeRDFGraphFromN3String query21str--query21str :: String-query21str = prefix2 ++- "?a rel:wife ?b . \n"--result21 :: RDFGraph-result21 = makeRDFGraphFromN3String result21str--result21str :: String-result21str = prefix2 ++- "?b rel:husband ?a . \n"--result21a :: RDFGraph-result21a = makeRDFGraphFromN3String result21astr--result21astr :: String-result21astr = prefix2 ++- "pers:Do1 rel:husband pers:St1 . \n" ++- "pers:Ma2 rel:husband pers:Pa2 . \n" ++- "pers:Ri2 rel:husband pers:Br2 . \n" ++- "pers:Ma3 rel:husband pers:Gr3 . \n" ++- "pers:Jo3 rel:husband pers:Si3 . \n" ++- "pers:Su3 rel:husband pers:Al3 . \n"--result21b :: RDFGraph-result21b = makeRDFGraphFromN3String result21bstr--result21bstr :: String-result21bstr = prefix2 ++- "pers:Do1 rel:husband pers:St1 . \n" ++- "pers:Ma2 rel:husband pers:Pa2 . \n"--bwd21a :: RDFGraph-bwd21a = makeRDFGraphFromN3String bwd21astr--bwd21astr :: String-bwd21astr = prefix2 ++- "pers:St1 rel:wife pers:Do1 . \n" ++- "pers:Pa2 rel:wife pers:Ma2 . \n"--rul21 :: RDFRule-rul21 = makeN3ClosureSimpleRule scope2 "rul21" query21str result21str--fwd21 :: [RDFGraph]-fwd21 = fwdApply rul21 [graph2]--bwd21 :: [[RDFGraph]]-bwd21 = bwdApply rul21 result21b--query22 :: RDFGraph-query22 = makeRDFGraphFromN3String query22str--query22str :: String-query22str = prefix2 ++- "?a rel:son ?b . \n" ++- "?b rel:son ?c . \n"--result22 :: RDFGraph-result22 = makeRDFGraphFromN3String result22str--result22str :: String-result22str = prefix2 ++- "?a rel:grandparent ?c . \n"--result22a :: RDFGraph-result22a = makeRDFGraphFromN3String result22astr--result22astr :: String-result22astr = prefix2 ++- "pers:Pa2 rel:grandparent pers:Ro4 . \n" ++- "pers:Pa2 rel:grandparent pers:Ol4 . \n" ++- "pers:Pa2 rel:grandparent pers:Lo4 . \n" ++- "pers:Pa2 rel:grandparent pers:Ha4 . \n" ++- "pers:Pa2 rel:grandparent pers:El4 . \n"--result22b :: RDFGraph-result22b = makeRDFGraphFromN3String result22bstr--result22bstr :: String-result22bstr = prefix2 ++- "pers:Pa2 rel:grandparent pers:Ro4 . \n" ++- "pers:Pa2 rel:grandparent pers:Ol4 . \n"--bwd22a :: RDFGraph-bwd22a = makeRDFGraphFromN3String bwd22astr--bwd22astr :: String-bwd22astr = prefix2 ++- "pers:Pa2 rel:son _:p1 . \n" ++- "_:p1 rel:son pers:Ro4 . \n" ++- "pers:Pa2 rel:son _:p2 . \n" ++- "_:p2 rel:son pers:Ol4 . \n"--rul22 :: RDFRule-rul22 = makeN3ClosureSimpleRule scope2 "rul22" query22str result22str--fwd22 :: [RDFGraph]-fwd22 = fwdApply rul22 [graph2]--bwd22 :: [[RDFGraph]]-bwd22 = bwdApply rul22 result22b--query23 :: RDFGraph-query23 = makeRDFGraphFromN3String query23str--query23str :: String-query23str = prefix2 ++- "?a rel:son ?b . \n" ++- "?a rel:son ?c . \n"--result23 :: RDFGraph-result23 = makeRDFGraphFromN3String result23str--result23str :: String-result23str = prefix2 ++- "?b rel:brother ?c . \n"--result23a :: RDFGraph-result23a = makeRDFGraphFromN3String result23astr--result23astr :: String-result23astr = prefix2 ++- "pers:Gr3 rel:brother pers:Gr3 . \n" ++- "pers:Gr3 rel:brother pers:La3 . \n" ++- "pers:Gr3 rel:brother pers:Si3 . \n" ++- "pers:Gr3 rel:brother pers:Al3 . \n" ++- "pers:La3 rel:brother pers:Gr3 . \n" ++- "pers:La3 rel:brother pers:La3 . \n" ++- "pers:La3 rel:brother pers:Si3 . \n" ++- "pers:La3 rel:brother pers:Al3 . \n" ++- "pers:Si3 rel:brother pers:Gr3 . \n" ++- "pers:Si3 rel:brother pers:La3 . \n" ++- "pers:Si3 rel:brother pers:Si3 . \n" ++- "pers:Si3 rel:brother pers:Al3 . \n" ++- "pers:Al3 rel:brother pers:Gr3 . \n" ++- "pers:Al3 rel:brother pers:La3 . \n" ++- "pers:Al3 rel:brother pers:Si3 . \n" ++- "pers:Al3 rel:brother pers:Al3 . \n" ++- "pers:Wi3 rel:brother pers:Wi3 . \n" ++- "pers:Ro4 rel:brother pers:Ro4 . \n" ++- "pers:Ol4 rel:brother pers:Lo4 . \n" ++- "pers:Ol4 rel:brother pers:Ol4 . \n" ++- "pers:Lo4 rel:brother pers:Lo4 . \n" ++- "pers:Lo4 rel:brother pers:Ol4 . \n" ++- "pers:Ha4 rel:brother pers:El4 . \n" ++- "pers:Ha4 rel:brother pers:Ha4 . \n" ++- "pers:El4 rel:brother pers:El4 . \n" ++- "pers:El4 rel:brother pers:Ha4 . \n"--result23b :: RDFGraph-result23b = makeRDFGraphFromN3String result23bstr--result23bstr :: String-result23bstr = prefix2 ++- "pers:Gr3 rel:brother pers:Gr3 . \n" ++- "pers:Gr3 rel:brother pers:La3 . \n"--bwd23a :: RDFGraph-bwd23a = makeRDFGraphFromN3String bwd23astr--bwd23astr :: String-bwd23astr = prefix2 ++- "_:a1 rel:son pers:Gr3 . \n" ++- "_:a1 rel:son pers:Gr3 . \n" ++- "_:a2 rel:son pers:Gr3 . \n" ++- "_:a2 rel:son pers:La3 . \n"--rul23 :: RDFRule-rul23 = makeN3ClosureSimpleRule scope2 "rul23" query23str result23str--fwd23 :: [RDFGraph]-fwd23 = fwdApply rul23 [graph2]--bwd23 :: [[RDFGraph]]-bwd23 = bwdApply rul23 result23b---- Test case to return multiple alternative bindings------ (?c son ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)------ a stepBrother b if--- (_:c1 son a, _:c1 stepSon b) || (_:c2 stepSon a, _:c2 son b)--graph24 :: RDFGraph-graph24 = makeRDFGraphFromN3String graph24str--graph24str :: String-graph24str = prefix2 ++- "pers:Ma2 rel:son pers:Gr3 . \n" ++- "pers:Ma2 rel:stepson pers:St3 . \n"--query24 :: RDFGraph-query24 = makeRDFGraphFromN3String query24str--query24str :: String-query24str = prefix2 ++- "?c rel:son ?a . \n" ++- "?c rel:stepson ?b . \n"--result24 :: RDFGraph-result24 = makeRDFGraphFromN3String result24str--result24str :: String-result24str = prefix2 ++- "?a rel:stepbrother ?b . \n" ++- "?b rel:stepbrother ?a . \n"--result24a :: RDFGraph-result24a = makeRDFGraphFromN3String result24astr--result24astr :: String-result24astr = prefix2 ++- "pers:Gr3 rel:stepbrother pers:St3 . \n" ++- "pers:St3 rel:stepbrother pers:Gr3 . \n"--bwd24a1 :: RDFGraph-bwd24a1 = makeRDFGraphFromN3String bwd24a1str--bwd24a1str :: String-bwd24a1str = prefix2 ++- "_:c1 rel:son pers:Gr3 . \n" ++- "_:c1 rel:stepson pers:St3 . \n" ++- "_:c2 rel:stepson pers:Gr3 . \n" ++- "_:c2 rel:son pers:St3 . \n"--bwd24a2 :: RDFGraph-bwd24a2 = makeRDFGraphFromN3String bwd24a2str--bwd24a2str :: String-bwd24a2str = prefix2 ++- "_:c1 rel:son pers:Gr3 . \n" ++- "_:c1 rel:stepson pers:St3 . \n"--bwd24a3 :: RDFGraph-bwd24a3 = makeRDFGraphFromN3String bwd24a3str--bwd24a3str :: String-bwd24a3str = prefix2 ++- "_:c2 rel:stepson pers:Gr3 . \n" ++- "_:c2 rel:son pers:St3 . \n"--bwd24a4 :: RDFGraph-bwd24a4 = makeRDFGraphFromN3String bwd24a4str--bwd24a4str :: String-bwd24a4str = prefix2 ++- "_:c1 rel:son pers:Gr3 . \n" ++- "_:c1 rel:stepson pers:St3 . \n" ++- "_:c2 rel:stepson pers:Gr3 . \n" ++- "_:c2 rel:son pers:St3 . \n"--rul24 :: RDFRule-rul24 = makeN3ClosureSimpleRule scope2 "rul24" query24str result24str--fwd24 :: [RDFGraph]-fwd24 = fwdApply rul24 [graph24]--bwd24 :: [[RDFGraph]]-bwd24 = bwdApply rul24 result24a---- bwd chain from partial conclusion--- Also, fail because conclusion is more than the rule--- can derive from any input.--query25 :: RDFGraph-query25 = makeRDFGraphFromN3String query25str--query25str :: String-query25str = prefix2 ++- "?a rel:son ?b . \n" ++- "?a rel:daughter ?c . \n"--result25 :: RDFGraph-result25 = makeRDFGraphFromN3String result25str--result25str :: String-result25str = prefix2 ++- "?b rel:sister ?c . \n" ++- "?c rel:brother ?b . \n"--result25a :: RDFGraph-result25a = makeRDFGraphFromN3String result25astr--result25astr :: String-result25astr = prefix2 ++- "pers:Wi3 rel:sister pers:Ma3 . \n" ++- "pers:Ma3 rel:brother pers:Wi3 . \n" ++- "pers:Ro4 rel:sister pers:Rh4 . \n" ++- "pers:Rh4 rel:brother pers:Ro4 . \n"--{--result25b = makeRDFGraphFromN3String result25bstr-result25bstr = prefix2 ++- "pers:Ro4 rel:sister pers:Rh4 . \n" ++- "pers:Rh4 rel:brother pers:Ro4 . \n"--}--result25c :: RDFGraph-result25c = makeRDFGraphFromN3String result25cstr--result25cstr :: String-result25cstr = prefix2 ++- "pers:Wi3 rel:sister pers:Ma3 . \n" ++- "pers:Ma3 rel:brother pers:Wi3 . \n" ++- "pers:Ro4 rel:sister pers:Rh4 . \n" ++- "pers:Rh4 rel:brother pers:Ro4 . \n" ++- "pers:xx3 rel:mother pers:yy3 . \n" ++- "pers:yy3 rel:brother pers:xx3 . \n"--result25d :: RDFGraph-result25d = makeRDFGraphFromN3String result25dstr--result25dstr :: String-result25dstr = prefix2 ++- "pers:Wi3 rel:sister pers:Ma3 . \n" ++- "pers:Ma3 rel:brother pers:Wi3 . \n" ++- "pers:Ro4 rel:sister pers:Rh4 . \n" ++- "pers:Rh4 rel:brother pers:Ro4 . \n" ++- "pers:xx3 rel:father pers:yy3 . \n"--conc25 :: RDFGraph-conc25 = makeRDFGraphFromN3String conc25str--conc25str :: String-conc25str = prefix2 ++- "pers:Wi3 rel:sister pers:Ma3 . \n" ++- "pers:Rh4 rel:brother pers:Ro4 . \n"--bwd25a :: RDFGraph-bwd25a = makeRDFGraphFromN3String bwd25astr--bwd25astr :: String-bwd25astr = prefix2 ++- "_:a1 rel:son pers:Wi3 . \n" ++- "_:a1 rel:daughter pers:Ma3 . \n" ++- "_:a2 rel:son pers:Ro4 . \n" ++- "_:a2 rel:daughter pers:Rh4 . \n"--rul25 :: RDFRule-rul25 = makeN3ClosureSimpleRule scope2 "rul25" query25str result25str--fwd25 :: [RDFGraph]-fwd25 = fwdApply rul25 [graph2]--bwd25, bwd25c, bwd25d :: [[RDFGraph]]-bwd25 = bwdApply rul25 conc25-bwd25c = bwdApply rul25 result25c-bwd25d = bwdApply rul25 result25d--test2 :: Test-test2 = - TestList- [ testEq "testResult21" 1 (length fwd21)- , testIn "testResult21a" result21a fwd21- , testEq "testBwd21" 1 (length $ head bwd21)- , testIn "testBwd21a" bwd21a (head bwd21)- , testEq "testResult22" 1 (length fwd22)- , testIn "testResult22a" result22a fwd22- , testEq "testBwd22" 1 (length $ head bwd22)- , testIn "testBwd22a" bwd22a (head bwd22)- , testEq "testResult23" 1 (length fwd23)- , testIn "testResult23a" result23a fwd23- , testEq "testBwd23" 1 (length $ head bwd23)- , testIn "testBwd23a" bwd23a (head bwd23)- , testEq "testResult24" 1 (length fwd24)- , testIn "testResult24a" result24a fwd24- , testEq "testBwd24" 4 (length bwd24)- , testIn "testBwd24a1" bwd24a1 (head bwd24)- , testIn "testBwd24a2" bwd24a2 (bwd24!!1)- , testIn "testBwd24a3" bwd24a3 (bwd24!!2)- , testIn "testBwd24a4" bwd24a4 (bwd24!!3)- , testEq "testResult25" 1 (length fwd25)- , testIn "testResult25a" result25a fwd25- , testEq "testBwd25" 1 (length $ head bwd25)- , testIn "testBwd25a" bwd25a (head bwd25)- -- testBwd25a1 = testEq "testBwd25a" bwd25a (head $ head bwd25)- , testNo "testBwd25c" bwd25c- , testNo "testBwd25d" bwd25d- ]---- test3: check variable binding filters--scope3 :: Namespace-scope3 = Namespace "scope3"- "http://id.ninebynine.org/wip/2003/rdfprooftest/scope3"--query31 :: RDFGraph-query31 = makeRDFGraphFromN3String query31str--query31str :: String-query31str = prefix2 ++- "?a rel:son ?b . \n" ++- "?a rel:son ?c . \n"--modify31 :: RDFVarBindingModify-modify31 = makeVarFilterModify $ varFilterNE (Var "b") (Var "c")--result31 :: RDFGraph-result31 = makeRDFGraphFromN3String result31str--result31str :: String-result31str = prefix2 ++- "?b rel:brother ?c . \n"--result31a :: RDFGraph-result31a = makeRDFGraphFromN3String result31astr--result31astr :: String-result31astr = prefix2 ++- "pers:Gr3 rel:brother pers:La3 . \n" ++- "pers:Gr3 rel:brother pers:Si3 . \n" ++- "pers:Gr3 rel:brother pers:Al3 . \n" ++- "pers:La3 rel:brother pers:Gr3 . \n" ++- "pers:La3 rel:brother pers:Si3 . \n" ++- "pers:La3 rel:brother pers:Al3 . \n" ++- "pers:Si3 rel:brother pers:Gr3 . \n" ++- "pers:Si3 rel:brother pers:La3 . \n" ++- "pers:Si3 rel:brother pers:Al3 . \n" ++- "pers:Al3 rel:brother pers:Gr3 . \n" ++- "pers:Al3 rel:brother pers:La3 . \n" ++- "pers:Al3 rel:brother pers:Si3 . \n" ++- "pers:Ol4 rel:brother pers:Lo4 . \n" ++- "pers:Lo4 rel:brother pers:Ol4 . \n" ++- "pers:Ha4 rel:brother pers:El4 . \n" ++- "pers:El4 rel:brother pers:Ha4 . \n"--result31b :: RDFGraph-result31b = makeRDFGraphFromN3String result31bstr--result31bstr :: String-result31bstr = prefix2 ++- "pers:Gr3 rel:brother pers:Gr3 . \n"--result31c :: RDFGraph-result31c = makeRDFGraphFromN3String result31cstr--result31cstr :: String-result31cstr = prefix2 ++- "pers:Gr3 rel:brother pers:La3 . \n"--bwd31c :: RDFGraph-bwd31c = makeRDFGraphFromN3String bwd31cstr--bwd31cstr :: String-bwd31cstr = prefix2 ++- "_:a rel:son pers:Gr3 . \n" ++- "_:a rel:son pers:La3 . \n"--rul31 :: RDFRule-rul31 = makeN3ClosureRule scope3 "rul31" query31str result31str modify31--fwd31 :: [RDFGraph]-fwd31 = fwdApply rul31 [graph2]--calcbwd31b, calcbwd31c :: [[RDFGraph]]-calcbwd31b = bwdApply rul31 result31b-calcbwd31c = bwdApply rul31 result31c--test3 :: Test-test3 = - TestList- [ testEq "testResult31" 1 (length fwd31)- , testIn "testResult31a" result31a fwd31- , testEq "testBwd31" 0 (length calcbwd31b)- , testEq "testBwd31" 1 (length $ head calcbwd31c)- , testIn "testBwd31c" bwd31c (head calcbwd31c)- ]---- Instance entailment tests--scope4 :: Namespace-scope4 = Namespace "scope4"- "http://id.ninebynine.org/wip/2003/rdfprooftest/scope4"--graph4 :: RDFGraph-graph4 = makeRDFGraphFromN3String graph4str--graph4str :: String-graph4str = prefix2 ++- "pers:Gr3 rel:son pers:Ro4 ; \n" ++- " rel:daughter pers:Rh4 . \n"--vocab4 :: [RDFLabel]-vocab4 = allNodes (not . labelIsVar) graph4--name4 :: ScopedName-name4 = ScopedName scope4 "instance4"--rule4 :: RDFRule-rule4 = makeRdfInstanceEntailmentRule name4 vocab4--fwd42a :: RDFGraph-fwd42a = makeRDFGraphFromN3String fwd42astr--fwd42astr :: String-fwd42astr = prefix2 ++- "pers:Gr3 rel:son _:Ro4 ; \n" ++- " rel:daughter pers:Rh4 . \n"--fwd42b :: RDFGraph-fwd42b = makeRDFGraphFromN3String fwd42bstr--fwd42bstr :: String-fwd42bstr = prefix2 ++- "pers:Gr3 rel:son pers:Ro4 ; \n" ++- " rel:daughter _:Rh4 . \n"--fwd42c :: RDFGraph-fwd42c = makeRDFGraphFromN3String fwd42cstr--fwd42cstr :: String-fwd42cstr = prefix2 ++- "pers:Gr3 rel:son _:Ro4 ; \n" ++- " rel:daughter _:Rh4 . \n"--fwd42d :: RDFGraph-fwd42d = makeRDFGraphFromN3String fwd42dstr--fwd42dstr :: String-fwd42dstr = prefix2 ++- "_:Gr3 rel:son _:Ro4 ; \n" ++- " rel:daughter pers:Rh4 . \n"--fwd42e :: RDFGraph-fwd42e = makeRDFGraphFromN3String fwd42estr--fwd42estr :: String-fwd42estr = prefix2 ++- "_:Gr3 rel:son _:Ro4 ; \n" ++- " rel:daughter pers:Rh4 . \n"--fwd42f :: RDFGraph-fwd42f = makeRDFGraphFromN3String fwd42fstr--fwd42fstr :: String-fwd42fstr = prefix2 ++- "_:Gr3 rel:son pers:Ro4 ; \n" ++- " rel:daughter _:Rh4 . \n"--fwd42g :: RDFGraph-fwd42g = makeRDFGraphFromN3String fwd42gstr--fwd42gstr :: String-fwd42gstr = prefix2 ++- "_:Gr3 rel:son _:Ro4 ; \n" ++- " rel:daughter _:Rh4 . \n"---- Non-entailments--fwd42w :: RDFGraph-fwd42w = makeRDFGraphFromN3String fwd42wstr--fwd42wstr :: String-fwd42wstr = prefix2 ++- "pers:Gr3 rel:daughter pers:Ro4 . \n"--fwd42x :: RDFGraph-fwd42x = makeRDFGraphFromN3String fwd42xstr--fwd42xstr :: String-fwd42xstr = prefix2 ++- "pers:Gr3 rel:daughter pers:Ro4 . \n"--fwd42y :: RDFGraph-fwd42y = makeRDFGraphFromN3String fwd42ystr--fwd42ystr :: String-fwd42ystr = prefix2 ++- "_:Gr3 rel:son pers:Ro4 ; \n" ++- " rel:daughter pers:Ro4 . \n"--fwd42z :: RDFGraph-fwd42z = makeRDFGraphFromN3String fwd42zstr--fwd42zstr :: String-fwd42zstr = prefix2 ++- "_:Gr3 rel:son _:Ro4 ; \n" ++- " rel:son _:Rh4 . \n"--bwd43 :: RDFGraph-bwd43 = makeRDFGraphFromN3String bwd43str--bwd43str :: String-bwd43str = prefix2 ++- "_:a1 rel:son pers:Ro4 . \n" ++- "_:a2 rel:daughter pers:Rh4 . \n"--bwd43a :: RDFGraph-bwd43a = makeRDFGraphFromN3String bwd43astr--bwd43astr :: String-bwd43astr = prefix2 ++- "pers:Gr3 rel:son pers:Ro4 . \n" ++- "pers:Gr3 rel:daughter pers:Rh4 . \n"--bwd43b :: RDFGraph-bwd43b = makeRDFGraphFromN3String bwd43bstr--bwd43bstr :: String-bwd43bstr = prefix2 ++- "pers:Gr3 rel:son pers:Ro4 . \n" ++- "pers:Ro4 rel:daughter pers:Rh4 . \n"--bwd43c :: RDFGraph-bwd43c = makeRDFGraphFromN3String bwd43cstr--bwd43cstr :: String-bwd43cstr = prefix2 ++- "pers:Gr3 rel:son pers:Ro4 . \n" ++- "pers:Rh4 rel:daughter pers:Rh4 . \n"--bwd43d :: RDFGraph-bwd43d = makeRDFGraphFromN3String bwd43dstr--bwd43dstr :: String-bwd43dstr = prefix2 ++- "pers:Ro4 rel:son pers:Ro4 . \n" ++- "pers:Gr3 rel:daughter pers:Rh4 . \n"--bwd43e :: RDFGraph-bwd43e = makeRDFGraphFromN3String bwd43estr--bwd43estr :: String-bwd43estr = prefix2 ++- "pers:Ro4 rel:son pers:Ro4 . \n" ++- "pers:Ro4 rel:daughter pers:Rh4 . \n"--bwd43f :: RDFGraph-bwd43f = makeRDFGraphFromN3String bwd43fstr--bwd43fstr :: String-bwd43fstr = prefix2 ++- "pers:Ro4 rel:son pers:Ro4 . \n" ++- "pers:Rh4 rel:daughter pers:Rh4 . \n"--bwd43g :: RDFGraph-bwd43g = makeRDFGraphFromN3String bwd43gstr--bwd43gstr :: String-bwd43gstr = prefix2 ++- "pers:Rh4 rel:son pers:Ro4 . \n" ++- "pers:Gr3 rel:daughter pers:Rh4 . \n"--bwd43h :: RDFGraph-bwd43h = makeRDFGraphFromN3String bwd43hstr--bwd43hstr :: String-bwd43hstr = prefix2 ++- "pers:Rh4 rel:son pers:Ro4 . \n" ++- "pers:Ro4 rel:daughter pers:Rh4 . \n"--bwd43i :: RDFGraph-bwd43i = makeRDFGraphFromN3String bwd43istr--bwd43istr :: String-bwd43istr = prefix2 ++- "pers:Rh4 rel:son pers:Ro4 . \n" ++- "pers:Rh4 rel:daughter pers:Rh4 . \n"---- Forward chaining--fwdApply42 :: [RDFGraph]-fwdApply42 = fwdApply rule4 [graph4]---- Backward chaining--bwdApply43 :: [[RDFGraph]]-bwdApply43 = bwdApply rule4 bwd43--test4 :: Test-test4 = - TestList- [ - -- Check basics- testEq "testRuleName41" name4 (ruleName rule4)- , testEq "testVocab41" 3 (length vocab4)- , testEq "testFwdLength42" 7 (length fwdApply42)- , testIn "testFwdApply42a" fwd42a fwdApply42- , testIn "testFwdApply42b" fwd42b fwdApply42- , testIn "testFwdApply42c" fwd42c fwdApply42- , testIn "testFwdApply42d" fwd42d fwdApply42- , testIn "testFwdApply42e" fwd42e fwdApply42- , testIn "testFwdApply42f" fwd42f fwdApply42- , testIn "testFwdApply42g" fwd42g fwdApply42- , testEq "testBwdLength43" 9 (length bwdApply43)- , testIn "testBwdApply43a" [bwd43a] bwdApply43- , testIn "testBwdApply43b" [bwd43b] bwdApply43- , testIn "testBwdApply43c" [bwd43c] bwdApply43- , testIn "testBwdApply43d" [bwd43d] bwdApply43- , testIn "testBwdApply43e" [bwd43e] bwdApply43- , testIn "testBwdApply43f" [bwd43f] bwdApply43- , testIn "testBwdApply43g" [bwd43g] bwdApply43- , testIn "testBwdApply43h" [bwd43h] bwdApply43- , testIn "testBwdApply43i" [bwd43i] bwdApply43- - -- Entailment checks- , testEq "testEntail44a" True (checkInference rule4 [graph4] fwd42a)- , testEq "testEntail44b" True (checkInference rule4 [graph4] fwd42b)- , testEq "testEntail44g" True (checkInference rule4 [graph4] fwd42g)- , testEq "testEntail44w" False (checkInference rule4 [graph4] fwd42w)- , testEq "testEntail44x" False (checkInference rule4 [graph4] fwd42x)- , testEq "testEntail44y" False (checkInference rule4 [graph4] fwd42y)- , testEq "testEntail44z" False (checkInference rule4 [graph4] fwd42z)- ]---- Subgraph entailment tests--scope5 :: Namespace-scope5 = Namespace "scope5"- "http://id.ninebynine.org/wip/2003/rdfprooftest/scope5"--graph5 :: RDFGraph-graph5 = makeRDFGraphFromN3String graph5str--graph5str :: String-graph5str = prefix2 ++- "pers:Gr3 rel:son pers:Ro4 ; \n" ++- " rel:daughter pers:Rh4 . \n" ++- "pers:Si3 rel:son pers:Ol4 . \n"--name5 :: ScopedName-name5 = ScopedName scope5 "subgraph5"--rule5 :: RDFRule-rule5 = makeRdfSubgraphEntailmentRule name5---- Forward chaining excludes null agraph and copy of antecedent--fwd52a :: RDFGraph-fwd52a = makeRDFGraphFromN3String fwd52astr--fwd52astr :: String-fwd52astr = prefix2 ++- "pers:Gr3 rel:son pers:Ro4 . \n"--fwd52b :: RDFGraph-fwd52b = makeRDFGraphFromN3String fwd52bstr--fwd52bstr :: String-fwd52bstr = prefix2 ++- "pers:Gr3 rel:daughter pers:Rh4 . \n"--fwd52c :: RDFGraph-fwd52c = makeRDFGraphFromN3String fwd52cstr--fwd52cstr :: String-fwd52cstr = prefix2 ++- "pers:Si3 rel:son pers:Ol4 . \n"--fwd52d :: RDFGraph-fwd52d = makeRDFGraphFromN3String fwd52dstr--fwd52dstr :: String-fwd52dstr = prefix2 ++- "pers:Gr3 rel:son pers:Ro4 . \n" ++- "pers:Gr3 rel:daughter pers:Rh4 . \n"--fwd52e :: RDFGraph-fwd52e = makeRDFGraphFromN3String fwd52estr--fwd52estr :: String-fwd52estr = prefix2 ++- "pers:Gr3 rel:son pers:Ro4 . \n" ++- "pers:Si3 rel:son pers:Ol4 . \n"--fwd52f :: RDFGraph-fwd52f = makeRDFGraphFromN3String fwd52fstr--fwd52fstr :: String-fwd52fstr = prefix2 ++- "pers:Gr3 rel:daughter pers:Rh4 . \n" ++- "pers:Si3 rel:son pers:Ol4 . \n"----- Forward chaining--fwdApply52 :: [RDFGraph]-fwdApply52 = fwdApply rule5 [graph5]--test5 :: Test-test5 = - TestList- [ testEq "testRuleName51" name5 (ruleName rule5)- , testEq "testFwdLength52" 6 (length fwdApply52)- , testIn "testFwdApply52a" fwd52a fwdApply52- , testIn "testFwdApply52b" fwd52b fwdApply52- , testIn "testFwdApply52c" fwd52c fwdApply52- , testIn "testFwdApply52d" fwd52d fwdApply52- , testIn "testFwdApply52e" fwd52e fwdApply52- , testIn "testFwdApply52f" fwd52f fwdApply52- ]---- Simple entailment test--- Simple entailment provides entailment check only, no forward or--- backward chaining. For that use instance- and subgraph- rules.--scope6 :: Namespace-scope6 = Namespace "scope6"- "http://id.ninebynine.org/wip/2003/rdfprooftest/scope6"--graph6 :: RDFGraph-graph6 = makeRDFGraphFromN3String graph6str--graph6str :: String-graph6str = prefix2 ++- "pers:Gr3 rel:son pers:Ro4 ; \n" ++- " rel:daughter pers:Rh4 . \n" ++- "pers:Si3 rel:son pers:Ol4 ; \n" ++- " rel:son pers:Lo4 . \n"--name6 :: ScopedName-name6 = ScopedName scope5 "subgraph6"--rule6 :: RDFRule-rule6 = makeRdfSimpleEntailmentRule name6--simple6a :: RDFGraph-simple6a = makeRDFGraphFromN3String simple6astr--simple6astr :: String-simple6astr = prefix2 ++- "_:Gr3 rel:son pers:Ro4 ; \n" ++- " rel:daughter pers:Rh4 . \n"--simple6b :: RDFGraph-simple6b = makeRDFGraphFromN3String simple6bstr--simple6bstr :: String-simple6bstr = prefix2 ++- "_:Si3 rel:son pers:Ol4 ; \n" ++- " rel:son pers:Lo4 . \n"--simple6c :: RDFGraph-simple6c = makeRDFGraphFromN3String simple6cstr--simple6cstr :: String-simple6cstr = prefix2 ++- "_:Si3 rel:son _:Ol4 ; \n" ++- " rel:son _:Lo4 . \n"--simple6d :: RDFGraph-simple6d = makeRDFGraphFromN3String simple6dstr--simple6dstr :: String-simple6dstr = prefix2 ++- "_:Si3 rel:son _:Ol4 ; \n" ++- " rel:daughter _:Lo4 . \n"--simple6e :: RDFGraph-simple6e = makeRDFGraphFromN3String simple6estr--simple6estr :: String-simple6estr = prefix2 ++- "_:Si3 rel:daughter _:Ol4 ; \n" ++- " rel:mother _:Lo4 . \n"--test6 :: Test-test6 = - TestList- [ testEq "testRuleName61" name6 (ruleName rule6)- , test "testSimple62" (checkInference rule6 [graph6] simple6a)- , test "testSimple63" (checkInference rule6 [graph6] simple6b)- , test "testSimple64" (checkInference rule6 [graph6] simple6c)- , test "testSimple65" (checkInference rule6 [graph6] simple6d)- , test "testSimple66" (not $ checkInference rule6 [graph6] simple6e)- , test "testFwd64" (null $ fwdApply rule6 [graph6])- , test "testBwd65" (null $ bwdApply rule6 graph6)- ]---- Test forward chaining node allocation logic------ ?a uncle ?c => ?a father ?b, ?b brother ?c, ?b allocTo ?a------ Ro4 uncle La3, Ro4 uncle Si3, Rh4 uncle La3, Rh4 uncle Si3--- =>--- Ro4 father _:f1, _:f1 brother La3,--- Ro4 father _:f1, _:f1 brother Si3,--- Rh4 father _:f2, _:f2 brother La3,--- Rh4 father _:f2, _:f2 brother Si3--scope7 :: Namespace-scope7 = Namespace "scope7"- "http://id.ninebynine.org/wip/2003/rdfprooftest/scope7"--graph7 :: RDFGraph-graph7 = makeRDFGraphFromN3String graph7str--graph7str :: String-graph7str = prefix2 ++- "pers:Ro4 rel:uncle pers:La3 ; \n" ++- " rel:uncle pers:Si3 . \n" ++- "pers:Rh4 rel:uncle pers:La3 ; \n" ++- " rel:uncle pers:Si3 . \n"--query71 :: RDFGraph-query71 = makeRDFGraphFromN3String query71str--query71str :: String-query71str = prefix2 ++- "?a rel:uncle ?c . \n"--result71 :: RDFGraph-result71 = makeRDFGraphFromN3String result71str--result71str :: String-result71str = prefix2 ++- "?a rel:father ?b . \n" ++- "?b rel:brother ?c . \n"--result71a :: RDFGraph-result71a = makeRDFGraphFromN3String result71astr--result71astr :: String-result71astr = prefix2 ++- "pers:Ro4 rel:father _:f1 . \n" ++- "_:f1 rel:brother pers:La3 . \n" ++- "pers:Ro4 rel:father _:f1 . \n" ++- "_:f1 rel:brother pers:Si3 . \n" ++- "pers:Rh4 rel:father _:f2 . \n" ++- "_:f2 rel:brother pers:La3 . \n" ++- "pers:Rh4 rel:father _:f2 . \n" ++- "_:f2 rel:brother pers:Si3 . \n"--rul71 :: RDFRule-rul71 = makeN3ClosureAllocatorRule scope7 "rul71"- query71str result71str varBindingId mod71--mod71 :: [RDFLabel] -> RDFVarBindingModify-mod71 = makeNodeAllocTo (Var "b") (Var "a")--var71 :: [RDFVarBinding]-var71 = rdfQueryFind query71 graph7--var71a :: [VarBinding RDFLabel RDFLabel]-var71a = vbmApply (mod71 (allLabels labelIsVar graph7)) var71--var71_1 :: VarBinding RDFLabel RDFLabel-var71_1 = head var71a--map71a, map71b, map71c :: Maybe RDFLabel-map71a = Just (Var "#a")-map71b = Just (Var "#b")-map71c = Just (Var "#c")--sub71a :: [RDFGraph]-sub71a = rdfQuerySubs var71a result71+{-# LANGUAGE OverloadedStrings #-}++--------------------------------------------------------------------------------+-- See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+-- Module : RDFProofTest+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+-- License : GPL V2+--+-- Maintainer : Douglas Burke+-- Stability : experimental+-- Portability : OverloadedStrings+--+-- This module tests the RDFproof module, which instantiates the proof+-- rule class over RDF graphs.+--+--------------------------------------------------------------------------------++module Main where++import Swish.RDF.RDFProof+ ( makeRdfInstanceEntailmentRule+ , makeRdfSubgraphEntailmentRule+ , makeRdfSimpleEntailmentRule+ )++import Swish.RDF.RDFQuery (rdfQueryFind, rdfQuerySubs)+import Swish.RDF.RDFVarBinding (RDFVarBinding, RDFVarBindingModify)++import Swish.RDF.RDFRuleset+ ( RDFRule+ , makeRDFGraphFromN3Builder+ , makeN3ClosureAllocatorRule+ , makeN3ClosureRule+ , makeN3ClosureSimpleRule+ , makeNodeAllocTo+ )++import Swish.RDF.RDFGraph+ ( Label(..), RDFLabel(..), RDFGraph+ , add, allLabels, allNodes )++import Swish.RDF.VarBinding+ ( VarBinding(..) + , VarBindingModify(..)+ , makeVarFilterModify+ , varBindingId -- , varFilterDisjunction, varFilterConjunction+ , varFilterNE+ )++import Swish.RDF.Rule (Rule(..))+import Swish.Utils.Namespace (Namespace(..), ScopedName(..))++import Test.HUnit+ ( Test(TestCase,TestList)+ , assertBool, assertEqual+ , runTestTT )++import Network.URI (URI, parseURI)++import Data.Monoid (Monoid(..))+import Data.Maybe (isJust, fromJust)++import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as B++-- misc helpers++test :: String -> Bool -> Test+test lab tst = TestCase $ assertBool lab tst++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab e a = TestCase $ assertEqual lab e a++testJe :: (Eq a, Show a) => String -> a -> Maybe a -> Test+testJe lab e a = TestList+ [ TestCase $ assertBool lab (isJust a)+ , TestCase $ assertEqual lab e (fromJust a)+ ]++testJl :: (Eq a, Show a) => String -> Int -> Maybe [a] -> Test+testJl lab e a = TestList+ [ TestCase $ assertBool lab (isJust a)+ , TestCase $ assertEqual lab e (length (fromJust a))+ ]++testNo :: (Eq a, Show a) => String -> [[a]] -> Test+testNo lab a =+ TestCase $ assertBool lab (null a)++testIn :: (Eq a, Show a) => String -> a -> [a] -> Test+testIn lab eg a = TestCase $ assertBool lab (eg `elem` a)++mkGr :: B.Builder -> [B.Builder] -> RDFGraph+mkGr pr bdy = makeRDFGraphFromN3Builder $ mconcat (pr : bdy)++mkGr1, mkGr2 :: [B.Builder] -> RDFGraph+mkGr1 = mkGr prefix1+mkGr2 = mkGr prefix2++toURI :: String -> URI+toURI = fromJust . parseURI++toNS :: Maybe T.Text -> String -> Namespace+toNS p = Namespace p . toURI++-- test1: simple query with URI, literal and blank nodes.++scope1 :: Namespace+scope1 = toNS (Just "scope1")+ "http://id.ninebynine.org/wip/2003/rdfprooftest/scope1"++prefix1 :: B.Builder+prefix1 = "@prefix ex: <http://example.org/> . \n"++graph1 :: RDFGraph+graph1 = mkGr1 + ["ex:s1 ex:p ex:o1 . \n"+ , "ex:s2 ex:p \"lit1\" . \n"+ , "[ ex:p ex:o3 ] . \n"+ ]++query11 :: RDFGraph+query11 = makeRDFGraphFromN3Builder query11str++query11str :: B.Builder+query11str = prefix1 `mappend` "?s ex:p ?o . \n"++result11 :: RDFGraph+result11 = makeRDFGraphFromN3Builder result11str++result11str :: B.Builder+result11str = prefix1 `mappend` "?s ex:r ?o . \n"++result11a :: RDFGraph+result11a = mkGr1 + [ "ex:s1 ex:r ex:o1 . \n"+ , "ex:s2 ex:r \"lit1\" . \n" + , "[ ex:r ex:o3 ] . \n"+ ]++result11b :: RDFGraph+result11b = mkGr1 ["ex:s1 ex:r ex:o1 . \n"]++result11c :: RDFGraph+result11c = mkGr1 ["ex:s2 ex:r \"lit1\" . \n"]++backsub11a :: RDFGraph+backsub11a = mkGr1 + [ "ex:s1 ex:p ex:o1 . \n"+ , "ex:s2 ex:p \"lit1\" . \n"+ ]++backsub11b :: RDFGraph+backsub11b = mkGr1 ["ex:s2 ex:p \"lit1\" . \n"]++rul11 :: RDFRule+rul11 = makeN3ClosureSimpleRule scope1 "rul11" query11str result11str++fwd11 :: [RDFGraph]+fwd11 = fwdApply rul11 [graph1]++bwd11 :: [[RDFGraph]]+bwd11 = bwdApply rul11 (add result11b result11c)++test1 :: Test+test1 = + TestList+ [ testEq "testFwd11" 1 (length fwd11)+ , testIn "testFwd11a" result11a fwd11+ , testEq "testBwd11" 1 (length (head bwd11))+ , testIn "testBwd11a" backsub11a (head bwd11)+ ]++-- test2: a range of more complex queries based on a+-- single relationship graph.++scope2 :: Namespace+scope2 = toNS (Just "scope2")+ "http://id.ninebynine.org/wip/2003/rdfprooftest/scope2"++prefix2 :: B.Builder+prefix2 =+ "@prefix pers: <urn:pers:> . \n"+ `mappend`+ "@prefix rel: <urn:rel:> . \n"++graph2 :: RDFGraph+graph2 = mkGr2+ [ "pers:St1 rel:wife pers:Do1 ; \n"+ , " rel:daughter pers:Ma2 ; \n"+ , " rel:daughter pers:An2 . \n"+ , "pers:Pa2 rel:wife pers:Ma2 ; \n"+ , " rel:son pers:Gr3 ; \n"+ , " rel:son pers:La3 ; \n"+ , " rel:son pers:Si3 ; \n"+ , " rel:son pers:Al3 . \n"+ , "pers:Br2 rel:wife pers:Ri2 ; \n"+ , " rel:daughter pers:Ma3 ; \n"+ , " rel:son pers:Wi3 . \n"+ , "pers:Gr3 rel:wife pers:Ma3 ; \n"+ , " rel:son pers:Ro4 ; \n"+ , " rel:daughter pers:Rh4 . \n"+ , "pers:Si3 rel:wife pers:Jo3 ; \n"+ , " rel:son pers:Ol4 ; \n"+ , " rel:son pers:Lo4 . \n"+ , "pers:Al3 rel:wife pers:Su3 ; \n"+ , " rel:son pers:Ha4 ; \n"+ , " rel:son pers:El4 . \n"+ ]+ +query21 :: RDFGraph+query21 = makeRDFGraphFromN3Builder query21str++query21str :: B.Builder+query21str = prefix2 `mappend` "?a rel:wife ?b . \n"++result21 :: RDFGraph+result21 = makeRDFGraphFromN3Builder result21str++result21str :: B.Builder+result21str = prefix2 `mappend` "?b rel:husband ?a . \n"++result21a :: RDFGraph+result21a = mkGr2+ [ "pers:Do1 rel:husband pers:St1 . \n"+ , "pers:Ma2 rel:husband pers:Pa2 . \n"+ , "pers:Ri2 rel:husband pers:Br2 . \n"+ , "pers:Ma3 rel:husband pers:Gr3 . \n"+ , "pers:Jo3 rel:husband pers:Si3 . \n"+ , "pers:Su3 rel:husband pers:Al3 . \n"+ ]+ +result21b :: RDFGraph+result21b = mkGr2 + [ "pers:Do1 rel:husband pers:St1 . \n"+ , "pers:Ma2 rel:husband pers:Pa2 . \n"+ ]++bwd21a :: RDFGraph+bwd21a = mkGr2 + [ "pers:St1 rel:wife pers:Do1 . \n"+ , "pers:Pa2 rel:wife pers:Ma2 . \n"+ ]+ +rul21 :: RDFRule+rul21 = makeN3ClosureSimpleRule scope2 "rul21" query21str result21str++fwd21 :: [RDFGraph]+fwd21 = fwdApply rul21 [graph2]++bwd21 :: [[RDFGraph]]+bwd21 = bwdApply rul21 result21b++query22 :: RDFGraph+query22 = makeRDFGraphFromN3Builder query22str++query22str :: B.Builder+query22str = + mconcat+ [ prefix2+ , "?a rel:son ?b . \n"+ , "?b rel:son ?c . \n"+ ]+ +result22 :: RDFGraph+result22 = makeRDFGraphFromN3Builder result22str++result22str :: B.Builder+result22str = prefix2 `mappend` "?a rel:grandparent ?c . \n"++result22a :: RDFGraph+result22a = mkGr2 + [ "pers:Pa2 rel:grandparent pers:Ro4 . \n"+ , "pers:Pa2 rel:grandparent pers:Ol4 . \n"+ , "pers:Pa2 rel:grandparent pers:Lo4 . \n"+ , "pers:Pa2 rel:grandparent pers:Ha4 . \n"+ , "pers:Pa2 rel:grandparent pers:El4 . \n"+ ]+ +result22b :: RDFGraph+result22b = mkGr2+ [ "pers:Pa2 rel:grandparent pers:Ro4 . \n"+ , "pers:Pa2 rel:grandparent pers:Ol4 . \n"+ ]+ +bwd22a :: RDFGraph+bwd22a = mkGr2+ [ "pers:Pa2 rel:son _:p1 . \n"+ , "_:p1 rel:son pers:Ro4 . \n"+ , "pers:Pa2 rel:son _:p2 . \n"+ , "_:p2 rel:son pers:Ol4 . \n"+ ]+ +rul22 :: RDFRule+rul22 = makeN3ClosureSimpleRule scope2 "rul22" query22str result22str++fwd22 :: [RDFGraph]+fwd22 = fwdApply rul22 [graph2]++bwd22 :: [[RDFGraph]]+bwd22 = bwdApply rul22 result22b++query23 :: RDFGraph+query23 = makeRDFGraphFromN3Builder query23str++query23str :: B.Builder+query23str = + mconcat + [ prefix2+ , "?a rel:son ?b . \n"+ , "?a rel:son ?c . \n"+ ]+ +result23 :: RDFGraph+result23 = makeRDFGraphFromN3Builder result23str++result23str :: B.Builder+result23str = prefix2 `mappend` "?b rel:brother ?c . \n"++result23a :: RDFGraph+result23a = mkGr2+ [ "pers:Gr3 rel:brother pers:Gr3 . \n"+ , "pers:Gr3 rel:brother pers:La3 . \n"+ , "pers:Gr3 rel:brother pers:Si3 . \n"+ , "pers:Gr3 rel:brother pers:Al3 . \n"+ , "pers:La3 rel:brother pers:Gr3 . \n"+ , "pers:La3 rel:brother pers:La3 . \n"+ , "pers:La3 rel:brother pers:Si3 . \n"+ , "pers:La3 rel:brother pers:Al3 . \n"+ , "pers:Si3 rel:brother pers:Gr3 . \n"+ , "pers:Si3 rel:brother pers:La3 . \n"+ , "pers:Si3 rel:brother pers:Si3 . \n"+ , "pers:Si3 rel:brother pers:Al3 . \n"+ , "pers:Al3 rel:brother pers:Gr3 . \n"+ , "pers:Al3 rel:brother pers:La3 . \n"+ , "pers:Al3 rel:brother pers:Si3 . \n"+ , "pers:Al3 rel:brother pers:Al3 . \n"+ , "pers:Wi3 rel:brother pers:Wi3 . \n"+ , "pers:Ro4 rel:brother pers:Ro4 . \n"+ , "pers:Ol4 rel:brother pers:Lo4 . \n"+ , "pers:Ol4 rel:brother pers:Ol4 . \n"+ , "pers:Lo4 rel:brother pers:Lo4 . \n"+ , "pers:Lo4 rel:brother pers:Ol4 . \n"+ , "pers:Ha4 rel:brother pers:El4 . \n"+ , "pers:Ha4 rel:brother pers:Ha4 . \n"+ , "pers:El4 rel:brother pers:El4 . \n"+ , "pers:El4 rel:brother pers:Ha4 . \n"+ ]+ +result23b :: RDFGraph+result23b = mkGr2+ [ "pers:Gr3 rel:brother pers:Gr3 . \n"+ , "pers:Gr3 rel:brother pers:La3 . \n"+ ]++bwd23a :: RDFGraph+bwd23a = mkGr2 + [ "_:a1 rel:son pers:Gr3 . \n"+ , "_:a1 rel:son pers:Gr3 . \n"+ , "_:a2 rel:son pers:Gr3 . \n"+ , "_:a2 rel:son pers:La3 . \n"+ ]+ +rul23 :: RDFRule+rul23 = makeN3ClosureSimpleRule scope2 "rul23" query23str result23str++fwd23 :: [RDFGraph]+fwd23 = fwdApply rul23 [graph2]++bwd23 :: [[RDFGraph]]+bwd23 = bwdApply rul23 result23b++-- Test case to return multiple alternative bindings+--+-- (?c on ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)+--+-- a stepBrother b if+-- (_:c1 son a, _:c1 stepSon b) || (_:c2 stepSon a, _:c2 son b)++graph24 :: RDFGraph+graph24 = mkGr2+ [ "pers:Ma2 rel:son pers:Gr3 . \n"+ , "pers:Ma2 rel:stepson pers:St3 . \n"+ ]+ +query24 :: RDFGraph+query24 = makeRDFGraphFromN3Builder query24str++query24str :: B.Builder+query24str = + mconcat+ [ prefix2+ , "?c rel:son ?a . \n"+ , "?c rel:stepson ?b . \n"+ ]+ +result24 :: RDFGraph+result24 = makeRDFGraphFromN3Builder result24str++result24str :: B.Builder+result24str = + mconcat+ [ prefix2 + , "?a rel:stepbrother ?b . \n"+ , "?b rel:stepbrother ?a . \n"+ ]+ +result24a :: RDFGraph+result24a = mkGr2+ [ "pers:Gr3 rel:stepbrother pers:St3 . \n"+ , "pers:St3 rel:stepbrother pers:Gr3 . \n"+ ]+ +bwd24a1 :: RDFGraph+bwd24a1 = mkGr2 + ["_:c1 rel:son pers:Gr3 . \n"+ , "_:c1 rel:stepson pers:St3 . \n"+ , "_:c2 rel:stepson pers:Gr3 . \n"+ , "_:c2 rel:son pers:St3 . \n"+ ]+ +bwd24a2 :: RDFGraph+bwd24a2 = mkGr2+ [ "_:c1 rel:son pers:Gr3 . \n"+ , "_:c1 rel:stepson pers:St3 . \n"+ ]+ +bwd24a3 :: RDFGraph+bwd24a3 = mkGr2 + [ "_:c2 rel:stepson pers:Gr3 . \n"+ , "_:c2 rel:son pers:St3 . \n"+ ]+ +bwd24a4 :: RDFGraph+bwd24a4 = mkGr2 + [ "_:c1 rel:son pers:Gr3 . \n" + , "_:c1 rel:stepson pers:St3 . \n"+ , "_:c2 rel:stepson pers:Gr3 . \n"+ , "_:c2 rel:son pers:St3 . \n"+ ]+ +rul24 :: RDFRule+rul24 = makeN3ClosureSimpleRule scope2 "rul24" query24str result24str++fwd24 :: [RDFGraph]+fwd24 = fwdApply rul24 [graph24]++bwd24 :: [[RDFGraph]]+bwd24 = bwdApply rul24 result24a++-- bwd chain from partial conclusion+-- Also, fail because conclusion is more than the rule+-- can derive from any input.++query25 :: RDFGraph+query25 = makeRDFGraphFromN3Builder query25str++query25str :: B.Builder+query25str = + mconcat+ [ prefix2+ , "?a rel:son ?b . \n"+ , "?a rel:daughter ?c . \n"+ ]++result25 :: RDFGraph+result25 = makeRDFGraphFromN3Builder result25str++result25str :: B.Builder+result25str = + mconcat+ [ prefix2+ , "?b rel:sister ?c . \n"+ , "?c rel:brother ?b . \n"+ ]+ +result25a :: RDFGraph+result25a = mkGr2+ [ "pers:Wi3 rel:sister pers:Ma3 . \n"+ , "pers:Ma3 rel:brother pers:Wi3 . \n"+ , "pers:Ro4 rel:sister pers:Rh4 . \n"+ , "pers:Rh4 rel:brother pers:Ro4 . \n"+ ]++{-+result25b = makeRDFGraphFromN3Builder result25bstr+result25bstr = prefix2 +++ "pers:Ro4 rel:sister pers:Rh4 . \n" +++ "pers:Rh4 rel:brother pers:Ro4 . \n"+-}++result25c :: RDFGraph+result25c = mkGr2+ [ "pers:Wi3 rel:sister pers:Ma3 . \n"+ , "pers:Ma3 rel:brother pers:Wi3 . \n"+ , "pers:Ro4 rel:sister pers:Rh4 . \n"+ , "pers:Rh4 rel:brother pers:Ro4 . \n"+ , "pers:xx3 rel:mother pers:yy3 . \n"+ , "pers:yy3 rel:brother pers:xx3 . \n"+ ]+ +result25d :: RDFGraph+result25d = mkGr2 + [ "pers:Wi3 rel:sister pers:Ma3 . \n"+ , "pers:Ma3 rel:brother pers:Wi3 . \n"+ , "pers:Ro4 rel:sister pers:Rh4 . \n"+ , "pers:Rh4 rel:brother pers:Ro4 . \n"+ , "pers:xx3 rel:father pers:yy3 . \n"+ ]+ +conc25 :: RDFGraph+conc25 = mkGr2+ [ "pers:Wi3 rel:sister pers:Ma3 . \n"+ , "pers:Rh4 rel:brother pers:Ro4 . \n"+ ]+ +bwd25a :: RDFGraph+bwd25a = mkGr2+ [ "_:a1 rel:son pers:Wi3 . \n"+ , "_:a1 rel:daughter pers:Ma3 . \n"+ , "_:a2 rel:son pers:Ro4 . \n"+ , "_:a2 rel:daughter pers:Rh4 . \n"+ ]+ +rul25 :: RDFRule+rul25 = makeN3ClosureSimpleRule scope2 "rul25" query25str result25str++fwd25 :: [RDFGraph]+fwd25 = fwdApply rul25 [graph2]++bwd25, bwd25c, bwd25d :: [[RDFGraph]]+bwd25 = bwdApply rul25 conc25+bwd25c = bwdApply rul25 result25c+bwd25d = bwdApply rul25 result25d++test2 :: Test+test2 = + TestList+ [ testEq "testResult21" 1 (length fwd21)+ , testIn "testResult21a" result21a fwd21+ , testEq "testBwd21" 1 (length $ head bwd21)+ , testIn "testBwd21a" bwd21a (head bwd21)+ , testEq "testResult22" 1 (length fwd22)+ , testIn "testResult22a" result22a fwd22+ , testEq "testBwd22" 1 (length $ head bwd22)+ , testIn "testBwd22a" bwd22a (head bwd22)+ , testEq "testResult23" 1 (length fwd23)+ , testIn "testResult23a" result23a fwd23+ , testEq "testBwd23" 1 (length $ head bwd23)+ , testIn "testBwd23a" bwd23a (head bwd23)+ , testEq "testResult24" 1 (length fwd24)+ , testIn "testResult24a" result24a fwd24+ , testEq "testBwd24" 4 (length bwd24)+ , testIn "testBwd24a1" bwd24a1 (head bwd24)+ , testIn "testBwd24a2" bwd24a2 (bwd24!!1)+ , testIn "testBwd24a3" bwd24a3 (bwd24!!2)+ , testIn "testBwd24a4" bwd24a4 (bwd24!!3)+ , testEq "testResult25" 1 (length fwd25)+ , testIn "testResult25a" result25a fwd25+ , testEq "testBwd25" 1 (length $ head bwd25)+ , testIn "testBwd25a" bwd25a (head bwd25)+ -- testBwd25a1 = testEq "testBwd25a" bwd25a (head $ head bwd25)+ , testNo "testBwd25c" bwd25c+ , testNo "testBwd25d" bwd25d+ ]++-- test3: check variable binding filters++scope3 :: Namespace+scope3 = toNS (Just "scope3")+ "http://id.ninebynine.org/wip/2003/rdfprooftest/scope3"++query31 :: RDFGraph+query31 = makeRDFGraphFromN3Builder query31str++query31str :: B.Builder+query31str = + mconcat+ [ prefix2+ , "?a rel:son ?b . \n"+ , "?a rel:son ?c . \n"+ ]+ +modify31 :: RDFVarBindingModify+modify31 = makeVarFilterModify $ varFilterNE (Var "b") (Var "c")++result31 :: RDFGraph+result31 = makeRDFGraphFromN3Builder result31str++result31str :: B.Builder+result31str = prefix2 `mappend` "?b rel:brother ?c . \n"++result31a :: RDFGraph+result31a = mkGr2+ [ "pers:Gr3 rel:brother pers:La3 . \n"+ , "pers:Gr3 rel:brother pers:Si3 . \n"+ , "pers:Gr3 rel:brother pers:Al3 . \n"+ , "pers:La3 rel:brother pers:Gr3 . \n"+ , "pers:La3 rel:brother pers:Si3 . \n"+ , "pers:La3 rel:brother pers:Al3 . \n"+ , "pers:Si3 rel:brother pers:Gr3 . \n"+ , "pers:Si3 rel:brother pers:La3 . \n"+ , "pers:Si3 rel:brother pers:Al3 . \n"+ , "pers:Al3 rel:brother pers:Gr3 . \n"+ , "pers:Al3 rel:brother pers:La3 . \n"+ , "pers:Al3 rel:brother pers:Si3 . \n"+ , "pers:Ol4 rel:brother pers:Lo4 . \n"+ , "pers:Lo4 rel:brother pers:Ol4 . \n"+ , "pers:Ha4 rel:brother pers:El4 . \n"+ , "pers:El4 rel:brother pers:Ha4 . \n"+ ]+ +result31b :: RDFGraph+result31b = mkGr2 ["pers:Gr3 rel:brother pers:Gr3 . \n"]++result31c :: RDFGraph+result31c = mkGr2 ["pers:Gr3 rel:brother pers:La3 . \n"]++bwd31c :: RDFGraph+bwd31c = mkGr2 + [ "_:a rel:son pers:Gr3 . \n"+ , "_:a rel:son pers:La3 . \n"+ ]+ +rul31 :: RDFRule+rul31 = makeN3ClosureRule scope3 "rul31" query31str result31str modify31++fwd31 :: [RDFGraph]+fwd31 = fwdApply rul31 [graph2]++calcbwd31b, calcbwd31c :: [[RDFGraph]]+calcbwd31b = bwdApply rul31 result31b+calcbwd31c = bwdApply rul31 result31c++test3 :: Test+test3 = + TestList+ [ testEq "testResult31" 1 (length fwd31)+ , testIn "testResult31a" result31a fwd31+ , testEq "testBwd31" 0 (length calcbwd31b)+ , testEq "testBwd31" 1 (length $ head calcbwd31c)+ , testIn "testBwd31c" bwd31c (head calcbwd31c)+ ]++-- Instance entailment tests++scope4 :: Namespace+scope4 = toNS (Just "scope4")+ "http://id.ninebynine.org/wip/2003/rdfprooftest/scope4"++graph4 :: RDFGraph+graph4 = mkGr2+ [ "pers:Gr3 rel:son pers:Ro4 ; \n"+ , " rel:daughter pers:Rh4 . \n"+ ]+ +vocab4 :: [RDFLabel]+vocab4 = allNodes (not . labelIsVar) graph4++name4 :: ScopedName+name4 = ScopedName scope4 "instance4"++rule4 :: RDFRule+rule4 = makeRdfInstanceEntailmentRule name4 vocab4++fwd42a :: RDFGraph+fwd42a = mkGr2 + [ "pers:Gr3 rel:son _:Ro4 ; \n"+ , " rel:daughter pers:Rh4 . \n"+ ]+ +fwd42b :: RDFGraph+fwd42b = mkGr2 + [ "pers:Gr3 rel:son pers:Ro4 ; \n"+ , " rel:daughter _:Rh4 . \n"+ ]+ +fwd42c :: RDFGraph+fwd42c = mkGr2+ [ "pers:Gr3 rel:son _:Ro4 ; \n"+ , " rel:daughter _:Rh4 . \n"+ ]+ +fwd42d :: RDFGraph+fwd42d = mkGr2+ [ "_:Gr3 rel:son _:Ro4 ; \n"+ , " rel:daughter pers:Rh4 . \n"+ ]++fwd42e :: RDFGraph+fwd42e = mkGr2 + [ "_:Gr3 rel:son _:Ro4 ; \n"+ , " rel:daughter pers:Rh4 . \n"+ ]++fwd42f :: RDFGraph+fwd42f = mkGr2 + [ "_:Gr3 rel:son pers:Ro4 ; \n"+ , " rel:daughter _:Rh4 . \n"+ ]+ +fwd42g :: RDFGraph+fwd42g = mkGr2+ [ "_:Gr3 rel:son _:Ro4 ; \n"+ , " rel:daughter _:Rh4 . \n"+ ]++-- Non-entailments++fwd42w :: RDFGraph+fwd42w = mkGr2 ["pers:Gr3 rel:daughter pers:Ro4 . \n"]++fwd42x :: RDFGraph+fwd42x = mkGr2 ["pers:Gr3 rel:daughter pers:Ro4 . \n"]++fwd42y :: RDFGraph+fwd42y = mkGr2 + [ "_:Gr3 rel:son pers:Ro4 ; \n"+ , " rel:daughter pers:Ro4 . \n"+ ]+ +fwd42z :: RDFGraph+fwd42z = mkGr2 + [ "_:Gr3 rel:son _:Ro4 ; \n"+ , " rel:son _:Rh4 . \n"+ ]+ +bwd43 :: RDFGraph+bwd43 = mkGr2+ [ "_:a1 rel:son pers:Ro4 . \n"+ , "_:a2 rel:daughter pers:Rh4 . \n"+ ]++bwd43a :: RDFGraph+bwd43a = mkGr2 + [ "pers:Gr3 rel:son pers:Ro4 . \n"+ , "pers:Gr3 rel:daughter pers:Rh4 . \n"+ ]++bwd43b :: RDFGraph+bwd43b = mkGr2+ [ "pers:Gr3 rel:son pers:Ro4 . \n"+ , "pers:Ro4 rel:daughter pers:Rh4 . \n"+ ]+ +bwd43c :: RDFGraph+bwd43c = mkGr2+ [ "pers:Gr3 rel:son pers:Ro4 . \n"+ , "pers:Rh4 rel:daughter pers:Rh4 . \n"+ ]+ +bwd43d :: RDFGraph+bwd43d = mkGr2+ [ "pers:Ro4 rel:son pers:Ro4 . \n"+ , "pers:Gr3 rel:daughter pers:Rh4 . \n"+ ]+ +bwd43e :: RDFGraph+bwd43e = mkGr2 + [ "pers:Ro4 rel:son pers:Ro4 . \n"+ , "pers:Ro4 rel:daughter pers:Rh4 . \n"+ ]+ +bwd43f :: RDFGraph+bwd43f = mkGr2+ [ "pers:Ro4 rel:son pers:Ro4 . \n"+ , "pers:Rh4 rel:daughter pers:Rh4 . \n"+ ]+ +bwd43g :: RDFGraph+bwd43g = mkGr2+ [ "pers:Rh4 rel:son pers:Ro4 . \n"+ , "pers:Gr3 rel:daughter pers:Rh4 . \n"+ ]+ +bwd43h :: RDFGraph+bwd43h = mkGr2+ [ "pers:Rh4 rel:son pers:Ro4 . \n"+ , "pers:Ro4 rel:daughter pers:Rh4 . \n"+ ]+ +bwd43i :: RDFGraph+bwd43i = mkGr2+ [ "pers:Rh4 rel:son pers:Ro4 . \n"+ , "pers:Rh4 rel:daughter pers:Rh4 . \n"+ ]+ +-- Forward chaining++fwdApply42 :: [RDFGraph]+fwdApply42 = fwdApply rule4 [graph4]++-- Backward chaining++bwdApply43 :: [[RDFGraph]]+bwdApply43 = bwdApply rule4 bwd43++test4 :: Test+test4 = + TestList+ [ + -- Check basics+ testEq "testRuleName41" name4 (ruleName rule4)+ , testEq "testVocab41" 3 (length vocab4)+ , testEq "testFwdLength42" 7 (length fwdApply42)+ , testIn "testFwdApply42a" fwd42a fwdApply42+ , testIn "testFwdApply42b" fwd42b fwdApply42+ , testIn "testFwdApply42c" fwd42c fwdApply42+ , testIn "testFwdApply42d" fwd42d fwdApply42+ , testIn "testFwdApply42e" fwd42e fwdApply42+ , testIn "testFwdApply42f" fwd42f fwdApply42+ , testIn "testFwdApply42g" fwd42g fwdApply42+ , testEq "testBwdLength43" 9 (length bwdApply43)+ , testIn "testBwdApply43a" [bwd43a] bwdApply43+ , testIn "testBwdApply43b" [bwd43b] bwdApply43+ , testIn "testBwdApply43c" [bwd43c] bwdApply43+ , testIn "testBwdApply43d" [bwd43d] bwdApply43+ , testIn "testBwdApply43e" [bwd43e] bwdApply43+ , testIn "testBwdApply43f" [bwd43f] bwdApply43+ , testIn "testBwdApply43g" [bwd43g] bwdApply43+ , testIn "testBwdApply43h" [bwd43h] bwdApply43+ , testIn "testBwdApply43i" [bwd43i] bwdApply43+ + -- Entailment checks+ , testEq "testEntail44a" True (checkInference rule4 [graph4] fwd42a)+ , testEq "testEntail44b" True (checkInference rule4 [graph4] fwd42b)+ , testEq "testEntail44g" True (checkInference rule4 [graph4] fwd42g)+ , testEq "testEntail44w" False (checkInference rule4 [graph4] fwd42w)+ , testEq "testEntail44x" False (checkInference rule4 [graph4] fwd42x)+ , testEq "testEntail44y" False (checkInference rule4 [graph4] fwd42y)+ , testEq "testEntail44z" False (checkInference rule4 [graph4] fwd42z)+ ]++-- Subgraph entailment tests++scope5 :: Namespace+scope5 = toNS (Just "scope5")+ "http://id.ninebynine.org/wip/2003/rdfprooftest/scope5"++graph5 :: RDFGraph+graph5 = mkGr2+ [ "pers:Gr3 rel:son pers:Ro4 ; \n"+ , " rel:daughter pers:Rh4 . \n"+ , "pers:Si3 rel:son pers:Ol4 . \n"+ ]++name5 :: ScopedName+name5 = ScopedName scope5 "subgraph5"++rule5 :: RDFRule+rule5 = makeRdfSubgraphEntailmentRule name5++-- Forward chaining excludes null agraph and copy of antecedent++fwd52a :: RDFGraph+fwd52a = mkGr2 ["pers:Gr3 rel:son pers:Ro4 . \n"]++fwd52b :: RDFGraph+fwd52b = mkGr2 ["pers:Gr3 rel:daughter pers:Rh4 . \n"]++fwd52c :: RDFGraph+fwd52c = mkGr2 ["pers:Si3 rel:son pers:Ol4 . \n"]++fwd52d :: RDFGraph+fwd52d = mkGr2+ [ "pers:Gr3 rel:son pers:Ro4 . \n"+ , "pers:Gr3 rel:daughter pers:Rh4 . \n"+ ]++fwd52e :: RDFGraph+fwd52e = mkGr2+ [ "pers:Gr3 rel:son pers:Ro4 . \n"+ , "pers:Si3 rel:son pers:Ol4 . \n"+ ]+ +fwd52f :: RDFGraph+fwd52f = mkGr2+ [ "pers:Gr3 rel:daughter pers:Rh4 . \n"+ , "pers:Si3 rel:son pers:Ol4 . \n"+ ]++-- Forward chaining++fwdApply52 :: [RDFGraph]+fwdApply52 = fwdApply rule5 [graph5]++test5 :: Test+test5 = + TestList+ [ testEq "testRuleName51" name5 (ruleName rule5)+ , testEq "testFwdLength52" 6 (length fwdApply52)+ , testIn "testFwdApply52a" fwd52a fwdApply52+ , testIn "testFwdApply52b" fwd52b fwdApply52+ , testIn "testFwdApply52c" fwd52c fwdApply52+ , testIn "testFwdApply52d" fwd52d fwdApply52+ , testIn "testFwdApply52e" fwd52e fwdApply52+ , testIn "testFwdApply52f" fwd52f fwdApply52+ ]++-- Simple entailment test+-- Simple entailment provides entailment check only, no forward or+-- backward chaining. For that use instance- and subgraph- rules.++scope6 :: Namespace+scope6 = toNS (Just "scope6")+ "http://id.ninebynine.org/wip/2003/rdfprooftest/scope6"++graph6 :: RDFGraph+graph6 = mkGr2+ [ "pers:Gr3 rel:son pers:Ro4 ; \n"+ , " rel:daughter pers:Rh4 . \n"+ , "pers:Si3 rel:son pers:Ol4 ; \n"+ , " rel:son pers:Lo4 . \n"+ ]++name6 :: ScopedName+name6 = ScopedName scope5 "subgraph6"++rule6 :: RDFRule+rule6 = makeRdfSimpleEntailmentRule name6++simple6a :: RDFGraph+simple6a = mkGr2 + [ "_:Gr3 rel:son pers:Ro4 ; \n"+ , " rel:daughter pers:Rh4 . \n"+ ]++simple6b :: RDFGraph+simple6b = mkGr2+ [ "_:Si3 rel:son pers:Ol4 ; \n"+ , " rel:son pers:Lo4 . \n"+ ]+ +simple6c :: RDFGraph+simple6c = mkGr2+ [ "_:Si3 rel:son _:Ol4 ; \n"+ , " rel:son _:Lo4 . \n"+ ]+ +simple6d :: RDFGraph+simple6d = mkGr2+ [ "_:Si3 rel:son _:Ol4 ; \n"+ , " rel:daughter _:Lo4 . \n"+ ]+ +simple6e :: RDFGraph+simple6e = mkGr2+ [ "_:Si3 rel:daughter _:Ol4 ; \n"+ , " rel:mother _:Lo4 . \n"+ ]++test6 :: Test+test6 = + TestList+ [ testEq "testRuleName61" name6 (ruleName rule6)+ , test "testSimple62" (checkInference rule6 [graph6] simple6a)+ , test "testSimple63" (checkInference rule6 [graph6] simple6b)+ , test "testSimple64" (checkInference rule6 [graph6] simple6c)+ , test "testSimple65" (checkInference rule6 [graph6] simple6d)+ , test "testSimple66" (not $ checkInference rule6 [graph6] simple6e)+ , test "testFwd64" (null $ fwdApply rule6 [graph6])+ , test "testBwd65" (null $ bwdApply rule6 graph6)+ ]++-- Test forward chaining node allocation logic+--+-- ?a uncle ?c => ?a father ?b, ?b brother ?c, ?b allocTo ?a+--+-- Ro4 uncle La3, Ro4 uncle Si3, Rh4 uncle La3, Rh4 uncle Si3+-- =>+-- Ro4 father _:f1, _:f1 brother La3,+-- Ro4 father _:f1, _:f1 brother Si3,+-- Rh4 father _:f2, _:f2 brother La3,+-- Rh4 father _:f2, _:f2 brother Si3++scope7 :: Namespace+scope7 = toNS (Just "scope7")+ "http://id.ninebynine.org/wip/2003/rdfprooftest/scope7"++graph7 :: RDFGraph+graph7 = mkGr2+ [ "pers:Ro4 rel:uncle pers:La3 ; \n"+ , " rel:uncle pers:Si3 . \n"+ , "pers:Rh4 rel:uncle pers:La3 ; \n"+ , " rel:uncle pers:Si3 . \n"+ ]++query71str, result71str :: B.Builder+query71str = prefix2 `mappend` "?a rel:uncle ?c . \n"+result71str =+ mconcat + [ prefix2+ , "?a rel:father ?b . \n"+ , "?b rel:brother ?c . \n"+ ]+ +query71, result71 :: RDFGraph+query71 = makeRDFGraphFromN3Builder query71str+result71 = makeRDFGraphFromN3Builder result71str++result71a :: RDFGraph+result71a = mkGr2 + [ "pers:Ro4 rel:father _:f1 . \n"+ , "_:f1 rel:brother pers:La3 . \n"+ , "pers:Ro4 rel:father _:f1 . \n"+ , "_:f1 rel:brother pers:Si3 . \n"+ , "pers:Rh4 rel:father _:f2 . \n"+ , "_:f2 rel:brother pers:La3 . \n"+ , "pers:Rh4 rel:father _:f2 . \n"+ , "_:f2 rel:brother pers:Si3 . \n"+ ]+ +rul71 :: RDFRule+rul71 = makeN3ClosureAllocatorRule scope7 "rul71"+ query71str result71str varBindingId mod71++mod71 :: [RDFLabel] -> RDFVarBindingModify+mod71 = makeNodeAllocTo (Var "b") (Var "a")++var71 :: [RDFVarBinding]+var71 = rdfQueryFind query71 graph7++var71a :: [VarBinding RDFLabel RDFLabel]+var71a = vbmApply (mod71 (allLabels labelIsVar graph7)) var71++var71_1 :: VarBinding RDFLabel RDFLabel+var71_1 = head var71a++map71a, map71b, map71c :: Maybe RDFLabel+map71a = Just (Var "#a")+map71b = Just (Var "#b")+map71c = Just (Var "#c")++sub71a :: [RDFGraph]+sub71a = rdfQuerySubs var71a result71 fwd71 :: [RDFGraph] fwd71 = fwdApply rul71 [graph7]
tests/RDFQueryTest.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module defines test cases for querying an RDF graph to obtain -- a set of variable substitutions, and to apply a set of variable@@ -40,11 +42,7 @@ , rdfVarBindingMemberProp ) -import Swish.RDF.RDFGraph- ( RDFGraph, RDFLabel(..)- , merge- )-+import Swish.RDF.RDFGraph (RDFGraph, RDFLabel(..), merge) import Swish.RDF.VarBinding ( VarBinding(..) , makeVarBinding@@ -55,21 +53,9 @@ , varFilterNE ) -import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..)- , makeScopedName- )--import Swish.RDF.Vocabulary- ( namespaceRDF- , langName- , swishName- , rdf_type, rdf_XMLLiteral- )--import Swish.RDF.N3Parser (parseN3fromString)-+import Swish.Utils.Namespace (Namespace(..), ScopedName(..), makeScopedName)+import Swish.RDF.Vocabulary (namespaceRDF, langName, swishName, rdfType, rdfXMLLiteral)+import Swish.RDF.N3Parser (parseN3) import Swish.Utils.ListHelpers (equiv) import Test.HUnit@@ -77,6 +63,13 @@ , assertBool, assertEqual , runTestTT ) +import qualified Data.Text.Lazy.Builder as B++import Network.URI (URI, parseURI)++import Data.Monoid (Monoid(..))+import Data.Maybe (fromJust)+ ------------------------------------------------------------ -- misc helpers ------------------------------------------------------------@@ -95,15 +88,17 @@ testLs :: (Eq a, Show a) => String -> [a] -> [a] -> Test testLs lab e a = TestCase $ assertEqual lab (Set e) (Set a) -testGr :: String -> String -> [RDFGraph] -> Test+testGr :: String -> B.Builder -> [RDFGraph] -> Test testGr lab e a = TestCase $ assertBool lab (eg `elem` a)- where eg = graphFromString e+ where eg = graphFromBuilder mempty e -graphFromString :: String -> RDFGraph-graphFromString str = case parseN3fromString str of+graphFromBuilder :: B.Builder -> B.Builder -> RDFGraph+graphFromBuilder prefix body = + let txt = B.toLazyText $ prefix `mappend` body+ in case parseN3 txt Nothing of Right gr -> gr Left msg -> error msg-+ -- Compare lists for set equivalence: data ListTest a = ListTest [a]@@ -122,30 +117,30 @@ -- test1: simple query qith URI, literal and blank nodes. ------------------------------------------------------------ -prefix1 :: String-prefix1 =- "@prefix ex: <http://example.org/> . \n" ++- " \n"+prefix1 :: B.Builder+prefix1 = "@prefix ex: <http://example.org/> . \n" +gr1 :: B.Builder -> RDFGraph+gr1 = graphFromBuilder prefix1+ graph1 :: RDFGraph-graph1 = graphFromString $ prefix1 ++- "ex:s1 ex:p ex:o1 . \n" ++- "ex:s2 ex:p \"lit1\" . \n" ++- "[ ex:p ex:o3 ] . \n"+graph1 = gr1 $+ mconcat+ [ "ex:s1 ex:p ex:o1 . \n"+ , "ex:s2 ex:p \"lit1\" . \n"+ , "[ ex:p ex:o3 ] . \n" ] query11 :: RDFGraph-query11 = graphFromString $ prefix1 ++- "?s ex:p ?o . \n"+query11 = gr1 "?s ex:p ?o . \n" result11 :: RDFGraph-result11 = graphFromString $ prefix1 ++- "?s ex:r ?o . \n"+result11 = gr1 "?s ex:r ?o . \n" -result11a, result11b, result11c :: String+result11a, result11b, result11c :: B.Builder -result11a = prefix1 ++ "ex:s1 ex:r ex:o1 . \n"-result11b = prefix1 ++ "ex:s2 ex:r \"lit1\" . \n"-result11c = prefix1 ++ "[ ex:r ex:o3 ] . \n"+result11a = prefix1 `mappend` "ex:s1 ex:r ex:o1 . \n"+result11b = prefix1 `mappend` "ex:s2 ex:r \"lit1\" . \n"+result11c = prefix1 `mappend` "[ ex:r ex:o3 ] . \n" var11 :: [RDFVarBinding] var11 = rdfQueryFind query11 graph1@@ -168,102 +163,99 @@ -- single relationship graph. ------------------------------------------------------------ -prefix2 :: String+prefix2 :: B.Builder prefix2 =- "@prefix pers: <urn:pers:> . \n" ++- "@prefix rel: <urn:rel:> . \n" ++- " \n"+ "@prefix pers: <urn:pers:> . \n" `mappend`+ "@prefix rel: <urn:rel:> . \n" +gr2 :: B.Builder -> RDFGraph+gr2 = graphFromBuilder prefix2+ graph2 :: RDFGraph-graph2 = graphFromString $ prefix2 ++- "pers:St1 rel:wife pers:Do1 ; \n" ++- " rel:daughter pers:Ma2 ; \n" ++- " rel:daughter pers:An2 . \n" ++- "pers:Pa2 rel:wife pers:Ma2 ; \n" ++- " rel:son pers:Gr3 ; \n" ++- " rel:son pers:La3 ; \n" ++- " rel:son pers:Si3 ; \n" ++- " rel:son pers:Al3 . \n" ++- "pers:Br2 rel:wife pers:Ri2 ; \n" ++- " rel:daughter pers:Ma3 ; \n" ++- " rel:son pers:Wi3 . \n" ++- "pers:Gr3 rel:wife pers:Ma3 ; \n" ++- " rel:son pers:Ro4 ; \n" ++- " rel:daughter pers:Rh4 . \n" ++- "pers:Si3 rel:wife pers:Jo3 ; \n" ++- " rel:son pers:Ol4 ; \n" ++- " rel:son pers:Lo4 . \n" ++- "pers:Al3 rel:wife pers:Su3 ; \n" ++- " rel:son pers:Ha4 ; \n" ++- " rel:son pers:El4 . \n"+graph2 = gr2 $+ mconcat+ [ "pers:St1 rel:wife pers:Do1 ; \n"+ , " rel:daughter pers:Ma2 ; \n"+ , " rel:daughter pers:An2 . \n"+ , "pers:Pa2 rel:wife pers:Ma2 ; \n"+ , " rel:son pers:Gr3 ; \n"+ , " rel:son pers:La3 ; \n"+ , " rel:son pers:Si3 ; \n"+ , " rel:son pers:Al3 . \n"+ , "pers:Br2 rel:wife pers:Ri2 ; \n"+ , " rel:daughter pers:Ma3 ; \n"+ , " rel:son pers:Wi3 . \n"+ , "pers:Gr3 rel:wife pers:Ma3 ; \n"+ , " rel:son pers:Ro4 ; \n"+ , " rel:daughter pers:Rh4 . \n"+ , "pers:Si3 rel:wife pers:Jo3 ; \n"+ , " rel:son pers:Ol4 ; \n"+ , " rel:son pers:Lo4 . \n"+ , "pers:Al3 rel:wife pers:Su3 ; \n"+ , " rel:son pers:Ha4 ; \n"+ , " rel:son pers:El4 . \n"+ ] query21 :: RDFGraph-query21 = graphFromString $ prefix2 ++- "?a rel:wife ?b . \n"+query21 = gr2 "?a rel:wife ?b . \n" result21 :: RDFGraph-result21 = graphFromString $ prefix2 ++- "?b rel:husband ?a . \n"+result21 = gr2 "?b rel:husband ?a . \n" result21a, result21b, result21c, result21d,- result21e, result21f :: String+ result21e, result21f :: B.Builder -result21a = prefix2 ++ "pers:Do1 rel:husband pers:St1 . \n"-result21b = prefix2 ++ "pers:Ma2 rel:husband pers:Pa2 . \n"-result21c = prefix2 ++ "pers:Ri2 rel:husband pers:Br2 . \n"-result21d = prefix2 ++ "pers:Ma3 rel:husband pers:Gr3 . \n"-result21e = prefix2 ++ "pers:Jo3 rel:husband pers:Si3 . \n"-result21f = prefix2 ++ "pers:Su3 rel:husband pers:Al3 . \n"+result21a = prefix2 `mappend` "pers:Do1 rel:husband pers:St1 . \n"+result21b = prefix2 `mappend` "pers:Ma2 rel:husband pers:Pa2 . \n"+result21c = prefix2 `mappend` "pers:Ri2 rel:husband pers:Br2 . \n"+result21d = prefix2 `mappend` "pers:Ma3 rel:husband pers:Gr3 . \n"+result21e = prefix2 `mappend` "pers:Jo3 rel:husband pers:Si3 . \n"+result21f = prefix2 `mappend` "pers:Su3 rel:husband pers:Al3 . \n" var21 :: [RDFVarBinding]-var21 = rdfQueryFind query21 graph2+var21 = rdfQueryFind query21 graph2 res21 :: [RDFGraph]-res21 = rdfQuerySubs var21 result21+res21 = rdfQuerySubs var21 result21 query22 :: RDFGraph-query22 = graphFromString $ prefix2 ++- "?a rel:son ?b . \n" ++- "?b rel:son ?c . \n"+query22 = gr2 $+ "?a rel:son ?b . \n" `mappend`+ "?b rel:son ?c . \n" result22 :: RDFGraph-result22 = graphFromString $ prefix2 ++- "?a rel:grandparent ?c . \n"+result22 = gr2 "?a rel:grandparent ?c . \n" -result22a :: String-result22a = prefix2 +++result22a, result22b, result22c, result22d, result22e :: B.Builder++result22a = prefix2 `mappend` "pers:Pa2 rel:grandparent pers:Ro4 . \n" -result22b :: String-result22b = prefix2 +++result22b = prefix2 `mappend` "pers:Pa2 rel:grandparent pers:Ol4 . \n" -result22c :: String-result22c = prefix2 +++result22c = prefix2 `mappend` "pers:Pa2 rel:grandparent pers:Lo4 . \n" -result22d :: String-result22d = prefix2 +++result22d = prefix2 `mappend` "pers:Pa2 rel:grandparent pers:Ha4 . \n" -result22e :: String-result22e = prefix2 +++result22e = prefix2 `mappend` "pers:Pa2 rel:grandparent pers:El4 . \n" var22 :: [RDFVarBinding]-var22 = rdfQueryFind query22 graph2+var22 = rdfQueryFind query22 graph2 res22 :: [RDFGraph]-res22 = rdfQuerySubs var22 result22+res22 = rdfQuerySubs var22 result22 query23 :: RDFGraph-query23 = graphFromString $ prefix2 ++- "?a rel:son ?b . \n" +++query23 = gr2 $+ "?a rel:son ?b . \n" `mappend` "?a rel:son ?c . \n" result23 :: RDFGraph-result23 = graphFromString $ prefix2 ++- "?b rel:brother ?c . \n"+result23 = gr2 "?b rel:brother ?c . \n" result23a, result23b, result23c, result23d, result23e, result23f, result23g, result23h,@@ -271,84 +263,84 @@ result23m, result23n, result23o, result23p, result23q, result23r, result23s, result23t, result23u, result23v, result23w, result23x,- result23y, result23z :: String+ result23y, result23z :: B.Builder -result23a = prefix2 +++result23a = prefix2 `mappend` "pers:Gr3 rel:brother pers:Gr3 . \n" -result23b = prefix2 +++result23b = prefix2 `mappend` "pers:Gr3 rel:brother pers:La3 . \n" -result23c = prefix2 +++result23c = prefix2 `mappend` "pers:Gr3 rel:brother pers:Si3 . \n" -result23d = prefix2 +++result23d = prefix2 `mappend` "pers:Gr3 rel:brother pers:Al3 . \n" -result23e = prefix2 +++result23e = prefix2 `mappend` "pers:La3 rel:brother pers:Gr3 . \n" -result23f = prefix2 +++result23f = prefix2 `mappend` "pers:La3 rel:brother pers:La3 . \n" -result23g = prefix2 +++result23g = prefix2 `mappend` "pers:La3 rel:brother pers:Si3 . \n" -result23h = prefix2 +++result23h = prefix2 `mappend` "pers:La3 rel:brother pers:Al3 . \n" -result23i = prefix2 +++result23i = prefix2 `mappend` "pers:Si3 rel:brother pers:Gr3 . \n" -result23j = prefix2 +++result23j = prefix2 `mappend` "pers:Si3 rel:brother pers:La3 . \n" -result23k = prefix2 +++result23k = prefix2 `mappend` "pers:Si3 rel:brother pers:Si3 . \n" -result23l = prefix2 +++result23l = prefix2 `mappend` "pers:Si3 rel:brother pers:Al3 . \n" -result23m = prefix2 +++result23m = prefix2 `mappend` "pers:Al3 rel:brother pers:Gr3 . \n" -result23n = prefix2 +++result23n = prefix2 `mappend` "pers:Al3 rel:brother pers:La3 . \n" -result23o = prefix2 +++result23o = prefix2 `mappend` "pers:Al3 rel:brother pers:Si3 . \n" -result23p = prefix2 +++result23p = prefix2 `mappend` "pers:Al3 rel:brother pers:Al3 . \n" -result23q = prefix2 +++result23q = prefix2 `mappend` "pers:Wi3 rel:brother pers:Wi3 . \n" -result23r = prefix2 +++result23r = prefix2 `mappend` "pers:Ro4 rel:brother pers:Ro4 . \n" -result23s = prefix2 +++result23s = prefix2 `mappend` "pers:Ol4 rel:brother pers:Lo4 . \n" -result23t = prefix2 +++result23t = prefix2 `mappend` "pers:Ol4 rel:brother pers:Ol4 . \n" -result23u = prefix2 +++result23u = prefix2 `mappend` "pers:Lo4 rel:brother pers:Lo4 . \n" -result23v = prefix2 +++result23v = prefix2 `mappend` "pers:Lo4 rel:brother pers:Ol4 . \n" -result23w = prefix2 +++result23w = prefix2 `mappend` "pers:Ha4 rel:brother pers:El4 . \n" -result23x = prefix2 +++result23x = prefix2 `mappend` "pers:Ha4 rel:brother pers:Ha4 . \n" -result23y = prefix2 +++result23y = prefix2 `mappend` "pers:El4 rel:brother pers:El4 . \n" -result23z = prefix2 +++result23z = prefix2 `mappend` "pers:El4 rel:brother pers:Ha4 . \n" var23 :: [RDFVarBinding]@@ -369,34 +361,33 @@ res23F = rdfQuerySubs var23F result23 query24 :: RDFGraph-query24 = graphFromString $ prefix2 ++- "?a rel:daughter ?b . \n" ++- "?a rel:daughter ?c . \n"+query24 = gr2 $+ "?a rel:daughter ?b . \n" `mappend`+ "?a rel:daughter ?c . \n" result24 :: RDFGraph-result24 = graphFromString $ prefix2 ++- "?b rel:sister ?c . \n"+result24 = gr2 "?b rel:sister ?c . \n" result24a, result24b, result24c, result24d,- result24e, result24f :: String+ result24e, result24f :: B.Builder -result24a = prefix2 ++- "pers:Ma2 rel:sister pers:Ma2 . \n"+result24a = prefix2 `mappend`+ "pers:Ma2 rel:sister pers:Ma2 . \n" -result24b = prefix2 ++- "pers:Ma2 rel:sister pers:An2 . \n"+result24b = prefix2 `mappend`+ "pers:Ma2 rel:sister pers:An2 . \n" -result24c = prefix2 ++- "pers:An2 rel:sister pers:Ma2 . \n"+result24c = prefix2 `mappend`+ "pers:An2 rel:sister pers:Ma2 . \n" -result24d = prefix2 ++- "pers:An2 rel:sister pers:An2 . \n"+result24d = prefix2 `mappend`+ "pers:An2 rel:sister pers:An2 . \n" -result24e = prefix2 ++- "pers:Ma3 rel:sister pers:Ma3 . \n"+result24e = prefix2 `mappend`+ "pers:Ma3 rel:sister pers:Ma3 . \n" -result24f = prefix2 ++- "pers:Rh4 rel:sister pers:Rh4 . \n"+result24f = prefix2 `mappend`+ "pers:Rh4 rel:sister pers:Rh4 . \n" var24 :: [RDFVarBinding] var24 = rdfQueryFind query24 graph2@@ -405,24 +396,30 @@ res24 = rdfQuerySubs var24 result24 query25 :: RDFGraph-query25 = graphFromString $ prefix2 ++- "?a rel:son ?b . \n" +++query25 = gr2 $+ "?a rel:son ?b . \n" `mappend` "?a rel:daughter ?c . \n" result25 :: RDFGraph-result25 = graphFromString $ prefix2 ++- "?b rel:sister ?c . \n" +++result25 = gr2 $+ "?b rel:sister ?c . \n" `mappend` "?c rel:brother ?b . \n" -result25a, result25b :: String-result25a = prefix2 ++- "pers:Wi3 rel:sister pers:Ma3 . \n" ++- "pers:Ma3 rel:brother pers:Wi3 . \n"--result25b = prefix2 ++- "pers:Ro4 rel:sister pers:Rh4 . \n" ++- "pers:Rh4 rel:brother pers:Ro4 . \n"-+result25a, result25b :: B.Builder+result25a = + mconcat + [ prefix2+ , "pers:Wi3 rel:sister pers:Ma3 . \n"+ , "pers:Ma3 rel:brother pers:Wi3 . \n"+ ]+ +result25b = + mconcat+ [ prefix2 + , "pers:Ro4 rel:sister pers:Rh4 . \n"+ , "pers:Rh4 rel:brother pers:Ro4 . \n"+ ]+ var25 :: [RDFVarBinding] var25 = rdfQueryFind query25 graph2 @@ -513,27 +510,32 @@ ------------------------------------------------------------ graph3 :: RDFGraph-graph3 = graphFromString $ prefix2 ++- "pers:Pa2 rel:grandparent pers:Ro4 . \n" +++graph3 = gr2 $+ "pers:Pa2 rel:grandparent pers:Ro4 . \n" `mappend` "pers:Pa2 rel:grandparent pers:Ol4 . \n" query31 :: RDFGraph-query31 = graphFromString $ prefix2 ++- "?a rel:grandparent ?c . \n"+query31 = gr2 "?a rel:grandparent ?c . \n" result31 :: RDFGraph-result31 = graphFromString $ prefix2 ++- "?a rel:son ?b . \n" +++result31 = gr2 $+ "?a rel:son ?b . \n" `mappend` "?b rel:son ?c . \n" -result31a, result31b :: String-result31a = prefix2 ++- "pers:Pa2 rel:son ?b . \n" ++- "?b rel:son pers:Ro4 . \n"--result31b = prefix2 ++- "pers:Pa2 rel:son ?b . \n" ++- "?b rel:son pers:Ol4 . \n"+result31a, result31b :: B.Builder+result31a = + mconcat+ [ prefix2 + , "pers:Pa2 rel:son ?b . \n" + , "?b rel:son pers:Ro4 . \n"+ ]+ +result31b = + mconcat+ [ prefix2+ , "pers:Pa2 rel:son ?b . \n"+ , "?b rel:son pers:Ol4 . \n"+ ] var31 :: [RDFVarBinding] var31 = rdfQueryFind query31 graph3@@ -546,28 +548,35 @@ (res31,res31v) = unzip res31pairs query32 :: RDFGraph-query32 = graphFromString $ prefix2 ++- "?a rel:grandparent ?c . \n"+query32 = gr2 "?a rel:grandparent ?c . \n" result32 :: RDFGraph-result32 = graphFromString $ prefix2 ++- "?a rel:wife _:b . \n" ++- "?d rel:any _:b0 . \n" ++- "?a rel:son ?b . \n" ++- "?b rel:son ?c . \n"--result32a, result32b :: String-result32a = prefix2 ++- "pers:Pa2 rel:wife _:b . \n" ++- "_:d0 rel:any _:b0 . \n" ++- "pers:Pa2 rel:son _:b1 . \n" ++- "_:b1 rel:son pers:Ro4 . \n"+result32 = gr2 $+ mconcat+ [ "?a rel:wife _:b . \n"+ , "?d rel:any _:b0 . \n"+ , "?a rel:son ?b . \n" + , "?b rel:son ?c . \n"+ ]+ +result32a, result32b :: B.Builder+result32a = + mconcat+ [ prefix2 + , "pers:Pa2 rel:wife _:b . \n"+ , "_:d0 rel:any _:b0 . \n"+ , "pers:Pa2 rel:son _:b1 . \n"+ , "_:b1 rel:son pers:Ro4 . \n"+ ] -result32b = prefix2 ++- "pers:Pa2 rel:wife _:b . \n" ++- "_:d0 rel:any _:b0 . \n" ++- "pers:Pa2 rel:son _:b1 . \n" ++- "_:b1 rel:son pers:Ol4 . \n"+result32b = + mconcat+ [ prefix2+ , "pers:Pa2 rel:wife _:b . \n"+ , "_:d0 rel:any _:b0 . \n"+ , "pers:Pa2 rel:son _:b1 . \n"+ , "_:b1 rel:son pers:Ol4 . \n"+ ] res32, res33 :: [RDFGraph] res32 = rdfQuerySubsBlank var31 result32@@ -603,27 +612,33 @@ -- test4: test of backward-chaining query ------------------------------------------------------------ -prefix4 :: String+prefix4 :: B.Builder prefix4 =- "@prefix pers: <urn:pers:> . \n" ++- "@prefix rel: <urn:rel:> . \n" ++- " \n"+ "@prefix pers: <urn:pers:> . \n" `mappend`+ "@prefix rel: <urn:rel:> . \n" +-- should use gr4l rather than gr+gr4 :: B.Builder -> RDFGraph+gr4 = graphFromBuilder prefix4++gr4l :: [B.Builder] -> RDFGraph+gr4l = graphFromBuilder prefix4 . mconcat++b4 :: [B.Builder] -> B.Builder+b4 = mconcat . (prefix4 :)+ graph41 :: RDFGraph-graph41 = graphFromString $ prefix4 ++- "pers:St1 rel:wife pers:Do1 . \n"+graph41 = gr4 "pers:St1 rel:wife pers:Do1 . \n" query41 :: RDFGraph-query41 = graphFromString $ prefix4 ++- "?a rel:wife ?b . \n"+query41 = gr4 "?a rel:wife ?b . \n" result41 :: RDFGraph-result41 = graphFromString $ prefix4 ++- "?b rel:husband ?a . \n"+result41 = gr4 "?b rel:husband ?a . \n" -result41a :: String-result41a = prefix4 ++- "pers:Do1 rel:husband pers:St1 . \n"+result41a :: B.Builder+result41a = prefix4 `mappend`+ "pers:Do1 rel:husband pers:St1 . \n" var41 :: [[RDFVarBinding]] var41 = rdfQueryBack query41 graph41@@ -632,23 +647,24 @@ res41 = rdfQueryBackSubs var41 result41 graph42 :: RDFGraph-graph42 = graphFromString $ prefix4 ++- "pers:Pa2 rel:grandparent pers:Ro4 . \n"+graph42 = gr4 "pers:Pa2 rel:grandparent pers:Ro4 . \n" query42 :: RDFGraph-query42 = graphFromString $ prefix4 ++- "?a rel:grandparent ?c . \n"+query42 = gr4 "?a rel:grandparent ?c . \n" result42 :: RDFGraph-result42 = graphFromString $ prefix4 ++- "?a rel:son ?b . \n" +++result42 = gr4 $+ "?a rel:son ?b . \n" `mappend` "?b rel:son ?c . \n" -result42a :: String-result42a = prefix4 ++- "pers:Pa2 rel:son ?b . \n" ++- "?b rel:son pers:Ro4 . \n"-+result42a :: B.Builder+result42a = + mconcat+ [ prefix4+ , "pers:Pa2 rel:son ?b . \n"+ , "?b rel:son pers:Ro4 . \n"+ ]+ var42 :: [[RDFVarBinding]] var42 = rdfQueryBack query42 graph42 @@ -656,23 +672,24 @@ res42 = rdfQueryBackSubs var42 result42 graph43 :: RDFGraph-graph43 = graphFromString $ prefix4 ++- "pers:Gr3 rel:brother pers:La3 . \n"+graph43 = gr4 "pers:Gr3 rel:brother pers:La3 . \n" query43 :: RDFGraph-query43 = graphFromString $ prefix4 ++- "?b rel:brother ?c . \n"+query43 = gr4 "?b rel:brother ?c . \n" result43 :: RDFGraph-result43 = graphFromString $ prefix4 ++- "?a rel:son ?b . \n" +++result43 = gr4 $+ "?a rel:son ?b . \n" `mappend` "?a rel:son ?c . \n" -result43a :: String-result43a = prefix4 ++- "?a rel:son pers:Gr3 . \n" ++- "?a rel:son pers:La3 . \n"-+result43a :: B.Builder+result43a = + mconcat+ [ prefix4+ , "?a rel:son pers:Gr3 . \n"+ , "?a rel:son pers:La3 . \n"+ ]+ var43 :: [[RDFVarBinding]] var43 = rdfQueryBack query43 graph43 @@ -680,37 +697,44 @@ res43 = rdfQueryBackSubs var43 result43 graph44 :: RDFGraph-graph44 = graphFromString $ prefix4 ++- "pers:Pa2 rel:grandson pers:Ro4 . \n"+graph44 = gr4 "pers:Pa2 rel:grandson pers:Ro4 . \n" query44 :: RDFGraph-query44 = graphFromString $ prefix4 ++- "?a rel:grandson ?b . \n" +++query44 = gr4 $+ "?a rel:grandson ?b . \n" `mappend` "?c rel:grandson ?d . \n" result44 :: RDFGraph-result44 = graphFromString $ prefix4 ++- "?a rel:son ?m . \n" ++- "?m rel:son ?b . \n" ++- "?c rel:daughter ?n . \n" ++- "?n rel:son ?d . \n"--result44a, result44b :: String-result44a = prefix4 ++- "pers:Pa2 rel:son ?m . \n" ++- "?m rel:son pers:Ro4 . \n" ++- "?c rel:daughter ?n . \n" ++- "?n rel:son ?d . \n"--result44b = prefix4 ++- "?a rel:son ?m . \n" ++- "?m rel:son ?b . \n" ++- "pers:Pa2 rel:daughter ?n . \n" ++- "?n rel:son pers:Ro4 . \n"+result44 = gr4 $+ mconcat+ [ "?a rel:son ?m . \n"+ , "?m rel:son ?b . \n"+ , "?c rel:daughter ?n . \n"+ , "?n rel:son ?d . \n"+ ]+ +result44a, result44b :: B.Builder+result44a = + mconcat+ [ prefix4+ , "pers:Pa2 rel:son ?m . \n"+ , "?m rel:son pers:Ro4 . \n"+ , "?c rel:daughter ?n . \n"+ , "?n rel:son ?d . \n"+ ] +result44b = + mconcat+ [ prefix4+ , "?a rel:son ?m . \n"+ , "?m rel:son ?b . \n"+ , "pers:Pa2 rel:daughter ?n . \n"+ , "?n rel:son pers:Ro4 . \n"+ ]+ unbound44a, unbound44b :: [RDFLabel]-unbound44a = [Var "m",Var "c",Var "n",Var "d"]-unbound44b = [Var "a",Var "m",Var "b",Var "n"]+unbound44a = [Var "m", Var "c", Var "n", Var "d"]+unbound44b = [Var "a", Var "m", Var "b", Var "n"] var44 :: [[RDFVarBinding]] var44 = rdfQueryBack query44 graph44@@ -729,28 +753,33 @@ -- (?a daughter b1, ?a son c1) && (?a daughter b2, ?a son c2) graph45 :: RDFGraph-graph45 = graphFromString $ prefix4 ++- "pers:Rh4 rel:brother pers:Ro4 . \n" +++graph45 = gr4 $+ "pers:Rh4 rel:brother pers:Ro4 . \n" `mappend` "pers:Ma3 rel:brother pers:Wi3 . \n" query45 :: RDFGraph-query45 = graphFromString $ prefix4 ++- "?b rel:brother ?c . \n"+query45 = gr4 "?b rel:brother ?c . \n" result45 :: RDFGraph-result45 = graphFromString $ prefix4 ++- "?a rel:daughter ?b . \n" +++result45 = gr4 $+ "?a rel:daughter ?b . \n" `mappend` "?a rel:son ?c . \n" -result45a1, result45a2 :: String-result45a1 = prefix4 ++- "?a rel:daughter pers:Rh4 . \n" ++- "?a rel:son pers:Ro4 . \n"--result45a2 = prefix4 ++- "?a rel:daughter pers:Ma3 . \n" ++- "?a rel:son pers:Wi3 . \n"+result45a1, result45a2 :: B.Builder+result45a1 = + mconcat+ [ prefix4+ , "?a rel:daughter pers:Rh4 . \n"+ , "?a rel:son pers:Ro4 . \n"+ ] +result45a2 = + mconcat+ [ prefix4+ , "?a rel:daughter pers:Ma3 . \n"+ , "?a rel:son pers:Wi3 . \n"+ ]+ unbound45a1, unbound45a2 :: [RDFLabel] unbound45a1 = [Var "a"] unbound45a2 = [Var "a"]@@ -775,27 +804,33 @@ -- (_:c1 son a, _:c1 stepSon b) || (_:c2 stepSon a, _:c2 son b) graph46 :: RDFGraph-graph46 = graphFromString $ prefix4 ++- "pers:Gr3 rel:stepbrother pers:St3 . \n"+graph46 = gr4 "pers:Gr3 rel:stepbrother pers:St3 . \n" query46 :: RDFGraph-query46 = graphFromString $ prefix4 ++- "?b rel:stepbrother ?c . \n" +++query46 = gr4 $+ "?b rel:stepbrother ?c . \n" `mappend` "?c rel:stepbrother ?b . \n" result46 :: RDFGraph-result46 = graphFromString $ prefix4 ++- "?a rel:son ?b . \n" +++result46 = gr4 $+ "?a rel:son ?b . \n" `mappend` "?a rel:stepson ?c . \n" -result46a, result46b :: String-result46a = prefix4 ++- "?a rel:son pers:St3 . \n" ++- "?a rel:stepson pers:Gr3 . \n"-result46b = prefix4 ++- "?a rel:son pers:Gr3 . \n" ++- "?a rel:stepson pers:St3 . \n"-+result46a, result46b :: B.Builder+result46a = + mconcat+ [ prefix4+ , "?a rel:son pers:St3 . \n"+ , "?a rel:stepson pers:Gr3 . \n"+ ]+ +result46b = + mconcat+ [ prefix4+ , "?a rel:son pers:Gr3 . \n"+ , "?a rel:stepson pers:St3 . \n"+ ]+ unbound46a, unbound46b :: [RDFLabel] unbound46a = [Var "a"] unbound46b = [Var "a"]@@ -824,56 +859,56 @@ -- ((_:e stepSon a, _:e son b) && (_:f stepSon a, _:f son b)) graph47 :: RDFGraph-graph47 = graphFromString $ prefix4 ++- "pers:Gr3 rel:stepbrother pers:St3 . \n" +++graph47 = gr4 $+ "pers:Gr3 rel:stepbrother pers:St3 . \n" `mappend` "pers:St3 rel:stepbrother pers:Gr3 . \n" query47 :: RDFGraph-query47 = graphFromString $ prefix4 ++- "?b rel:stepbrother ?c . \n" +++query47 = gr4 $+ "?b rel:stepbrother ?c . \n" `mappend` "?c rel:stepbrother ?b . \n" result47 :: RDFGraph-result47 = graphFromString $ prefix4 ++- "?a rel:son ?b . \n" +++result47 = gr4 $+ "?a rel:son ?b . \n" `mappend` "?a rel:stepson ?c . \n" result47a1, result47a2, result47b1, result47b2, result47c1, result47c2,- result47d1, result47d2 :: String+ result47d1, result47d2 :: B.Builder -result47a1 = prefix4 ++- "?a rel:son pers:St3 . \n" ++- "?a rel:stepson pers:Gr3 . \n"+result47a1 = + b4 [ "?a rel:son pers:St3 . \n"+ , "?a rel:stepson pers:Gr3 . \n"] -result47a2 = prefix4 ++- "?a rel:son pers:Gr3 . \n" ++- "?a rel:stepson pers:St3 . \n"+result47a2 = + b4 [ "?a rel:son pers:Gr3 . \n"+ , "?a rel:stepson pers:St3 . \n"] -result47b1 = prefix4 ++- "?a rel:stepson pers:St3 . \n" ++- "?a rel:son pers:Gr3 . \n"+result47b1 = + b4 [ "?a rel:stepson pers:St3 . \n"+ , "?a rel:son pers:Gr3 . \n"] -result47b2 = prefix4 ++- "?a rel:stepson pers:St3 . \n" ++- "?a rel:son pers:Gr3 . \n"+result47b2 = + b4 [ "?a rel:stepson pers:St3 . \n"+ , "?a rel:son pers:Gr3 . \n"] -result47c1 = prefix4 ++- "?a rel:son pers:St3 . \n" ++- "?a rel:stepson pers:Gr3 . \n"+result47c1 = + b4 [ "?a rel:son pers:St3 . \n"+ , "?a rel:stepson pers:Gr3 . \n"] -result47c2 = prefix4 ++- "?a rel:son pers:St3 . \n" ++- "?a rel:stepson pers:Gr3 . \n"+result47c2 = + b4 [ "?a rel:son pers:St3 . \n"+ , "?a rel:stepson pers:Gr3 . \n"] -result47d1 = prefix4 ++- "?a rel:stepson pers:St3 . \n" ++- "?a rel:son pers:Gr3 . \n"+result47d1 =+ b4 [ "?a rel:stepson pers:St3 . \n"+ , "?a rel:son pers:Gr3 . \n"] -result47d2 = prefix4 ++- "?a rel:son pers:St3 . \n" ++- "?a rel:stepson pers:Gr3 . \n"+result47d2 = + b4 [ "?a rel:son pers:St3 . \n"+ , "?a rel:stepson pers:Gr3 . \n"] unbound47a1, unbound47a2, unbound47b1, unbound47b2,@@ -915,26 +950,25 @@ -- (_:c1 son a, _:c1 son b) || (_:c2 son b, _:c2 son a) graph48 :: RDFGraph-graph48 = graphFromString $ prefix4 ++- "pers:Gr3 rel:brother pers:La3 . \n"+graph48 = gr4 "pers:Gr3 rel:brother pers:La3 . \n" query48 :: RDFGraph-query48 = graphFromString $ prefix4 ++- "?b rel:brother ?c . \n" +++query48 = gr4 $+ "?b rel:brother ?c . \n" `mappend` "?c rel:brother ?b . \n" result48 :: RDFGraph-result48 = graphFromString $ prefix4 ++- "?a rel:son ?b . \n" +++result48 = gr4 $+ "?a rel:son ?b . \n" `mappend` "?a rel:son ?c . \n" -result48a, result48b :: String-result48a = prefix4 ++- "?a rel:son pers:La3 . \n" ++- "?a rel:son pers:Gr3 . \n"-result48b = prefix4 ++- "?a rel:son pers:Gr3 . \n" ++- "?a rel:son pers:La3 . \n"+result48a, result48b :: B.Builder+result48a = + b4 [ "?a rel:son pers:La3 . \n"+ , "?a rel:son pers:Gr3 . \n"]+result48b =+ b4 [ "?a rel:son pers:Gr3 . \n"+ , "?a rel:son pers:La3 . \n"] unbound48a, unbound48b :: [RDFLabel] unbound48a = [Var "a"]@@ -960,17 +994,15 @@ -- (a bar b) cannot be deduced directly graph49 :: RDFGraph-graph49 = graphFromString $ prefix4 ++- "pers:Gr3 rel:foo pers:La3 . \n"+graph49 = gr4l ["pers:Gr3 rel:foo pers:La3 . \n"] query49 :: RDFGraph-query49 = graphFromString $ prefix4 ++- "?a rel:bar ?a . \n"+query49 = gr4l ["?a rel:bar ?a . \n"] result49 :: RDFGraph-result49 = graphFromString $ prefix4 ++- "?a rel:foo ?b . \n" ++- "?b rel:foo ?a . \n"+result49 = gr4l + [ "?a rel:foo ?b . \n"+ , "?b rel:foo ?a . \n"] var49 :: [[RDFVarBinding]] var49 = rdfQueryBack query49 graph49@@ -986,27 +1018,26 @@ -- (_:c1 son a, _:c1 son b) || (_:c2 son b, _:c2 son a) graph50 :: RDFGraph-graph50 = graphFromString $ prefix4 ++- "pers:Gr3 rel:brother pers:Gr3 . \n"+graph50 = gr4l ["pers:Gr3 rel:brother pers:Gr3 . \n"] query50 :: RDFGraph-query50 = graphFromString $ prefix4 ++- "?b rel:brother ?c . \n" ++- "?c rel:brother ?b . \n"+query50 = gr4l+ [ "?b rel:brother ?c . \n"+ , "?c rel:brother ?b . \n"] result50 :: RDFGraph-result50 = graphFromString $ prefix4 ++- "?a rel:son ?b . \n" ++- "?a rel:son ?c . \n"+result50 = gr4l + [ "?a rel:son ?b . \n"+ , "?a rel:son ?c . \n"] -result50a, result50b :: String-result50a = prefix4 ++- "?a rel:son pers:Gr3 . \n" ++- "?a rel:son pers:Gr3 . \n"+result50a, result50b :: B.Builder+result50a = + b4 [ "?a rel:son pers:Gr3 . \n"+ , "?a rel:son pers:Gr3 . \n"] -result50b = prefix4 ++- "?a rel:son pers:Gr3 . \n" ++- "?a rel:son pers:Gr3 . \n"+result50b = + b4 [ "?a rel:son pers:Gr3 . \n"+ , "?a rel:son pers:Gr3 . \n"] unbound50a, unbound50b :: [RDFLabel] unbound50a = [Var "a"]@@ -1153,31 +1184,30 @@ -- a subgraph graph61 :: RDFGraph-graph61 = graphFromString $ prefix4 ++- "pers:Gr3 rel:brother pers:La3 . \n" ++- "pers:Gr3 rel:brother pers:Si3 . \n"+graph61 = gr4l + [ "pers:Gr3 rel:brother pers:La3 . \n"+ , "pers:Gr3 rel:brother pers:Si3 . \n"] query61 :: RDFGraph-query61 = graphFromString $ prefix4 ++- "?b rel:brother ?c . \n"+query61 = gr4l ["?b rel:brother ?c . \n"] result61 :: RDFGraph-result61 = graphFromString $ prefix4 ++- "?a rel:son ?b . \n" ++- "?a rel:son ?c . \n"+result61 = gr4l + [ "?a rel:son ?b . \n"+ , "?a rel:son ?c . \n"] -result61a, result63a :: String-result61a = prefix4 ++- "_:a1 rel:son pers:Gr3 . \n" ++- "_:a1 rel:son pers:La3 . \n" ++- "_:a2 rel:son pers:Gr3 . \n" ++- "_:a2 rel:son pers:Si3 . \n"+result61a, result63a :: B.Builder+result61a = + b4 [ "_:a1 rel:son pers:Gr3 . \n"+ , "_:a1 rel:son pers:La3 . \n"+ , "_:a2 rel:son pers:Gr3 . \n"+ , "_:a2 rel:son pers:Si3 . \n"] -result63a = prefix4 ++- "pers:Pa2 rel:son pers:Gr3 . \n" ++- "pers:Pa2 rel:son pers:La3 . \n" ++- "pers:Pa2 rel:son pers:Gr3 . \n" ++- "pers:Pa2 rel:son pers:Si3 . \n"+result63a = + b4 [ "pers:Pa2 rel:son pers:Gr3 . \n"+ , "pers:Pa2 rel:son pers:La3 . \n"+ , "pers:Pa2 rel:son pers:Gr3 . \n"+ , "pers:Pa2 rel:son pers:Si3 . \n"] -- 1. Backchain query with blank substutions @@ -1245,14 +1275,17 @@ rdfQueryBackModify qbm qbss = concatMap (rdfQueryBackModify1 qbm) qbss -} -baseex :: String-baseex = "http://example.org/"+toURI :: String -> URI+toURI = fromJust . parseURI -baserdf :: String+baseex :: URI+baseex = toURI "http://example.org/"++baserdf :: URI baserdf = nsURI namespaceRDF q_dattyp :: ScopedName-q_dattyp = makeScopedName "" baseex "datatype"+q_dattyp = makeScopedName Nothing baseex "datatype" v_a, v_b, v_c, v_x, v_y, v_z :: RDFLabel v_a = Var "a"@@ -1264,16 +1297,16 @@ u_s, u_o, u_p, u_p1, u_p2a, u_p2b, u_m1, u_m2, u_rt, u_xt, u_dt :: RDFLabel-u_s = Res $ makeScopedName "" baseex "s"-u_o = Res $ makeScopedName "" baseex "o"-u_p = Res $ makeScopedName "" baseex "p"-u_p1 = Res $ makeScopedName "" baseex "p1"-u_p2a = Res $ makeScopedName "" baseex "p2a"-u_p2b = Res $ makeScopedName "" baseex "p2b"-u_m1 = Res $ makeScopedName "" baserdf "_1"-u_m2 = Res $ makeScopedName "" baserdf "_2"-u_rt = Res rdf_type-u_xt = Res rdf_XMLLiteral+u_s = Res $ makeScopedName Nothing baseex "s"+u_o = Res $ makeScopedName Nothing baseex "o"+u_p = Res $ makeScopedName Nothing baseex "p"+u_p1 = Res $ makeScopedName Nothing baseex "p1"+u_p2a = Res $ makeScopedName Nothing baseex "p2a"+u_p2b = Res $ makeScopedName Nothing baseex "p2b"+u_m1 = Res $ makeScopedName Nothing baserdf "_1"+u_m2 = Res $ makeScopedName Nothing baserdf "_2"+u_rt = Res rdfType+u_xt = Res rdfXMLLiteral u_dt = Res q_dattyp l_1, l_2, l_3, l_4, l_5 :: RDFLabel@@ -1281,7 +1314,7 @@ l_2 = Lit "l2" (Just $ langName "fr") l_3 = Lit "l3" (Just q_dattyp) l_4 = Lit "l4" (Just q_dattyp) -- was: (Lang "fr")-l_5 = Lit "l5" (Just rdf_XMLLiteral)+l_5 = Lit "l5" (Just rdfXMLLiteral) b_1, b_2, b_3, b_l1, b_l2 :: RDFLabel b_1 = Blank "1"@@ -1533,7 +1566,7 @@ "@prefix list : <" ++ nsURI namespacelist ++ "> . \n" ++ " \n" -graphlist = graphFromString graphliststr+graphlist = graphFromBuilder graphliststr graphliststr = prefixlist ++ "test:a rdf:type test:C1 ; " ++ " test:p test:item1 ; " ++@@ -1567,7 +1600,7 @@ list02 = [] testVal01 = testEqv "testVal01" testabc $- rdfFindValSubj res_rdf_type testC1 graphlist+ rdfFindValSubj res_rdfType testC1 graphlist testVal02 = testEqv "testVal02" testi12 $ rdfFindPredVal (testabc!!0) testp graphlist testVal03 = testEqv "testVal03" test123 $
tests/RDFRulesetTest.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,21 +10,20 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- 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.RDF.RDFRuleset ( RDFFormula, RDFRule, RDFClosure, RDFRuleset , GraphClosure(..)- , makeRDFGraphFromN3String+ , makeRDFGraphFromN3Builder , makeRDFFormula , makeN3ClosureSimpleRule , makeNodeAllocTo@@ -30,8 +31,7 @@ , graphClosureFwdApply, graphClosureBwdApply ) -import Swish.RDF.RDFQuery- ( rdfQueryBack, rdfQueryBackModify )+import Swish.RDF.RDFQuery (rdfQueryBack, rdfQueryBackModify) import Swish.RDF.RDFVarBinding ( RDFVarBinding@@ -48,31 +48,14 @@ , toRDFGraph ) -import Swish.RDF.VarBinding- ( makeVarBinding- , vbmCompose- , makeVarFilterModify- )-+import Swish.RDF.VarBinding (makeVarBinding, vbmCompose, makeVarFilterModify) import Swish.RDF.Ruleset ( makeRuleset, getRulesetNamespace, getRulesetAxioms, getRulesetRules , getRulesetAxiom, getRulesetRule ) -import Swish.RDF.Rule- ( Formula(..), Rule(..)- , fwdCheckInference )--import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..)- , makeScopedName- )--import Swish.RDF.Vocabulary- ( namespaceRDF- , namespaceOWL- , scopeRDF- )+import Swish.RDF.Rule (Formula(..), Rule(..), fwdCheckInference )+import Swish.RDF.Vocabulary (namespaceRDF, namespaceRDFS, namespaceOWL, scopeRDF)+import Swish.Utils.Namespace (Namespace(..), ScopedName(..), makeScopedName, namespaceToBuilder) import Test.HUnit ( Test(TestCase,TestList)@@ -80,9 +63,15 @@ , runTestTT ) +import Network.URI (URI, parseURI)++import Data.Monoid (Monoid(..)) import Data.List (nub, sort) import Data.Maybe (isJust, fromJust) +import qualified Data.Text as T+import qualified Data.Text.Lazy.Builder as B+ ------------------------------------------------------------ -- Test case helpers ------------------------------------------------------------@@ -145,10 +134,16 @@ -- Common values ------------------------------------------------------------ -pref_rdf, pref_owl :: String+pref_rdf, pref_owl :: URI pref_rdf = nsURI namespaceRDF pref_owl = nsURI namespaceOWL +toURI :: String -> URI+toURI = fromJust . parseURI++toNS :: Maybe T.Text -> String -> Namespace+toNS p = Namespace p . toURI+ ------------------------------------------------------------ -- Define and manipulate rulesets ------------------------------------------------------------@@ -164,28 +159,33 @@ -- which may be cited by a proof. rn1 :: Namespace-rn1 = Namespace "r1" "http://id.ninebynine.org/wip/2003/rulesettest/r1"+rn1 = toNS (Just "r1") "http://id.ninebynine.org/wip/2003/rulesettest/r1" -- Common prefix declarations for graph expressions-pref :: String-pref =- "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> . \n" ++- "@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . \n" ++- "@prefix ex: <http://example.org/> . \n" ++- " \n" +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" (pref++"ex:R1 rdf:type ex:C1 .")-a12 = makeRDFFormula rn1 "a12" (pref++"ex:R2 rdf:type ex:C2 .")+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"- ( pref++"?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )- ( pref++"?r1 ex:P1 ?r2 ." )+ ( prefix `mappend` "?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )+ ( prefix `mappend` "?r1 ex:P1 ?r2 ." ) r12 = makeN3ClosureSimpleRule rn1 "r12"- ( pref++"?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )- ( pref++"?r2 ex:P2 ?r1 ." )+ ( 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)@@ -243,19 +243,12 @@ -- Component tests for RDF proof context ------------------------------------------------------------ -prefix :: String-prefix =- "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> . \n" ++- "@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . \n" ++- "@prefix ex: <http://example.org/> . \n" ++- " \n"- scopeex :: Namespace-scopeex = Namespace "ex" "http://id.ninebynine.org/wip/2003/RDFProofCheck#"+scopeex = toNS (Just "ex") "http://id.ninebynine.org/wip/2003/RDFProofCheck#" -makeFormula :: Namespace -> String -> String -> RDFFormula+makeFormula :: Namespace -> T.Text -> B.Builder -> RDFFormula makeFormula scope local gr =- makeRDFFormula scope local (prefix++gr)+ makeRDFFormula scope local $ prefix `mappend` gr allocateTo :: String -> String -> [RDFLabel] -> RDFVarBindingModify allocateTo bv av = makeNodeAllocTo (Var bv) (Var av)@@ -269,8 +262,8 @@ -- Backward chaining rdf:r2 rdfr2ant, rdfr2con :: RDFGraph-rdfr2ant = makeRDFGraphFromN3String "?x ?a ?l . "-rdfr2con = makeRDFGraphFromN3String "?x ?a ?b . ?b rdf:type rdf:XMLLiteral ."+rdfr2ant = makeRDFGraphFromN3Builder "?x ?a ?l . "+rdfr2con = makeRDFGraphFromN3Builder "?x ?a ?b . ?b rdf:type rdf:XMLLiteral ." rdfr2modv :: RDFVarBindingModify rdfr2modv = allocateTo "b" "l" $ allLabels labelIsVar rdfr2ant@@ -296,8 +289,8 @@ con03 :: RDFGraph con03 = formExpr $ makeFormula scopeex "con03" $- "ex:s ex:p1 _:l1 ; ex:p2a _:l2; ex:p2b _:l2 ." ++- "_:l1 rdf:type rdf:XMLLiteral ." +++ "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@@ -305,13 +298,16 @@ 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 "" "http://example.org/" "s"-u_p1 = Res $ makeScopedName "" "http://example.org/" "p1"-u_p2a = Res $ makeScopedName "" "http://example.org/" "p2a"-u_p2b = Res $ makeScopedName "" "http://example.org/" "p2b"-u_rt = Res $ makeScopedName "" pref_rdf "type"-u_rx = Res $ makeScopedName "" pref_rdf "XMLLiteral"+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"
tests/VarBindingTest.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -8,7 +10,7 @@ -- -- Maintainer : Douglas Burke -- Stability : experimental--- Portability : H98+-- Portability : OverloadedStrings -- -- This module contains test cases for variable binding values and -- variable binding modifier values.@@ -47,6 +49,8 @@ import Control.Monad (unless) import Data.List (union, intersect) import Data.Maybe (isJust, isNothing, fromJust)++-- import qualified Data.Text as T ------------------------------------------------------------ -- Test case helpers