diff --git a/Swish.hs b/Swish.hs
new file mode 100644
--- /dev/null
+++ b/Swish.hs
@@ -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:
+--
+-- (2) CWM:
+--
+-- (3) Motivation:
+--
+-- (4) Notation 3:
+--
+-- (5) 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
+--
+--------------------------------------------------------------------------------
diff --git a/Swish/RDF.hs b/Swish/RDF.hs
new file mode 100644
--- /dev/null
+++ b/Swish/RDF.hs
@@ -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
+--
+--------------------------------------------------------------------------------
diff --git a/Swish/RDF/BuiltInRules.hs b/Swish/RDF/BuiltInRules.hs
--- a/Swish/RDF/BuiltInRules.hs
+++ b/Swish/RDF/BuiltInRules.hs
@@ -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
diff --git a/Swish/RDF/GraphClass.hs b/Swish/RDF/GraphClass.hs
--- a/Swish/RDF/GraphClass.hs
+++ b/Swish/RDF/GraphClass.hs
@@ -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
diff --git a/Swish/RDF/GraphMatch.hs b/Swish/RDF/GraphMatch.hs
--- a/Swish/RDF/GraphMatch.hs
+++ b/Swish/RDF/GraphMatch.hs
@@ -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`.
--
diff --git a/Swish/RDF/N3Formatter.hs b/Swish/RDF/N3Formatter.hs
--- a/Swish/RDF/N3Formatter.hs
+++ b/Swish/RDF/N3Formatter.hs
@@ -13,7 +13,6 @@
-- This Module implements a Notation 3 formatter (see [1], [2] and [3]),
-- for an RDFGraph value.
--
---
-- REFERENCES:
--
-- (1)
@@ -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
-- (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
diff --git a/Swish/RDF/N3Parser.hs b/Swish/RDF/N3Parser.hs
--- a/Swish/RDF/N3Parser.hs
+++ b/Swish/RDF/N3Parser.hs
@@ -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
diff --git a/Swish/RDF/NTFormatter.hs b/Swish/RDF/NTFormatter.hs
--- a/Swish/RDF/NTFormatter.hs
+++ b/Swish/RDF/NTFormatter.hs
@@ -169,7 +169,7 @@
-}
quoteStr :: String -> String
-quoteStr st = ['"'] ++ quote st ++ ['"']
+quoteStr st = '"' : quote st ++ "\""
quote :: String -> String
quote [] = ""
diff --git a/Swish/RDF/Proof.hs b/Swish/RDF/Proof.hs
--- a/Swish/RDF/Proof.hs
+++ b/Swish/RDF/Proof.hs
@@ -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
{-
diff --git a/Swish/RDF/RDFGraph.hs b/Swish/RDF/RDFGraph.hs
--- a/Swish/RDF/RDFGraph.hs
+++ b/Swish/RDF/RDFGraph.hs
@@ -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
+.
+
+-}
+
+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
diff --git a/Swish/RDF/SwishCommands.hs b/Swish/RDF/SwishCommands.hs
--- a/Swish/RDF/SwishCommands.hs
+++ b/Swish/RDF/SwishCommands.hs
@@ -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 >>
diff --git a/Swish/RDF/SwishMain.hs b/Swish/RDF/SwishMain.hs
--- a/Swish/RDF/SwishMain.hs
+++ b/Swish/RDF/SwishMain.hs
@@ -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:
---
--- (2) CWM:
---
--- (3) Motivation:
---
--- (4) Notation 3:
+-- 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:
+-- This module is likely to be moved to the Swish module.
--
--------------------------------------------------------------------------------
diff --git a/Swish/RDF/VarBinding.hs b/Swish/RDF/VarBinding.hs
--- a/Swish/RDF/VarBinding.hs
+++ b/Swish/RDF/VarBinding.hs
@@ -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.
--
diff --git a/Swish/RDF/Vocabulary.hs b/Swish/RDF/Vocabulary.hs
--- a/Swish/RDF/Vocabulary.hs
+++ b/Swish/RDF/Vocabulary.hs
@@ -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"
diff --git a/Swish/Utils/DateTime.hs b/Swish/Utils/DateTime.hs
--- a/Swish/Utils/DateTime.hs
+++ b/Swish/Utils/DateTime.hs
@@ -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
diff --git a/Swish/Utils/Namespace.hs b/Swish/Utils/Namespace.hs
--- a/Swish/Utils/Namespace.hs
+++ b/Swish/Utils/Namespace.hs
@@ -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
diff --git a/Swish/Utils/PartOrderedCollection.hs b/Swish/Utils/PartOrderedCollection.hs
--- a/Swish/Utils/PartOrderedCollection.hs
+++ b/Swish/Utils/PartOrderedCollection.hs
@@ -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.
--
--------------------------------------------------------------------------------
diff --git a/Swish/Utils/QName.hs b/Swish/Utils/QName.hs
--- a/Swish/Utils/QName.hs
+++ b/Swish/Utils/QName.hs
@@ -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
diff --git a/src/Swish.hs b/src/Swish.hs
--- a/src/Swish.hs
+++ b/src/Swish.hs
@@ -26,7 +26,7 @@
import System.IO (stderr, hPutStrLn)
-import Swish.RDF.SwishMain
+import Swish
------------------------------------------------------------
-- Swish main program
diff --git a/swish.cabal b/swish.cabal
--- a/swish.cabal
+++ b/swish.cabal
@@ -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 ()
- 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:
- .
- -
- .
- -
- .
- - CWM:
- .
+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 ()
+ 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:
+ .
+ -
+ .
+ -
+ .
+ - CWM:
+ .
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
diff --git a/tests/BuiltInMapTest.hs b/tests/BuiltInMapTest.hs
--- a/tests/BuiltInMapTest.hs
+++ b/tests/BuiltInMapTest.hs
@@ -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
-}
diff --git a/tests/GraphTest.hs b/tests/GraphTest.hs
--- a/tests/GraphTest.hs
+++ b/tests/GraphTest.hs
@@ -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 ()
diff --git a/tests/N3FormatterTest.hs b/tests/N3FormatterTest.hs
--- a/tests/N3FormatterTest.hs
+++ b/tests/N3FormatterTest.hs
@@ -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: .\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
+
]
------------------------------------------------------------
diff --git a/tests/N3ParserTest.hs b/tests/N3ParserTest.hs
--- a/tests/N3ParserTest.hs
+++ b/tests/N3ParserTest.hs
@@ -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 "
" (Just rdf_XMLLiteral )
-lfrxml = Lit "chat" (Just rdf_XMLLiteral )
+lfr = Lit "chat" $ Just $ langName "fr"
+lxml = Lit "
" $ Just rdf_XMLLiteral
+lfrxml = Lit "chat" $ 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
]
------------------------------------------------------------
diff --git a/tests/QNameTest.hs b/tests/QNameTest.hs
--- a/tests/QNameTest.hs
+++ b/tests/QNameTest.hs
@@ -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 =
diff --git a/tests/RDFGraphTest.hs b/tests/RDFGraphTest.hs
--- a/tests/RDFGraphTest.hs
+++ b/tests/RDFGraphTest.hs
@@ -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
diff --git a/tests/RDFQueryTest.hs b/tests/RDFQueryTest.hs
--- a/tests/RDFQueryTest.hs
+++ b/tests/RDFQueryTest.hs
@@ -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)