swish 0.3.0.3 → 0.3.1.0
raw patch · 27 files changed
+1310/−482 lines, 27 filesdep +old-localedep +timePVP ok
version bump matches the API change (PVP)
Dependencies added: old-locale, time
API changes (from Hackage documentation)
+ Swish.RDF.RDFGraph: class FromRDFLabel a
+ Swish.RDF.RDFGraph: class ToRDFLabel a
+ Swish.RDF.RDFGraph: fromRDFLabel :: FromRDFLabel a => RDFLabel -> Maybe a
+ Swish.RDF.RDFGraph: fromRDFTriple :: (FromRDFLabel s, FromRDFLabel p, FromRDFLabel o) => RDFTriple -> Maybe (s, p, o)
+ Swish.RDF.RDFGraph: instance FromRDFLabel Bool
+ Swish.RDF.RDFGraph: instance FromRDFLabel Char
+ Swish.RDF.RDFGraph: instance FromRDFLabel Day
+ Swish.RDF.RDFGraph: instance FromRDFLabel Double
+ Swish.RDF.RDFGraph: instance FromRDFLabel Float
+ Swish.RDF.RDFGraph: instance FromRDFLabel Int
+ Swish.RDF.RDFGraph: instance FromRDFLabel Integer
+ Swish.RDF.RDFGraph: instance FromRDFLabel QName
+ Swish.RDF.RDFGraph: instance FromRDFLabel RDFLabel
+ Swish.RDF.RDFGraph: instance FromRDFLabel ScopedName
+ Swish.RDF.RDFGraph: instance FromRDFLabel String
+ Swish.RDF.RDFGraph: instance FromRDFLabel URI
+ Swish.RDF.RDFGraph: instance FromRDFLabel UTCTime
+ Swish.RDF.RDFGraph: instance IsString RDFLabel
+ Swish.RDF.RDFGraph: instance Label lb => Monoid (NSGraph lb)
+ Swish.RDF.RDFGraph: instance ToRDFLabel Bool
+ Swish.RDF.RDFGraph: instance ToRDFLabel Char
+ Swish.RDF.RDFGraph: instance ToRDFLabel Day
+ Swish.RDF.RDFGraph: instance ToRDFLabel Double
+ Swish.RDF.RDFGraph: instance ToRDFLabel Float
+ Swish.RDF.RDFGraph: instance ToRDFLabel Int
+ Swish.RDF.RDFGraph: instance ToRDFLabel Integer
+ Swish.RDF.RDFGraph: instance ToRDFLabel QName
+ Swish.RDF.RDFGraph: instance ToRDFLabel RDFLabel
+ Swish.RDF.RDFGraph: instance ToRDFLabel ScopedName
+ Swish.RDF.RDFGraph: instance ToRDFLabel String
+ Swish.RDF.RDFGraph: instance ToRDFLabel URI
+ Swish.RDF.RDFGraph: instance ToRDFLabel UTCTime
+ Swish.RDF.RDFGraph: toRDFLabel :: ToRDFLabel a => a -> RDFLabel
+ Swish.RDF.RDFGraph: toRDFTriple :: (ToRDFLabel s, ToRDFLabel p, ToRDFLabel o) => s -> p -> o -> RDFTriple
+ Swish.RDF.Vocabulary: xsd_date :: ScopedName
+ Swish.RDF.Vocabulary: xsd_dateTime :: ScopedName
+ Swish.Utils.Namespace: instance IsString ScopedName
+ Swish.Utils.QName: instance IsString QName
Files
- Swish.hs +77/−0
- Swish/RDF.hs +44/−0
- Swish/RDF/BuiltInRules.hs +14/−19
- Swish/RDF/GraphClass.hs +10/−1
- Swish/RDF/GraphMatch.hs +2/−2
- Swish/RDF/N3Formatter.hs +14/−7
- Swish/RDF/N3Parser.hs +20/−3
- Swish/RDF/NTFormatter.hs +1/−1
- Swish/RDF/Proof.hs +6/−13
- Swish/RDF/RDFGraph.hs +313/−30
- Swish/RDF/SwishCommands.hs +1/−1
- Swish/RDF/SwishMain.hs +6/−26
- Swish/RDF/VarBinding.hs +2/−0
- Swish/RDF/Vocabulary.hs +10/−8
- Swish/Utils/DateTime.hs +4/−2
- Swish/Utils/Namespace.hs +7/−5
- Swish/Utils/PartOrderedCollection.hs +3/−3
- Swish/Utils/QName.hs +18/−14
- src/Swish.hs +1/−1
- swish.cabal +80/−65
- tests/BuiltInMapTest.hs +9/−10
- tests/GraphTest.hs +8/−1
- tests/N3FormatterTest.hs +57/−8
- tests/N3ParserTest.hs +118/−143
- tests/QNameTest.hs +5/−3
- tests/RDFGraphTest.hs +458/−94
- tests/RDFQueryTest.hs +22/−22
+ Swish.hs view
@@ -0,0 +1,77 @@+--------------------------------------------------------------------------------+-- See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+-- Module : Swish+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+-- License : GPL V2+--+-- Maintainer : Douglas Burke+-- Stability : experimental+-- Portability : H98+--+-- Swish: Semantic Web Inference Scripting in Haskell+--+-- This program is a simple skeleton for constructing Semantic Web [1]+-- inference tools in Haskell, using the RDF graph and several RDF+-- parsers (at present Notation 3 and NTriples).+--+-- It might be viewed as a kind of embroyonic CWM [2] in Haskell,+-- except that the intent is that Haskell will be used as a primary+-- language for defining inferences. As such, Swish is an open-ended+-- toolkit for constructing new special-purpose Semantic Web+-- applications rather than a closed, self-contained general-purpose+-- SW application. As such, it is part of another experiment along+-- the lines described in [3].+--+-- The script format used by Swish is described in+-- "Swish.RDF.SwishScript".+--+-- Users wishing to process RDF data directly may prefer to look at+-- the following modules; "Swish.RDF", "Swish.RDF.N3Parser",+-- "Swish.RDF.N3Formatter", "Swish.RDF.NTParser" and+-- "Swish.RDF.NTFormatter".+--+-- (1) Semantic web: <http://www.w3.org/2001/sw/>+--+-- (2) CWM: <http://www.w3.org/2000/10/swap/doc/cwm.html>+--+-- (3) Motivation: <http://www.w3.org/2000/10/swap/doc/Motivation.html>+--+-- (4) Notation 3: <http://www.w3.org/TeamSubmission/2008/SUBM-n3-20080114/>+--+-- (5) RDF: <http://www.w3.org/RDF/>+--+--------------------------------------------------------------------------------++module Swish+ (+ module Swish.RDF.SwishMain+ ) where++import Swish.RDF.SwishMain+-- should this re-export Swish.RDF.SwishMain or other components?+ +--------------------------------------------------------------------------------+--+-- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+-- All rights reserved.+--+-- This file is part of Swish.+--+-- Swish is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- Swish is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with Swish; if not, write to:+-- The Free Software Foundation, Inc.,+-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+--+--------------------------------------------------------------------------------
+ Swish/RDF.hs view
@@ -0,0 +1,44 @@+--------------------------------------------------------------------------------+-- See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+-- Module : RDF+-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+-- License : GPL V2+--+-- Maintainer : Douglas Burke+-- Stability : experimental+-- Portability : FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances+--+-- This module provides an in-memory RDF Graph (it re-exports+-- "Swish.RDF.RDFGraph").+--+--------------------------------------------------------------------------------++module Swish.RDF (module Swish.RDF.RDFGraph) where++import Swish.RDF.RDFGraph++--------------------------------------------------------------------------------+--+-- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011 Douglas Burke+-- All rights reserved.+--+-- This file is part of Swish.+--+-- Swish is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- Swish is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with Swish; if not, write to:+-- The Free Software Foundation, Inc.,+-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+--+--------------------------------------------------------------------------------
Swish/RDF/BuiltInRules.hs view
@@ -23,8 +23,7 @@ ) where -import Swish.RDF.BuiltInDatatypes- ( allDatatypes )+import Swish.RDF.BuiltInDatatypes (allDatatypes) import Swish.RDF.RDFVarBinding ( RDFOpenVarBindingModify@@ -35,8 +34,7 @@ , rdfVarBindingMemberProp ) -import Swish.RDF.RDFRuleset- ( RDFRuleset, RDFRulesetMap )+import Swish.RDF.RDFRuleset (RDFRuleset, RDFRulesetMap) import Swish.RDF.RDFProofContext ( rulesetRDF@@ -49,18 +47,9 @@ , varFilterEQ, varFilterNE ) -import Swish.RDF.Datatype- ( typeRules- , typeMkModifiers- )--import Swish.Utils.LookupMap- ( LookupMap(..)- , mapFindMaybe- )--import Swish.Utils.Namespace- ( ScopedName(..) )+import Swish.RDF.Datatype (typeRules, typeMkModifiers)+import Swish.Utils.LookupMap (LookupMap(..), mapFindMaybe)+import Swish.Utils.Namespace (ScopedName(..)) ------------------------------------------------------------ -- Declare variable binding filters list@@ -83,9 +72,15 @@ , filter2 varFilterNE ] where- filter1 f lbs = makeVarFilterModify $ f (head lbs)- filter2 f lbs = makeVarFilterModify $ f (head lbs) (lbs!!1)- -- filterN f lbs = makeVarFilterModify $ f ...+ -- Swish.RDF.VarBinding.openVbmName seems to require that the label+ -- list not be evaluated which means that we can not replace these+ -- statements by ones like+ --+ -- filter1 f (lb:_) = makeVarFilterModift $ f lb+ --+ filter1 f lbs = makeVarFilterModify $ f (head lbs)+ filter2 f lbs = makeVarFilterModify $ f (head lbs) (lbs!!1)+ -- filterN f lbs = makeVarFilterModify $ f ... ------------------------------------------------------------ -- Declare variable binding modifiers map
Swish/RDF/GraphClass.hs view
@@ -90,6 +90,14 @@ update :: ( [Arc lb] -> [Arc lb] ) -> lg lb -> lg lb update f g = setArcs ( f (getArcs g) ) g +{-+TODO:+ add a Monoid instance for LDGraph, so that we can remove the+ NSGraph instance in RDFGraph++ This means adding the emptyGr function to the interface+-}+ -- |Function to replace arcs in a graph with a given list of arcs replaceArcs :: (LDGraph lg lb) => lg lb -> [Arc lb] -> lg lb replaceArcs gr as = update (const as) gr@@ -147,7 +155,8 @@ arc = Arc arcToTriple :: Arc lb -> (lb,lb,lb)-arcToTriple a = (asubj a,apred a,aobj a)+arcToTriple (Arc s p o) = (s, p, o)+-- arcToTriple a = (asubj a,apred a,aobj a) arcFromTriple :: (lb,lb,lb) -> Arc lb arcFromTriple (s,p,o) = Arc s p o
Swish/RDF/GraphMatch.hs view
@@ -22,7 +22,7 @@ module Swish.RDF.GraphMatch ( graphMatch,- -- The rest exported for testing only+ -- * Exported for testing LabelMap, GenLabelMap(..), LabelEntry, GenLabelEntry(..), ScopedLabel(..), makeScopedLabel, makeScopedArc, LabelIndex, EquivalenceClass, nullLabelVal, emptyMap,@@ -186,7 +186,7 @@ -> [Arc lb] -- ^ the first graph to be compared, as a list of arcs -> [Arc lb] -- ^ the second graph to be compared, as a list of arcs -> (Bool,LabelMap (ScopedLabel lb))- -- ^ If the first element is `True` then the secondelement maps each label+ -- ^ If the first element is `True` then the second element maps each label -- to an equivalence class identifier, otherwise it is just -- `emptyMap`. --
Swish/RDF/N3Formatter.hs view
@@ -13,7 +13,6 @@ -- This Module implements a Notation 3 formatter (see [1], [2] and [3]), -- for an RDFGraph value. ----- -- REFERENCES: -- -- (1) <http://www.w3.org/TeamSubmission/2008/SUBM-n3-20080114/>@@ -75,6 +74,7 @@ rdf_type, rdf_nil, owl_sameAs, log_implies+ , xsd_boolean, xsd_decimal, xsd_integer, xsd_double ) import Swish.RDF.GraphClass@@ -737,7 +737,9 @@ -- (b) URI nodes: if possible, replace URI with qname, -- else display as <uri> -- (c) formula nodes (containing graphs).---+-- (d) use the "special-case" formats for integer/float/double+-- literals. +-- -- [[[TODO:]]] -- (d) generate multi-line literals when appropriate --@@ -793,15 +795,20 @@ queueFormula lab return name -formatLabel _ (Lit lit mlit) = return $ quoteStr lit ++ formatAnnotation mlit+-- We assume there that the values are valid (e.g. that lit is syntactically+-- correct).+-- +formatLabel _ (Lit lit (Just dtype)) + | dtype `elem` [xsd_boolean, xsd_decimal, xsd_integer, xsd_double] = return lit+ | otherwise = return $ quoteStr lit ++ formatAnnotation dtype+formatLabel _ (Lit lit Nothing) = return $ quoteStr lit formatLabel _ lab = return $ show lab -- the annotation for a literal (ie type or language)-formatAnnotation :: Maybe ScopedName -> String-formatAnnotation Nothing = ""-formatAnnotation (Just a) | isLang a = '@' : langTag a- | otherwise = '^':'^': showScopedName a+formatAnnotation :: ScopedName -> String+formatAnnotation a | isLang a = '@' : langTag a+ | otherwise = '^':'^': showScopedName a {- Swish.Utils.MiscHelpers contains a quote routine
Swish/RDF/N3Parser.hs view
@@ -180,7 +180,7 @@ setPrefix :: String -> String -> N3State -> N3State setPrefix pre uri st = st { prefixUris=p' } where- p' = mapReplaceOrAdd (Namespace pre uri) (prefixUris st)+ p' = mapReplaceOrAdd (Namespace pre uri) (prefixUris st) -- | Set name for special syntax element setSName :: String -> ScopedName -> N3State -> N3State@@ -225,7 +225,7 @@ -- 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) } ----------------------------------------------------------------------@@ -399,11 +399,28 @@ -} operatorLabel snam = (Res . flip getPrefixScopedName snam) <$> getState --- Add statement to graph in N3 parser state+{-+Add statement to graph in N3 parser state. +To support literals that are written directly/implicitly - i.e. as+true/false/1/1.0/1.0e23 - rather than a string with an explicit+datatype we need to special case handling of the object label for+literals. Is this actually needed? The N3 Formatter now doesn't+display the xsd: datatypes on output, but there may be issues with+other formats (e.g RDF/XML once it is supported).++-}+ 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+ let stmt = arc s p o+ oldp = prefixUris st+ ogs = graphState st+ newp = mapReplaceOrAdd (snScope dtype) oldp+ setState $ st { prefixUris = newp, graphState = addArc stmt ogs } addStatement s p o = updateState (updateGraph (addArc (arc s p o) )) addStatementRev :: RDFLabel -> RDFLabel -> AddStatement
Swish/RDF/NTFormatter.hs view
@@ -169,7 +169,7 @@ -} quoteStr :: String -> String-quoteStr st = ['"'] ++ quote st ++ ['"']+quoteStr st = '"' : quote st ++ "\"" quote :: String -> String quote [] = ""
Swish/RDF/Proof.hs view
@@ -24,25 +24,18 @@ , checkProof, explainProof, checkStep, showProof, showsProof, showsFormula ) where -import Swish.RDF.Ruleset- ( Ruleset(..) )+import Swish.RDF.Ruleset (Ruleset(..)) import Swish.RDF.Rule ( Expression(..), Formula(..), Rule(..) , showsFormula, showsFormulae ) -import Swish.Utils.ShowM- ( ShowM(..) )--import Swish.Utils.ListHelpers- ( subset )--import Data.List- ( union, intersect, intercalate )+import Swish.Utils.ShowM (ShowM(..)) -import Data.Maybe- ( catMaybes )+import Swish.Utils.ListHelpers (subset) +import Data.List (union, intersect, intercalate)+import Data.Maybe (catMaybes, isNothing) ------------------------------------------------------------ -- Proof framework@@ -114,7 +107,7 @@ -> Step ex -- ^ the step to validate -> Bool -- ^ @True@ if the step is valid -checkStep rules prev step = maybe True (const False) $ explainStep rules prev step+checkStep rules prev step = isNothing $ explainStep rules prev step {-
Swish/RDF/RDFGraph.hs view
@@ -20,12 +20,19 @@ ------------------------------------------------------------ module Swish.RDF.RDFGraph- ( RDFLabel(..)+ ( + -- * Labels+ RDFLabel(..), ToRDFLabel(..), FromRDFLabel(..) , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral , isDatatyped, isMemberProp, isUri, isBlank, isQueryVar , getLiteralText, getScopedName, makeBlank+ + -- * RDF Graphs , RDFTriple- , NSGraph(..), RDFGraph+ , toRDFTriple, fromRDFTriple+ , NSGraph(..)+ , RDFGraph+ , toRDFGraph, emptyRDFGraph {-, updateRDFGraph-} , NamespaceMap, RevNamespaceMap, RevNamespace , emptyNamespaceMap , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap@@ -34,17 +41,19 @@ , newNode, newNodes , setNamespaces, getNamespaces , setFormulae, getFormulae, setFormula, getFormula- , toRDFGraph, emptyRDFGraph {-, updateRDFGraph-}- -- Re-export from GraphClass+ + -- * Re-export from GraphClass , LDGraph(..), Label (..), Arc(..) , arc, arcSubj, arcPred, arcObj, Selector- -- Export selected RDFLabel values+ + -- * 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- -- Exported for testing:+ + -- * Exported for testing , grMatchMap, grEq , mapnode, maplist )@@ -54,6 +63,9 @@ ( Namespace(..) , getScopedNameURI , ScopedName(..)+ , getQName+ , makeQNameScopedName+ , makeUriScopedName , nullScopedName ) @@ -66,6 +78,9 @@ , rdfd_GeneralRestriction , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality , owl_sameAs, log_implies+ -- , xsd_type+ , xsd_boolean, xsd_float, xsd_double, xsd_integer+ , xsd_dateTime, xsd_date ) import Swish.RDF.GraphClass@@ -73,14 +88,11 @@ , Arc(..), arc, arcSubj, arcPred, arcObj , Selector ) -import Swish.RDF.GraphMatch- ( graphMatch, LabelMap, ScopedLabel(..) )--import Swish.Utils.MiscHelpers- ( hash, quote )+import Swish.RDF.GraphMatch (graphMatch, LabelMap, ScopedLabel(..)) -import Swish.Utils.ListHelpers- ( addSetElem )+import Swish.Utils.QName (QName)+import Swish.Utils.MiscHelpers (hash, quote)+import Swish.Utils.ListHelpers (addSetElem) import Swish.Utils.LookupMap ( LookupMap(..), LookupEntryClass(..)@@ -93,13 +105,16 @@ import Control.Applicative (Applicative, liftA, (<$>), (<*>)) -- import Control.Monad (liftM, ap) -import Data.Char- ( isDigit )--import Data.List- ( intersect, union, findIndices )+import Network.URI (URI, parseURI, uriToString) +import Data.Monoid (Monoid(..))+import Data.Char (isDigit)+import Data.List (intersect, union, findIndices) import Data.Ord (comparing)+import Data.String (IsString(..))+import Data.Time (UTCTime, Day, ParseTime, parseTime, formatTime)+import System.Locale (defaultTimeLocale) +import Text.Printf ----------------------------------------------------------- -- | RDF graph node values@@ -176,6 +191,247 @@ makeLabel loc = Blank loc labelHash seed lb = hash seed (showCanon lb) +instance IsString RDFLabel where+ fromString = flip Lit Nothing++{-|+A type that can be converted to a RDF Label.++The String instance converts to an untyped literal+(so no language tag is assumed).++The `UTCTime` and `Day` instances assume values are in UTC.+ +The conversion for XSD types attempts to use the+canonical form described in section 2.3.1 of+<http://www.w3.org/TR/2004/REC-xmlschema-2-20041028/#lexical-space>.+ +-}++class ToRDFLabel a where+ toRDFLabel :: a -> RDFLabel+ +{-|+A type that can be converted from a RDF Label,+with the possibility of failure.+ +The String instance converts from an untyped literal+(so it can not be used with a string with a language tag).++The following conversions are supported for common XSD+types (out-of-band values result in @Nothing@):++ - @xsd:boolean@ to @Bool@++ - @xsd:integer@ to @Int@ and @Integer@++ - @xsd:float@ to @Float@++ - @xsd:double@ to @Double@++ - @xsd:dateTime@ to @UTCTime@++ - @xsd:date@ to @Day@++-}++class FromRDFLabel a where+ fromRDFLabel :: RDFLabel -> Maybe a++-- instances for type conversion to/from RDFLabel+ +instance ToRDFLabel RDFLabel where+ toRDFLabel = id+ +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+ _ -> Nothing+ +fLabel :: (String -> 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 dtype conv = flip Lit (Just dtype) . conv . show ++instance ToRDFLabel Char where+ toRDFLabel = flip Lit Nothing . (:[])++instance FromRDFLabel Char where+ fromRDFLabel (Lit [c] Nothing) = Just c+ fromRDFLabel _ = Nothing++instance ToRDFLabel String where+ toRDFLabel = flip Lit Nothing++instance FromRDFLabel String where+ fromRDFLabel (Lit xs Nothing) = Just xs+ fromRDFLabel _ = Nothing++instance ToRDFLabel Bool where+ toRDFLabel b = Lit (if b then "true" else "false") (Just xsd_boolean)+ +instance FromRDFLabel Bool where+ fromRDFLabel = fLabel conv xsd_boolean+ where+ conv s | s `elem` ["1", "true"] = Just True+ | s `elem` ["0", "false"] = Just False+ | otherwise = Nothing++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+ where+ toL = flip Lit (Just dtype)++toRealFloat :: (RealFloat a, Read a) => (a -> Maybe a) -> ScopedName -> RDFLabel -> Maybe a+toRealFloat conv = fLabel 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+ +instance ToRDFLabel Float where+ toRDFLabel = fromRealFloat xsd_float+ +instance FromRDFLabel Float where+ fromRDFLabel = toRealFloat conv xsd_float+ where+ -- 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+ +instance ToRDFLabel Double where+ toRDFLabel = fromRealFloat xsd_double+ +instance FromRDFLabel Double where+ fromRDFLabel = toRealFloat Just xsd_double+ +-- TODO: are there subtypes of xsd::integer that are +-- useful here? +-- +-- TODO: add in support for Int8/..., Word8/... +-- +instance ToRDFLabel Int where+ toRDFLabel = tLabel xsd_integer id++{-+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.+-}++instance FromRDFLabel Int where+ fromRDFLabel = fLabel (\istr -> maybeRead istr >>= conv) xsd_integer+ where+ 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++instance ToRDFLabel Integer where+ toRDFLabel = tLabel xsd_integer id++instance FromRDFLabel Integer where+ fromRDFLabel = fLabel maybeRead xsd_integer++{-+Support an ISO-8601 style format supporting++ 2005-02-28T00:00:00Z+ 2004-12-31T19:01:00-05:00+ 2005-07-14T03:18:56.234+01:00++fromUTCFormat is used to convert UTCTime to a string+for storage within a Lit.++toUTCFormat is used to convert a string into UTCTime;+we have to support + no time zone+ Z+ +/-HH:MM++which means a somewhat messy convertor, which is written+for clarity rather than speed.+-}++fromUTCFormat :: UTCTime -> String+fromUTCFormat = formatTime defaultTimeLocale "%FT%T%QZ"+ +fromDayFormat :: Day -> String+fromDayFormat = formatTime defaultTimeLocale "%FZ"+ +toTimeFormat :: (ParseTime a) => String -> String -> Maybe a+toTimeFormat fmt inVal =+ let fmtHHMM = fmt ++ "%z"+ fmtZ = fmt ++ "Z"+ pt f = parseTime defaultTimeLocale f inVal+ in case pt fmtHHMM of+ o@(Just _) -> o+ _ -> case pt fmtZ of+ o@(Just _) -> o+ _ -> pt fmt + +toUTCFormat :: String -> Maybe UTCTime+toUTCFormat = toTimeFormat "%FT%T%Q"+ +toDayFormat :: String -> Maybe Day+toDayFormat = toTimeFormat "%F"+ +instance ToRDFLabel UTCTime where+ toRDFLabel = flip Lit (Just xsd_dateTime) . fromUTCFormat+ +instance FromRDFLabel UTCTime where+ fromRDFLabel = fLabel toUTCFormat xsd_dateTime+ +instance ToRDFLabel Day where+ toRDFLabel = flip Lit (Just xsd_date) . fromDayFormat++instance FromRDFLabel Day where+ fromRDFLabel = fLabel toDayFormat xsd_date+ +instance ToRDFLabel ScopedName where + toRDFLabel = Res++instance FromRDFLabel ScopedName where+ fromRDFLabel (Res sn) = Just sn+ fromRDFLabel _ = Nothing+ +instance ToRDFLabel QName where + toRDFLabel = Res . makeQNameScopedName+ +instance FromRDFLabel QName where+ fromRDFLabel (Res sn) = Just $ getQName sn+ fromRDFLabel _ = Nothing+ +instance ToRDFLabel URI where + toRDFLabel u = Res $ makeUriScopedName $ uriToString id u ""+ +instance FromRDFLabel URI where+ fromRDFLabel (Res sn) = parseURI $ getScopedNameURI sn+ fromRDFLabel _ = Nothing+ -- | Get the canonical string for RDF label. -- -- Used for hashing, so that equivalent labels always return@@ -301,9 +557,37 @@ makeBlank lb = lb -- | RDF Triple (statement)-+-- +-- At present there is no check or type-level+-- constraint that stops the subject or+-- predicate of the triple from being a literal.+-- type RDFTriple = Arc RDFLabel +-- | Convert 3 RDF labels to a RDF triple.+--+-- See also `arcFromTriple`.+toRDFTriple :: + (ToRDFLabel s, ToRDFLabel p, ToRDFLabel o) + => s -- ^ Subject + -> p -- ^ Predicate+ -> o -- ^ Object+ -> RDFTriple+toRDFTriple s p o = + Arc (toRDFLabel s) (toRDFLabel p) (toRDFLabel o)++-- | Extract the contents of a RDF triple.+--+-- See also `arcToTriple`.+fromRDFTriple :: + (FromRDFLabel s, FromRDFLabel p, FromRDFLabel o) + => RDFTriple + -> Maybe (s, p, o) -- ^ The conversion only succeeds if all three+ -- components can be converted to the correct+ -- Haskell types.+fromRDFTriple (Arc s p o) = + (,,) <$> fromRDFLabel s <*> fromRDFLabel p <*> fromRDFLabel o+ -- | Namespace prefix list entry type NamespaceMap = LookupMap Namespace@@ -326,7 +610,7 @@ , formGraph :: gr } -instance ( Eq lb, Eq gr ) => Eq (LookupFormula lb gr) where+instance (Eq lb, Eq gr) => Eq (LookupFormula lb gr) where f1 == f2 = formLabel f1 == formLabel f2 && formGraph f1 == formGraph f2 @@ -413,6 +697,10 @@ setFormula :: (Label lb) => Formula lb -> NSGraph lb -> NSGraph lb setFormula f g = g { formulae=mapReplaceOrAdd f (formulae g) } +instance (Label lb) => Monoid (NSGraph lb) where+ mempty = NSGraph emptyNamespaceMap (LookupMap []) []+ mappend = merge+ instance (Label lb) => LDGraph NSGraph lb where getArcs = statements setArcs as g = g { statements=as }@@ -473,17 +761,12 @@ matchable l1 l2 = mapFormula g1 l1 == mapFormula g2 l2 mapFormula g l = mapFindMaybe l (getFormulae g) -toNSGraph :: (Eq lb, Show lb) => [Arc lb] -> NSGraph lb-toNSGraph arcs =- NSGraph- { statements = arcs- , namespaces = emptyNamespaceMap- , formulae = LookupMap []- }- -- |Merge RDF graphs, renaming blank and query variable nodes as -- needed to neep variable nodes from the two graphs distinct in -- the resulting graph.+-- +-- Currently formulae are not preserved across a merge.+-- merge :: (Label lb) => NSGraph lb -> NSGraph lb -> NSGraph lb merge gr1 gr2 = let@@ -615,11 +898,11 @@ -- |Create a new RDF graph from a supplied list of arcs toRDFGraph :: [Arc RDFLabel] -> RDFGraph-toRDFGraph = toNSGraph +toRDFGraph arcs = emptyRDFGraph { statements = arcs } -- |Create a new, empty RDF graph. emptyRDFGraph :: RDFGraph-emptyRDFGraph = toRDFGraph []+emptyRDFGraph = mempty {- -- |Update an RDF graph using a supplied list of arcs, keeping
Swish/RDF/SwishCommands.hs view
@@ -363,7 +363,7 @@ Right res -> return $ Just res case fmt of- N3 -> readIn (`parseN3` (Just buri))+ N3 -> readIn (`parseN3` Just buri) NT -> readIn parseNT {- _ -> swishError ("Unsupported file format: "++show fmt) SwishArgumentError >>
Swish/RDF/SwishMain.hs view
@@ -10,34 +10,14 @@ -- Stability : experimental -- Portability : H98 ----- Swish: Semantic Web Inference Scripting in Haskell------ This program is a simple skeleton for constructing Semantic Web [1]--- inference tools in Haskell, using the RDF graph and several RDF--- parsers (at present Notation 3 and NTriples).------ It might be viewed as a kind of embroyonic CWM [2] in Haskell, except--- that the intent is that Haskell will be used as a primary language for--- defining inferences. As such, Swish is an open-ended toolkit for--- constructing new special-purpose Semantic Web applications rather--- than a closed, self-contained general-purpose SW application. -- I anticipate that this module may be used as a starting point for--- creating new programs rathar then as a complete program in its own right.--- The functionality built into this code is selected with a view to testing--- the Haskell modules for handling RDF rather than for performing any--- particular application processing (though development as a tool with--- some broader utility is not ruled out). As such, it is part of--- another experiment along the lines described in [3].------ (1) Semantic web: <http://www.w3.org/2001/sw/>------ (2) CWM: <http://www.w3.org/2000/10/swap/doc/cwm.html>------ (3) Motivation: <http://www.w3.org/2000/10/swap/doc/Motivation.html>------ (4) Notation 3: <http://www.w3.org/TeamSubmission/2008/SUBM-n3-20080114/>+-- creating new programs rather then as a complete program in its own+-- right. The functionality built into this code is selected with a+-- view to testing the Haskell modules for handling RDF rather than+-- for performing any particular application processing (though+-- development as a tool with some broader utility is not ruled out). ----- (5) RDF: <http://www.w3.org/RDF/>+-- This module is likely to be moved to the Swish module. -- --------------------------------------------------------------------------------
Swish/RDF/VarBinding.hs view
@@ -61,6 +61,8 @@ -- Query variable bindings ------------------------------------------------------------ +-- TODO: is it worth making a Monoid instance of VarBinding?+ -- |VarBinding is the type of an arbitrary variable bindings -- value, where the type of the bound values is not specified. --
Swish/RDF/Vocabulary.hs view
@@ -43,15 +43,13 @@ , 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 ) where -import Swish.Utils.Namespace- ( Namespace(..), ScopedName(..) )--import Swish.Utils.MiscHelpers- ( lower )+import Swish.Utils.Namespace (Namespace(..), ScopedName(..))+import Swish.Utils.MiscHelpers (lower) ------------------------------------------------------------ -- Define some common namespace values@@ -116,10 +114,10 @@ ------------------------------------------------------------ -- -- Note: simple language tag URIs may be abbreviated as lang:tag,--- but if the tag contains ahyphen, this would not be valid QName+-- but if the tag contains a hyphen, this would not be valid QName -- form in Notation3, even though it is a valid QName component. -- Fortunately, they do not currently need to appear in Notation3 as--- distinct labels (but future developments m,ay change that).+-- distinct labels (but future developments may change that). namespaceLang :: Namespace namespaceLang@@ -127,7 +125,7 @@ -- To be replaced by urn:ietf:params:lang? langName :: String -> ScopedName-langName tag = ScopedName namespaceLang (lower tag)+langName = ScopedName namespaceLang . lower langTag :: ScopedName -> String langTag = snLocal@@ -229,6 +227,10 @@ xsd_double :: ScopedName xsd_double = xsd_type "double"++xsd_date, xsd_dateTime :: ScopedName+xsd_date = xsd_type "date"+xsd_dateTime = xsd_type "dateTime" owl_sameAs :: ScopedName owl_sameAs = ScopedName namespaceOWL "sameAs"
Swish/Utils/DateTime.hs view
@@ -11,8 +11,11 @@ -- Portability : H98 -- -- This Module defines a collection of date/time manipulation functions. It--- should probably be replaced by standard modules from Hackage. +-- is deprecated - since it's functionality is available from other+-- modules - and will be removed in a future release. --+--------------------------------------------------------------------------------+-- -- Date/time value manipulation. -- -- Date/time can be date-only or time-only@@ -23,7 +26,6 @@ -- 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
Swish/Utils/Namespace.hs view
@@ -32,11 +32,10 @@ ) where -import Swish.Utils.QName- ( QName(..), getQNameURI )+import Swish.Utils.QName (QName(..), getQNameURI)+import Swish.Utils.LookupMap (LookupEntryClass(..)) -import Swish.Utils.LookupMap- ( LookupEntryClass(..) )+import Data.String (IsString(..)) ------------------------------------------------------------ -- Namespace, having a prefix and a URI@@ -96,6 +95,9 @@ getScopeURI :: ScopedName -> String getScopeURI = nsURI . snScope +instance IsString ScopedName where+ fromString = makeUriScopedName+ instance Eq ScopedName where (==) = snEq @@ -109,7 +111,7 @@ pre = nsPrefix n uri = nsURI n --- Scoped names are equal of ther corresponding QNames are equal+-- Scoped names are equal if their corresponding QNames are equal snEq :: ScopedName -> ScopedName -> Bool snEq s1 s2 = getQName s1 == getQName s2
Swish/Utils/PartOrderedCollection.hs view
@@ -12,11 +12,11 @@ -- -- This module provides methods to support operations on partially ordered -- collections. The partial ordering relationship is represented by--- Maybe `Ordering`.+-- `Maybe Ordering`. -- -- Thanks to members of the haskell-cafe mailing list ---- Robert (rvollmert-lists@gmx.net) and--- Tom Pledger (Tom.Pledger@peace.com) -+-- Robert (rvollmert-lists\@gmx.net) and+-- Tom Pledger (Tom.Pledger\@peace.com) - -- who suggested key ideas on which some of the code in this module is based. -- --------------------------------------------------------------------------------
Swish/Utils/QName.hs view
@@ -27,6 +27,7 @@ import System.Directory (canonicalizePath) import System.FilePath (splitDirectories)+import Data.String (IsString(..)) import Data.List (intercalate) ------------------------------------------------------------@@ -37,6 +38,23 @@ data QName = QName { qnNsuri, qnLocal :: String } +instance IsString QName where+ fromString = qnameFromURI++instance Eq QName where+ (==) = qnEq++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++instance Show QName where+ show (QName ns ln) = "<" ++ ns ++ ln ++ ">"+ newQName :: String -> String -> QName newQName = QName @@ -54,20 +72,6 @@ getQNameURI :: QName -> String getQNameURI (QName ns ln) = ns++ln--instance Eq QName where- (==) = qnEq--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--instance Show QName where- show (QName ns ln) = "<" ++ ns ++ ln ++ ">" -- Original used comparison of concatenated strings, -- but that was very inefficient. This version does the
src/Swish.hs view
@@ -26,7 +26,7 @@ import System.IO (stderr, hPutStrLn) -import Swish.RDF.SwishMain+import Swish ------------------------------------------------------------ -- Swish main program
swish.cabal view
@@ -1,5 +1,5 @@ Name: swish-Version: 0.3.0.3+Version: 0.3.1.0 Stability: experimental License: LGPL License-file: LICENSE @@ -14,69 +14,82 @@ Homepage: https://bitbucket.org/doug_burke/swish/wiki/Home Bug-reports: https://bitbucket.org/doug_burke/swish/issues -Description: Swish is a framework, written in the purely functional - programming language Haskell, for performing deductions in - RDF data using a variety of techniques. Swish is conceived - as a toolkit for experimenting with RDF inference, and for - implementing stand-alone RDF file processors (usable in - similar style to CWM, but with a view to being extensible - in declarative style through added Haskell function and data- value declarations). It explores Haskell as \"a scripting - language for the Semantic Web\".- .- Swish is a work-in-progress, and currently incorporates:- .- * Notation3 and NTriples input and output. The N3 support is- incomplete (no handling of @\@forAll@).- .- * RDF graph isomorphism testing and merging.- .- * Display of differences between RDF graphs.- .- * Inference operations in forward chaining, backward chaining and proof-checking modes.- .- * Simple Horn-style rule implementations, extendable through variable binding modifiers and filters.- .- * Class restriction rule implementation, primarily for datatype inferences.- .- * RDF formal semantics entailment rule implementation.- .- * Complete, ready-to-run, command-line and script-driven programs.- .- Major Changes:- .- [Version 0.3.0.3] Changed @scripts/SwishExample.ss@ script so that the- proof succeeds. Some documentation improvements, including a discussion- of the Swish script format (see "Swish.RDF.SwishScript"). Very minor- changes to behavior of Swish in several edge cases.- .- [Version 0.3.0.2] Bugfix: stop losing triples with a bnode subject when- using the N3Formatter; this also makes the @scripts/SwishTest.ss@ test- pass again. Several commands in Swish scripts now create screen- output (mainly to check what it is doing). Added the @developer@- flag for building.- .- [Version 0.3.0.1] updates the Swish script parser to work with the- changes in 0.3.0.0 (reported by Rick Murphy).- Several example scripts are installed in the- @scripts/@ directory, although only @VehicleCapacity.ss@ works- with this release.- .- [Version 0.3.0.0] is an attempt to update - version 0.2.1 (<http://hackage.haskell.org/package/swish-0.2.1/>)- to build against- a recent ghc install, with some clean ups - including support for- the current N3 specification - and the addition of the- NTriples format. It has not been tested against ghc7.- .- References:- .- - <http://www.ninebynine.org/RDFNotes/Swish/Intro.html>- .- - <http://www.ninebynine.org/Software/swish-0.2.1.html>- .- - CWM: <http://www.w3.org/2000/10/swap/doc/cwm.html>- .+Description: + Swish is a framework, written in the purely functional + programming language Haskell, for performing deductions in + RDF data using a variety of techniques. Swish is conceived + as a toolkit for experimenting with RDF inference, and for + implementing stand-alone RDF file processors (usable in + similar style to CWM, but with a view to being extensible + in declarative style through added Haskell function and data+ value declarations). It explores Haskell as \"a scripting + language for the Semantic Web\".+ .+ Swish is a work-in-progress, and currently incorporates:+ .+ * Notation3 and NTriples input and output. The N3 support is+ incomplete (no handling of @\@forAll@).+ .+ * RDF graph isomorphism testing and merging.+ .+ * Display of differences between RDF graphs.+ .+ * Inference operations in forward chaining, backward chaining and proof-checking modes.+ .+ * Simple Horn-style rule implementations, extendable through variable binding modifiers and filters.+ .+ * Class restriction rule implementation, primarily for datatype inferences.+ .+ * RDF formal semantics entailment rule implementation.+ .+ * Complete, ready-to-run, command-line and script-driven programs.+ .+ Major Changes:+ .+ [Version 0.3.1.0] Added the `Swish.RDF.RDFGraph.ToRDFLabel` and+ `Swish.RDF.RDFGraph.FromRDFLabel` classes and the + `Swish.RDF.RDFGraph.toRDFTriple` and `Swish.RDF.RDFGraph.fromRDFTriple`+ functions.+ Added instances: @IsString RDFLabel@, @IsString QName@, @IsString ScopedName@+ and @Monoid NSGraph@.+ The modules "Swish" and "Swish.RDF" have been introduced to provide+ documentation. The module "Swish.Utils.DateTime" is deprecated and+ will be removed in a later release.+ The N3 formatter now writes out literals with @xsd:boolean@, @xsd:integer@, + @xsd:decimal@ and @xsd:double@ types as literals rather than as a typed string.+ .+ [Version 0.3.0.3] Changed @scripts/SwishExample.ss@ script so that the+ proof succeeds. Some documentation improvements, including a discussion+ of the Swish script format (see "Swish.RDF.SwishScript"). Very minor+ changes to behavior of Swish in several edge cases.+ .+ [Version 0.3.0.2] Bugfix: stop losing triples with a bnode subject when+ using the N3Formatter; this also makes the @scripts/SwishTest.ss@ test+ pass again. Several commands in Swish scripts now create screen+ output (mainly to check what it is doing). Added the @developer@+ flag for building.+ .+ [Version 0.3.0.1] updates the Swish script parser to work with the+ changes in 0.3.0.0 (reported by Rick Murphy).+ Several example scripts are installed in the+ @scripts/@ directory, although only @VehicleCapacity.ss@ works+ with this release.+ .+ [Version 0.3.0.0] is an attempt to update + version 0.2.1 (<http://hackage.haskell.org/package/swish-0.2.1/>)+ to build against+ a recent ghc install, with some clean ups - including support for+ the current N3 specification - and the addition of the+ NTriples format. It has not been tested against ghc7.+ .+ References:+ .+ - <http://www.ninebynine.org/RDFNotes/Swish/Intro.html>+ .+ - <http://www.ninebynine.org/Software/swish-0.2.1.html>+ .+ - CWM: <http://www.w3.org/2000/10/swap/doc/cwm.html>+ . Build-Type: Simple Data-Files: README@@ -108,13 +121,15 @@ parallel == 2.2.*, parsec == 2.1.*, random == 1.0.*,- old-time == 1.0.*,+ old-time == 1.0.*, old-locale == 1.0.*, time == 1.1.*, mtl >= 1 && < 3, HUnit == 1.2.*, network >= 2.2 && < 2.4, directory >= 1.0 && <= 1.1, filepath >= 1.1 && <= 1.2 Exposed-Modules:+ Swish+ Swish.RDF Swish.RDF.BuiltInDatatypes Swish.RDF.BuiltInMap Swish.RDF.BuiltInRules
tests/BuiltInMapTest.hs view
@@ -54,17 +54,11 @@ ( Test(TestCase,TestList) , Assertion , assertBool, assertEqual, assertFailure- , runTestTT, runTestText, putTextToHandle- )--import System.IO- ( IOMode(WriteMode)- , openFile, hClose+ , runTestTT ) import Control.Monad (unless)-import Data.Maybe (isJust)-+import Data.Maybe (isJust, isNothing) ------------------------------------------------------------ -- Test case helpers@@ -100,7 +94,7 @@ testNothing :: String -> Maybe a -> Test testNothing lab av =- TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )+ TestCase ( assertBool ("testNothing:"++lab) (isNothing av) ) -- Compare lists and lists of lists and Maybe lists for set equivalence: @@ -173,6 +167,11 @@ testVarModSuite = TestList [ testVarMod01, testVarMod02, testVarMod03, testVarMod04 , testVarMod05, testVarMod06, testVarMod07+ -- the following just exposes a few "edge" cases (a Show instance+ -- and using the namespace part of the swish namespace)+ , TestCase (assertEqual "show:rdfVarBindingUriRef" + (Just "swish:rdfVarBindingUriRef")+ $ fmap show (findRDFOpenVarBindingModifier (swishName "rdfVarBindingUriRef"))) ] ------------------------------------------------------------@@ -252,13 +251,13 @@ main :: IO () main = runTestTT allTests >> return () +{- runTestFile :: Test -> IO () runTestFile t = do h <- openFile "a.tmp" WriteMode _ <- runTestText (putTextToHandle h False) t hClose h -{- tf = runTestFile tt = runTestTT -}
tests/GraphTest.hs view
@@ -16,9 +16,13 @@ module Main where +import qualified Data.Foldable as F+ import Test.HUnit ( Test(TestCase,TestList,TestLabel),- assertEqual, runTestTT )+ assertEqual, assertBool,+ runTestTT )+ import Data.List (sort, elemIndex) import Data.Maybe (fromJust) @@ -1756,6 +1760,7 @@ , testGraphSuite , testLabelEqSuite , testLabelOrdSuite+ , TestCase (assertBool "arc neq" ((Arc True True True) /= (Arc True True False))) -- silly test of Eq instance , testStmtEqSuite , testLabelMapSuite , testGraphMatchSupportSuite@@ -1763,6 +1768,8 @@ , testGraphEqSuitePart , testGraphEqSuite , testGraphEqSuiteMore+ -- test of Foldable instance of Arc+ , TestCase (assertEqual "fold Arc" [1::Int,2,4] (F.fold (Arc [1::Int] [2] [4]))) ] main :: IO ()
tests/N3FormatterTest.hs view
@@ -24,7 +24,9 @@ import Swish.RDF.N3Parser (parseN3fromString) import Swish.RDF.RDFGraph- ( RDFGraph, RDFLabel(..), NSGraph(..)+ ( RDFGraph+ , RDFLabel(..), ToRDFLabel(..)+ , NSGraph(..) , NamespaceMap , LookupFormula(..) , emptyRDFGraph, toRDFGraph@@ -33,17 +35,16 @@ , res_owl_sameAs ) -import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..)- )+import Swish.Utils.Namespace (Namespace(..), ScopedName(..)) import Swish.Utils.LookupMap ( LookupMap(..)- , emptyLookupMap, makeLookupMap )+ , emptyLookupMap, makeLookupMap, mapAdd ) import Swish.RDF.GraphClass (Arc, arc) +import Swish.RDF.Vocabulary (langName)+ import Test.HUnit ( Test(TestCase,TestList) , assertEqual, runTestTT )@@ -127,6 +128,10 @@ l13 = Lit l13txt Nothing l14 = Lit l14txt Nothing +lfr, lfoobar :: RDFLabel+lfr = Lit "chat et chien" (Just (langName "fr"))+lfoobar = Lit "foo bar" (Just (ScopedName base1 "o1"))+ f1, f2 :: RDFLabel f1 = Res $ ScopedName base1 "f1" f2 = Res $ ScopedName base2 "f2"@@ -623,6 +628,19 @@ arc b2 p2 o2, arc b3 res_rdf_type o3] +-- datatype/literal graphs++graph_l1, graph_l2, graph_l3 :: RDFGraph+graph_l1 = toGraph [arc s1 p1 lfr]+graph_l2 = toGraph [arc s1 p1 lfoobar]+graph_l3 = + let gtmp = toGraph [arc s1 p1 (toRDFLabel (12::Int)),+ arc s1 p1 (toRDFLabel (23.4::Float)),+ arc s1 p1 (toRDFLabel ((-2.304e-108)::Double)),+ arc s1 p1 (toRDFLabel True)+ ]+ in gtmp { namespaces = mapAdd (namespaces gtmp) (Namespace "xsd" "http://www.w3.org/2001/XMLSchema#") }+ ------------------------------------------------------------ -- Trivial formatter tests ------------------------------------------------------------@@ -832,8 +850,29 @@ "[\n base2:p2 base2:o2\n] .\n" ++ "[\n a base3:o3\n] .\n" --- diag13 = diagTest "trivialTest13" x13a simpleN3Graph_x13a-+{-+Simple datatype/language tests; may replicate some of the+previous tests.+-}+simpleN3Graph_l1 :: String+simpleN3Graph_l1 =+ commonPrefixes +++ "base1:s1 base1:p1 \"chat et chien\"@fr .\n"+ +simpleN3Graph_l2 :: String+simpleN3Graph_l2 =+ commonPrefixes +++ "base1:s1 base1:p1 \"foo bar\"^^base1:o1 .\n"+ +simpleN3Graph_l3 :: String+simpleN3Graph_l3 =+ "@prefix xsd: <http://www.w3.org/2001/XMLSchema#> .\n" ++ + commonPrefixes ++ + "\n" ++ -- TODO: why do we need this?+ "base1:s1 base1:p1 -2.304E-108,\n" ++ + " 12,\n" ++ + " \"2.34E1\"^^xsd:float, true .\n"+ trivialTestSuite :: Test trivialTestSuite = TestList [ formatTest "trivialTest01" g1np simpleN3Graph_g1_01@@ -862,6 +901,10 @@ , formatTest "trivialTestb1rev" graph_b1rev simpleN3Graph_b1rev , formatTest "trivialTestb2rev" graph_b2rev simpleN3Graph_b2rev + , formatTest "lit1" graph_l1 simpleN3Graph_l1 + , formatTest "lit2" graph_l2 simpleN3Graph_l2+ , formatTest "lit3" graph_l3 simpleN3Graph_l3+ , formatTest "trivialTestx4" x4 exoticN3Graph_x4 , formatTest "trivialTestx5" x5 exoticN3Graph_x5 , formatTest "trivialTestx7" x7 exoticN3Graph_x7@@ -949,6 +992,11 @@ , roundTripTest "04" g1a1 , roundTripTest "05" g1l1 , roundTripTest "06" g1l2+ + , roundTripTest "l1" graph_l1+ , roundTripTest "l2" graph_l2+ , roundTripTest "l3" graph_l3+ -- roundTripTest07 = roundTripTest "07" g1f1 -- formula is a named node , roundTripTest "08" g1f2 , fullRoundTripTest "11" simpleN3Graph_g1_01@@ -959,6 +1007,7 @@ , fullRoundTripTest "16rt" simpleN3Graph_g1_06_rt -- roundTripTest17 = fullRoundTripTest "17" simpleN3Graph_g1_07 -- TODO: :- with named node for formula , fullRoundTripTest "18" simpleN3Graph_g1_08+ ] ------------------------------------------------------------
tests/N3ParserTest.hs view
@@ -26,11 +26,8 @@ import Swish.RDF.RDFGraph ( RDFGraph, RDFLabel(..), NSGraph(..)- -- LookupNamespace(..), Namespace- , emptyNamespaceMap- , LookupFormula(..), emptyFormulaMap+ , LookupFormula(..) , emptyRDFGraph, toRDFGraph- -- Export selected RDFLabel values , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil , res_owl_sameAs, res_log_implies )@@ -48,6 +45,10 @@ ( namespaceRDF , langName , rdf_XMLLiteral+ , xsd_boolean + , xsd_integer+ , xsd_decimal + , xsd_double ) import Swish.Utils.QName (QName, qnameFromURI)@@ -57,6 +58,7 @@ import Test.HUnit (Test(TestCase,TestList), assertEqual, runTestTT) +import Data.Monoid (Monoid(..)) import Data.List (intercalate) ------------------------------------------------------------@@ -250,6 +252,9 @@ 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 "" @@ -310,13 +315,13 @@ l3 = Lit "l3--\r\"'\\--\x0020\&--\x00A0\&--" Nothing lfr, lxml, lfrxml :: RDFLabel-lfr = Lit "chat" (Just $ langName "fr")-lxml = Lit "<br/>" (Just rdf_XMLLiteral )-lfrxml = Lit "<em>chat</em>" (Just rdf_XMLLiteral )+lfr = Lit "chat" $ Just $ langName "fr"+lxml = Lit "<br/>" $ Just rdf_XMLLiteral+lfrxml = Lit "<em>chat</em>" $ Just rdf_XMLLiteral bTrue, bFalse :: RDFLabel-bTrue = Lit "true" $ Just $ ScopedName (Namespace "xsd" "http://www.w3.org/2001/XMLSchema#") "boolean"-bFalse = Lit "false" $ Just $ ScopedName (Namespace "xsd" "http://www.w3.org/2001/XMLSchema#") "boolean"+bTrue = Lit "true" $ Just xsd_boolean+bFalse = Lit "false" $ Just xsd_boolean f1, f2 :: RDFLabel f1 = Res $ ScopedName base1 "f1"@@ -379,17 +384,23 @@ xb5 = mUN ns5 "b5" xc5 = mUN ns5 "c5" -nslist :: LookupMap Namespace+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 = NSGraph { namespaces = nslist- , formulae = emptyFormulaMap+toGraph stmts = mempty { namespaces = nslist , statements = stmts } @@ -424,25 +435,13 @@ g4_2 = toGraph [arc b1 res_rdf_type o1, arc b2 res_rdf_type o2] g5 :: RDFGraph-g5 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t01,t02,t03,t04,t05]- }+g5 = toGraph [t01,t02,t03,t04,t05] g6 :: RDFGraph-g6 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t01,t06]- }+g6 = toGraph [t01,t06] g7 :: RDFGraph-g7 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t01,t07]- }+g7 = toGraph [t01,t07] t801, t802, t807, t808, t811, t812 :: Arc RDFLabel t801 = arc s1 res_rdf_type o1@@ -453,25 +452,13 @@ t812 = arc o2 res_log_implies s2 g8 :: RDFGraph-g8 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t801,t802,t807,t808,t811,t812]- }+g8 = toGraph [t801,t802,t807,t808,t811,t812] g81 :: RDFGraph-g81 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t801,t802]- }+g81 = toGraph [t801,t802] g83 :: RDFGraph-g83 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t807,t808,t811,t812]- }+g83 = toGraph [t807,t808,t811,t812] t911, t912, t913, t914, t921, t922, t923, t924, t925, t926, t927, t928 :: Arc RDFLabel@@ -489,13 +476,9 @@ t928 = arc s2 p2 l1 g9 :: RDFGraph-g9 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t911,t912,t913,t914,- t921,t922,t923,t924,- t925,t926,t927,t928]- }+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@@ -513,13 +496,9 @@ t1028 = arc l1 p2 s2 g10 :: RDFGraph-g10 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t1011,t1012,t1013,t1014,- t1021,t1022,t1023,t1024,- t1025,t1026,t1027,t1028]- }+g10 = toGraph [t1011,t1012,t1013,t1014,+ t1021,t1022,t1023,t1024,+ t1025,t1026,t1027,t1028] t1111, t1112, t1113 :: Arc RDFLabel t1111 = arc s1 p1 v1@@ -527,11 +506,7 @@ t1113 = arc v3 p1 v4 g11 :: RDFGraph-g11 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t1111,t1112,t1113]- }+g11 = toGraph [t1111,t1112,t1113] t1211, t1221, t1222, t1223, t1224 :: Arc RDFLabel t1211 = arc b1 p1 o1@@ -541,11 +516,7 @@ t1224 = arc b3 res_rdf_rest res_rdf_nil g12 :: RDFGraph-g12 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t1211,t1221,t1222,t1223,t1224]- }+g12 = toGraph [t1211,t1221,t1222,t1223,t1224] t1711, t1722, t1733 :: Arc RDFLabel t1711 = arc s1 p1 lfr@@ -553,11 +524,7 @@ t1733 = arc s3 p3 lfrxml g17 :: RDFGraph-g17 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [t1711,t1722,t1733]- }+g17 = toGraph [t1711,t1722,t1733] tx101, tx102, tx111, tx112, tx113, tx114, tx121, tx122, tx123, tx124, tx125, tx126, tx127, tx128 :: Arc RDFLabel@@ -577,14 +544,10 @@ tx128 = arc b2 p2 l1 x1 :: RDFGraph-x1 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [tx101,tx102,- tx111,tx112,tx113,tx114,- tx121,tx122,tx123,tx124,- tx125,tx126,tx127,tx128]- }+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@@ -604,14 +567,10 @@ tx228 = arc l1 p2 b2 x2 :: RDFGraph-x2 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [tx201,tx202,- tx211,tx212,tx213,tx214,- tx221,tx222,tx223,tx224,- tx225,tx226,tx227,tx228]- }+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@@ -629,13 +588,9 @@ tx328 = arc l1 p2 s2 x3 :: RDFGraph-x3 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [tx311,tx312,tx313,tx314,- tx321,tx322,tx323,tx324,- tx325,tx326,tx327,tx328]- }+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@@ -650,13 +605,9 @@ tx409 = arc b4 res_rdf_rest res_rdf_nil x4 :: RDFGraph-x4 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [tx401,tx402,tx403,tx404,- tx405,tx406,tx407,tx408,- tx409]- }+x4 = toGraph [tx401,tx402,tx403,tx404,+ tx405,tx406,tx407,tx408,+ tx409] tx501, tx502, tx503, tx504, tx505, tx506, tx507, tx508, tx509 :: Arc RDFLabel@@ -671,13 +622,9 @@ tx509 = arc b4 res_rdf_rest res_rdf_nil x5 :: RDFGraph-x5 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [tx501,tx502,tx503,tx504,- tx505,tx506,tx507,tx508,- tx509]- }+x5 = toGraph [tx501,tx502,tx503,tx504,+ tx505,tx506,tx507,tx508,+ tx509] tx601, tx602, tx603, tx604, tx605, tx606, tx607, tx608 :: Arc RDFLabel@@ -691,12 +638,8 @@ tx608 = arc b4 res_rdf_rest res_rdf_nil x6 :: RDFGraph-x6 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [tx601,tx602,tx603,tx604,- tx605,tx606,tx607,tx608]- }+x6 = toGraph [tx601,tx602,tx603,tx604,+ tx605,tx606,tx607,tx608] tx701 :: Arc RDFLabel tx701 = arc b1 p2 f2@@ -738,11 +681,14 @@ 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@@ -766,12 +712,8 @@ tx1309 = arc b3 p1 o3 x13 :: RDFGraph-x13 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [tx1301,tx1302,tx1303,tx1304,tx1305,tx1306,- tx1307,tx1308,tx1309]- }+x13 = toGraph [tx1301,tx1302,tx1303,tx1304,tx1305,tx1306,+ tx1307,tx1308,tx1309] -- List of more complex anon nodes @@ -791,12 +733,8 @@ tx1412 = arc b3 p2 o3 x14 :: RDFGraph-x14 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [tx1401,tx1402,tx1403,tx1404,tx1405,tx1406,- tx1407,tx1408,tx1409,tx1410,tx1411,tx1412]- }+x14 = toGraph [tx1401,tx1402,tx1403,tx1404,tx1405,tx1406,+ tx1407,tx1408,tx1409,tx1410,tx1411,tx1412] -- List with nested list @@ -825,14 +763,10 @@ tx1529 = arc b6 p1 o3 x15 :: RDFGraph-x15 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [tx1501,tx1502,tx1503,tx1504,tx1505,tx1506,- tx1507,tx1508,tx1509,- tx1521,tx1522,tx1523,tx1524,tx1525,tx1526,- tx1527,tx1528,tx1529]- }+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 @@ -866,14 +800,10 @@ tx1632 = arc b6 p2 o3 x16 :: RDFGraph-x16 = NSGraph- { namespaces = nslist- , formulae = emptyFormulaMap- , statements = [tx1601,tx1602,tx1603,tx1604,tx1605,tx1606,- tx1607,tx1608,tx1609,tx1610,tx1611,- tx1621,tx1622,tx1623,tx1624,tx1625,tx1626,- tx1627,tx1628,tx1629,tx1630,tx1631,tx1632]- }+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@@ -1228,20 +1158,65 @@ 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_g1 noError+ , parseTest "litTest02" litN3Graph_g2 lit_g2 noError+ , parseTest "litTest03" litN3Graph_g3 lit_g2 noError+ , parseTest "litTest04" litN3Graph_g4 lit_g4 noError ] ------------------------------------------------------------
tests/QNameTest.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -113,9 +115,9 @@ 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"-qu3 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph3/node"-qu4 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph5/"-qu5 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph5/s5"+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" testMakeQNameSuite :: Test testMakeQNameSuite =
tests/RDFGraphTest.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------------------- -- See end of this file for licence information. --------------------------------------------------------------------------------@@ -17,51 +19,58 @@ module Main where import Swish.Utils.LookupMap- ( LookupMap(..)+ ( LookupMap(..), LookupEntryClass(..) , mapFindMaybe ) -import Swish.Utils.ListHelpers- ( equiv )+import Swish.Utils.ListHelpers (equiv) -import Swish.RDF.GraphClass- ( Label(..), Arc, arc )+import Swish.RDF.GraphClass (Label(..), arc) -import Swish.Utils.Namespace- ( Namespace(..)- , ScopedName(..)- , nullScopedName- , makeUriScopedName- )+import Swish.Utils.Namespace (Namespace(..), ScopedName(..), nullScopedName)+import Swish.Utils.QName (QName, qnameFromURI) import Swish.RDF.RDFGraph- ( RDFTriple, RDFGraph, RDFLabel(..), NSGraph(..)- , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral- , isDatatyped, isMemberProp- , isUri, isBlank, isQueryVar, makeBlank- , getScopedName- , LookupFormula(..), FormulaMap, emptyFormulaMap- , getArcs, addArc, merge- , remapLabels, remapLabelList- , setFormulae, getFormulae, setFormula, getFormula- , newNode, newNodes )+ ( RDFTriple, toRDFTriple, fromRDFTriple+ , RDFGraph + , RDFLabel(..), ToRDFLabel(..), FromRDFLabel(..)+ , NSGraph(..), Arc(..)+ , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral+ , isDatatyped, isMemberProp+ , isUri, isBlank, isQueryVar, makeBlank+ , getScopedName+ , LookupFormula(..), FormulaMap, emptyFormulaMap+ , getArcs, addArc+ , remapLabels, remapLabelList+ , setFormulae, getFormulae, setFormula, getFormula+ , newNode, newNodes ) import Swish.RDF.Vocabulary- ( namespaceRDF- , langName - , rdf_XMLLiteral+ ( namespaceRDF+ , langName + , rdf_XMLLiteral+ , xsd_boolean+ , xsd_integer+ , xsd_float+ , xsd_double+ , xsd_dateTime+ , xsd_date ) import qualified Data.Traversable as T+import qualified Data.Foldable as F -import Data.List- ( elemIndex )+import Network.URI (URI, parseURI)+import Data.Monoid (Monoid(..))+import Data.List (elemIndex, intercalate)+import Data.Maybe (fromJust) -import Data.Maybe- ( fromJust )+import System.Locale (defaultTimeLocale)+import Data.Time (UTCTime(..), Day, fromGregorian, buildTime) import Test.HUnit ( Test(TestCase,TestList,TestLabel)- , assertBool, assertEqual, assertString+ , Assertion+ , assertBool, assertEqual , runTestTT ) ------------------------------------------------------------@@ -133,15 +142,24 @@ -- Define some common values ------------------------------------------------------------ +base1Str :: String+base1Str = "http://id.ninebynine.org/wip/2003/test/graph1/node#"+ -- TODO: using a base of "" or "?" causes a fromJust failure somewhere basee, baseu, base1, base2, base3, base4 :: Namespace basee = Namespace "" "http://example.com/a#" baseu = Namespace "?" "http://example.com/"-base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node#"+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" +qn1s1 :: QName+qn1s1 = qnameFromURI $ base1Str ++ "s1"++qu1s1 :: URI+qu1s1 = fromJust $ parseURI $ base1Str ++ "s1"+ qbes1, qbus1, qb1s1, qb2s2, qb3s3, qb3, qb3bm, qb4m :: ScopedName qbes1 = ScopedName basee "s1" qbus1 = ScopedName baseu "s1"@@ -155,9 +173,9 @@ es1, us1, s1, s2, s3, s4, s5, s6, s7, s8 :: RDFLabel es1 = Res qbes1 us1 = Res qbus1-s1 = Res qb1s1 -s2 = Res qb2s2 -s3 = Res qb3s3 +s1 = toRDFLabel qb1s1 +s2 = toRDFLabel qb2s2 +s3 = toRDFLabel qb3s3 s4 = Res qb3 s5 = Blank "s5" s6 = Res qb3bm @@ -165,9 +183,9 @@ s8 = Blank "s8" st1, st2, st3 :: RDFLabel-st1 = Res $ ScopedName base1 "st1"-st2 = Res $ ScopedName base2 "st2" -st3 = Res $ ScopedName base3 "st3"+st1 = toRDFLabel $ ScopedName base1 "st1"+st2 = toRDFLabel $ ScopedName base2 "st2" +st3 = toRDFLabel $ ScopedName base3 "st3" bb, bb0, b1, b2, b3, b4, b5, b6, b7, b8, b9, b10 :: RDFLabel@@ -212,7 +230,7 @@ o1 = Res $ ScopedName base1 "o1" o2 = Res $ ScopedName base2 "o2" o3 = Res $ ScopedName base3 "o3"-o4 = Res qb3 +o4 = toRDFLabel qb3 o5 = Blank "o5" o6 = Blank "s5" @@ -222,20 +240,32 @@ l1, l2, l2gb, l3, l4, l5, l6, l7, l8, l9, l10, l11, l12 :: RDFLabel-l1 = Lit "l1" Nothing -l2 = Lit "l2" (Just (langName "en")) +l1 = "l1" -- use IsString instance+l2 = Lit "l2" (Just (langName "en")) l2gb = Lit "l2" (Just (langName "en-gb")) -l3 = Lit "l2" (Just (langName "fr")) -l4 = Lit "l4" (Just qb1t1) -l5 = Lit "l4" (Just qb1t1) -l6 = Lit "l4" (Just qb1t1) -l7 = Lit "l4" (Just qb1t2) -l8 = Lit "l4" (Just qb1t2) -l9 = Lit "l4" (Just qb1t2) -l10 = Lit "l10" (Just rdf_XMLLiteral) -l11 = Lit "l10" (Just rdf_XMLLiteral) -l12 = Lit "l10" (Just rdf_XMLLiteral) +l3 = Lit "l2" (Just (langName "fr")) +l4 = Lit "l4" (Just qb1t1) +l5 = Lit "l4" (Just qb1t1) +l6 = Lit "l4" (Just qb1t1) +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 +nanF, infF, ninfF :: RDFLabel+nanF = Lit "NaN" (Just xsd_float)+infF = Lit "INF" (Just xsd_float)+ninfF = Lit "-INF" (Just xsd_float)++nanD, infD, ninfD :: RDFLabel+nanD = Lit "NaN" (Just xsd_double)+infD = Lit "INF" (Just xsd_double)+ninfD = Lit "-INF" (Just xsd_double)+ v1, v2, v3, v4, vb3, vb4 :: RDFLabel v1 = Var "v1" v2 = Var "v2" @@ -300,6 +330,177 @@ (ll1,ll2) `elem` nodeeqlist || (ll2,ll1) `elem` nodeeqlist +-- test ToRDFLabel/FromRDFlabel/IsString instances+--+ +testToConv :: + (ToRDFLabel a, Eq a, Show a) + => String -> String -> 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+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 +testConv lbl sVal dtype hVal = + TestList [ + testToConv lbl sVal dtype hVal,+ testFrConv lbl sVal dtype hVal + ]+ +-- some conversions (e.g. toRDFTriple) are covered by +-- other tests+--+testConversionSuite :: Test+testConversionSuite =+ TestList+ [+ -- 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 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 int1" (Nothing :: Maybe Int) (fromRDFLabel l1)+ , testEq "fconv:fail int2" (Nothing :: Maybe Int) (fromRDFLabel (Lit "123456789012345" (Just xsd_integer))) + , 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 sn1" (Nothing :: Maybe ScopedName) (fromRDFLabel l1)+ , testEq "fconv:fail qn1" (Nothing :: Maybe QName) (fromRDFLabel l1)+ , testEq "fconv:fail qu1" (Nothing :: Maybe URI) (fromRDFLabel l1)+ , testEq "fconv:fail triple" (Nothing :: Maybe (ScopedName, ScopedName, Int)) (fromRDFTriple t01)+ + -- basic string tests+ , testEq "tconv:emptystring1" (Lit "" Nothing) "" -- want to try out IsString so do not use testToConv+ , testConv "emptystring2" "" Nothing (""::String)+ , testConv "char" "x" Nothing 'x'+ , testToConv "l1-1" "l1" Nothing l1+ , 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+ + {-+For example, -1E4, 1267.43233E12, 12.78e-2, 12 , -0, 0 and INF are all legal literals for float.+For example, -1E4, 1267.43233E12, 12.78e-2, 12 , -0, 0 and INF are all legal literals for double.++Valid values for xsd:integer include -123456789012345678901234567890, 2147483647, 0, or -0000000000000000000005.+++ -}+ + -- 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)+ + , 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)+ , 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)+ , 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 "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)+ + -- URI related types+ , testEq "tconv:sname s1" s1 (toRDFLabel qb1s1)+ , testEq "fconv:sname s1" (Just qb1s1) (fromRDFLabel s1)+ + , testEq "tconv:qname s1" s1 (toRDFLabel qn1s1)+ , testEq "fconv:qname s1" (Just qn1s1) (fromRDFLabel s1)+ + , testEq "tconv:URI s1" s1 (toRDFLabel qu1s1)+ , 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 "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+ + -- basic fromRDFTriple test+ + , testEq "fconv:triple" (Just (qb1s1, p1, "l1" :: String)) (fromRDFTriple t04)+ + -- TODO+ + ]+ +utc1, utc2 :: UTCTime+utc1 = buildTime defaultTimeLocale []+utc2 =+ let dNum = fromGregorian 2011 2 28+ tDiff = (23.0 - 3.0) * 3600.0 + 4.0 * 60.0 + 2.304 + in UTCTime dNum tDiff+ +day1 :: Day+day1 = fromGregorian 1970 1 1+ ------------------------------------------------------------ -- RDFLabel classification tests ------------------------------------------------------------@@ -438,16 +639,17 @@ testNodeEq :: String -> RDFLabel -> RDFLabel -> Test testNodeEq = testCompare "testNodeEq:" -tnn01, tnn02, tnn03, tnn04, tnn05, tnn06,- tnn07, tnn08, tnn09 :: RDFLabel-tnn01 = (newNode v1 [b1,b3,v1,v2])-tnn02 = (newNode b1 [b1,b3,v1,v2])-tnn03 = (newNodes b1 [b1,b3,v1,v2])!!0-tnn04 = (newNodes b1 [b1,b3,v1,v2])!!1-tnn05 = (newNodes b1 [b1,b3,v1,v2])!!2-tnn06 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!0-tnn07 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!1-tnn08 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!2+tnn01, tnn02 :: RDFLabel+tnn01 = newNode v1 [b1,b3,v1,v2]+tnn02 = newNode b1 [b1,b3,v1,v2]++tnn03, tnn04, tnn05 :: RDFLabel+(tnn03 : tnn04 : tnn05 : _ ) = newNodes b1 [b1, b3, v1, v2]++tnn06, tnn07, tnn08 :: RDFLabel+(tnn06 : tnn07 : tnn08 : _ ) = newNodes s1 [b1,b3,v1,v2,tnns3]++tnn09 :: RDFLabel tnn09 = (newNodes l1 [b1,b3,v1,v2,tnns3])!!2 tnns1, tnns2, tnns3, tnns4, tnnl1 :: RDFLabel@@ -552,11 +754,11 @@ ("l1",l1), ("l4",l4), ("l7",l7), ("l8",l8), ("l10",l10) ] -tlist :: [(String, Arc RDFLabel)]+tlist :: [(String, RDFTriple)] tlist = [ (lab s p o,trp s p o) | s <- slist, p <- plist, o <- olist ] where- lab (s,_) (p,_) (o,_) = s++"."++p++"."++o+ lab (s,_) (p,_) (o,_) = intercalate "." [s, p, o] trp (_,s) (_,p) (_,o) = arc s p o stmteqlist :: [(String, String)]@@ -609,7 +811,7 @@ testGraphEqM :: String -> Bool -> Maybe RDFGraph -> Maybe RDFGraph -> Test testGraphEqM = testCompareEq "testGraphEq:" -t01, t02, t03, t04, t05, t06 :: Arc RDFLabel+t01, t02, t03, t04, t05, t06 :: RDFTriple t01 = arc s1 p1 o1 t02 = arc s2 p1 o2 t03 = arc s3 p1 o3@@ -617,21 +819,22 @@ t05 = arc s2 p1 l4 t06 = arc s3 p1 l10 -t10, t11, t12 :: Arc RDFLabel+t10, t11, t12 :: RDFTriple t10 = arc s1 p1 b1 t11 = arc b1 p2 b2 t12 = arc b2 p3 o1 -t20, t21, t22 :: Arc RDFLabel+t20, t21, t22 :: RDFTriple t20 = arc s1 p1 b3 t21 = arc b3 p2 b4 t22 = arc b4 p3 o1 -tt01, tt02, tt03, tt04, tt05, tt06 :: Arc RDFLabel+tt01, tt02, tt03, tt04, tt05, tt06 :: RDFTriple tt01 = arc st1 p1 o1 tt02 = arc st2 p1 o2 tt03 = arc st3 p1 o3-tt04 = arc st1 p1 l1+tt04 = toRDFTriple st1 p1 ("l1" :: RDFLabel)+-- tt04 = arc st1 p1 l1 tt05 = arc st2 p1 l4 tt06 = arc st3 p1 l10 @@ -653,7 +856,7 @@ , ("altbase3",base3) ] -toGraph :: [Arc RDFLabel] -> RDFGraph+toGraph :: [RDFTriple] -> RDFGraph toGraph stmts = NSGraph { namespaces = nslist , formulae = emptyFormulaMap@@ -676,16 +879,37 @@ -- Construct version of g1 using just URIs uris1, urip1, urio1 :: ScopedName-uris1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"-urip1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#p1"-urio1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#o1"+uris1 = "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"+urip1 = "http://id.ninebynine.org/wip/2003/test/graph1/node#p1"+urio1 = "http://id.ninebynine.org/wip/2003/test/graph1/node#o1" -tu01 :: Arc RDFLabel-tu01 = arc (Res uris1) (Res urip1) (Res urio1)+tu01 :: RDFTriple+tu01 = toRDFTriple uris1 urip1 urio1 +g2arcs :: [String]+g2arcs = [+ "(base1:s1,base1:p1,base1:o1)", + "(base2:s2,base1:p1,base2:o2)", + "(base3:s3,base1:p1,base3:o3)", + "(base1:s1,base1:p1,\"l1\")", + "(base2:s2,base1:p1,\"l4\"^^base1:type1)", + "(base3:s3,base1:p1,\"l10\"^^rdf:XMLLiteral)"+ ]+ +g2str :: String -> String+g2str sp = + let spaces = " "+ in intercalate ('\n':sp) $ + ["Graph, formulae: ",+ "arcs: "]+ ++ map (spaces++) g2arcs+ +g2Labels :: [RDFTriple]+g2Labels = [t01,t02,t03,t04,t05,t06]+ g1uri, g2, gt2, g3, gt3, g4, g5, g6, g7, g8, g9, g10 :: RDFGraph g1uri = toGraph [tu01]-g2 = toGraph [t01,t02,t03,t04,t05,t06]+g2 = toGraph g2Labels gt2 = toGraph [tt01,tt02,tt03,tt04,tt05,tt06] g3 = toGraph [t06,t05,t04,t03,t02,t01] gt3 = toGraph [tt06,tt05,tt04,tt03,tt02,tt01]@@ -697,6 +921,9 @@ g9 = toGraph [t03,t02,t01] g10 = toGraph [t02,t02,t01] +fg1g2 :: RDFGraph+fg1g2 = g1 `mappend` g2+ g9a, g10a :: RDFGraph g9a = addArc t03 g8 g10a = addArc t02 g8@@ -752,6 +979,29 @@ , testGraphEq "g10-g10a" True g10 g10a ] +showLabel :: RDFLabel -> String+showLabel = (" " ++) . show++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 "foldMapg1" + (concatMap showLabel [s1,p1,o1])+ (F.foldMap showLabel g1)+ , testEq "foldMapg1f2" + (concatMap showLabel $ s2 : concatMap (\(Arc s p o) -> [s,p,o]) g2Labels ++ [s1,p1,o1])+ (F.foldMap showLabel g1f2)+ ]+ ------------------------------------------------------------ -- Test updating formulae ------------------------------------------------------------@@ -775,13 +1025,46 @@ g1f6 = setFormulae fm6 g1f1 g1f7 = setFormulae fm7 g1f1 +g1f1str, g1f2str :: String++g1f1str = + "Graph, formulae: \n" +++ "arcs: \n" +++ " (base1:s1,base1:p1,base1:o1)"++g1f2str =+ "Graph, formulae: \n " +++ lf22str ++ "\n" +++ "arcs: \n" +++ " (base1:s1,base1:p1,base1:o1)"++lf11, lf22, lf23, lf24, lf25, lf27, lf33, lf36 :: LookupFormula RDFLabel RDFGraph+lf11 = Formula s1 g1+lf22 = newEntry (s2,g2)+lf23 = newEntry (s2,g3)+lf24 = newEntry (s2,g4)+lf25 = newEntry (s2,g5)+lf27 = newEntry (s2,g7)+lf33 = newEntry (s3,g3)+lf36 = newEntry (s3,g6)++lf22str :: String+lf22str =+ "base2:s2 :- { \n" ++ + " (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,\"l4\"^^base1:type1)\n" ++ + " (base3:s3,base1:p1,\"l10\"^^rdf:XMLLiteral) }"+ fm2, fm3, fm4, fm5, fm6, fm7 :: LookupMap (LookupFormula RDFLabel RDFGraph)-fm2 = LookupMap [Formula s2 g2]-fm3 = LookupMap [Formula s1 g1,Formula s2 g2,Formula s3 g3]-fm4 = LookupMap [Formula s1 g1,Formula s2 g3,Formula s3 g3]-fm5 = LookupMap [Formula s1 g1,Formula s2 g4,Formula s3 g6]-fm6 = LookupMap [Formula s1 g1,Formula s2 g5,Formula s3 g6]-fm7 = LookupMap [Formula s1 g1,Formula s2 g7,Formula s3 g6]+fm2 = LookupMap [lf22]+fm3 = LookupMap [lf11, lf22, lf33]+fm4 = LookupMap [lf11, lf23, lf33]+fm5 = LookupMap [lf11, lf24, lf36]+fm6 = LookupMap [lf11, lf25, lf36]+fm7 = LookupMap [lf11, lf27, lf36] f1, f2, f3, f4, f5, f6, f7 :: FormulaMap RDFLabel f1 = getFormulae g1f1@@ -823,7 +1106,7 @@ f21 = getFormulae g1f21 f22 = getFormulae g1f22 -f23a, f23b, f23c :: Maybe (NSGraph RDFLabel)+f23a, f23b, f23c :: Maybe RDFGraph f23a = getFormula g1f22 s1 f23b = getFormula g1f22 s2 f23c = getFormula g1f22 s3@@ -860,6 +1143,18 @@ , testFormulaLookup "10a" f10 s1 (Just g1) , testFormulaLookup "10b" f10 s2 (Just g2) , testFormulaLookup "10c" f10 s3 (Just g3)+ + -- a few tests added in to improve test coverage+ , testEq "lf11" (Formula s1 g1) lf11 + , testEq "g2:show" (g2str "") (show g2) + , testEq "g1f1:show" g1f1str (show g1f1) + , testEq "g1f2:show" g1f2str (show g1f2) + , testEq "lf22:show" lf22str (show lf22) + , testEq "[]:showList" "[no graphs]" (show ([] :: [RDFGraph])) + , testEq "g2:showList1" ("[" ++ g2str " " ++ "]") (show [g2]) + , testEq "g2:showList2" ("[" ++ g2str " " ++ ",\n " ++ g2str " " ++ "]") (show [g2,g2]) + + -- back to the main schedule , testGraphEq "g1f1-g1f1" True g1f1 g1f1 , testGraphEq "g1f1-g1f2" True g1f1 g1f2 , testGraphEq "g1f1-g1f3" False g1f1 g1f3@@ -1007,18 +1302,25 @@ testMerge :: String -> RDFGraph -> RDFGraph -> RDFGraph -> Test testMerge lab a1 a2 gr =- TestCase ( assertEquiv ("testMerge:"++lab) gr (merge a1 a2) )- where- grequiv gg1 gg2 = (getArcs gg1) `equiv` (getArcs gg2)- assertEquiv lbl gg1 gg2 = assertString $- if grequiv gg1 gg2 then ""- else lbl++"\nExpected: "++(show gg1)++"\nObtained: "++(show gg2)+ TestCase ( assertGrEquiv ("testMerge:"++lab) gr (a1 `mappend` a2) )+ +assertGrHelper :: String -> RDFGraph -> RDFGraph -> Bool -> Assertion+assertGrHelper lbl gg1 gg2 = assertBool $ + lbl++"\nExpected: "++(show gg1)++"\nObtained: "++(show gg2)+ +assertGrEquiv :: String -> RDFGraph -> RDFGraph -> Assertion+assertGrEquiv lbl gg1 gg2 = + assertGrHelper lbl gg1 gg2 $ (getArcs gg1) `equiv` (getArcs gg2) +assertGrEq :: String -> RDFGraph -> RDFGraph -> Assertion+assertGrEq lbl gg1 gg2 = + assertGrHelper lbl gg1 gg2 $ gg1 == gg2+ testEquiv :: (Eq a) => String -> [a] -> [a] -> Test testEquiv lab l1s l2s = TestCase $ assertBool lab (l1s `equiv` l2s) tm01, tm02, tm03, tm04, tm05, tm06, tm07, tm08, tm09,- tm10, tm11, tm12, tm13, tm14 :: Arc RDFLabel+ tm10, tm11, tm12, tm13, tm14 :: RDFTriple tm01 = arc s1 p1 b1 tm02 = arc b1 p1 o2 tm03 = arc b1 p1 o3@@ -1035,7 +1337,7 @@ tm14 = arc bn4 p2 o4 tm21, tm22, tm23, tm24, tm25, tm26, tm27, tm28, tm29,- tm30, tm31, tm32, tm33, tm34 :: Arc RDFLabel+ tm30, tm31, tm32, tm33, tm34 :: RDFTriple tm21 = arc s1 p1 b6 tm22 = arc b6 p1 o2 tm23 = arc b6 p1 o3@@ -1051,18 +1353,18 @@ tm33 = arc s4 p2 bn5 tm34 = arc bn6 p2 o4 -tm41, tm42, tm43, tm44 :: Arc RDFLabel+tm41, tm42, tm43, tm44 :: RDFTriple tm41 = arc s1 p1 b2 tm42 = arc b2 p1 o2 tm43 = arc b2 p1 o3 tm44 = arc b4 p2 b5 -tm41a, tm44a :: Arc RDFLabel+tm41a, tm44a :: RDFTriple tm41a = arc s1 p1 b4 tm44a = arc b5 p2 b6 tm67, tm68, tm69, tm70, tm71, tm72,- tm73, tm74 :: Arc RDFLabel+ tm73, tm74 :: RDFTriple tm67 = arc s2 p3 v3 tm68 = arc s3 p3 v4 tm69 = arc s4 p1 c3@@ -1074,7 +1376,7 @@ gm0, gms, gms2, gm1, gm11, gm2, gm2f, gm22, gm3, gm3f, gm33, gm4, gm44 :: RDFGraph-gm0 = toGraph []+gm0 = mempty gms = toGraph [arc s1 p1 o1, arc o1 p2 s3, arc s2 p3 o4] gms2 = toGraph [arc us1 p1 o1, arc p1 p2 es1] gm1 = toGraph [tm01,tm02,tm03,tm04,tm05,tm06,tm07,tm08@@ -1094,7 +1396,7 @@ gm4 = toGraph [tm01,tm04] gm44 = toGraph [tm01,tm04,tm41a,tm44a] -gm5, gm55, gm6, gm66 :: RDFGraph+gm5, gm55 :: RDFGraph gm5 = NSGraph { namespaces = nslist , formulae = LookupMap [Formula b1 gm2]@@ -1107,6 +1409,15 @@ , statements = [tm01,tm02,tm03,tm41,tm42,tm43] } +gm5s :: RDFGraph+gm5s = NSGraph+ { namespaces = nslist+ , formulae = LookupMap [Formula b1 gm2]+ , statements = [tm01,tm02,tm03,+ arc s1 p1 o1, arc o1 p2 s3, arc s2 p3 o4]+ }++gm6, gm66 :: RDFGraph gm6 = NSGraph { namespaces = nslist , formulae = LookupMap [Formula ba1 gm2,Formula bn3 gm3]@@ -1124,7 +1435,46 @@ ] } -tm81, tm82, tm811, tm821, tm812, tm822 :: Arc RDFLabel+gm456 :: RDFGraph+gm456 = NSGraph + { namespaces = nslist+ -- , formulae = LookupMap [Formula b1 gm2, Formula ba1 gm2, Formula bn3 gm3]+ , formulae = LookupMap []+ , statements = [tm01, tm04,+ tm07, tm08, tm09, tm10, tm11, tm12, tm13, tm14+ , arc s1 p1 b4+ , arc b4 p1 o2+ , arc b4 p1 o3+ ]+ }++gm564 :: RDFGraph+gm564 = NSGraph + { namespaces = nslist+ -- , formulae = LookupMap [Formula b1 gm2, Formula ba1 gm2, Formula bn3 gm3]+ , formulae = LookupMap []+ , statements = [tm01, tm02, tm03+ , arc b5 p2 b6+ , tm07, tm08, tm09, tm10, tm11, tm12, tm13, tm14+ , arc s1 p1 b4+ ]+ }++gm645 :: RDFGraph+gm645 = NSGraph + { namespaces = nslist+ -- , formulae = LookupMap [Formula b1 gm2, Formula ba1 gm2, Formula bn3 gm3]+ , formulae = LookupMap []+ , statements = [tm07, tm08, tm09, tm10, tm11, tm12, tm13, tm14+ , arc s1 p1 b4+ , arc b4 p1 o2+ , arc b4 p1 o3+ , arc s1 p1 b5+ , arc b6 p2 b7+ ]+ }++tm81, tm82, tm811, tm821, tm812, tm822 :: RDFTriple tm81 = arc b1 p1 v1 tm82 = arc b2 p2 v2 tm811 = arc b1 p1 v3@@ -1175,6 +1525,18 @@ , testMerge "04" gm4 gm4 gm44 , testMerge "05" gm5 gm5 gm55 , testMerge "06" gm6 gm6 gm66+ , testMerge "0+s" gm0 gms gms+ , testMerge "s+0" gms gm0 gms+ , testMerge "0+5" gm0 gm5 gm5+ , testMerge "5+0" gm5 gm0 gm5+ , testMerge "5+s" gm5 gms gm5s+ , testMerge "s+5" gms gm5 gm5s+ , TestCase (assertGrEquiv "mconcat:456" gm456 (mconcat [gm4,gm5,gm6]))+ , TestCase (assertGrEquiv "mconcat:564" gm564 (mconcat [gm5,gm6,gm4]))+ , TestCase (assertGrEquiv "mconcat:645" gm645 (mconcat [gm6,gm4,gm5]))+ , TestCase (assertGrEq "mappend" + (mappend gm4 (mappend gm5 gm6))+ (mappend (mappend gm4 gm5) gm6)) , testGraphEq "Remap07" True gm82 gm82a , testEquiv "testRemapList07" gm82b2 gm82b1 , testGraphEq "Remap08" True gm83 gm83a@@ -1189,6 +1551,7 @@ allTests :: Test allTests = TestList [ testLangEqSuite+ , testConversionSuite , testNodeEqSuite , testNodeClassSuite , testNodeLocalSuite@@ -1198,6 +1561,7 @@ , testStmtEqSuite , testGraphEqSuite , testGraphEqSelSuite+ , testGraphFoldSuite , testGraphFormulaSuite , testGraphTranslateSuite , testMergeSuite
tests/RDFQueryTest.hs view
@@ -578,8 +578,8 @@ TestList [ test "testQuery31" (not $ null var31) , testEq "testUnsubs31" 2 (length res31v)- , testEq "testUnsubs31a" [(Var "b")] (head res31v)- , testEq "testUnsubs31a" [(Var "b")] (head . tail $ res31v)+ , testEq "testUnsubs31a" [Var "b"] (head res31v)+ , testEq "testUnsubs31a" [Var "b"] (head . tail $ res31v) , testEq "testResult31" 2 (length res31) , testGr "testResult31a" result31a res31 , testGr "testResult31b" result31b res31@@ -709,8 +709,8 @@ "?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@@ -752,8 +752,8 @@ "?a rel:son pers:Wi3 . \n" unbound45a1, unbound45a2 :: [RDFLabel]-unbound45a1 = [(Var "a")]-unbound45a2 = [(Var "a")]+unbound45a1 = [Var "a"]+unbound45a2 = [Var "a"] var45 :: [[RDFVarBinding]] var45 = rdfQueryBack query45 graph45@@ -797,8 +797,8 @@ "?a rel:stepson pers:St3 . \n" unbound46a, unbound46b :: [RDFLabel]-unbound46a = [(Var "a")]-unbound46b = [(Var "a")]+unbound46a = [Var "a"]+unbound46b = [Var "a"] var46 :: [[RDFVarBinding]] var46 = rdfQueryBack query46 graph46@@ -880,14 +880,14 @@ unbound47c1, unbound47c2, unbound47d1, unbound47d2 :: [RDFLabel] -unbound47a1 = [(Var "a")]-unbound47a2 = [(Var "a")]-unbound47b1 = [(Var "a")]-unbound47b2 = [(Var "a")]-unbound47c1 = [(Var "a")]-unbound47c2 = [(Var "a")]-unbound47d1 = [(Var "a")]-unbound47d2 = [(Var "a")]+unbound47a1 = [Var "a"]+unbound47a2 = [Var "a"]+unbound47b1 = [Var "a"]+unbound47b2 = [Var "a"]+unbound47c1 = [Var "a"]+unbound47c2 = [Var "a"]+unbound47d1 = [Var "a"]+unbound47d2 = [Var "a"] var47 :: [[RDFVarBinding]] var47 = rdfQueryBack query47 graph47@@ -937,8 +937,8 @@ "?a rel:son pers:La3 . \n" unbound48a, unbound48b :: [RDFLabel]-unbound48a = [(Var "a")]-unbound48b = [(Var "a")]+unbound48a = [Var "a"]+unbound48b = [Var "a"] var48 :: [[RDFVarBinding]] var48 = rdfQueryBack query48 graph48@@ -1009,8 +1009,8 @@ "?a rel:son pers:Gr3 . \n" unbound50a, unbound50b :: [RDFLabel]-unbound50a = [(Var "a")]-unbound50b = [(Var "a")]+unbound50a = [Var "a"]+unbound50b = [Var "a"] var50 :: [[RDFVarBinding]] var50 = rdfQueryBack query50 graph50@@ -1048,12 +1048,12 @@ , testEq "testQuery42a" 1 (length var42) , testEq "testResult42" 1 (length res42) , testGr "testResult42a" result42a (fst $ unzip $ head res42)- , testLs "testUnbound42a" [(Var "b")] (snd $ head $ head res42)+ , testLs "testUnbound42a" [Var "b"] (snd $ head $ head res42) , test "testQuery43" (not $ null var43) , testEq "testQuery43a" 1 (length var43) , testEq "testResult43" 1 (length res43) , testGr "testResult43a" result43a (fst $ unzip $ head res43)- , testLs "testUnbound43a" [(Var "a")] (snd $ head $ head res43)+ , testLs "testUnbound43a" [Var "a"] (snd $ head $ head res43) , test "testQuery44" (not $ null var44) , testEq "testQuery44a" 2 (length var44) , testEq "testResult44" 2 (length res44)