Permalink
Browse files

Parse top level XML

Ignore-this: c065825fd94b8d3f6043fcf308bbd468

darcs-hash:20110118170812-1786f-fde5818bc4b4c644cf55f0816d5d68963362806e.gz
  • Loading branch information...
1 parent 8a09933 commit 7fa7b3845e4d034e96a662fef48724c3b764aa22 @amccausl committed Jan 18, 2011
View
2 rdf4h.cabal
@@ -52,6 +52,7 @@ library
, network >= 2.2.0.0 && < 2.3
, HTTP >= 4000.0.0 && < 4000.2
, hxt >= 9.0.0 && < 9.1
+ , MissingH >= 1.0.0 && < 1.1
other-modules: Data.RDF.Utils
, Text.RDF.RDF4H.ParserUtils
, Text.RDF.RDF4H.Interact
@@ -69,6 +70,7 @@ executable rdf4h
, network >= 2.2.0.0 && < 2.3
, HTTP >= 4000.0.0 && < 4000.2
, hxt >= 9.0.0 && < 9.1
+ , MissingH >= 1.0.0 && < 1.1
hs-source-dirs: src
extensions: BangPatterns
ghc-options: -O2 -Wall -fglasgow-exts -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-unused-do-bind
View
1 src/Data/RDF/MGraph.hs
@@ -35,6 +35,7 @@ import Data.List
--
-- * 'query' : O(log n)
newtype MGraph = MGraph (SPOMap, Maybe BaseUrl, PrefixMappings)
+ deriving (Show)
instance RDF MGraph where
baseUrl = baseUrl'
View
39 src/Text/RDF/RDF4H/XmlParser.hs
@@ -1,23 +1,54 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE Arrows, RankNTypes #-}
-- |An parser for the RDF/XML format
-- <http://www.w3.org/TR/REC-rdf-syntax/>.
module Text.RDF.RDF4H.XmlParser(
- parseXmlRDF
+ parseXmlRDF, getRDF
) where
+import qualified Data.Map as Map
import Data.RDF
-import Data.RDF.Namespace
+
+import Control.Arrow
import Text.XML.HXT.Core
-import Data.Tree.NTree.TypeDefs (NTree(..))
import Data.ByteString.Lazy.Char8(ByteString)
+import Data.String.Utils
+-- |Parse a xml ByteString to an RDF representation
parseXmlRDF :: forall rdf. (RDF rdf)
=> Maybe BaseUrl -- ^ The base URL for the RDF if required
-> Maybe ByteString -- ^ DocUrl: The request URL for the RDF if available
-> ByteString -- ^ The contents to parse
-> Either ParseFailure rdf -- ^ The RDF representation of the triples or ParseFailure
parseXmlRDF bUrl dUrl xmlStr = Left (ParseFailure "XML parsing not implemented")
+ where xml = runLA xread (b2s xmlStr)
+
+-- |Arrow that translates HXT XmlTree to an RDF representation
+getRDF :: forall rdf a. (RDF rdf, ArrowXml a) => a XmlTree rdf
+getRDF = proc xml -> do
+ rdf <- hasName "rdf:RDF" <<< isElem <<< getChildren -< xml
+ bUrl <- arr (Just . BaseUrl . s2b) <<< getAttrValue "transfer-URI" -< xml
+ prefixMap <- arr toPrefixMap <<< toAttrMap -< rdf
+ triples <- (parseDescription <<< hasName "rdf:Description" <<< isElem <<< getChildren) >. id -< rdf
+ returnA -< mkRdf triples bUrl prefixMap
+ where toAttrMap = (getAttrl >>> (getName &&& (getChildren >>> getText))) >. id
+ toPrefixMap = PrefixMappings . Map.fromList . map (\(n, m) -> (s2b (drop 6 n), s2b m)) . filter (startswith "xmlns:" . fst)
+ toUNode = unode . s2b
+ parseDescription = proc desc -> do
+ s <- getAttrValue "rdf:about" -< desc
+ (p, o) <- ((getName >>> isA (/= "rdf:about")) &&& (getChildren >>> getText)) <<< getAttrl -< desc
+ returnA -< Triple (toUNode s) (toUNode p) (toUNode o)
+
+fakeDoc :: ArrowXml a => a XmlTree XmlTree
+fakeDoc = mkelem "/"
+ [ sattr "source" "../../data/xml/example07.rdf"
+ , sattr "transfer-URI" "http://www.w3.org/TR/REC-rdf-syntax/example07.rdf"
+ , sattr "transfer-Message" "OK"
+ , sattr "transfer-Status" "200"
+ , sattr "transfer-MimeType" "text/rdf"
+ , sattr "transfer-Encoding" "ISO-8859-1"
+ ]
+ [ arr id ]
View
0 ...te/tests/Text/RDF/RDF4H/GraphTestUtils.hs → testsuite/tests/Data/RDF/GraphTestUtils.hs
File renamed without changes.
View
0 ...suite/tests/Text/RDF/RDF4H/MGraph_Test.hs → testsuite/tests/Data/RDF/MGraph_Test.hs
File renamed without changes.
View
0 ...tests/Text/RDF/RDF4H/TriplesGraph_Test.hs → ...suite/tests/Data/RDF/TriplesGraph_Test.hs
File renamed without changes.
View
4 testsuite/tests/Test.hs
@@ -7,8 +7,8 @@ import Test.Framework.Providers.QuickCheck (testProperty)
import Test.QuickCheck
import Test.HUnit
-import Text.RDF.RDF4H.MGraph_Test
-import Text.RDF.RDF4H.TriplesGraph_Test
+import Data.RDF.MGraph_Test
+import Data.RDF.TriplesGraph_Test
import Text.RDF.RDF4H.TurtleParser_ConformanceTest
main :: IO ()

0 comments on commit 7fa7b38

Please sign in to comment.