Skip to content
Browse files

Cleaned up warnings, added Data tests to main test harness.

Ignore-this: 13653f4f526a435c0fe80d6469ebe9a7

darcs-hash:20110201091053-1786f-b90f413185b3d17bf17e6a2a9693e468d5f1c1ea.gz
  • Loading branch information...
1 parent db125c8 commit 0c793cc42e350ae59c1238fcbfe88af9ae79113a @amccausl committed Feb 1, 2011
View
24 src/Text/RDF/RDF4H/XmlParser.hs
@@ -12,7 +12,6 @@ import Data.RDF
import Control.Arrow
import Text.XML.HXT.Core
-import Text.XML.HXT.Arrow.XmlState (expandURI)
import Data.ByteString.Lazy.Char8(ByteString)
import Data.String.Utils
@@ -34,7 +33,7 @@ parseXmlRDF :: forall rdf. (RDF rdf)
-> ByteString -- ^ The contents to parse
-> Either ParseFailure rdf -- ^ The RDF representation of the triples or ParseFailure
parseXmlRDF bUrl dUrl xmlStr = case runSLA (xread >>> addMetaData bUrl dUrl >>> getRDF) (GParseState { stateGenId = 0 }) (b2s xmlStr) of
- (_,r:rest) -> Right r
+ (_,r:_) -> Right r
_ -> Left (ParseFailure "XML parsing failed")
-- |Add a root tag to a given XmlTree to appear as if it was read from a readDocument function
@@ -75,12 +74,12 @@ parseDescription = (updateState
>>> (arr2A parsePredicatesFromAttr
<+> (second (getChildren >>> isElem) >>> parsePredicatesFromChildren)
<+> (second (neg (hasName "rdf:Description")) >>> arr2A readTypeTriple))) -- If the rdf:Description element has another name, that is it's type
- >>. (replaceLiElems [] 1)
+ >>. (replaceLiElems [] (1 :: Int))
where readTypeTriple :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple
readTypeTriple state = getName >>> arr ((Triple (stateSubject state) ((unode . s2b) "rdf:type")) . unode . s2b)
replaceLiElems acc n (Triple s p o : rest) | p == (unode . s2b) "rdf:li" = replaceLiElems (Triple s ((unode . s2b) ("rdf:_" ++ show n)) o : acc) (n + 1) rest
replaceLiElems acc n (Triple s p o : rest) = replaceLiElems (Triple s p o : acc) n rest
- replaceLiElems acc n [] = acc
+ replaceLiElems acc _ [] = acc
-- |Read the attributes of an rdf:Description element. These correspond to the Predicate Object pairs of the Triple
parsePredicatesFromAttr :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple
@@ -96,7 +95,7 @@ parsePredicatesFromAttr s = getAttrl >>> ((getName
parsePredicatesFromChildren :: forall a. (ArrowXml a, ArrowState GParseState a) => a (LParseState, XmlTree) Triple
parsePredicatesFromChildren = updateState
>>> choiceA [ second (hasAttrValue "rdf:parseType" (== "Literal")) :-> arr2A parseAsLiteralTriple
- , second (hasAttrValue "rdf:parseType" (== "Resource")) :-> arr2A parseAsResourceTriples
+ , second (hasAttrValue "rdf:parseType" (== "Resource")) :-> (defaultA <+> parseDescription)
, second (hasAttrValue "rdf:parseType" (== "Collection")) :-> (listA (defaultA >>> arr id &&& mkBlankNode) >>> mkCollectionTriples >>> unlistA)
, second (hasAttr "rdf:datatype") :-> arr2A getTypedTriple
, second (hasAttr "rdf:resource") :-> arr2A getResourceTriple
@@ -151,16 +150,13 @@ parseAsLiteralTriple state = ((getName >>> arr (unode . s2b)) &&& (xshow ( getCh
mkCollectionTriples :: forall a. (ArrowXml a, ArrowState GParseState a) => a [(Triple, Node)] Triples
mkCollectionTriples = arr (mkCollectionTriples' [])
where mkCollectionTriples' [] ((Triple s1 p1 o1, n1):rest) = mkCollectionTriples' [Triple s1 p1 n1] ((Triple s1 p1 o1, n1):rest)
- mkCollectionTriples' acc ((Triple s1 p1 o1, n1):(t2, n2):rest) = mkCollectionTriples' (Triple n1 headNode o1 : Triple n1 tailNode n2 : acc) ((t2, n2):rest)
- mkCollectionTriples' acc ((Triple s1 p1 o1, n1):[]) = Triple n1 headNode o1 : Triple n1 tailNode nilNode : acc
- mkCollectionTriples' acc [] = []
+ mkCollectionTriples' acc ((Triple _ _ o1, n1):(t2, n2):rest) = mkCollectionTriples' (Triple n1 headNode o1 : Triple n1 tailNode n2 : acc) ((t2, n2):rest)
+ mkCollectionTriples' acc ((Triple _ _ o1, n1):[]) = Triple n1 headNode o1 : Triple n1 tailNode nilNode : acc
+ mkCollectionTriples' _ [] = []
headNode = (unode . s2b) "rdf:first"
tailNode = (unode . s2b) "rdf:rest"
nilNode = (unode . s2b) "rdf:nil"
-parseAsResourceTriples :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple
-parseAsResourceTriples state = ((getName >>> arr (unode . s2b)) &&& (getAttrValue "rdf:resource" >>> arr (unode . s2b))) >>> arr (attachSubject (stateSubject state))
-
-- |Read a Triple and it's type when rdf:datatype is available
getTypedTriple :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple
getTypedTriple state = ((getName >>> arr (unode . s2b)) &&& ((getAttrValue "rdf:datatype" &&& baseUrl >>> expandURI) &&& xshow (getChildren) >>> arr (\(t, v) -> lnode (typedL (s2b v) (mkFastString (s2b t)))))) >>> arr (attachSubject (stateSubject state))
@@ -181,16 +177,14 @@ mkNode s = choiceA [ hasAttr "rdf:about" :-> (getAttrValue "rdf:about" &&& baseU
, hasAttr "rdf:ID" :-> mkRelativeNode s
, this :-> mkBlankNode
]
- where attrToUnode attr = getAttrValue attr >>> arr (unode . s2b)
- baseUrl = constA (case stateBaseUrl s of BaseUrl b -> b2s b)
+ where baseUrl = constA (case stateBaseUrl s of BaseUrl b -> b2s b)
--mkRelativeNode :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Node
mkRelativeNode s = (getAttrValue "rdf:ID" >>> arr (\x -> '#':x)) &&& baseUrl >>> expandURI >>> arr (unode . s2b)
where baseUrl = constA (case stateBaseUrl s of BaseUrl b -> b2s b)
mkTypedLiteralNode :: LParseState -> FastString -> String -> Node
-mkTypedLiteralNode (LParseState _ (Just lang) _) t content = (lnode (typedL (s2b content) t))
-mkTypedLiteralNode (LParseState _ Nothing _) t content = lnode (typedL (s2b content) t)
+mkTypedLiteralNode (LParseState _ _ _) t content = lnode (typedL (s2b content) t)
-- |Use the given state to create a literal node
mkLiteralNode :: LParseState -> String -> Node
View
29 testsuite/tests/Data/RDF/MGraph_Test.hs
@@ -1,5 +1,9 @@
module Data.RDF.MGraph_Test where
+-- Testing imports
+import Test.Framework (testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
import Data.RDF
import Data.RDF.Namespace
import Data.RDF.MGraph
@@ -9,6 +13,31 @@ import qualified Data.Map as Map
import Control.Monad
import Test.QuickCheck
+tests = [ testGroup "MGraph"
+ [ testProperty "empty" (p_empty _triplesOf _empty)
+ , testProperty "mkRdf_triplesOf" (p_mkRdf_triplesOf _triplesOf _mkRdf)
+ , testProperty "mkRdf_no_dupes" (p_mkRdf_no_dupes _triplesOf _mkRdf)
+ , testProperty "query_match_none" (p_query_match_none _mkRdf)
+ , testProperty "query_matched_spo" (p_query_matched_spo _triplesOf)
+ , testProperty "query_matched_spo_no_dupes" (p_query_matched_spo_no_dupes _triplesOf _mkRdf)
+ , testProperty "query_unmatched_spo" (p_query_unmatched_spo _triplesOf)
+ , testProperty "query_match_s" (p_query_match_s _triplesOf)
+ , testProperty "query_match_p" (p_query_match_p _triplesOf)
+ , testProperty "query_match_o" (p_query_match_o _triplesOf)
+ , testProperty "query_match_sp" (p_query_match_sp _triplesOf)
+ , testProperty "query_match_so" (p_query_match_so _triplesOf)
+ , testProperty "query_match_po" (p_query_match_po _triplesOf)
+ , testProperty "match_none" (p_select_match_none :: MGraph -> Bool)
+ , testProperty "select_match_s" (p_select_match_s _triplesOf)
+ , testProperty "select_match_p" (p_select_match_p _triplesOf)
+ , testProperty "select_match_o" (p_select_match_o _triplesOf)
+ , testProperty "select_match_sp" (p_select_match_sp _triplesOf)
+ , testProperty "select_match_so" (p_select_match_so _triplesOf)
+ , testProperty "select_match_po" (p_select_match_po _triplesOf)
+ , testProperty "select_match_spo" (p_select_match_spo _triplesOf)
+ ]
+ ]
+
----------------------------------------------------
-- * instances and graph functions for MGraph
----------------------------------------------------
View
28 testsuite/tests/Data/RDF/TriplesGraph_Test.hs
@@ -1,5 +1,9 @@
module Data.RDF.TriplesGraph_Test where
+-- Testing imports
+import Test.Framework (testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
import Data.RDF
import Data.RDF.Namespace
import Data.RDF.TriplesGraph
@@ -12,6 +16,30 @@ import Test.QuickCheck
import Control.Monad
+tests = [ testGroup "TriplesGraph"
+ [ testProperty "empty" prop_tg_empty
+ , testProperty "mkRdf_triplesOf" prop_tg_mkRdf_triplesOf
+ , testProperty "query_match_none" prop_tg_query_match_none
+ , testProperty "query_matched_spo" prop_tg_query_matched_spo
+ , testProperty "query_matched_spo_no_dupes" prop_tg_query_matched_spo_no_dupes
+ , testProperty "query_unmatched_spo" prop_tg_query_unmatched_spo
+ , testProperty "query_match_s" prop_tg_query_match_s
+ , testProperty "query_match_p" prop_tg_query_match_p
+ , testProperty "query_match_o" prop_tg_query_match_o
+ , testProperty "query_match_sp" prop_tg_query_match_sp
+ , testProperty "query_match_so" prop_tg_query_match_so
+ , testProperty "query_match_po" prop_tg_query_match_po
+ , testProperty "select_match_none" prop_tg_select_match_none
+ , testProperty "select_match_s" prop_tg_select_match_s
+ , testProperty "select_match_p" prop_tg_select_match_p
+ , testProperty "select_match_o" prop_tg_select_match_o
+ , testProperty "select_match_sp" prop_tg_select_match_sp
+ , testProperty "select_match_so" prop_tg_select_match_so
+ , testProperty "select_match_po" prop_tg_select_match_po
+ , testProperty "select_match_spo" prop_tg_select_match_spo
+ ]
+ ]
+
----------------------------------------------------
-- * instances and graph functions for TriplesGraph
----------------------------------------------------
View
9 testsuite/tests/Test.hs
@@ -7,11 +7,18 @@ import Test.Framework.Providers.QuickCheck (testProperty)
import Test.QuickCheck
import Test.HUnit
+import Data.RDF.GraphTestUtils
import Data.RDF.MGraph_Test
import Data.RDF.TriplesGraph_Test
import Text.RDF.RDF4H.TurtleParser_ConformanceTest
+
+import qualified Data.RDF.TriplesGraph_Test as TriplesGraph
+import qualified Data.RDF.MGraph_Test as MGraph
import qualified Text.RDF.RDF4H.XmlParser_Test as XmlParser
main :: IO ()
-main = defaultMain ( XmlParser.tests )
+main = defaultMain ( TriplesGraph.tests
+ ++ MGraph.tests
+ ++ XmlParser.tests
+ )

0 comments on commit 0c793cc

Please sign in to comment.
Something went wrong with that request. Please try again.