diff --git a/Swish/RDF/ClassRestrictionRule.hs b/Swish/RDF/ClassRestrictionRule.hs
--- a/Swish/RDF/ClassRestrictionRule.hs
+++ b/Swish/RDF/ClassRestrictionRule.hs
@@ -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.
diff --git a/Swish/RDF/Datatype.hs b/Swish/RDF/Datatype.hs
--- a/Swish/RDF/Datatype.hs
+++ b/Swish/RDF/Datatype.hs
@@ -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
diff --git a/Swish/RDF/GraphMatch.hs b/Swish/RDF/GraphMatch.hs
--- a/Swish/RDF/GraphMatch.hs
+++ b/Swish/RDF/GraphMatch.hs
@@ -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 =
diff --git a/Swish/RDF/MapXsdInteger.hs b/Swish/RDF/MapXsdInteger.hs
--- a/Swish/RDF/MapXsdInteger.hs
+++ b/Swish/RDF/MapXsdInteger.hs
@@ -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
--------------------------------------------------------------------------------
--
diff --git a/Swish/RDF/N3Formatter.hs b/Swish/RDF/N3Formatter.hs
--- a/Swish/RDF/N3Formatter.hs
+++ b/Swish/RDF/N3Formatter.hs
@@ -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
diff --git a/Swish/RDF/N3Parser.hs b/Swish/RDF/N3Parser.hs
--- a/Swish/RDF/N3Parser.hs
+++ b/Swish/RDF/N3Parser.hs
@@ -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
@@ -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
{-
diff --git a/Swish/RDF/NTFormatter.hs b/Swish/RDF/NTFormatter.hs
--- a/Swish/RDF/NTFormatter.hs
+++ b/Swish/RDF/NTFormatter.hs
@@ -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
diff --git a/Swish/RDF/NTParser.hs b/Swish/RDF/NTParser.hs
--- a/Swish/RDF/NTParser.hs
+++ b/Swish/RDF/NTParser.hs
@@ -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
@@ -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
--------------------------------------------------------------------------------
--
diff --git a/Swish/RDF/RDFDatatype.hs b/Swish/RDF/RDFDatatype.hs
--- a/Swish/RDF/RDFDatatype.hs
+++ b/Swish/RDF/RDFDatatype.hs
@@ -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)
--------------------------------------------------------------------------------
--
diff --git a/Swish/RDF/RDFDatatypeXsdInteger.hs b/Swish/RDF/RDFDatatypeXsdInteger.hs
--- a/Swish/RDF/RDFDatatypeXsdInteger.hs
+++ b/Swish/RDF/RDFDatatypeXsdInteger.hs
@@ -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
diff --git a/Swish/RDF/RDFDatatypeXsdString.hs b/Swish/RDF/RDFDatatypeXsdString.hs
--- a/Swish/RDF/RDFDatatypeXsdString.hs
+++ b/Swish/RDF/RDFDatatypeXsdString.hs
@@ -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
diff --git a/Swish/RDF/RDFGraph.hs b/Swish/RDF/RDFGraph.hs
--- a/Swish/RDF/RDFGraph.hs
+++ b/Swish/RDF/RDFGraph.hs
@@ -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 = ""
@@ -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
diff --git a/Swish/RDF/RDFGraphShowM.hs b/Swish/RDF/RDFGraphShowM.hs
--- a/Swish/RDF/RDFGraphShowM.hs
+++ b/Swish/RDF/RDFGraphShowM.hs
@@ -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
--------------------------------------------------------------------------------
--
diff --git a/Swish/RDF/RDFParser.hs b/Swish/RDF/RDFParser.hs
--- a/Swish/RDF/RDFParser.hs
+++ b/Swish/RDF/RDFParser.hs
@@ -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
diff --git a/Swish/RDF/RDFProof.hs b/Swish/RDF/RDFProof.hs
--- a/Swish/RDF/RDFProof.hs
+++ b/Swish/RDF/RDFProof.hs
@@ -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:
diff --git a/Swish/RDF/RDFProofContext.hs b/Swish/RDF/RDFProofContext.hs
--- a/Swish/RDF/RDFProofContext.hs
+++ b/Swish/RDF/RDFProofContext.hs
@@ -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")
diff --git a/Swish/RDF/RDFQuery.hs b/Swish/RDF/RDFQuery.hs
--- a/Swish/RDF/RDFQuery.hs
+++ b/Swish/RDF/RDFQuery.hs
@@ -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
diff --git a/Swish/RDF/RDFRuleset.hs b/Swish/RDF/RDFRuleset.hs
--- a/Swish/RDF/RDFRuleset.hs
+++ b/Swish/RDF/RDFRuleset.hs
@@ -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
diff --git a/Swish/RDF/RDFVarBinding.hs b/Swish/RDF/RDFVarBinding.hs
--- a/Swish/RDF/RDFVarBinding.hs
+++ b/Swish/RDF/RDFVarBinding.hs
@@ -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.
diff --git a/Swish/RDF/Rule.hs b/Swish/RDF/Rule.hs
--- a/Swish/RDF/Rule.hs
+++ b/Swish/RDF/Rule.hs
@@ -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
diff --git a/Swish/RDF/SwishCommands.hs b/Swish/RDF/SwishCommands.hs
--- a/Swish/RDF/SwishCommands.hs
+++ b/Swish/RDF/SwishCommands.hs
@@ -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
diff --git a/Swish/RDF/SwishMain.hs b/Swish/RDF/SwishMain.hs
--- a/Swish/RDF/SwishMain.hs
+++ b/Swish/RDF/SwishMain.hs
@@ -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
diff --git a/Swish/RDF/SwishScript.hs b/Swish/RDF/SwishScript.hs
--- a/Swish/RDF/SwishScript.hs
+++ b/Swish/RDF/SwishScript.hs
@@ -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 [ ]
@@ -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
diff --git a/Swish/RDF/VarBinding.hs b/Swish/RDF/VarBinding.hs
--- a/Swish/RDF/VarBinding.hs
+++ b/Swish/RDF/VarBinding.hs
@@ -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
diff --git a/Swish/RDF/Vocabulary.hs b/Swish/RDF/Vocabulary.hs
--- a/Swish/RDF/Vocabulary.hs
+++ b/Swish/RDF/Vocabulary.hs
@@ -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"
--------------------------------------------------------------------------------
--
diff --git a/Swish/Utils/DateTime.hs b/Swish/Utils/DateTime.hs
deleted file mode 100644
--- a/Swish/Utils/DateTime.hs
+++ /dev/null
@@ -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 ( 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
diff --git a/Swish/Utils/LookupMap.hs b/Swish/Utils/LookupMap.hs
--- a/Swish/Utils/LookupMap.hs
+++ b/Swish/Utils/LookupMap.hs
@@ -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
diff --git a/Swish/Utils/MiscHelpers.hs b/Swish/Utils/MiscHelpers.hs
--- a/Swish/Utils/MiscHelpers.hs
+++ b/Swish/Utils/MiscHelpers.hs
@@ -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
diff --git a/Swish/Utils/Namespace.hs b/Swish/Utils/Namespace.hs
--- a/Swish/Utils/Namespace.hs
+++ b/Swish/Utils/Namespace.hs
@@ -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
+
+-}
+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
--------------------------------------------------------------------------------
--
diff --git a/Swish/Utils/QName.hs b/Swish/Utils/QName.hs
--- a/Swish/Utils/QName.hs
+++ b/Swish/Utils/QName.hs
@@ -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 "" ""
--------------------------------------------------------------------------------
--
diff --git a/Swish/Utils/ShowM.hs b/Swish/Utils/ShowM.hs
--- a/Swish/Utils/ShowM.hs
+++ b/Swish/Utils/ShowM.hs
@@ -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 ""
-
--------------------------------------------------------------------------------
--
diff --git a/Swish/Utils/TraceHelpers.hs b/Swish/Utils/TraceHelpers.hs
deleted file mode 100644
--- a/Swish/Utils/TraceHelpers.hs
+++ /dev/null
@@ -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
---
---------------------------------------------------------------------------------
diff --git a/scripts/SwishExample.ss b/scripts/SwishExample.ss
--- a/scripts/SwishExample.ss
+++ b/scripts/SwishExample.ss
@@ -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: .
+@prefix rdfs: .
+@prefix rdfd: .
+
@prefix ex: .
@prefix pv: .
@prefix xsd: .
@@ -28,14 +35,6 @@
@prefix rs_rdf: .
@prefix rs_rdfs: .
@prefix : .
-
-# Additionally, prefix declarations are provided automatically for:
-# @prefix rdf: .
-# @prefix rdfs: .
-# @prefix rdfd: .
-# @prefix rdfo: .
-# @prefix owl: .
-
# -- Simple named graph declarations --
diff --git a/scripts/SwishTest.ss b/scripts/SwishTest.ss
--- a/scripts/SwishTest.ss
+++ b/scripts/SwishTest.ss
@@ -4,10 +4,14 @@
#
# --------+---------+---------+---------+---------+---------+---------+---------
+@prefix rdf: .
+@prefix rdfs: .
+
@prefix ex: .
@prefix pv: .
@prefix xsd: .
@prefix xsd_integer: .
+@prefix rdfd: .
@prefix rs_rdf: .
@prefix rs_rdfs: .
@prefix : .
diff --git a/scripts/VehicleCapacity.ss b/scripts/VehicleCapacity.ss
--- a/scripts/VehicleCapacity.ss
+++ b/scripts/VehicleCapacity.ss
@@ -8,8 +8,7 @@
@prefix pv: .
@prefix xsd: .
@prefix xsd_integer: .
-@prefix rs_rdf: .
-@prefix rs_rdfs: .
+@prefix rdfd: .
@prefix : .
diff --git a/swish.cabal b/swish.cabal
--- a/swish.cabal
+++ b/swish.cabal
@@ -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
diff --git a/tests/BuiltInMapTest.hs b/tests/BuiltInMapTest.hs
--- a/tests/BuiltInMapTest.hs
+++ b/tests/BuiltInMapTest.hs
@@ -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.
diff --git a/tests/GraphTest.hs b/tests/GraphTest.hs
--- a/tests/GraphTest.hs
+++ b/tests/GraphTest.hs
@@ -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
diff --git a/tests/N3FormatterTest.hs b/tests/N3FormatterTest.hs
--- a/tests/N3FormatterTest.hs
+++ b/tests/N3FormatterTest.hs
@@ -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 form
-simpleN3Graph_g1_01 :: String
+simpleN3Graph_g1_01 :: B.Builder
simpleN3Graph_g1_01 =
- " " ++
- " " ++
- " .\n"
+ " .\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: .\n"
+ , "@prefix : .\n"
+ -- , ":me.png me:depicts me:me ;\n"
+ , " me:depicts me:me ;\n"
+ , " me:hasURN .\n"
+ ]
+
{-
Simple troublesome case
-}
-simpleN3Graph_x13a :: String
+simpleN3Graph_x13a :: B.Builder
simpleN3Graph_x13a =
- commonPrefixes ++
- "base1:s1 " ++ b1s ++ " ;\n"++
- " ( " ++ b2s ++ " " ++ b3s ++ " ) .\n"
+ mconcat
+ [ commonPrefixes
+ , "base1:s1 "
+ , b1s
+ , " ;\n"
+ , " ( ", 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\\\"\"\"\"^^ .\n"
+ mconcat
+ [ commonPrefixes
+ , "base1:s1 base1:p1 \"\"\"A string with \"quotes\\\"\"\"\" .\n"
+ , "base2:s2 base2:p2 \"\"\"A typed string with \"quotes\\\"\"\"\"^^ .\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 =
diff --git a/tests/N3ParserTest.hs b/tests/N3ParserTest.hs
--- a/tests/N3ParserTest.hs
+++ b/tests/N3ParserTest.hs
@@ -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:"++lab) er pe )
- , TestCase ( assertEqual ("parseTestGraph:"++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 = ""
-absUriRefInp01s = " "
-absUriRef01 = "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"
-
-absUriRefInp02, absUriRefInp02s, absUriRef02 :: String
-absUriRefInp02 = ""
-absUriRefInp02s = " "
-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 = " "
-
-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 "
" $ Just rdf_XMLLiteral
-lfrxml = Lit "chat" $ 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" ++
- " .\n" ++
- "@base .\n" ++
- "# In-scope base URI is http://example.org/ns/ at this point\n" ++
- " .\n" ++
- "@base .\n" ++
- "# In-scope base URI is http://example.org/ns/foo/ at this point\n" ++
- " .\n" ++
- "@prefix : .\n" ++
- ":a4 :b4 :c4 .\n" ++
- "@prefix : .\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 form
-simpleN3Graph_g1_01 :: String
-simpleN3Graph_g1_01 =
- " " ++
- " " ++
- " . "
-
--- 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" ++
- " . "
-
--- 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 \"
\"^^rdf:XMLLiteral . \n " ++
- " base3:s3 base3:p3 \"chat\"^^rdf:XMLLiteral . \n "
-
-emsg16 :: String
-emsg16 = intercalate "\n" [
- "",
- "@prefix base1 : . 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\"^^.\n" ++
- " base2:s2 base2:p2 \"false\"^^.\n" ++
- " base3:s3 base3:p3 \"true\"^^.\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 : . ",
- " 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 "" Nothing
+
+parseTestB :: QName -> String -> B.Builder -> RDFGraph -> String -> Test
+parseTestB base = parseTestBase "" (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 = ""
+absUriRefInp01s = " "
+absUriRefInp02 = ""
+absUriRefInp02s = " "
+
+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 = " "
+
+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 "
" $ Just rdfXMLLiteral
+lfrxml = Lit "chat" $ 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"
+ , " .\n"
+ , "@base .\n"
+ , "# In-scope base URI is http://example.org/ns/ at this point\n"
+ , " .\n"
+ , "@base .\n"
+ , "# In-scope base URI is http://example.org/ns/foo/ at this point\n"
+ , " .\n"
+ , "@prefix : .\n"
+ , ":a4 :b4 :c4 .\n"
+ , "@prefix : .\n"
+ , ":a5 :b5 :c5 .\n"
+ ]
+
+-- try out file prefixes
+simpleN3Graph_dg_03 :: B.Builder
+simpleN3Graph_dg_03 =
+ mconcat
+ [ "@prefix : .\n"
+ , "@prefix me: .\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 form
+simpleN3Graph_g1_01 :: B.Builder
+simpleN3Graph_g1_01 =
+ " . "
+
+-- 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"
+ , " . "
+ ]
+
+-- 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 \"
\"^^rdf:XMLLiteral . \n "
+ , " base3:s3 base3:p3 \"chat\"^^rdf:XMLLiteral . \n "
+ ]
+
+emsg16 :: String
+{- parsec error
+emsg16 = intercalate "\n" [
+ "",
+ "@prefix base1 : . 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\"^^.\n"
+ , " base2:s2 base2:p2 \"false\"^^.\n"
+ , " base3:s3 base3:p3 \"true\"^^.\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 : ."
+ , "@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 <= . \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 : . ",
+ " 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
diff --git a/tests/NTTest.hs b/tests/NTTest.hs
--- a/tests/NTTest.hs
+++ b/tests/NTTest.hs
@@ -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# \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 .\n_:anon .\n _:anon .\n# spaces and tabs throughout:\n \t \t \t \t.\t \n\n# line ending with CR NL (ASCII 13, ASCII 10)\n .\r\n\n# 2 statement lines separated by single CR (ASCII 10)\n .\r .\n\n\n# All literal escapes\n \"simple literal\" .\n \"backslash:\\\\\" .\n \"dquote:\\\"\" .\n \"newline:\\n\" .\n \"return\\r\" .\n \"tab:\\t\" .\n\n# Space is optional before final .\n .\n \"x\".\n _:anon.\n\n# \\u and \\U escapes\n# latin small letter e with acute symbol \\u00E9 - 3 UTF-8 bytes #xC3 #A9\n \"\\u00E9\" .\n# Euro symbol \\u20ac - 3 UTF-8 bytes #xE2 #x82 #xAC\n \"\\u20AC\" .\n# resource18 test removed\n# resource19 test removed\n# resource20 test removed\n\n# XML Literals as Datatyped Literals\n \"\"^^ .\n \" \"^^ .\n \"x\"^^ .\n \"\\\"\"^^ .\n \"\"^^ .\n \"a \"^^ .\n \"a c\"^^ .\n \"a\\n\\nc\"^^ .\n \"chat\"^^ .\n# resource28 test removed 2003-08-03\n# resource29 test removed 2003-08-03\n\n# Plain literals with languages\n \"chat\"@fr .\n \"chat\"@en .\n\n# Typed Literals\n \"abc\"^^ .\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 "
" (Just rdf_XMLLiteral)
-lxml2 = Lit "chat" (Just rdf_XMLLiteral)
+lxml1 = Lit "
" (Just rdfXMLLiteral)
+lxml2 = Lit "chat" (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 = " ."
graph2 = " \"\"."
@@ -173,8 +185,9 @@
graph9 = " \"chat\"^^."
graph10 = " _:x1 . "
graph11 = "_:genid23 _:x1 . "
+graph12 = " \"l4 \\\\\" ."
-graphm1, graphm1r :: String
+graphm1, graphm1r :: T.Text
graphm1 = "_:genid23 .\n\n # test \n_:genid23 _:x1 .\n\n"
graphm1r = "_:genid23 _:x1.\n_:genid23 .\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
]
diff --git a/tests/QNameTest.hs b/tests/QNameTest.hs
--- a/tests/QNameTest.hs
+++ b/tests/QNameTest.hs
@@ -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"
""
(show qb5)
+ , testStringEq "testShowQName06"
+ ""
+ (show qb6)
+ , testStringEq "testShowQName07"
+ ""
+ (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 ()
diff --git a/tests/RDFDatatypeXsdIntegerTest.hs b/tests/RDFDatatypeXsdIntegerTest.hs
--- a/tests/RDFDatatypeXsdIntegerTest.hs
+++ b/tests/RDFDatatypeXsdIntegerTest.hs
@@ -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
diff --git a/tests/RDFGraphTest.hs b/tests/RDFGraphTest.hs
--- a/tests/RDFGraphTest.hs
+++ b/tests/RDFGraphTest.hs
@@ -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
diff --git a/tests/RDFProofContextTest.hs b/tests/RDFProofContextTest.hs
--- a/tests/RDFProofContextTest.hs
+++ b/tests/RDFProofContextTest.hs
@@ -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: . \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
diff --git a/tests/RDFProofTest.hs b/tests/RDFProofTest.hs
--- a/tests/RDFProofTest.hs
+++ b/tests/RDFProofTest.hs
@@ -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: . \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: . \n" ++
- "@prefix 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: . \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: . \n"
+ `mappend`
+ "@prefix 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]
diff --git a/tests/RDFQueryTest.hs b/tests/RDFQueryTest.hs
--- a/tests/RDFQueryTest.hs
+++ b/tests/RDFQueryTest.hs
@@ -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: . \n" ++
- " \n"
+prefix1 :: B.Builder
+prefix1 = "@prefix ex: . \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: . \n" ++
- "@prefix rel: . \n" ++
- " \n"
+ "@prefix pers: . \n" `mappend`
+ "@prefix 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: . \n" ++
- "@prefix rel: . \n" ++
- " \n"
+ "@prefix pers: . \n" `mappend`
+ "@prefix 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 $
diff --git a/tests/RDFRulesetTest.hs b/tests/RDFRulesetTest.hs
--- a/tests/RDFRulesetTest.hs
+++ b/tests/RDFRulesetTest.hs
@@ -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: . \n" ++
- "@prefix rdfs: . \n" ++
- "@prefix ex: . \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: . \n" ++
- "@prefix rdfs: . \n" ++
- "@prefix ex: . \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"
diff --git a/tests/VarBindingTest.hs b/tests/VarBindingTest.hs
--- a/tests/VarBindingTest.hs
+++ b/tests/VarBindingTest.hs
@@ -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