packages feed

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 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)