Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Parse top level XML

Ignore-this: c065825fd94b8d3f6043fcf308bbd468

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

0 comments on commit 7fa7b38

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