rdf4h (empty) → 0.9.1

raw patch · 17 files changed

+2930/−0 lines, 17 filesdep +HTTPdep +HUnitdep +MissingHsetup-changed

Dependencies added: HTTP, HUnit, MissingH, QuickCheck, base, bytestring, containers, directory, hxt, network, parsec, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

• LICENSE.txt +27/−0
• Setup.hs +4/−0
• rdf4h.cabal +112/−0
• src/Data/RDF.hs +546/−0
• src/Data/RDF/MGraph.hs +155/−0
• src/Data/RDF/Namespace.hs +141/−0
• src/Data/RDF/TriplesGraph.hs +96/−0
• src/Data/RDF/Utils.hs +161/−0
• src/Rdf4hParseMain.hs +191/−0
• src/Text/RDF/RDF4H/Interact.hs +89/−0
• src/Text/RDF/RDF4H/NTriplesParser.hs +232/−0
• src/Text/RDF/RDF4H/NTriplesSerializer.hs +89/−0
• src/Text/RDF/RDF4H/ParserUtils.hs +46/−0
• src/Text/RDF/RDF4H/TurtleParser.hs +597/−0
• src/Text/RDF/RDF4H/TurtleSerializer.hs +185/−0
• src/Text/RDF/RDF4H/XmlParser.hs +242/−0
• testsuite/tests/Test.hs +17/−0

@@ -0,0 +1,27 @@+Copyright (c) Calvin Smith++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.

@@ -0,0 +1,4 @@+import Distribution.Simple++main :: IO ()+main = defaultMain

@@ -0,0 +1,112 @@+name:            rdf4h+version:         0.9.1+synopsis:        A library for RDF processing in Haskell+description:     +  'RDF for Haskell' is a library for working with RDF in Haskell.+  At present it includes parsers and serializers for RDF in the N-Triples+  and Turtle, and parsing support for RDF/XML. It provides abilities such as querying+  for triples  containing a particular subject, predicate, or object, or+  selecting triples that satisfy an arbitrary predicate function.++author:          Calvin Smith+copyright:       (c) Calvin Smith+maintainer:      Rob Stewart <robstewart@gmail.com>+homepage:        https://github.com/robstewart57/rdf4h+bug-reports:     https://github.com/robstewart57/rdf4h/issues+license:         BSD3+license-file:    LICENSE.txt+cabal-version:   >= 1.8+build-type:      Simple+category:        RDF+stability:       Experimental+tested-with:     GHC==7.4.1+extra-tmp-files: test++flag small_base+  description: Choose the new smaller, split-up base package.+  default:     False++flag tests+  description: Build the tests+  default:     False++flag hpc+  description: Use HPC for tests+  default:     True++library+  exposed-modules: Data.RDF+                 , Data.RDF.Namespace+                 , Data.RDF.MGraph+                 , Data.RDF.TriplesGraph+                 , Text.RDF.RDF4H.NTriplesParser+                 , Text.RDF.RDF4H.NTriplesSerializer+                 , Text.RDF.RDF4H.TurtleParser+                 , Text.RDF.RDF4H.TurtleSerializer+                 , Text.RDF.RDF4H.XmlParser+  if flag(small_base)+    build-depends: base >= 3, bytestring, directory, containers+  else+    build-depends: base < 3+  build-depends:   parsec >= 3 && < 3.2+                 , network >= 2.2.0.0 && < 2.4+                 , HTTP >= 4000.0.0 && < 4000.3+                 , hxt >= 9.0.0 && < 9.2+                 , MissingH >= 1.0.0 && < 1.2+  other-modules:   Data.RDF.Utils+                 , Text.RDF.RDF4H.ParserUtils+                 , Text.RDF.RDF4H.Interact+  hs-source-dirs:  src+  extensions:      BangPatterns RankNTypes MultiParamTypeClasses Arrows FlexibleContexts+  ghc-options:     -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures -funbox-strict-fields -fno-warn-unused-do-bind+++executable rdf4h+  main-is:         Rdf4hParseMain.hs +  if flag(small_base)+    build-depends: base >= 3, bytestring+  else+    build-depends: base >= 4 && < 6+  build-depends:   parsec >= 3+                 , network >= 2.2.0.0 && < 2.4+                 , HTTP >= 4000.0.0 && < 4000.3+                 , hxt >= 9.0.0 && < 9.2+                 , MissingH >= 1.0.0 && < 1.2+                 , containers+  hs-source-dirs:  src+  extensions:      BangPatterns RankNTypes ScopedTypeVariables MultiParamTypeClasses+  ghc-options:     -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures -funbox-strict-fields -fno-warn-unused-do-bind+++test-suite test-rdf4h+  type:          exitcode-stdio-1.0+  main-is:       Test.hs+  ghc-options:   -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures -funbox-strict-fields -fno-warn-unused-do-bind+  extensions:    RankNTypes MultiParamTypeClasses Arrows FlexibleContexts+  build-depends: base >= 4 && < 6+               , parsec >= 3+               , test-framework >= 0.2.3 && < 0.7+               , test-framework-quickcheck2 >= 0.2.12.2+               , test-framework-hunit >= 0.2.7+               , HTTP >= 4000.0.0 && < 4000.3+               , network >= 2.2.0.0 && < 2.4+               , QuickCheck >= 1.2.0.0 && < 2.5+               , HUnit >= 1.2.2.1 && < 1.3+               , MissingH >= 1.0.0 && < 1.2+               , bytestring+               , hxt+               , containers+  other-modules: Data.RDF+               , Data.RDF.Namespace+               , Data.RDF.MGraph+               , Data.RDF.TriplesGraph+               , Text.RDF.RDF4H.NTriplesParser+               , Text.RDF.RDF4H.NTriplesSerializer+               , Text.RDF.RDF4H.TurtleParser+               , Text.RDF.RDF4H.TurtleSerializer+               , Text.RDF.RDF4H.XmlParser+  hs-source-dirs: src, testsuite/tests++source-repository head+  type:     git+  location: git://github.com/robstewart57/rdf4h.git

@@ -0,0 +1,546 @@+-- |The Core module provides the fundamental types,+-- type classes, and functions of the library.+--++-- TODO: update writeT to writeTriple, etc.++module Data.RDF (+  -- * Parsing RDF+  RdfParser(parseString, parseFile, parseURL),+  -- * Serializing RDF+  RdfSerializer(hWriteRdf, writeRdf, hWriteH, writeH, hWriteTs, writeTs, hWriteT, writeT, hWriteN, writeN),+  -- * RDF type+  RDF(empty, mkRdf, triplesOf, select, query, baseUrl, prefixMappings, addPrefixMappings),+  -- * RDF triples, nodes, and literals+  Triple(Triple), triple, Triples, sortTriples,+  Node(UNode, BNode, BNodeGen, LNode),+  LValue(PlainL, PlainLL, TypedL),++  -- * Supporting types and functions+  BaseUrl(BaseUrl),+  PrefixMappings(PrefixMappings), toPMList, PrefixMapping(PrefixMapping),+  NodeSelector, isUNode, isBNode, isLNode,+  equalSubjects, equalPredicates, equalObjects,+  isIsomorphic,+  subjectOf, predicateOf, objectOf, isEmpty,+  rdfContainsNode,tripleContainsNode,+  listSubjectsWithPredicate,listObjectsOfPredicate,+  Subject, Predicate, Object,+  ParseFailure(ParseFailure),+  FastString(uniq,value),mkFastString,+  s2b,b2s,unode,bnode,lnode,plainL,plainLL,typedL,+  View, view,+  fromEither, maybeHead, removeDupes+)+where++import Data.RDF.Namespace+import Data.RDF.Utils+import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import Data.List+import System.IO+import Text.Printf++-- |A type class for ADTs that expose views to clients.+class View a b where+  view :: a -> b++-- |An alias for 'Node', defined for convenience and readability purposes.+type Subject = Node++-- |An alias for 'Node', defined for convenience and readability purposes.+type Predicate = Node++-- |An alias for 'Node', defined for convenience and readability purposes.+type Object = Node++-- |An RDF value is a set of (unique) RDF triples, together with the+-- operations defined upon them.+--+-- For information about the efficiency of the functions, see the+-- documentation for the particular RDF instance.+--+-- For more information about the concept of an RDF graph, see+-- the following: <http://www.w3.org/TR/rdf-concepts/#section-rdf-graph>.+class RDF rdf where++  -- |Return the base URL of this RDF, if any.+  baseUrl :: rdf -> Maybe BaseUrl++  -- |Return the prefix mappings defined for this RDF, if any.+  prefixMappings :: rdf -> PrefixMappings++  -- |Return an RDF with the specified prefix mappings merged with+  -- the existing mappings. If the Bool arg is True, then a new mapping+  -- for an existing prefix will replace the old mapping; otherwise,+  -- the new mapping is ignored.+  addPrefixMappings :: rdf -> PrefixMappings -> Bool -> rdf++  -- |Return an empty RDF.+  empty  :: rdf++  -- |Return a RDF containing all the given triples. Handling of duplicates+  -- in the input depend on the particular RDF implementation.+  mkRdf :: Triples -> Maybe BaseUrl -> PrefixMappings -> rdf++  -- |Return all triples in the RDF, as a list.+  triplesOf :: rdf -> Triples++  -- |Select the triples in the RDF that match the given selectors.+  --+  -- The three NodeSelector parameters are optional functions that match+  -- the respective subject, predicate, and object of a triple. The triples+  -- returned are those in the given graph for which the first selector+  -- returns true when called on the subject, the second selector returns+  -- true when called on the predicate, and the third selector returns true+  -- when called on the ojbect. A 'Nothing' parameter is equivalent to a+  -- function that always returns true for the appropriate node; but+  -- implementations may be able to much more efficiently answer a select+  -- that involves a 'Nothing' parameter rather than an @(id True)@ parameter.+  --+  -- The following call illustrates the use of select, and would result in+  -- the selection of all and only the triples that have a blank node+  -- as subject and a literal node as object:+  --+  -- > select gr (Just isBNode) Nothing (Just isLNode)+  --+  -- Note: this function may be very slow; see the documentation for the+  -- particular RDF implementation for more information.+  select    :: rdf -> NodeSelector -> NodeSelector -> NodeSelector -> Triples++  -- |Return the triples in the RDF that match the given pattern, where+  -- the pattern (3 Maybe Node parameters) is interpreted as a triple pattern.+  --+  -- The @Maybe Node@ params are interpreted as the subject, predicate, and+  -- object of a triple, respectively. @Just n@ is true iff the triple has+  -- a node equal to @n@ in the appropriate location; @Nothing@ is always+  -- true, regardless of the node in the appropriate location.+  --+  -- For example, @ query rdf (Just n1) Nothing (Just n2) @ would return all+  -- and only the triples that have @n1@ as subject and @n2@ as object,+  -- regardless of the predicate of the triple.+  query         :: rdf -> Maybe Node -> Maybe Node -> Maybe Node -> Triples++-- |An RdfParser is a parser that knows how to parse 1 format of RDF and+-- can parse an RDF document of that type from a string, a file, or a URL.+-- Required configuration options will vary from instance to instance.+class RdfParser p where++  -- |Parse RDF from the given bytestring, yielding a failure with error message or+  -- the resultant RDF.+  parseString :: forall rdf. (RDF rdf) => p -> ByteString -> Either ParseFailure rdf++  -- |Parse RDF from the local file with the given path, yielding a failure with error+  -- message or the resultant RDF in the IO monad.+  parseFile   :: forall rdf. (RDF rdf) => p -> String     -> IO (Either ParseFailure rdf)++  -- |Parse RDF from the remote file with the given HTTP URL (https is not supported),+  -- yielding a failure with error message or the resultant graph in the IO monad.+  parseURL    :: forall rdf. (RDF rdf) => p -> String -> IO (Either ParseFailure rdf)++-- |An RdfSerializer is a serializer of RDF to some particular output format, such as+-- NTriples or Turtle.+class RdfSerializer s where+  -- |Write the RDF to a file handle using whatever configuration is specified by+  -- the first argument.+  hWriteRdf     :: forall rdf. (RDF rdf) => s -> Handle -> rdf -> IO ()++  -- |Write the RDF to stdout; equivalent to @'hWriteRdf' stdout@.+  writeRdf      :: forall rdf. (RDF rdf) => s -> rdf -> IO ()++  -- |Write to the file handle whatever header information is required based on+  -- the output format. For example, if serializing to Turtle, this method would+  -- write the necessary \@prefix declarations and possibly a \@baseUrl declaration,+  -- whereas for NTriples, there is no header section at all, so this would be a no-op.+  hWriteH     :: forall rdf. (RDF rdf) => s -> Handle -> rdf -> IO ()++  -- |Write header information to stdout; equivalent to @'hWriteRdf' stdout@.+  writeH      :: forall rdf. (RDF rdf) => s -> rdf -> IO ()++  -- |Write some triples to a file handle using whatever configuration is specified+  -- by the first argument. +  -- +  -- WARNING: if the serialization format has header-level information +  -- that should be output (e.g., \@prefix declarations for Turtle), then you should+  -- use 'hWriteG' instead of this method unless you're sure this is safe to use, since+  -- otherwise the resultant document will be missing the header information and +  -- will not be valid.+  hWriteTs    :: s -> Handle  -> Triples -> IO ()++  -- |Write some triples to stdout; equivalent to @'hWriteTs' stdout@.+  writeTs     :: s -> Triples -> IO ()++  -- |Write a single triple to the file handle using whatever configuration is +  -- specified by the first argument. The same WARNING applies as to 'hWriteTs'.+  hWriteT     :: s -> Handle  -> Triple  -> IO ()++  -- |Write a single triple to stdout; equivalent to @'hWriteT' stdout@.+  writeT      :: s -> Triple  -> IO ()++  -- |Write a single node to the file handle using whatever configuration is +  -- specified by the first argument. The same WARNING applies as to 'hWriteTs'.+  hWriteN     :: s -> Handle  -> Node    -> IO ()++  -- |Write a single node to sdout; equivalent to @'hWriteN' stdout@.+  writeN      :: s -> Node    -> IO ()++-- |An RDF node, which may be either a URIRef node ('UNode'), a blank+-- node ('BNode'), or a literal node ('LNode').+data Node =++  -- |An RDF URI reference. See+  -- <http://www.w3.org/TR/rdf-concepts/#section-Graph-URIref> for more+  -- information.+  UNode !FastString++  -- |An RDF blank node. See+  -- <http://www.w3.org/TR/rdf-concepts/#section-blank-nodes> for more+  -- information.+  | BNode !FastString++  -- |An RDF blank node with an auto-generated identifier, as used in+  -- Turtle.+  | BNodeGen !Int++  -- |An RDF literal. See+  -- <http://www.w3.org/TR/rdf-concepts/#section-Graph-Literal> for more+  -- information.+  | LNode !LValue++-- ==============================+-- Constructor functions for Node++-- |Return a URIRef node for the given bytetring URI.+{-# INLINE unode #-}+unode :: ByteString -> Node+unode = UNode . mkFastString++-- |Return a blank node using the given string identifier.+{-# INLINE bnode #-}+bnode :: ByteString ->  Node+bnode = BNode . mkFastString++-- |Return a literal node using the given LValue.+{-# INLINE lnode #-}+lnode :: LValue ->  Node+lnode = LNode++-- Constructor functions for Node+-- ==============================+++-- |A list of triples. This is defined for convenience and readability.+type Triples = [Triple]++-- |An RDF triple is a statement consisting of a subject, predicate,+-- and object, respectively.+--+-- See <http://www.w3.org/TR/rdf-concepts/#section-triples> for+-- more information.+data Triple = Triple !Node !Node !Node++-- |A smart constructor function for 'Triple' that verifies the node arguments+-- are of the correct type and creates the new 'Triple' if so or calls 'error'.+-- /subj/ must be a 'UNode' or 'BNode', and /pred/ must be a 'UNode'.+triple :: Subject -> Predicate -> Object -> Triple+triple subj pred obj+  | isLNode subj     =  error $ "subject must be UNode or BNode: "     ++ show subj+  | isLNode pred     =  error $ "predicate must be UNode, not LNode: " ++ show pred+  | isBNode pred     =  error $ "predicate must be UNode, not BNode: " ++ show pred+  | otherwise        =  Triple subj pred obj++-- |The actual value of an RDF literal, represented as the 'LValue'+-- parameter of an 'LNode'.+data LValue =+  -- Constructors are not exported, because we need to have more+  -- control over the format of the literal bytestring that we store.++  -- |A plain (untyped) literal value in an unspecified language.+  PlainL !ByteString++  -- |A plain (untyped) literal value with a language specifier.+  | PlainLL !ByteString !ByteString++  -- |A typed literal value consisting of the literal value and+  -- the URI of the datatype of the value, respectively.+  | TypedL !ByteString  !FastString++-- ================================+-- Constructor functions for LValue++-- |Return a PlainL LValue for the given string value.+{-# INLINE plainL #-}+plainL :: ByteString -> LValue+plainL =  PlainL++-- |Return a PlainLL LValue for the given string value and language,+-- respectively.+{-# INLINE plainLL #-}+plainLL :: ByteString -> ByteString -> LValue+plainLL = PlainLL++-- |Return a TypedL LValue for the given string value and datatype URI,+-- respectively.+{-# INLINE typedL #-}+typedL :: ByteString -> FastString -> LValue+typedL val dtype = TypedL (canonicalize dtype val) dtype++-- Constructor functions for LValue+-- ================================+++-- |The base URL of an RDF.+newtype BaseUrl = BaseUrl ByteString+  deriving (Eq, Ord, Show)++-- |A 'NodeSelector' is either a function that returns 'True'+--  or 'False' for a node, or Nothing, which indicates that all+-- nodes would return 'True'.+--+-- The selector is said to select, or match, the nodes for+-- which it returns 'True'.+--+-- When used in conjunction with the 'select' method of 'Graph', three+-- node selectors are used to match a triple.+type NodeSelector = Maybe (Node -> Bool)++-- |Represents a failure in parsing an N-Triples document, including+-- an error message with information about the cause for the failure.+newtype ParseFailure = ParseFailure String+  deriving (Eq, Show)++-- |A node is equal to another node if they are both the same type+-- of node and if the field values are equal.+instance Eq Node where+  (UNode fs1)    ==  (UNode fs2)     =  uniq fs1 == uniq fs2+  (BNode fs1)    ==  (BNode fs2)     =  uniq fs1 == uniq fs2+  (BNodeGen i1)  ==  (BNodeGen i2)   =  i1 == i2+  (LNode l1)     ==  (LNode l2)      =  l1 == l2+  _              ==  _               =  False++-- |Node ordering is defined first by type, with Unode < BNode < BNodeGen+-- < LNode PlainL < LNode PlainLL < LNode TypedL, and secondly by+-- the natural ordering of the node value.+--+-- E.g., a '(UNode _)' is LT any other type of node, and a+-- '(LNode (TypedL _ _))' is GT any other type of node, and the ordering+-- of '(BNodeGen 44)' and '(BNodeGen 3)' is that of the values, or+-- 'compare 44 3', GT.+instance Ord Node where+  compare = compareNode++compareNode :: Node -> Node -> Ordering+compareNode (UNode fs1)                      (UNode fs2)                      = compareFS fs1 fs2+compareNode (UNode _)                        _                                = LT+compareNode (BNode fs1)                      (BNode fs2)                      = compareFS fs1 fs2+compareNode (BNode _)                        (UNode _)                        = GT+compareNode (BNode _)                        _                                = LT+compareNode (BNodeGen i1)                    (BNodeGen i2)                    = compare i1 i2+compareNode (BNodeGen _)                     (LNode _)                        = LT+compareNode (BNodeGen _)                     _                                = GT+compareNode (LNode (PlainL bs1))             (LNode (PlainL bs2))             = compare bs1 bs2+compareNode (LNode (PlainL _))               (LNode _)                        = LT+compareNode (LNode (PlainLL bs1 bs1'))       (LNode (PlainLL bs2 bs2'))       =+  case compare bs1' bs2' of+    EQ -> compare bs1 bs2+    LT -> LT+    GT -> GT+compareNode (LNode (PlainLL _ _))            (LNode (PlainL _))               = GT+compareNode (LNode (PlainLL _ _))            (LNode _)                        = LT+compareNode (LNode (TypedL bs1 fs1))         (LNode (TypedL bs2 fs2))         =+  case compare fs1 fs2 of+    EQ -> compare bs1 bs2+    LT -> LT+    GT -> GT+compareNode (LNode (TypedL _ _))             (LNode _)                        = GT+compareNode (LNode _)                        _                                = GT++-- |Two triples are equal iff their respective subjects, predicates, and objects+-- are equal.+instance Eq Triple where+  (Triple s1 p1 o1) == (Triple s2 p2 o2) = s1 == s2 && p1 == p2 && o1 == o2++-- |The ordering of triples is based on that of the subject, predicate, and object+-- of the triple, in that order.+instance Ord Triple where+  (Triple s1 p1 o1) `compare` (Triple s2 p2 o2) =+    case compareNode s1 s2 of+      EQ -> case compareNode p1 p2 of+              EQ -> compareNode o1 o2+              LT -> LT+              GT -> GT+      GT -> GT+      LT -> LT++-- |Two 'LValue' values are equal iff they are of the same type and all fields are+-- equal.+instance Eq LValue where+  (PlainL bs1)        ==  (PlainL bs2)        =  bs1 == bs2+  (PlainLL bs1 bs1')  ==  (PlainLL bs2 bs2')  =  bs1' == bs2'    &&  bs1 == bs2+  (TypedL bs1 fs1)    ==  (TypedL bs2 fs2)    =  equalFS fs1 fs2 &&  bs1 == bs2+  _                   ==  _                   =  False++-- |Ordering of 'LValue' values is as follows: (PlainL _) < (PlainLL _ _)+-- < (TypedL _ _), and values of the same type are ordered by field values,+-- with '(PlainLL literalValue language)' being ordered by language first and+-- literal value second, and '(TypedL literalValue datatypeUri)' being ordered+-- by datatype first and literal value second.+instance Ord LValue where+  compare = compareLValue++{-# INLINE compareLValue #-}+compareLValue :: LValue -> LValue -> Ordering+compareLValue (PlainL bs1)       (PlainL bs2)       = compare bs1 bs2+compareLValue (PlainL _)         _                  = LT+compareLValue _                  (PlainL _)         = GT+compareLValue (PlainLL bs1 bs1') (PlainLL bs2 bs2') =+  case compare bs1' bs2' of+    EQ -> compare bs1 bs2+    GT -> GT+    LT -> LT+compareLValue (PlainLL _ _)       _                 = LT+compareLValue _                   (PlainLL _ _)     = GT+compareLValue (TypedL l1 t1) (TypedL l2 t2) =+  case compareFS t1 t2 of+    EQ -> compare l1 l2+    GT -> GT+    LT -> LT++-- String representations of the various data types; generally NTriples-like.++instance Show Triple where+  show (Triple s p o) =+    printf "Triple(%s,%s,%s)" (show s) (show p) (show o)++instance Show Node where+  show (UNode uri)                   = "UNode(" ++ show uri ++ ")"+  show (BNode  i)                    = "BNode(" ++ show i ++ ")"+  show (BNodeGen genId)              = "BNodeGen(" ++ show genId ++ ")"+  show (LNode lvalue)                = "LNode(" ++ show lvalue ++ ")"++instance Show LValue where+  show (PlainL lit)               = "PlainL(" ++ B.unpack lit ++ ")"+  show (PlainLL lit lang)         = "PlainLL(" ++ B.unpack lit ++ ", " ++ B.unpack lang ++ ")"+  show (TypedL lit dtype)         = "TypedL(" ++ B.unpack lit ++ "," ++ show dtype ++ ")"++-- |Answer the given list of triples in sorted order.+sortTriples :: Triples -> Triples+sortTriples = sort++-- |Answer the subject node of the triple.+{-# INLINE subjectOf #-}+subjectOf :: Triple -> Node+subjectOf (Triple s _ _) = s++-- |Answer the predicate node of the triple.+{-# INLINE predicateOf #-}+predicateOf :: Triple -> Node+predicateOf (Triple _ p _) = p++-- |Answer the object node of the triple.+{-# INLINE objectOf #-}+objectOf :: Triple -> Node+objectOf (Triple _ _ o)   = o++-- |Answer if rdf contains node.+rdfContainsNode :: forall rdf. (RDF rdf) => rdf -> Node -> Bool+rdfContainsNode rdf node =+  let ts = triplesOf rdf+      xs = map (tripleContainsNode node) ts+  in elem True xs++-- |Answer if triple contains node.+tripleContainsNode :: Node -> Triple -> Bool+{-# INLINE tripleContainsNode #-}+tripleContainsNode node t = + subjectOf t == node || predicateOf t == node || objectOf t == node++-- |Answer if given node is a URI Ref node.+{-# INLINE isUNode #-}+isUNode :: Node -> Bool+isUNode (UNode _) = True+isUNode _         = False++-- |Answer if given node is a blank node.+{-# INLINE isBNode #-}+isBNode :: Node -> Bool+isBNode (BNode _)    = True+isBNode (BNodeGen _) = True+isBNode _            = False++-- |Answer if given node is a literal node.+{-# INLINE isLNode #-}+isLNode :: Node -> Bool+isLNode (LNode _) = True+isLNode _         = False++-- |Determine whether two triples have equal subjects.+equalSubjects :: Triple -> Triple -> Bool+equalSubjects (Triple s1 _ _) (Triple s2 _ _) = s1 == s2++-- |Determine whether two triples have equal predicates.+equalPredicates :: Triple -> Triple -> Bool+equalPredicates (Triple _ p1 _) (Triple _ p2 _) = p1 == p2++-- |Determine whether two triples have equal objects.+equalObjects :: Triple -> Triple -> Bool+equalObjects (Triple _ _ o1) (Triple _ _ o2) = o1 == o2++-- |Determines whether the 'RDF' contains zero triples.+isEmpty :: RDF rdf => rdf -> Bool+isEmpty rdf =+  let ts = triplesOf rdf+  in null ts++-- |Lists of all subjects of triples with the given predicate.+listSubjectsWithPredicate :: RDF rdf => rdf -> Predicate -> [Subject]+listSubjectsWithPredicate rdf pred =+  listNodesWithPredicate rdf pred subjectOf++-- |Lists of all objects of triples with the given predicate.+listObjectsOfPredicate :: RDF rdf => rdf -> Predicate -> [Object]+listObjectsOfPredicate rdf pred =+  listNodesWithPredicate rdf pred objectOf++listNodesWithPredicate :: RDF rdf => rdf -> Predicate -> (Triple -> Node) -> [Node]+listNodesWithPredicate rdf pred f =+  let ts = triplesOf rdf+      xs = filter (\t -> predicateOf t == pred) ts+  in map f xs+++-- |Convert a parse result into an RDF if it was successful+-- and error and terminate if not.+fromEither :: RDF rdf => Either ParseFailure rdf -> rdf+fromEither res =+  case res of+    (Left err) -> error (show err)+    (Right rdf) -> rdf++-- |Remove duplicate triples, returning unique triples. This +-- function may return the triples in a different order than +-- given.+removeDupes :: Triples -> Triples+removeDupes =  map head . group . sort++-- |This determines if two RDF representations are equal regardless of blank+-- nodc names, triple order and prefixes.  In math terms, this is the \simeq+-- latex operator, or ~=+isIsomorphic :: forall rdf1 rdf2. (RDF rdf1, RDF rdf2) => rdf1 -> rdf2 -> Bool+isIsomorphic g1 g2 = normalize g1 == normalize g2+  where normalize :: forall rdf. (RDF rdf) => rdf -> Triples+        normalize = sort . nub . expandTriples++-- |Expand the triples in a graph with the prefix map and base URL for that+-- graph.+expandTriples :: (RDF rdf) => rdf -> Triples+expandTriples rdf = expandTriples' [] (baseUrl rdf) (prefixMappings rdf) (triplesOf rdf)++expandTriples' :: Triples -> Maybe BaseUrl -> PrefixMappings -> Triples -> Triples+expandTriples' acc _ _ [] = acc+expandTriples' acc baseUrl prefixMappings (t:rest) = expandTriples' (normalize baseUrl prefixMappings t : acc) baseUrl prefixMappings rest+  where normalize baseUrl prefixMappings = expandPrefixes prefixMappings . expandBaseUrl baseUrl+        expandBaseUrl (Just _) triple = triple+        expandBaseUrl Nothing triple = triple+        expandPrefixes _ triple = triple

@@ -0,0 +1,155 @@+-- |A simple graph implementation backed by 'Data.Map'.++module Data.RDF.MGraph(MGraph, empty, mkRdf, triplesOf, select, query)++where++import Data.RDF+import Data.RDF.Namespace+import Data.Map(Map)+import qualified Data.Map as Map+import Data.Set(Set)+import qualified Data.Set as Set+import Data.List++-- |A map-based graph implementation.+--+-- Worst-case time complexity of the graph functions, with respect+-- to the number of triples, are:+--+--  * 'empty'    : O(1)+--+--  * 'mkRdf'  : O(n)+--+--  * 'triplesOf': O(n)+--+--  * 'select'   : O(n)+--+--  * 'query'    : O(log n)+newtype MGraph = MGraph (SPOMap, Maybe BaseUrl, PrefixMappings)++instance RDF MGraph where+  baseUrl           = baseUrl'+  prefixMappings    = prefixMappings'+  addPrefixMappings = addPrefixMappings'+  empty             = empty'+  mkRdf             = mkRdf'+  triplesOf         = triplesOf'+  select            = select'+  query             = query'++-- some convenience type alias for readability++-- An adjacency map for a subject, mapping from a predicate node to+-- to the adjacent nodes via that predicate.+type AdjacencyMap = Map Predicate Adjacencies++--+type Adjacencies = Set Object+type SPOMap    = Map Subject AdjacencyMap++baseUrl' :: MGraph -> Maybe BaseUrl+baseUrl' (MGraph (_, baseUrl, _)) = baseUrl++prefixMappings' :: MGraph -> PrefixMappings+prefixMappings' (MGraph (_, _, pms)) = pms++addPrefixMappings' :: MGraph -> PrefixMappings -> Bool -> MGraph+addPrefixMappings' (MGraph (ts, baseUrl, pms)) pms' replace = +  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings+  in  MGraph (ts, baseUrl, merge pms pms')++empty' :: MGraph+empty' = MGraph (Map.empty, Nothing, PrefixMappings Map.empty)++mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> MGraph+mkRdf' ts baseUrl pms = MGraph (mergeTs Map.empty ts, baseUrl, pms)++mergeTs :: SPOMap -> [Triple] -> SPOMap+mergeTs = foldl' mergeT+  where+    mergeT :: SPOMap -> Triple -> SPOMap+    mergeT m t = mergeT' m (subjectOf t) (predicateOf t) (objectOf t)++mergeT' :: SPOMap -> Subject -> Predicate -> Object -> SPOMap+mergeT' m s p o =+  if s `Map.member` m then+    (if p `Map.member` adjs then Map.insert s (addPredObj p o adjs) m+       else Map.insert s (addNewPredObjMap p o adjs) m)+    else Map.insert s (newPredMap p o) m+  where+    adjs = get s m+    newPredMap :: Predicate -> Object -> Map Predicate (Set Object)+    newPredMap p o = Map.singleton p (Set.singleton o)+    addNewPredObjMap :: Predicate -> Object -> Map Predicate (Set Object) ->+                       Map Predicate (Set Object)+    addNewPredObjMap p o = Map.insert p (Set.singleton o)+    addPredObj :: Predicate -> Object -> Map Predicate (Set Object) ->+                    Map Predicate (Set Object)+    addPredObj p o = Map.insert p (Set.insert o (get p adjs))+    get :: Ord k => k -> Map k v -> v+    get = Map.findWithDefault undefined++-- 3 following functions support triplesOf+triplesOf' :: MGraph -> Triples+triplesOf' (MGraph (spoMap, _, _)) = concatMap (uncurry tripsSubj) subjPredMaps+  where subjPredMaps = Map.toList spoMap++tripsSubj :: Subject -> AdjacencyMap -> Triples+tripsSubj s adjMap = concatMap (uncurry (tfsp s)) (Map.toList adjMap)+  where tfsp = tripsForSubjPred++tripsForSubjPred :: Subject -> Predicate -> Adjacencies -> Triples+tripsForSubjPred s p adjs = map (Triple s p) (Set.elems adjs)++-- supports select+select' :: MGraph -> NodeSelector -> NodeSelector -> NodeSelector -> Triples+select' (MGraph (spoMap,_,_)) subjFn predFn objFn =+  map (\(s,p,o) -> Triple s p o) $ Set.toList $ sel1 subjFn predFn objFn spoMap++sel1 :: NodeSelector -> NodeSelector -> NodeSelector -> SPOMap -> Set (Node, Node, Node)+sel1 (Just subjFn) p o spoMap =+  Set.unions $ map (sel2 p o) $ filter (\(x,_) -> subjFn x) $ Map.toList spoMap+sel1 Nothing p o spoMap = Set.unions $ map (sel2 p o) $ Map.toList spoMap++sel2 :: NodeSelector -> NodeSelector -> (Node, Map Node (Set Node)) -> Set (Node, Node, Node)+sel2 (Just predFn) mobjFn (s, ps) =+  Set.map (\(p,o) -> (s,p,o)) $+  foldl' Set.union Set.empty $+  map (sel3 mobjFn) poMapS :: Set (Node, Node, Node)+  where+    poMapS :: [(Node, Set Node)]+    poMapS = filter (\(k,_) -> predFn k) $ Map.toList ps+sel2 Nothing mobjFn (s, ps) =+  Set.map (\(p,o) -> (s,p,o)) $+  foldl' Set.union Set.empty $+  map (sel3 mobjFn) poMaps+  where+    poMaps = Map.toList ps++sel3 :: NodeSelector -> (Node, Set Node) -> Set (Node, Node)+sel3 (Just objFn) (p, os) = Set.map (\o -> (p, o)) $ Set.filter objFn os+sel3 Nothing      (p, os) = Set.map (\o -> (p, o)) os++-- support query+query' :: MGraph -> Maybe Node -> Maybe Predicate -> Maybe Node -> Triples+query' (MGraph (spoMap,_ , _)) subj pred obj = map f $ Set.toList $ q1 subj pred obj spoMap+  where f (s, p, o) = Triple s p o++q1 :: Maybe Node -> Maybe Node -> Maybe Node -> SPOMap -> Set (Node, Node, Node)+q1 (Just s) p o spoMap = q2 p o (s, Map.findWithDefault Map.empty s spoMap)+q1 Nothing  p o spoMap = Set.unions $ map (q2 p o) $ Map.toList spoMap++q2 :: Maybe Node -> Maybe Node -> (Node, Map Node (Set Node)) -> Set (Node, Node, Node)+q2 (Just p) o (s, pmap) =+  if p `Map.member` pmap then+    Set.map (\ (p', o') -> (s, p', o')) $+      q3 o (p, Map.findWithDefault undefined p pmap)+    else Set.empty+q2 Nothing o (s, pmap) = Set.map (\(x,y) -> (s,x,y)) $ Set.unions $ map (q3 o) opmaps+  where opmaps ::[(Node, Set Node)]+        opmaps = Map.toList pmap++q3 :: Maybe Node -> (Node, Set Node) -> Set (Node, Node)+q3 (Just o) (p, os) = if o `Set.member` os then Set.singleton (p, o) else Set.empty+q3 Nothing  (p, os) = Set.map (\o -> (p, o)) os

@@ -0,0 +1,141 @@+-- |Defines types and utility functions related to namespaces, and+-- some predefined values for commonly used namespaces, such as+-- rdf, xsd, dublin core, etc.++module Data.RDF.Namespace(+  -- * Namespace types and functions+  Namespace(..), mkPlainNS, mkPrefixedNS, mkPrefixedNS',+  PrefixMapping(PrefixMapping), PrefixMappings(PrefixMappings), toPMList,+  mergePrefixMappings,+  mkUri,+  prefixOf, uriOf,+  -- * Predefined namespace values+  rdf, rdfs, dc, dct, owl, xsd, skos, foaf, ex, ex2, standard_ns_mappings+)+where++import Data.RDF.Utils+import Text.Printf+import Data.Map(Map)+import qualified Data.Map as Map+import qualified Data.List as List+import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B++standard_namespaces :: [Namespace]+standard_namespaces = [rdf, rdfs, dc, dct, owl, xsd, skos, foaf, ex, ex2]++-- |The set of common predefined namespaces as a 'PrefixMappings' value.+standard_ns_mappings  :: PrefixMappings+standard_ns_mappings  =  PrefixMappings $ Map.fromList $ +                         map (\(PrefixedNS pre uri) -> (pre, uri)) standard_namespaces++-- |The RDF namespace.+rdf  :: Namespace+rdf   =   mkPrefixedNS' "rdf" "http://www.w3.org/1999/02/22-rdf-syntax-ns#"++-- |The RDF Schema namespace.+rdfs :: Namespace+rdfs  =   mkPrefixedNS'  "rdfs"  "http://www.w3.org/2000/01/rdf-schema#"++-- |The Dublic Core namespace.+dc   :: Namespace+dc    =   mkPrefixedNS'  "dc"    "http://purl.org/dc/elements/1.1/"++-- |The Dublin Core terms namespace.+dct  :: Namespace+dct   =   mkPrefixedNS'  "dct"    "http://purl.org/dc/terms/"++-- |The OWL namespace.+owl  :: Namespace+owl   =   mkPrefixedNS'  "owl"   "http://www.w3.org/2002/07/owl#"++-- |The XML Schema namespace.+xsd  :: Namespace+xsd   =   mkPrefixedNS'  "xsd"   "http://www.w3.org/2001/XMLSchema#"++-- |The SKOS namespace.+skos :: Namespace+skos  =   mkPrefixedNS'  "skos"  "http://www.w3.org/2004/02/skos/core#"++-- |The friend of a friend namespace.+foaf :: Namespace+foaf  =   mkPrefixedNS'  "foaf"  "http://xmlns.com/foaf/0.1/"++-- |Example namespace #1.+ex   :: Namespace+ex    =   mkPrefixedNS'  "ex"    "http://www.example.org/"++-- |Example namespace #2.+ex2  :: Namespace+ex2   =   mkPrefixedNS'  "ex2"   "http://www2.example.org/"++-- |An alias for a map from prefix to namespace URI.+newtype PrefixMappings   = PrefixMappings (Map ByteString ByteString)+  deriving (Eq, Ord)+instance Show PrefixMappings where+  -- This is really inefficient, but it's not used much so not what+  -- worth optimizing yet.+  show (PrefixMappings pmap) = printf "PrefixMappings [%s]" mappingsStr+    where showPM      = show . PrefixMapping+          mappingsStr = List.intercalate ", " (map showPM (Map.toList pmap))++-- |Perform a left-biased merge of the two sets of prefix mappings.+mergePrefixMappings :: PrefixMappings -> PrefixMappings -> PrefixMappings+mergePrefixMappings (PrefixMappings p1s) (PrefixMappings p2s) = +  PrefixMappings $ Map.union p1s p2s++-- |View the prefix mappings as a list of key-value pairs. The PM in+-- in the name is to reduce name clashes if used without qualifying.+toPMList :: PrefixMappings -> [(ByteString, ByteString)]+toPMList (PrefixMappings m) = Map.toList m++-- |A mapping of a prefix to the URI for that prefix.+newtype PrefixMapping = PrefixMapping (ByteString, ByteString)+  deriving (Eq, Ord)+instance Show PrefixMapping where+  show (PrefixMapping (prefix, uri)) = printf "PrefixMapping (%s, %s)" (b2s prefix) (b2s uri)++-- |Make a URI consisting of the given namespace and the given localname.+mkUri :: Namespace -> ByteString -> ByteString+mkUri ns local = uriOf ns `B.append` local++-- |Represents a namespace as either a prefix and uri, respectively,+--  or just a uri.+data Namespace = PrefixedNS  ByteString ByteString -- prefix and ns uri+               | PlainNS     ByteString            -- ns uri alone++-- |Make a namespace for the given URI reference.+mkPlainNS     ::  ByteString -> Namespace+mkPlainNS       =  PlainNS++-- |Make a namespace having the given prefix for the given URI reference,+-- respectively.+mkPrefixedNS  :: ByteString -> ByteString -> Namespace+mkPrefixedNS    =  PrefixedNS++-- |Make a namespace having the given prefix for the given URI reference,+-- respectively, using strings which will be converted to bytestrings+-- automatically.+mkPrefixedNS' :: String -> String -> Namespace+mkPrefixedNS' s1 s2 = mkPrefixedNS (B.pack s1) (B.pack s2)++instance Eq Namespace where+  (PrefixedNS _ u1) == (PrefixedNS _ u2)  = u1 == u2+  (PlainNS      u1) == (PlainNS      u2)  = u1 == u2+  (PrefixedNS _ u1) == (PlainNS      u2)  = u1 == u2+  (PlainNS      u1) == (PrefixedNS _ u2)  = u1 == u2++instance Show Namespace where+  show (PlainNS           uri)  =  B.unpack uri+  show (PrefixedNS prefix uri)  =  printf "(PrefixNS %s %s)" (B.unpack prefix) (B.unpack uri)++-- |Determine the URI of the given namespace.+uriOf     ::  Namespace -> ByteString+uriOf    (PlainNS      uri)  = uri+uriOf    (PrefixedNS _ uri)  = uri++-- |Determine the prefix of the given namespace, if it has one.+prefixOf  ::  Namespace -> Maybe ByteString+prefixOf (PlainNS      _)    = Nothing+prefixOf (PrefixedNS p _)    = Just p

@@ -0,0 +1,96 @@+-- |"TriplesGraph" contains a list-backed graph implementation suitable+-- for smallish graphs or for temporary graphs that will not be queried.+-- It maintains the triples in the order that they are given in, and is+-- especially useful for holding N-Triples, where it is often desirable+-- to preserve the order of the triples when they were originally parsed.+-- Duplicate triples are not filtered. If you might have duplicate triples,+-- use @MGraph@ instead, which is also more efficient. However, the query+-- functions of this graph (select, query) remove duplicates from their+-- result triples (but triplesOf does not) since it is usually cheap+-- to do so.+module Data.RDF.TriplesGraph(TriplesGraph, empty, mkRdf, triplesOf, select, query)++where++import Data.RDF+import Data.RDF.Namespace+import qualified Data.Map as Map++-- |A simple implementation of the 'RDF' type class that represents+-- the graph internally as a list of triples.+--+-- Note that this type of RDF is fine for interactive+-- experimentation and querying of smallish (<10,000 triples) graphs,+-- but there are better options for larger graphs or graphs that you+-- will do many queries against (e.g., @MGraph@ is faster for queries).+--+-- The time complexity of the functions (where n == num_triples) are:+--+--  * 'empty'    : O(1)+--+--  * 'mkRdf'  : O(n)+--+--  * 'triplesOf': O(1)+--+--  * 'select'   : O(n)+--+--  * 'query'    : O(n)+newtype TriplesGraph = TriplesGraph (Triples, Maybe BaseUrl, PrefixMappings)++instance RDF TriplesGraph where+  baseUrl           = baseUrl'+  prefixMappings    = prefixMappings'+  addPrefixMappings = addPrefixMappings'+  empty             = empty'+  mkRdf             = mkRdf'+  triplesOf         = triplesOf'+  select            = select'+  query             = query'++prefixMappings' :: TriplesGraph -> PrefixMappings+prefixMappings' (TriplesGraph (_, _, pms)) = pms++addPrefixMappings' :: TriplesGraph -> PrefixMappings -> Bool -> TriplesGraph+addPrefixMappings' (TriplesGraph (ts, baseUrl, pms)) pms' replace =+  let merge = if replace then flip mergePrefixMappings else mergePrefixMappings+  in  TriplesGraph (ts, baseUrl, merge pms pms')+  +baseUrl' :: TriplesGraph -> Maybe BaseUrl+baseUrl' (TriplesGraph (_, baseUrl, _)) = baseUrl++empty' :: TriplesGraph+empty' = TriplesGraph ([], Nothing, PrefixMappings Map.empty)++-- We no longer remove duplicates here, as it is very time consuming and is often not+-- necessary (raptor does not seem to remove dupes either). Instead, we remove dupes+-- from the results of the select' and query' functions, since it is cheap to do+-- there in most cases, but not when triplesOf' is called.+mkRdf' :: Triples -> Maybe BaseUrl -> PrefixMappings -> TriplesGraph+mkRdf' ts baseUrl pms = TriplesGraph (ts, baseUrl, pms)++triplesOf' :: TriplesGraph -> Triples+triplesOf' (TriplesGraph (ts, _, _)) = ts++select' :: TriplesGraph -> NodeSelector -> NodeSelector -> NodeSelector -> Triples+select' (TriplesGraph (ts, _, _)) s p o = removeDupes $ filter (matchSelect s p o) ts++query' :: TriplesGraph -> Maybe Subject -> Maybe Predicate -> Maybe Object -> Triples+query' (TriplesGraph (ts, _, _)) s p o = removeDupes $ filter (matchPattern s p o) ts++matchSelect :: NodeSelector -> NodeSelector -> NodeSelector -> Triple -> Bool+matchSelect s p o t =+  match s (subjectOf t) && match p (predicateOf t) && match o (objectOf t)+  where+    match Nothing   _ = True+    match (Just fn) n = fn n++matchPattern :: Maybe Subject -> Maybe Predicate -> Maybe Object -> Triple -> Bool+matchPattern subj pred obj t = smatch t && pmatch t && omatch t+  where+    smatch trp = matchNode subj (subjectOf trp)+    pmatch trp = matchNode pred (predicateOf trp)+    omatch trp = matchNode obj (objectOf trp)++matchNode :: Maybe Node -> Node -> Bool+matchNode Nothing   _  = True+matchNode (Just n1) n2 = n1 == n2

@@ -0,0 +1,161 @@+{-#  OPTIONS_GHC -fno-cse  #-}+module Data.RDF.Utils (+  FastString(uniq, value),+  mkFastString, equalFS, compareFS,+  s2b, b2s, hPutStrRev, hPutStrLnRev,+  canonicalize, maybeHead+) where++import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import Data.Map(Map)+import qualified Data.Map as Map+import System.IO+import Data.IORef+import System.IO.Unsafe(unsafePerformIO)++bs_newline :: ByteString+bs_newline = B.pack "\n"++-- |A safe version of head that returns 'Nothing' for an empty list or 'Just (head lst)' for+-- a non-empty list.+maybeHead :: [a] -> Maybe a+maybeHead lst | null lst   =  Nothing+              | otherwise  =  Just (head lst)++-- |'FastString' is a bytestring-based string type that provides constant-time equality+-- testing.+--+-- A 'FastString' value consists of a unique identifier and a (strict) 'ByteString' value.+-- The unique identifier is used for constant-time equality testing, and all other operations+-- are provided by the 'ByteString' value itself.+--+-- 'FastString' values are created by the 'mkFastString' function, which maintains a table+-- of all created values, and reuses old values whenever possible. The 'ByteString' is+-- maintained internally in reverse order of the string passed to 'mkFastString'; this+-- is to provide faster comparison testing for unequal values, since it is very common in+-- RDF to have URIs that are equal apart from the last few characters (localname).+data FastString = FS {+      uniq   :: !Int,+      value  :: !ByteString+}++instance Show FastString where+  show = B.unpack . B.reverse . value++-- |Two 'FastString' values are equal iff they have the same unique identifer.+instance Eq FastString where+  (==) = equalFS++{-# INLINE equalFS #-}+equalFS :: FastString -> FastString -> Bool+equalFS fs1 fs2 = uniq fs1 == uniq fs2+++-- |Two 'FastString' values are equal if they have the same unique identifier,+-- and are otherwise ordered using the natural ordering of 'ByteString' in the+-- internal (reversed) representation.+instance Ord FastString where+  compare = compareFS++{-# INLINE compareFS #-}+compareFS :: FastString -> FastString -> Ordering+compareFS fs1 fs2 =+  if uniq fs1 == uniq fs2 then EQ else+    compare (value fs1) (value fs2)++-- |A convenience function for converting from a bytestring to a string.+{-# INLINE b2s #-}+b2s :: ByteString -> String+b2s = B.unpack++-- |A convenience function for converting from a string to a bytestring.+{-# INLINE s2b #-}+s2b :: String -> ByteString+s2b = B.pack++-- |Write to the handle the reversed value of the bytestring, with no newline.+{-# INLINE hPutStrRev #-}+hPutStrRev :: Handle -> ByteString -> IO ()+hPutStrRev h bs = BL.hPutStr h (B.reverse bs)++-- |Write to the handle the reversed value of the bytestring, followed by+-- a newline.+{-# INLINE hPutStrLnRev #-}+hPutStrLnRev :: Handle -> ByteString -> IO ()+hPutStrLnRev h bs = BL.hPutStr h (B.reverse bs) >> BL.hPutStr h bs_newline++-- |Return a 'FastString' value for the given 'ByteString', reusing a 'FastString'+-- if one has been created for equal bytestrings, or creating a new one if necessary.+-- The 'FastString' values created maintain the invariant that two values have the+-- same unique identifier (accessible via 'uniq') iff their respective bytestring+-- values are equal.+--+-- The unique identifier is only for the given session, and equal 'ByteString' values+-- will generally not be assigned the same identifier under different processes and+-- different executions.+{-# NOINLINE mkFastString #-}+mkFastString :: ByteString -> FastString+mkFastString bs =+  unsafePerformIO $+  do m <- readIORef fsMap+     let mFs = Map.lookup bs m+     case mFs of+       Just fs  -> return fs+       Nothing  -> newFastString bs >>= \fs ->+                     writeIORef fsMap (Map.insert bs fs m) >>+                     return fs++-- |Canonicalize the given 'ByteString' value using the 'FastString'+-- as the datatype URI.+{-# NOINLINE canonicalize #-}+canonicalize :: FastString -> ByteString -> ByteString+canonicalize typeFs litValue =+  case Map.lookup typeFs canonicalizerTable of+    Nothing   ->  litValue+    Just fn   ->  fn litValue++{-# INLINE newFastString #-}+newFastString ::  ByteString -> IO FastString+newFastString str =+  do curr <- readIORef fsCounter+     modifyIORef fsCounter (+1)+     return $! FS curr (B.reverse str)++{-# NOINLINE fsCounter #-}+fsCounter :: IORef Int+fsCounter = unsafePerformIO $ newIORef 0++{-# NOINLINE fsMap #-}+fsMap :: IORef (Map ByteString FastString)+fsMap = unsafePerformIO $ newIORef Map.empty++-- A table of mappings from a FastString URI (reversed as+-- they are) to a function that canonicalizes a ByteString+-- assumed to be of that type.+{-# NOINLINE canonicalizerTable #-}+canonicalizerTable :: Map FastString (ByteString -> ByteString)+canonicalizerTable =+  Map.fromList [(integerUri, _integerStr), (doubleUri, _doubleStr),+                (decimalUri, _decimalStr)]+  where+    integerUri = mkFsUri "http://www.w3.org/2001/XMLSchema#integer"+    decimalUri = mkFsUri "http://www.w3.org/2001/XMLSchema#decimal"+    doubleUri  = mkFsUri "http://www.w3.org/2001/XMLSchema#double"+    mkFsUri :: String -> FastString+    mkFsUri uri = mkFastString . s2b $! uri++_integerStr, _decimalStr, _doubleStr :: ByteString -> ByteString+_integerStr = B.dropWhile (== '0')++-- exponent: [eE] ('-' | '+')? [0-9]++-- ('-' | '+') ? ( [0-9]+ '.' [0-9]* exponent | '.' ([0-9])+ exponent | ([0-9])+ exponent )+_doubleStr s = B.pack $ show (read $ B.unpack s :: Double)++-- ('-' | '+')? ( [0-9]+ '.' [0-9]* | '.' ([0-9])+ | ([0-9])+ )+_decimalStr s =     -- haskell double parser doesn't handle '1.'..,+  case B.last s of   -- so we add a zero if that's the case and then parse+    '.' -> f (s `B.snoc` '0')+    _   -> f s+  where f s' = B.pack $ show (read $ B.unpack s' :: Double)

@@ -0,0 +1,191 @@+module Main where++import Data.RDF+import Data.RDF.TriplesGraph++import Text.RDF.RDF4H.NTriplesParser+import Text.RDF.RDF4H.NTriplesSerializer+import Text.RDF.RDF4H.TurtleParser+import Text.RDF.RDF4H.TurtleSerializer++import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B++import System.Environment+import System.IO+import System.Exit+import System.Console.GetOpt++import Control.Monad++import Data.List+import qualified Data.Map as Map+import Data.Char(isLetter)+import Text.Printf(hPrintf)++-- TODO: cleanup and refactor main and elsewhere in this module++main :: IO ()+main =+  do (opts, args) <- getArgs >>= compilerOpts+     when (Help `elem` opts)+      (putStrLn (usageInfo header options) >> exitSuccess)+     when (Version `elem` opts) (putStrLn version >> exitSuccess)+     when (null args)+      (ioError+        (userError+           ("\n\n" ++ "INPUT-URI required\n\n" ++ usageInfo header options)))+     let debug = Debug `elem` opts+         inputUri = head args+         inputFormat = getWithDefault (InputFormat "turtle") opts+         outputFormat = getWithDefault (OutputFormat "ntriples") opts+         inputBaseUri = getInputBaseUri inputUri args opts+         outputBaseUri = getWithDefault (OutputBaseUri inputBaseUri) opts+     unless (outputFormat == "ntriples" || outputFormat == "turtle")+       (hPrintf stderr+          ("'" +++             outputFormat +++               "' is not a valid output format. Supported output formats are: ntriples, turtle\n")+          >> exitWith (ExitFailure 1))+     when debug+       (hPrintf stderr "      INPUT-URI:  %s\n\n" inputUri >>+          hPrintf stderr "   INPUT-FORMAT:  %s\n" inputFormat+          >> hPrintf stderr " INPUT-BASE-URI:  %s\n\n" inputBaseUri+          >> hPrintf stderr "  OUTPUT-FORMAT:  %s\n" outputFormat+          >> hPrintf stderr "OUTPUT-BASE-URI:  %s\n\n" outputBaseUri)+     let mInputUri+           = if inputBaseUri == "-" then Nothing else+               Just (BaseUrl $ s2b inputBaseUri)+         docUri = Just $ s2b inputUri+         emptyPms = PrefixMappings Map.empty+     case (inputFormat, isUri $ s2b inputUri) of+         ("turtle", True) -> parseURL (TurtleParser mInputUri docUri)+                               inputUri+                               >>=+                               \ (res :: Either ParseFailure TriplesGraph) ->+                                 write outputFormat docUri emptyPms res+         ("turtle", False) -> (if inputUri /= "-" then+                                 parseFile (TurtleParser mInputUri docUri) inputUri else+                                 liftM (parseString (TurtleParser mInputUri docUri)) B.getContents)+                                >>=+                                \ (res :: Either ParseFailure TriplesGraph) ->+                                  write outputFormat docUri emptyPms res+         ("ntriples", True) -> parseURL NTriplesParser inputUri >>=+                                 \ (res :: Either ParseFailure TriplesGraph) ->+                                   write outputFormat Nothing emptyPms res+         ("ntriples", False) -> (if inputUri /= "-" then+                                   parseFile NTriplesParser inputUri else+                                   liftM (parseString NTriplesParser) B.getContents)+                                  >>=+                                  \ (res :: Either ParseFailure TriplesGraph) ->+                                    write outputFormat Nothing emptyPms res+         (str, _) -> putStrLn ("Invalid format: " ++ str) >> exitFailure++write :: forall rdf. (RDF rdf) => String -> Maybe ByteString -> PrefixMappings -> Either ParseFailure rdf -> IO ()+write format docUri pms res =+  case res of+    (Left (ParseFailure msg)) -> putStrLn msg >> exitWith (ExitFailure 1)+    (Right rdf)               -> doWriteRdf rdf+  where doWriteRdf rdf = case format of +                           "turtle"   -> writeRdf (TurtleSerializer docUri pms) rdf+                           "ntriples" -> writeRdf NTriplesSerializer rdf+                           unknown    -> error $ "Unknown output format: " ++ unknown++-- Get the input base URI from the argument list or flags, using the+-- first string arg as the default if not found in string args (as+-- the second item in the list) or in the flags as an explicitly+-- selected flag. If the user submitted both a 2nd commandline arg+-- after the INPUT-URI and used the -I/--input-base-uri arg, then+-- the -I/--input-base-uri value is used and the 2nd commandline+-- arg is silently discarded.+getInputBaseUri :: String -> [String] -> [Flag] -> String+getInputBaseUri inputUri args flags =+  if null $ tail args then+  getWithDefault (InputBaseUri inputUri) flags else+  getWithDefault (InputBaseUri (head $ tail args)) flags++-- Determine if the bytestring represents a URI, which is currently+-- decided solely by checking for a colon in the string.+isUri :: ByteString -> Bool+isUri str = not (B.null post) && B.all isLetter pre+  where (pre, post) = B.break (== ':') str++-- Extract from the list of flags a flag of the same type as the first+-- flag argument, returning its string value; if there is no such flag,+-- return the string value of the first argument.+getWithDefault :: Flag -> [Flag] -> String+getWithDefault def args =+  case find (== def) args of+    Nothing  -> strValue def+    Just val -> strValue val++-- Convert the flag to a string, which is only valid for flags that have+-- a string argument.+strValue :: Flag -> String+strValue (InputFormat s)   = s+strValue (InputBaseUri s)  = s+strValue (OutputFormat s)  = s+strValue (OutputBaseUri s) = s+strValue flag              = error $ "No string value for flag: " ++ show flag++-- The commandline arguments we accept. None are required.+data Flag+ = Help | Debug | Version+ | InputFormat String | InputBaseUri String+ | OutputFormat String | OutputBaseUri String+ deriving (Show)++-- Two flags are equal if they are of the same type, regardless of value: a+-- strange definition, but we never care about values when finding or comparing+-- them.+instance Eq Flag where+  Help            == Help            = True+  Debug           == Debug           = True+  Version         == Version         = True+  InputFormat _   == InputFormat _   = True+  InputBaseUri _  == InputBaseUri _  = True+  OutputFormat _  == OutputFormat _  = True+  OutputBaseUri _ == OutputBaseUri _ = True+  _               == _               = False++-- The top part of the usage output.+header :: String+header =+  "\nrdf4h_parse: an RDF parser and serializer\n\n"                          +++  "\nUsage: rdf4h_parse [OPTION...] INPUT-URI [INPUT-BASE-URI]\n\n"          +++  "  INPUT-URI       a filename, URI or '-' for standard input (stdin).\n"   +++  "  INPUT-BASE-URI  the input/parser base URI or '-' for none.\n"           +++  "    Default is INPUT-URI\n"                                               +++  "    Equivalent to -I INPUT-BASE-URI, --input-base-uri INPUT-BASE-URI\n\n"++-- The current version of the executable, which for the moment is the same as+-- the version for the library as a whole, as given in rdf4h.cabal.+-- TODO: should get this from cabal file rather than duplicating i here.+version :: String+version = "0.9.1"++options :: [OptDescr Flag]+options =+ [ Option "h"  ["help"]                           (NoArg Help)   "Display this help, then exit"+ , Option "d"  ["debug"]                         (NoArg Debug)   "Print debug info (like INPUT-BASE-URI used, etc.)"+ , Option "v"  ["version"]                     (NoArg Version)   "Show version number\n\n"++ , Option "i"  ["input"]        (ReqArg InputFormat  "FORMAT") $ "Set input format/parser to one of:\n" +++                                                                   "  turtle      Turtle (default)\n" +++                                                                   "  ntriples    N-Triples"+ , Option "I"  ["input-base-uri"]  (ReqArg InputBaseUri "URI") $ "Set the input/parser base URI. '-' for none.\n" +++                                                                   "  Default is INPUT-BASE-URI argument value.\n\n"++ , Option "o"  ["output"]       (ReqArg OutputFormat "FORMAT") $ "Set output format/serializer to one of:\n" +++                                                                   "  ntriples    N-Triples (default)\n" +++                                                                   "  turtle      Turtle"+ , Option "O" ["output-base-uri"] (ReqArg OutputBaseUri "URI") $ "Set the output format/serializer base URI. '-' for none.\n" +++                                                                   "  Default is input/parser base URI."+ ]++compilerOpts :: [String] -> IO ([Flag], [String])+compilerOpts argv =+   case getOpt Permute options argv of+      (o,n,[]  ) -> return (o,n)+      (_,_,errs) -> ioError (userError ("\n\n" ++ concat errs ++ usageInfo header options))+

@@ -0,0 +1,89 @@+-- |This module re-exports most of the other modules of this library and also+-- defines some convenience methods for interactive experimentation, such as+-- simplified functions for parsing and serializing RDF, etc.+--+-- All the load functions can be used with any 'RDF' implementation, so you+-- must declare a type in order to help the type system disambiguate the +-- @RDF rdf@ constraint in those function's types.+-- +-- Many of the simplified functions in this module call 'error' when there is +-- a failure. This is so that you don't have to deal with 'Maybe' or 'Either'+-- return values while interacting. These functions are thus only intended+-- to be used when interactively exploring via ghci, and should not otherwise+-- be used.++module Text.RDF.RDF4H.Interact where++import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B++import Data.RDF+import Data.RDF.Utils()+import Data.RDF.TriplesGraph()+import Data.RDF.MGraph()++import Text.RDF.RDF4H.NTriplesParser+import Text.RDF.RDF4H.TurtleParser+import Text.RDF.RDF4H.NTriplesSerializer()+import Text.RDF.RDF4H.TurtleSerializer()++-- |Load a Turtle file from the filesystem using the optional base URL +-- (used to resolve relative URI fragments) and optional document URI+-- (used to resolve <> in the document). +-- +-- This function calls 'error' with an error message if unable to load the file.+loadTurtleFile :: forall rdf. (RDF rdf) => Maybe String -> Maybe String -> String -> IO rdf+loadTurtleFile baseUrl docUri = _load parseFile (mkTurtleParser baseUrl docUri)++-- |Load a Turtle file from a URL just like 'loadTurtleFile' does from the local+-- filesystem. See that function for explanation of args, etc.+loadTurtleURL  :: forall rdf. (RDF rdf) => Maybe String -> Maybe String -> String -> IO rdf+loadTurtleURL baseUrl docUri  = _load parseURL (mkTurtleParser baseUrl docUri)++-- |Parse a Turtle document from the given 'ByteString' using the given @baseUrl@ and +-- @docUri@, which have the same semantics as in the loadTurtle* functions.+parseTurtleString :: forall rdf. (RDF rdf) => Maybe String -> Maybe String -> ByteString -> rdf+parseTurtleString baseUrl docUri = _parse parseString (mkTurtleParser baseUrl docUri)++mkTurtleParser :: Maybe String -> Maybe String -> TurtleParser+mkTurtleParser b d = TurtleParser ((BaseUrl . B.pack) `fmap` b) (B.pack `fmap` d)++-- |Load an NTriples file from the filesystem.+-- +-- This function calls 'error' with an error message if unable to load the file.+loadNTriplesFile :: forall rdf. (RDF rdf) => String -> IO rdf+loadNTriplesFile = _load parseFile NTriplesParser++-- |Load an NTriples file from a URL just like 'loadNTriplesFile' does from the local+-- filesystem. See that function for more info.+loadNTriplesURL :: forall rdf. (RDF rdf) => String -> IO rdf+loadNTriplesURL  = _load parseURL  NTriplesParser++-- |Parse an NTriples document from the given 'ByteString', as 'loadNTriplesFile' does+-- from a file.+parseNTriplesString :: forall rdf. (RDF rdf) => ByteString -> rdf+parseNTriplesString = _parse parseString NTriplesParser++-- |Print a list of triples to stdout; useful for debugging and interactive use.+printTriples :: Triples -> IO ()+printTriples  = mapM_ print++-- Load an RDF using the given parseFunc, parser, and the location (filesystem path+-- or HTTP URL), calling error with the 'ParseFailure' message if unable to load+-- or parse for any reason.+_load :: forall p rdf. (RdfParser p, RDF rdf) => +            (p -> String -> IO (Either ParseFailure rdf)) -> +             p -> String -> IO rdf+_load parseFunc parser location = parseFunc parser location >>= _handle++-- Use the given parseFunc and parser to parse the given 'ByteString', calling error+-- with the 'ParseFailure' message if unable to load or parse for any reason.+_parse :: forall p rdf. (RdfParser p, RDF rdf) => +                        (p -> ByteString -> Either ParseFailure rdf) -> +                         p -> ByteString -> rdf+_parse parseFunc parser rdfBs = either (error . show) id $ parseFunc parser rdfBs++-- Handle the result of an IO parse by returning the graph if parse was successful+-- and calling 'error' with the 'ParseFailure' error message if unsuccessful.+_handle :: forall rdf. (RDF rdf) => Either ParseFailure rdf -> IO rdf+_handle = either (error . show) return

@@ -0,0 +1,232 @@+-- |A parser for RDF in N-Triples format +-- <http://www.w3.org/TR/rdf-testcases/#ntriples>.++module Text.RDF.RDF4H.NTriplesParser(+  NTriplesParser(NTriplesParser), ParseFailure+)++where++-- TODO: switch to OverloadedStrings and use ByteString literals (?).++import Data.RDF+import Text.RDF.RDF4H.ParserUtils+import Data.Char(isLetter, isDigit, isLower)+import qualified Data.Map as Map+import Text.Parsec+import Text.Parsec.ByteString.Lazy+import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import Control.Monad (liftM,void)++-- |NTriplesParser is an 'RdfParser' implementation for parsing RDF in the+-- NTriples format. It requires no configuration options. To use this parser,+-- pass an 'NTriplesParser' value as the first argument to any of the +-- 'parseString', 'parseFile', or 'parseURL' methods of the 'RdfParser' type+-- class.+data NTriplesParser = NTriplesParser++-- |'NTriplesParser' is an instance of 'RdfParser'.+instance RdfParser NTriplesParser where+  parseString _  = parseString'+  parseFile   _  = parseFile'+  parseURL    _  = parseURL'++-- We define or redefine all here using same names as the spec, but with an+-- 'nt_' prefix in order to avoid name clashes (e.g., ntripleDoc becomes+-- nt_ntripleDoc).++-- |nt_ntripleDoc is simply zero or more lines.+nt_ntripleDoc :: GenParser ByteString () [Maybe Triple]+nt_ntripleDoc = manyTill nt_line eof++nt_line :: GenParser ByteString () (Maybe Triple)+nt_line       = +    skipMany nt_space >>+     (nt_comment <|> nt_triple <|> nt_empty) >>=+     \res -> nt_eoln >> return res++-- A comment consists of an initial # character, followed by any number of+-- characters except cr or lf. The spec is redundant in specifying that+-- comment is hash followed by "character - (cr | lf)", since character+-- is already defined as the range #x0020-#x007E, so cr #x000D and+-- lf #x000A are both already excluded. This returns Nothing as we are+-- ignoring comments for now.+nt_comment :: GenParser ByteString () (Maybe Triple)+nt_comment   = char '#' >> skipMany nt_character >> return Nothing++-- A triple consists of whitespace-delimited subject, predicate, and object,+-- followed by optional whitespace and a period, and possibly more+-- whitespace.+nt_triple :: GenParser ByteString () (Maybe Triple)+nt_triple    =+  do+    subj <- nt_subject+    skipMany1 nt_space+    pred <- nt_predicate+    skipMany1 nt_space+    obj <- nt_object+    skipMany nt_space+    char '.'+    many nt_space+    return $ Just (Triple subj pred obj)++-- A literal is either a language literal (with optional language+-- specified) or a datatype literal (with required datatype+-- specified). The literal value is always enclosed in double+-- quotes. A language literal may have '@' after the closing quote,+-- followed by a language specifier. A datatype literal follows+-- the closing quote with ^^ followed by the URI of the datatype.+nt_literal :: GenParser ByteString () LValue+nt_literal = +  do lit_str <- between_chars '"' '"' inner_literal +     liftM (plainLL lit_str) (char '@' >> nt_language) <|>+       liftM (typedL lit_str . mkFastString) (count 2 (char '^') >> nt_uriref) <|>+       return (plainL lit_str)+  where inner_literal = liftM B.concat (manyTill inner_string (lookAhead $ char '"'))++-- A language specifier of a language literal is any number of lowercase+-- letters followed by any number of blocks consisting of a hyphen followed+-- by one or more lowercase letters or digits.+nt_language :: GenParser ByteString () ByteString+nt_language =+  do str <- liftM B.pack (many (satisfy (\ c -> c == '-' || isLower c)))+     if B.null str || B.last str == '-' || B.head str == '-'+        then fail ("Invalid language string: '" ++ B.unpack str ++ "'")+        else return str++-- nt_empty is a line that isn't a comment or a triple. They appear in the+-- parsed output as Nothing, whereas a real triple appears as (Just triple).+nt_empty :: GenParser ByteString () (Maybe Triple)+nt_empty     = skipMany nt_space >> return Nothing++-- A subject is either a URI reference for a resource or a node id for a+-- blank node.+nt_subject :: GenParser ByteString () Node+nt_subject   =+  liftM unode nt_uriref <|>+  liftM bnode nt_nodeID++-- A predicate may only be a URI reference to a resource.+nt_predicate :: GenParser ByteString () Node+nt_predicate = liftM unode nt_uriref++-- An object may be either a resource (represented by a URI reference),+-- a blank node (represented by a node id), or an object literal.+nt_object :: GenParser ByteString () Node+nt_object =+  liftM unode nt_uriref <|>+  liftM bnode nt_nodeID <|>+  liftM LNode nt_literal++-- A URI reference is one or more nrab_character inside angle brackets.+nt_uriref :: GenParser ByteString () ByteString+nt_uriref = between_chars '<' '>' (liftM B.pack (many (satisfy ( /= '>'))))++-- A node id is "_:" followed by a name.+nt_nodeID :: GenParser ByteString () ByteString+nt_nodeID = char '_' >> char ':' >> nt_name >>= \n -> +                return ('_' `B.cons'` (':' `B.cons'` n))++-- A name is a letter followed by any number of alpha-numeric characters.+nt_name :: GenParser ByteString () ByteString+nt_name =+  do init <- letter+     rest <- many (satisfy isLetterOrDigit)+     return $ B.pack (init:rest)++isLetterOrDigit :: Char -> Bool+isLetterOrDigit c = isLetter c || isDigit c++-- An nt_character is any character except a double quote character.+nt_character :: GenParser ByteString () Char+nt_character   =   satisfy is_nonquote_char++-- A character is any Unicode value from ASCII space to decimal 126 (tilde).+is_character :: Char -> Bool+is_character c =   c >= '\x0020' && c <= '\x007E'++-- A non-quote character is a character that isn't the double-quote character.+is_nonquote_char :: Char -> Bool+is_nonquote_char c = is_character c && c/= '"'++-- End-of-line consists of either lf or crlf.+-- We also test for eof and consider that to match as well.+nt_eoln :: GenParser ByteString () ()+nt_eoln =  eof <|> void (nt_cr >> nt_lf) <|> void nt_lf++-- Whitespace is either a space or tab character. We must avoid using the+-- built-in space combinator here, because it includes newline.+nt_space :: GenParser ByteString () Char+nt_space = char ' ' <|> nt_tab++-- Carriage return is \r.+nt_cr :: GenParser ByteString () Char+nt_cr          =   char '\r'++-- Line feed is \n.+nt_lf :: GenParser ByteString () Char+nt_lf          =   char '\n'++-- Tab is \t.+nt_tab :: GenParser ByteString () Char+nt_tab         =   char '\t'++-- An inner_string is a fragment of a string (this is used inside double+-- quotes), and consists of the non-quote characters allowed and the+-- standard escapes for a backslash (\\), a tab (\t), a carriage  return (\r),+-- a newline (\n), a double-quote (\"), a 4-digit Unicode escape (\uxxxx+-- where x is a hexadecimal digit), and an 8-digit Unicode escape+-- (\Uxxxxxxxx where x is a hexadecimaldigit).+inner_string :: GenParser ByteString () ByteString+inner_string =+  try (char '\\' >>+         ((char 't' >> return b_tab)  <|>+          (char 'r' >> return b_ret)  <|>+          (char 'n' >> return b_nl)  <|>+          (char '\\' >> return b_slash) <|>+          (char '"' >> return b_quote)   <|>+          (char 'u' >> count 4 hexDigit >>= \cs -> return $ B.pack ('\\':'u':cs)) <|>+          (char 'U' >> count 8 hexDigit >>= \cs -> return $ B.pack ('\\':'U':cs))))+  <|> liftM B.pack+    (many (satisfy (\ c -> is_nonquote_char c && c /= '\\')))++b_tab = B.singleton '\t'+b_ret = B.singleton '\r'+b_nl  = B.singleton '\n'+b_slash = B.singleton '\\'+b_quote = B.singleton '"'++between_chars :: Char -> Char -> GenParser ByteString () ByteString -> GenParser ByteString () ByteString+between_chars start end parser = char start >> parser >>= \res -> char end >> return res++parseString' :: forall rdf. (RDF rdf) => ByteString -> Either ParseFailure rdf+parseString' bs = handleParse mkRdf (runParser nt_ntripleDoc () "" bs)++parseURL' :: forall rdf. (RDF rdf) => String -> IO (Either ParseFailure rdf)+parseURL' = _parseURL parseString'++parseFile' :: forall rdf. (RDF rdf) => String -> IO (Either ParseFailure rdf)+parseFile' path = liftM (handleParse mkRdf . runParser nt_ntripleDoc () path)+                   (B.readFile path)++handleParse :: forall rdf. (RDF rdf) => (Triples -> Maybe BaseUrl -> PrefixMappings -> rdf) ->+                                        Either ParseError [Maybe Triple] ->+                                        Either ParseFailure rdf+handleParse _mkRdf result+--  | B.length rem /= 0 = (Left $ ParseFailure $ "Invalid Document. Unparseable end of document: " ++ B.unpack rem)+  | otherwise          = +      case result of+        Left err -> Left  $ ParseFailure $ "Parse failure: \n" ++ show err+        Right ts -> Right $ _mkRdf (conv ts) Nothing (PrefixMappings Map.empty)+  where+    conv []            = []+    conv (Nothing:ts)  = conv ts+    conv (Just t:ts) = t : conv ts++_test :: GenParser ByteString () a -> String -> IO a+_test p str =+    case result of+      (Left err) -> putStr "ParseError: '" >> putStr (show err) >> putStr "\n" >> error ""+      (Right a)  -> return a+  where result = runParser p () "" (B.pack str)

@@ -0,0 +1,89 @@+-- |A serializer for RDF as N-Triples+-- <http://www.w3.org/TR/rdf-testcases/#ntriples>.++module Text.RDF.RDF4H.NTriplesSerializer(+  NTriplesSerializer(NTriplesSerializer)+) where++import Data.RDF+import Data.RDF.Utils+import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.ByteString.Lazy as BL+import Control.Monad (void)+import System.IO+++data NTriplesSerializer = NTriplesSerializer++instance RdfSerializer NTriplesSerializer where+  hWriteRdf _     = _writeRdf+  writeRdf  _     = _writeRdf stdout+  hWriteH   _ _ _ = return ()+  writeH    _   _ = return ()+  hWriteTs  _     = _writeTriples+  writeTs   _     = _writeTriples stdout+  hWriteT   _     = _writeTriple+  writeT    _     = _writeTriple stdout+  hWriteN   _     = _writeNode+  writeN    _     = _writeNode stdout++_writeRdf :: RDF rdf => Handle -> rdf -> IO ()+_writeRdf h = _writeTriples h . triplesOf++_writeTriples :: Handle -> Triples -> IO ()+_writeTriples h = mapM_ (_writeTriple h)++_writeTriple :: Handle -> Triple -> IO ()+_writeTriple h (Triple s p o) =+  _writeNode h s >> hPutChar h ' ' >>+  _writeNode h p >> hPutChar h ' ' >>+  _writeNode h o >> hPutStrLn h " ."++_writeNode :: Handle -> Node -> IO ()+_writeNode h node =+  case node of+    (UNode fs)  -> hPutChar h '<' >>+                     hPutStrRev h (value fs) >>+                     hPutChar h '>'+    (BNode gId) -> hPutStrRev h (value gId)+    (BNodeGen i)-> putStr "_:genid" >> hPutStr h (show i)+    (LNode n)   -> _writeLValue h n++_writeLValue :: Handle -> LValue -> IO ()+_writeLValue h lv =+  case lv of+    (PlainL lit)       -> _writeLiteralString h lit+    (PlainLL lit lang) -> _writeLiteralString h lit >>+                            hPutStr h "@" >>+                            BL.hPutStr h lang+    (TypedL lit dtype) -> _writeLiteralString h lit >>+                            hPutStr h "^^<" >>+                            hPutStrRev h (value dtype) >>+                            hPutStr h ">"++-- TODO: this is REALLY slow.+_writeLiteralString:: Handle -> ByteString -> IO ()+_writeLiteralString h bs =+  do hPutChar h '"'+     B.foldl' writeChar (return ()) bs+     hPutChar h '"'+  where+    -- the seq is necessary in writeChar to ensure all chars+    -- are written. without it, only the last is written.+    writeChar :: IO () -> Char -> IO ()+    writeChar b c = b >>= \b' -> b' `seq`+      case c of+        '\n' ->  void (hPutChar h '\\' >> hPutChar h 'n')+        '\t' ->  void (hPutChar h '\\' >> hPutChar h 't')+        '\r' ->  void (hPutChar h '\\' >> hPutChar h 'r')+        '"'  ->  void (hPutChar h '\\' >> hPutChar h '"')+        '\\' ->  void (hPutChar h '\\' >> hPutChar h '\\')+        _    ->  void (hPutChar h c)++_bs1, _bs2 :: ByteString+_bs1 = B.pack "\nthis \ris a \\U00015678long\t\nliteral\\uABCD\n"+_bs2 = B.pack "\nan \\U00015678 escape\n"++_w :: IO ()+_w = _writeLiteralString stdout _bs1

@@ -0,0 +1,46 @@+module Text.RDF.RDF4H.ParserUtils(+  _parseURL, justTriples+) where++import Data.RDF++import Network.URI+import Network.HTTP+import Data.Char(intToDigit)+import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import Data.Maybe (fromMaybe)++-- A convenience function for terminating a parse with a parse failure, using+-- the given error message as the message for the failure.+errResult :: RDF rdf => String -> Either ParseFailure rdf+errResult msg = Left (ParseFailure msg)++-- Keep the (Just t) triples (eliminating the Nothing comments), and unbox the+-- triples, leaving a list of triples.+justTriples :: [Maybe Triple] -> [Triple]+justTriples = map (fromMaybe (error "ParserUtils.justTriples")) .+              filter (/= Nothing)++_parseURL :: RDF rdf => (ByteString -> Either ParseFailure rdf)  -> String -> IO (Either ParseFailure rdf)+_parseURL parseFunc url =+  maybe+    (return (Left (ParseFailure $ "Unable to parse URL: " ++ url)))+    p+    (parseURI url)+  where+    showRspCode (a, b, c) = map intToDigit [a, b, c]+    httpError resp = showRspCode (rspCode resp) ++ " " ++ rspReason resp+    p url =+      simpleHTTP (request url) >>= \resp ->+        case resp of+          (Left e)    -> return (errResult $ "couldn't retrieve from URL: " ++ show url ++ " [" ++ show e ++ "]")+          (Right res) -> case rspCode res of+                           (2, 0, 0) -> return $ parseFunc (rspBody res)+                           _         -> return (errResult $ "couldn't retrieve from URL: " ++ httpError res)++request :: URI -> HTTPRequest ByteString+request uri = Request { rqURI = uri,+                        rqMethod = GET,+                        rqHeaders = [Header HdrConnection "close"],+                        rqBody = B.empty }

@@ -0,0 +1,597 @@+-- |An 'RdfParser' implementation for the Turtle format +-- <http://www.w3.org/TeamSubmission/turtle/>.++module Text.RDF.RDF4H.TurtleParser(+  TurtleParser(TurtleParser)+)++where++import Data.RDF+import Data.RDF.Namespace+import Text.RDF.RDF4H.ParserUtils+import Text.Parsec+import Text.Parsec.ByteString.Lazy+import qualified Data.Map as Map+import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.ByteString.Lazy as BL+import Data.Sequence(Seq, (|>))+import qualified Data.Sequence as Seq+import qualified Data.Foldable as F+import Data.Char (isDigit)+import Control.Monad+import Data.Maybe (fromMaybe)+import Debug.Trace(trace)++-- To avoid compiler warnings when not being used.+_trace = trace++-- |An 'RdfParser' implementation for parsing RDF in the +-- Turtle format. It takes optional arguments representing the base URL to use+-- for resolving relative URLs in the document (may be overridden in the document+-- itself using the \@base directive), and the URL to use for the document itself+-- for resolving references to <> in the document.+-- To use this parser, pass a 'TurtleParser' value as the first argument to any of+-- the 'parseString', 'parseFile', or 'parseURL' methods of the 'RdfParser' type+-- class.+data TurtleParser = TurtleParser (Maybe BaseUrl) (Maybe ByteString)++-- |'TurtleParser' is an instance of 'RdfParser'.+instance RdfParser TurtleParser where+  parseString (TurtleParser bUrl dUrl)  = parseString' bUrl dUrl +  parseFile   (TurtleParser bUrl dUrl)  = parseFile' bUrl dUrl+  parseURL    (TurtleParser bUrl dUrl)  = parseURL'  bUrl dUrl++type ParseState =+  (Maybe BaseUrl,    -- the current BaseUrl, may be Nothing initially, but not after it is once set+   Maybe ByteString, -- the docUrl, which never changes and is used to resolve <> in the document.+   Int,              -- the id counter, containing the value of the next id to be used+   PrefixMappings,   -- the mappings from prefix to URI that are encountered while parsing+   [Subject],        -- stack of current subject nodes, if we have parsed a subject but not finished the triple+   [Predicate],      -- stack of current predicate nodes, if we've parsed a predicate but not finished the triple+   [Bool],           -- a stack of values to indicate that we're processing a (possibly nested) collection; top True indicates just started (on first element)+   Seq Triple)       -- the triples encountered while parsing; always added to on the right side++t_turtleDoc :: GenParser ByteString ParseState (Seq Triple, PrefixMappings)+t_turtleDoc =+  many t_statement >> (eof <?> "eof") >> getState >>= \(_, _, _, pms, _, _, _, ts) -> return (ts, pms)++t_statement :: GenParser ByteString ParseState ()+t_statement = d <|> t <|> void (many1 t_ws <?> "blankline-whitespace")+  where+    d = void+      (try t_directive >> (many t_ws <?> "directive-whitespace1") >>+      (char '.' <?> "end-of-directive-period") >>+      (many t_ws <?> "directive-whitespace2"))+    t = void+      (t_triples >> (many t_ws <?> "triple-whitespace1") >>+      (char '.' <?> "end-of-triple-period") >>+      (many t_ws <?> "triple-whitespace2"))++t_triples :: GenParser ByteString ParseState ()+t_triples = t_subject >> (many1 t_ws <?> "subject-predicate-whitespace") >> t_predicateObjectList >> resetSubjectPredicate++t_directive :: GenParser ByteString ParseState ()+t_directive = t_prefixID <|> t_base++t_resource :: GenParser ByteString ParseState ByteString+t_resource =  try t_uriref <|> t_qname++t_prefixID :: GenParser ByteString ParseState ()+t_prefixID =+  do try (string "@prefix" <?> "@prefix-directive")+     pre <- (many1 t_ws <?> "whitespace-after-@prefix") >> option B.empty t_prefixName+     char ':' >> (many1 t_ws <?> "whitespace-after-@prefix-colon")+     uriFrag <- t_uriref+     (bUrl, dUrl, _, PrefixMappings pms, _, _, _, _) <- getState+     updatePMs $ Just (PrefixMappings $ Map.insert pre (absolutizeUrl bUrl dUrl uriFrag) pms)+     return ()++t_base :: GenParser ByteString ParseState ()+t_base =+  do try (string "@base" <?> "@base-directive")+     many1 t_ws <?> "whitespace-after-@base"+     urlFrag <- t_uriref+     bUrl <- currBaseUrl+     dUrl <- currDocUrl+     updateBaseUrl (Just $ Just $ newBaseUrl bUrl (absolutizeUrl bUrl dUrl urlFrag))++t_verb :: GenParser ByteString ParseState ()+t_verb = (try t_predicate <|> (char 'a' >> return rdfTypeNode)) >>= pushPred++t_predicate :: GenParser ByteString ParseState Node+t_predicate = liftM (UNode . mkFastString) (t_resource <?> "resource")++t_nodeID  :: GenParser ByteString ParseState ByteString+t_nodeID = do { try (string "_:"); cs <- t_name; return $! s2b "_:" `B.append` cs }++t_qname :: GenParser ByteString ParseState ByteString+t_qname =+  do pre <- option B.empty (try t_prefixName)+     char ':'+     name <- option B.empty t_name+     (bUrl, _, _, pms, _, _, _, _) <- getState+     return $ resolveQName bUrl pre pms `B.append` name++t_subject :: GenParser ByteString ParseState ()+t_subject =+  simpleBNode <|>+  resource <|>+  nodeId <|>+  between (char '[') (char ']') poList+  where+    resource    = liftM (UNode . mkFastString) (t_resource <?> "subject resource") >>= pushSubj+    nodeId      = liftM (BNode . mkFastString) (t_nodeID <?> "subject nodeID") >>= pushSubj+    simpleBNode = try (string "[]") >> nextIdCounter >>=  pushSubj . BNodeGen+    poList      = void+                (nextIdCounter >>= pushSubj . BNodeGen >> many t_ws >>+                t_predicateObjectList >>+                many t_ws)++-- verb ws+ objectList ( ws* ';' ws* verb ws+ objectList )* (ws* ';')?+t_predicateObjectList :: GenParser ByteString ParseState ()+t_predicateObjectList =+  do t_verb <?> "verb"     -- pushes pred onto pred stack+     many1 t_ws   <?> "polist-whitespace-after-verb"+     t_objectList <?> "polist-objectList"+     many (try (many t_ws >> char ';') >> many t_ws >> t_verb >> many1 t_ws >> t_objectList >> popPred)+     popPred               -- pop off the predicate pushed by 1st t_verb+     return ()++t_objectList :: GenParser ByteString ParseState ()+t_objectList = -- t_object actually adds the triples+  void+  ((t_object <?> "object") >>+  many (try (many t_ws >> char ',' >> many t_ws >> t_object)))++t_object :: GenParser ByteString ParseState ()+t_object =+  do inColl      <- isInColl          -- whether this object is in a collection+     onFirstItem <- onCollFirstItem   -- whether we're on the first item of the collection+     let processObject = (t_literal >>= addTripleForObject) <|>+                          (liftM (UNode . mkFastString) t_resource >>= addTripleForObject) <|>+                          blank_as_obj <|> t_collection+     case (inColl, onFirstItem) of+       (False, _)    -> processObject+       (True, True)  -> liftM BNodeGen nextIdCounter >>= \bSubj -> addTripleForObject bSubj >>+                          pushSubj bSubj >> pushPred rdfFirstNode >> processObject >> collFirstItemProcessed+       (True, False) -> liftM BNodeGen nextIdCounter >>= \bSubj -> pushPred rdfRestNode >>+                          addTripleForObject bSubj >> popPred >> popSubj >>+                          pushSubj bSubj >> processObject++-- collection: '(' ws* itemList? ws* ')'+-- itemList:      object (ws+ object)*+t_collection:: GenParser ByteString ParseState ()+t_collection = +  -- ( object1 object2 ) is short for:+  -- [ rdf:first object1; rdf:rest [ rdf:first object2; rdf:rest rdf:nil ] ]+  -- ( ) is short for the resource:  rdf:nil+  between (char '(') (char ')') $+    do beginColl+       many t_ws+       emptyColl <- option True (try t_object  >> many t_ws >> return False)+       if emptyColl then void (addTripleForObject rdfNilNode) else+        void+         (many (many t_ws >> try t_object >> many t_ws) >> popPred >>+         pushPred rdfRestNode >>+         addTripleForObject rdfNilNode >>+         popPred)+       finishColl+       return ()++blank_as_obj :: GenParser ByteString ParseState ()+blank_as_obj =+  -- if a node id, like _:a1, then create a BNode and add the triple+  (liftM (BNode . mkFastString) t_nodeID >>= addTripleForObject) <|>+  -- if a simple blank like [], do likewise+  (genBlank >>= addTripleForObject) <|>+  -- if a blank containing a predicateObjectList, like [ :b :c; :b :d ]+  poList+  where+    genBlank = liftM BNodeGen (try (string "[]") >> nextIdCounter)+    poList   = between (char '[') (char ']') $ +                 liftM BNodeGen nextIdCounter >>= \bSubj ->   -- generate new bnode+                  void+                  (addTripleForObject bSubj >>   -- add triple with bnode as object+                  many t_ws >> pushSubj bSubj >> -- push bnode as new subject+                  t_predicateObjectList >> popSubj >> many t_ws) -- process polist, which uses bnode as subj, then pop bnode+++rdfTypeNode, rdfNilNode, rdfFirstNode, rdfRestNode :: Node+rdfTypeNode   = UNode $ mkFastString $ mkUri rdf $ s2b "type"+rdfNilNode    = UNode $ mkFastString $ mkUri rdf $ s2b "nil"+rdfFirstNode  = UNode $ mkFastString $ mkUri rdf $ s2b "first"+rdfRestNode   = UNode $ mkFastString $ mkUri rdf $ s2b "rest"++xsdIntUri, xsdDoubleUri, xsdDecimalUri, xsdBooleanUri :: FastString+xsdIntUri     =  mkFastString $! mkUri xsd $! s2b "integer"+xsdDoubleUri  =  mkFastString $! mkUri xsd $! s2b "double"+xsdDecimalUri =  mkFastString $! mkUri xsd $! s2b "decimal"+xsdBooleanUri =  mkFastString $! mkUri xsd $! s2b "boolean"++t_literal :: GenParser ByteString ParseState Node+t_literal =+  try str_literal <|>+  liftM (`mkLNode` xsdIntUri) (try t_integer)   <|>+  liftM (`mkLNode` xsdDoubleUri) (try t_double)  <|>+  liftM (`mkLNode` xsdDecimalUri) (try t_decimal) <|>+  liftM (`mkLNode` xsdBooleanUri) t_boolean+  where+    mkLNode :: ByteString -> FastString -> Node+    mkLNode bs fs = LNode (typedL bs fs)++str_literal :: GenParser ByteString ParseState Node+str_literal =+  do str <- t_quotedString <?> "quotedString"+     liftM (LNode . typedL str . mkFastString)+      (try (count 2 (char '^')) >> t_resource) <|>+      liftM (lnode . plainLL str) (char '@' >> t_language) <|>+      return (lnode $ plainL str)++t_quotedString  :: GenParser ByteString ParseState ByteString+t_quotedString = t_longString <|> t_string++-- a non-long string: any number of scharacters (echaracter without ") inside doublequotes.+t_string  :: GenParser ByteString ParseState ByteString+t_string = liftM B.concat (between (char '"') (char '"') (many t_scharacter))++t_longString  :: GenParser ByteString ParseState ByteString+t_longString =+  do+    try tripleQuote+    strVal <- liftM B.concat (many longString_char)+    tripleQuote+    return strVal+  where+    tripleQuote = count 3 (char '"')++t_integer :: GenParser ByteString ParseState ByteString+t_integer =+  do sign <- sign_parser <?> "+-"+     ds <- many1 digit   <?> "digit"+     notFollowedBy (char '.')+     -- integer must be in canonical format, with no leading plus sign or leading zero+     return $! (s2b sign `B.append` s2b ds)++t_double :: GenParser ByteString ParseState ByteString+t_double =+  do sign <- sign_parser <?> "+-"+     rest <- try (do { ds <- many1 digit <?> "digit";  char '.'; ds' <- many digit <?> "digit"; e <- t_exponent <?> "exponent"; return (s2b ds `B.snoc` '.' `B.append` s2b ds' `B.append` e) }) <|>+             try (do { char '.'; ds <- many1 digit <?> "digit"; e <- t_exponent <?> "exponent"; return ('.' `B.cons` s2b ds `B.append` e) }) <|>+             try (do { ds <- many1 digit <?> "digit"; e <- t_exponent <?> "exponent"; return (s2b ds `B.append` e) })+     return $! s2b sign `B.append` rest++sign_parser :: GenParser ByteString ParseState String+sign_parser = option "" (oneOf "-+" >>= (\c -> return [c]))++t_decimal :: GenParser ByteString ParseState ByteString+t_decimal =+  do sign <- sign_parser+     rest <- try (do ds <- many digit <?> "digit"; char '.'; ds' <- option "" (many digit); return (ds ++ ('.':ds')))+             <|> try (do { char '.'; ds <- many1 digit <?> "digit"; return ('.':ds) })+             <|> many1 digit <?> "digit"+     return $ s2b sign `B.append` s2b rest++t_exponent :: GenParser ByteString ParseState ByteString+t_exponent = do e <- oneOf "eE"+                s <- option "" (oneOf "-+" >>= \c -> return [c])+                ds <- many1 digit;+                return $! (e `B.cons` (s2b s `B.append` s2b ds))++t_boolean :: GenParser ByteString ParseState ByteString+t_boolean =+  try (liftM s2b (string "true") <|>+  liftM s2b (string "true"))++t_comment :: GenParser ByteString ParseState ()+t_comment =+  void (char '#' >> many (satisfy (\ c -> c /= '\n' && c /= '\r')))++t_ws  :: GenParser ByteString ParseState ()+t_ws =+    (void (try (char '\t' <|> char '\n' <|> char '\r' <|> char ' '))+    <|> try t_comment)+   <?> "whitespace-or-comment"+++t_language  :: GenParser ByteString ParseState ByteString+t_language =+  do init <- many1 lower;+     rest <- many (do {char '-'; cs <- many1 (lower <|> digit); return (s2b ('-':cs))})+     return $! (s2b init `B.append` B.concat rest)++identifier :: GenParser ByteString ParseState Char -> GenParser ByteString ParseState Char -> GenParser ByteString ParseState ByteString+identifier initial rest = initial >>= \i -> many rest >>= \r -> return (s2b (i:r))++t_prefixName :: GenParser ByteString ParseState ByteString+t_prefixName = identifier t_nameStartCharMinusUnderscore t_nameChar++t_name :: GenParser ByteString ParseState ByteString+t_name = identifier t_nameStartChar t_nameChar++t_uriref :: GenParser ByteString ParseState ByteString+t_uriref = between (char '<') (char '>') t_relativeURI++t_relativeURI  :: GenParser ByteString ParseState ByteString+t_relativeURI =+  do frag <- liftM (B.pack . concat) (many t_ucharacter)+     bUrl <- currBaseUrl+     dUrl <- currDocUrl+     return $ absolutizeUrl bUrl dUrl frag++-- We make this String rather than ByteString because we want+-- t_relativeURI (the only place it's used) to have chars so that+-- when it creates a ByteString it can all be in one chunk.+t_ucharacter  :: GenParser ByteString ParseState String+t_ucharacter =+  try (liftM B.unpack unicode_escape) <|>+  try (string "\\>") <|>+  liftM B.unpack (non_ctrl_char_except ">")++t_nameChar :: GenParser ByteString ParseState Char+t_nameChar = t_nameStartChar <|> char '-' <|> char '\x00B7' <|> satisfy f+  where+    f = flip in_range [('0', '9'), ('\x0300', '\x036F'), ('\x203F', '\x2040')]++longString_char  :: GenParser ByteString ParseState ByteString+longString_char  =+  specialChar        <|> -- \r|\n|\t as single char+  try escapedChar    <|> -- an backslash-escaped tab, newline, linefeed, backslash or doublequote+  try twoDoubleQuote <|> -- two doublequotes not followed by a doublequote+  try oneDoubleQuote <|> -- a single doublequote+  safeNonCtrlChar    <|> -- anything but a single backslash or doublequote+  try unicode_escape     -- a unicode escape sequence (\uxxxx or \Uxxxxxxxx)+  where+    specialChar     = oneOf "\t\n\r" >>= bs1+    escapedChar     =+      do char '\\'+         (char 't'  >> bs1 '\t') <|> (char 'n' >> bs1 '\n') <|> (char 'r' >> bs1 '\r') <|>+          (char '\\' >> bs1 '\\') <|> (char '"' >> bs1 '"')+    twoDoubleQuote  = string "\"\"" >> notFollowedBy (char '"') >> bs "\"\""+    oneDoubleQuote  = char '"' >> notFollowedBy (char '"') >> bs1 '"'+    safeNonCtrlChar = non_ctrl_char_except "\\\""++bs1 :: Char -> GenParser ByteString ParseState ByteString+bs1 = return . B.singleton++bs :: String -> GenParser ByteString ParseState ByteString+bs = return . B.pack++t_nameStartChar  :: GenParser ByteString ParseState Char+t_nameStartChar = char '_' <|> t_nameStartCharMinusUnderscore++t_nameStartCharMinusUnderscore  :: GenParser ByteString ParseState Char+t_nameStartCharMinusUnderscore = try $ satisfy $ flip in_range blocks+  where+    blocks = [('A', 'Z'), ('a', 'z'), ('\x00C0', '\x00D6'),+              ('\x00D8', '\x00F6'), ('\x00F8', '\x02FF'),+              ('\x0370', '\x037D'), ('\x037F', '\x1FFF'),+              ('\x200C', '\x200D'), ('\x2070', '\x218F'),+              ('\x2C00', '\x2FEF'), ('\x3001', '\xD7FF'),+              ('\xF900', '\xFDCF'), ('\xFDF0', '\xFFFD'),+              ('\x10000', '\xEFFFF')]++t_hex  :: GenParser ByteString ParseState Char+t_hex = satisfy (\c -> isDigit c || (c >= 'A' && c <= 'F')) <?> "hexadecimal digit"++-- characters used in (non-long) strings; any echaracters except ", or an escaped \"+-- echaracter - #x22 ) | '\"'+t_scharacter  :: GenParser ByteString ParseState ByteString+t_scharacter =+  (try (string "\\\"") >> return (B.singleton '"'))+     <|> try (do {char '\\';+                  (char 't' >> return (B.singleton '\t')) <|>+                  (char 'n' >> return (B.singleton '\n')) <|>+                  (char 'r' >> return (B.singleton '\r'))}) -- echaracter part 1+     <|> unicode_escape+     <|> (non_ctrl_char_except "\\\"" >>= \s -> return $! s) -- echaracter part 2 minus "++unicode_escape  :: GenParser ByteString ParseState ByteString+unicode_escape =+ (char '\\' >> return (B.singleton '\\')) >>+ ((char '\\' >> return (s2b "\\\\")) <|>+  (char 'u' >> count 4 t_hex >>= \cs -> return $! s2b "\\u" `B.append` s2b cs) <|>+  (char 'U' >> count 8 t_hex >>= \cs -> return $! s2b "\\U" `B.append` s2b cs))++non_ctrl_char_except  :: String -> GenParser ByteString ParseState ByteString+non_ctrl_char_except cs =+  liftM B.singleton+    (satisfy (\ c -> c <= '\1114111' && (c >= ' ' && c `notElem` cs)))++{-# INLINE in_range #-}+in_range :: Char -> [(Char, Char)] -> Bool+in_range c = any (\(c1, c2) -> c >= c1 && c <= c2)++-- Resolve a prefix using the given prefix mappings and base URL. If the prefix is+-- empty, then the base URL will be used if there is a base URL and if the map+-- does not contain an entry for the empty prefix.+resolveQName :: Maybe BaseUrl -> ByteString -> PrefixMappings -> ByteString+resolveQName mbaseUrl prefix (PrefixMappings pms') =+  case (mbaseUrl, B.null prefix) of+    (Just (BaseUrl base), True)  ->  Map.findWithDefault base BL.empty pms'+    (Nothing,             True)  ->  err1+    (_,                   _   )  ->  Map.findWithDefault err2 prefix pms'+  where+    err1 = error  "Cannot resolve empty QName prefix to a Base URL."+    err2 = error ("Cannot resolve QName prefix: " ++ B.unpack prefix)++-- Resolve a URL fragment found on the right side of a prefix mapping by converting it to an absolute URL if possible.+absolutizeUrl :: Maybe BaseUrl -> Maybe ByteString -> ByteString -> ByteString+absolutizeUrl mbUrl mdUrl urlFrag =+  if isAbsoluteUri urlFrag then urlFrag else+    (case (mbUrl, mdUrl) of+         (Nothing, Nothing) -> urlFrag+         (Just (BaseUrl bUrl), Nothing) -> bUrl `B.append` urlFrag+         (Nothing, Just dUrl) -> if isHash urlFrag then+                                     dUrl `B.append` urlFrag else urlFrag+         (Just (BaseUrl bUrl), Just dUrl) -> (if isHash urlFrag then dUrl+                                                  else bUrl)+                                                 `B.append` urlFrag)+  where+    isHash bs = B.length bs == 1 && B.head bs == '#'++{-# INLINE isAbsoluteUri #-}+isAbsoluteUri :: ByteString -> Bool+isAbsoluteUri = B.elem ':'++newBaseUrl :: Maybe BaseUrl -> ByteString -> BaseUrl+newBaseUrl Nothing                url = BaseUrl url+newBaseUrl (Just (BaseUrl bUrl)) url = BaseUrl $! mkAbsoluteUrl bUrl url++{-# INLINE mkAbsoluteUrl #-}+-- Make an absolute URL by returning as is if already an absolute URL and otherwise+-- appending the URL to the given base URL.+mkAbsoluteUrl :: ByteString -> ByteString -> ByteString+mkAbsoluteUrl base url =+  if isAbsoluteUri url then url else base `B.append` url++currBaseUrl :: GenParser ByteString ParseState (Maybe BaseUrl)+currBaseUrl = getState >>= \(bUrl, _, _, _, _, _, _, _) -> return bUrl++currDocUrl :: GenParser ByteString ParseState (Maybe ByteString)+currDocUrl = getState >>= \(_, dUrl, _, _, _, _, _, _) -> return dUrl++pushSubj :: Subject -> GenParser ByteString ParseState ()+pushSubj s = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, ts) ->+                  setState (bUrl, dUrl, i, pms, s:ss, ps, cs, ts)++popSubj :: GenParser ByteString ParseState Subject+popSubj = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, ts) ->+                setState (bUrl, dUrl, i, pms, tail ss, ps, cs, ts) >>+                  when (null ss) (error "Cannot pop subject off empty stack.") >>+                  return (head ss)++pushPred :: Predicate -> GenParser ByteString ParseState ()+pushPred p = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, ts) ->+                  setState (bUrl, dUrl, i, pms, ss, p:ps, cs, ts)++popPred :: GenParser ByteString ParseState Predicate+popPred = getState >>= \(bUrl, dUrl, i, pms, ss, ps, cs, ts) ->+                setState (bUrl, dUrl, i, pms, ss, tail ps, cs, ts) >>+                  when (null ps) (error "Cannot pop predicate off empty stack.") >>+                  -- _trace (show ps) (return ()) >>+                  return (head ps)++isInColl :: GenParser ByteString ParseState Bool+isInColl = getState >>= \(_, _, _, _, _, _, cs, _) -> return . not . null $ cs++updateBaseUrl :: Maybe (Maybe BaseUrl) -> GenParser ByteString ParseState ()+updateBaseUrl val = _modifyState val no no no no no++-- combines get_current and increment into a single function+nextIdCounter :: GenParser ByteString ParseState Int+nextIdCounter = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, ts) ->+                setState (bUrl, dUrl, i+1, pms, s, p, cs, ts) >> return i++updatePMs :: Maybe PrefixMappings -> GenParser ByteString ParseState ()+updatePMs val = _modifyState no no val no no no++-- Register that we have begun processing a collection+beginColl :: GenParser ByteString ParseState ()+beginColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, ts) ->+            setState (bUrl, dUrl, i, pms, s, p, True:cs, ts)++onCollFirstItem :: GenParser ByteString ParseState Bool+onCollFirstItem = getState >>= \(_, _, _, _, _, _, cs, _) -> return (not (null cs) && head cs)++collFirstItemProcessed :: GenParser ByteString ParseState ()+collFirstItemProcessed = getState >>= \(bUrl, dUrl, i, pms, s, p, _:cs, ts) ->+                         setState (bUrl, dUrl, i, pms, s, p, False:cs, ts)++-- Register that a collection is finished being processed; the bool value+-- in the monad is *not* the value that was popped from the stack, but whether+-- we are still processing a parent collection or have finished processing+-- all collections and are no longer in a collection at all.+finishColl :: GenParser ByteString ParseState Bool+finishColl = getState >>= \(bUrl, dUrl, i, pms, s, p, cs, ts) ->+             let cs' = drop 1 cs+             in setState (bUrl, dUrl, i, pms, s, p, cs', ts) >> return (not $ null cs')++-- Alias for Nothing for use with _modifyState calls, which can get very long with+-- many Nothing values.+no :: Maybe a+no = Nothing++-- Update the subject and predicate values of the ParseState to Nothing.+resetSubjectPredicate :: GenParser ByteString ParseState ()+resetSubjectPredicate =+  getState >>= \(bUrl, dUrl, n, pms, _, _, cs, ts) ->+  setState (bUrl, dUrl, n, pms, [], [], cs, ts)++-- Modifies the current parser state by updating any state values among the parameters+-- that have non-Nothing values.+_modifyState :: Maybe (Maybe BaseUrl) -> Maybe (Int -> Int) -> Maybe PrefixMappings ->+                Maybe Subject -> Maybe Predicate -> Maybe (Seq Triple) ->+                GenParser ByteString ParseState ()+_modifyState mb_bUrl mb_n mb_pms mb_subj mb_pred mb_trps =+  do (_bUrl, _dUrl, _n, _pms, _s, _p, _cs, _ts) <- getState+     setState (fromMaybe _bUrl mb_bUrl,+              _dUrl,+              maybe _n (const _n) mb_n,+              fromMaybe _pms mb_pms,+              maybe _s (: _s) mb_subj,+              maybe _p (: _p) mb_pred,+              _cs,+              fromMaybe _ts mb_trps)++addTripleForObject :: Object -> GenParser ByteString ParseState ()+addTripleForObject obj =+  do (bUrl, dUrl, i, pms, ss, ps, cs, ts) <- getState+     when (null ss) $+       error $ "No Subject with which to create triple for: " ++ show obj+     when (null ps) $+       error $ "No Predicate with which to create triple for: " ++ show obj+     setState (bUrl, dUrl, i, pms, ss, ps, cs, ts |> Triple (head ss) (head ps) obj)++-- |Parse the document at the given location URL as a Turtle document, using an optional @BaseUrl@+-- as the base URI, and using the given document URL as the URI of the Turtle document itself.+--+-- The @BaseUrl@ is used as the base URI within the document for resolving any relative URI references.+-- It may be changed within the document using the @\@base@ directive. At any given point, the current+-- base URI is the most recent @\@base@ directive, or if none, the @BaseUrl@ given to @parseURL@, or +-- if none given, the document URL given to @parseURL@. For example, if the @BaseUrl@ were+-- @http:\/\/example.org\/@ and a relative URI of @\<b>@ were encountered (with no preceding @\@base@ +-- directive), then the relative URI would expand to @http:\/\/example.org\/b@.+--+-- The document URL is for the purpose of resolving references to 'this document' within the document,+-- and may be different than the actual location URL from which the document is retrieved. Any reference+-- to @\<>@ within the document is expanded to the value given here. Additionally, if no @BaseUrl@ is +-- given and no @\@base@ directive has appeared before a relative URI occurs, this value is used as the+-- base URI against which the relative URI is resolved.+--p+-- Returns either a @ParseFailure@ or a new RDF containing the parsed triples.+parseURL' :: forall rdf. (RDF rdf) => +                 Maybe BaseUrl       -- ^ The optional base URI of the document.+                 -> Maybe ByteString -- ^ The document URI (i.e., the URI of the document itself); if Nothing, use location URI.+                 -> String           -- ^ The location URI from which to retrieve the Turtle document.+                 -> IO (Either ParseFailure rdf)+                                     -- ^ The parse result, which is either a @ParseFailure@ or the RDF+                                     --   corresponding to the Turtle document.+parseURL' bUrl docUrl = _parseURL (parseString' bUrl docUrl)++-- |Parse the given file as a Turtle document. The arguments and return type have the same semantics+-- as 'parseURL', except that the last @String@ argument corresponds to a filesystem location rather+-- than a location URI.+--+-- Returns either a @ParseFailure@ or a new RDF containing the parsed triples.+parseFile' :: forall rdf. (RDF rdf) => Maybe BaseUrl -> Maybe ByteString -> String -> IO (Either ParseFailure rdf)+parseFile' bUrl docUrl fpath =+  B.readFile fpath >>= \bs -> return $ handleResult bUrl (runParser t_turtleDoc initialState (maybe "" B.unpack docUrl) bs)+  where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], Seq.empty)++-- |Parse the given string as a Turtle document. The arguments and return type have the same semantics +-- as <parseURL>, except that the last @String@ argument corresponds to the Turtle document itself as+-- a a string rather than a location URI.+parseString' :: forall rdf. (RDF rdf) => Maybe BaseUrl -> Maybe ByteString -> ByteString -> Either ParseFailure rdf+parseString' bUrl docUrl ttlStr = handleResult bUrl (runParser t_turtleDoc initialState "" ttlStr)+  where initialState = (bUrl, docUrl, 1, PrefixMappings Map.empty, [], [], [], Seq.empty)++handleResult :: RDF rdf => Maybe BaseUrl -> Either ParseError (Seq Triple, PrefixMappings) -> Either ParseFailure rdf+handleResult bUrl result =+  case result of+    (Left err)         -> Left (ParseFailure $ show err)+    (Right (ts, pms))  -> Right $! mkRdf (F.toList ts) bUrl pms++_testParseState :: ParseState+_testParseState = (Nothing, Nothing, 1, PrefixMappings Map.empty, [], [], [], Seq.empty)

@@ -0,0 +1,185 @@+-- |An RDF serializer for Turtle +-- <http://www.w3.org/TeamSubmission/turtle/>.++module Text.RDF.RDF4H.TurtleSerializer(+  TurtleSerializer(TurtleSerializer)+)++where++import Data.RDF+import Data.RDF.Namespace+import Data.RDF.Utils++import Data.ByteString.Lazy.Char8(ByteString)+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.ByteString.Lazy as BL+import Data.Map(Map)+import qualified Data.Map as Map+import Data.List+import Control.Monad+import System.IO+import Debug.Trace(trace)++-- Defined so that there are no compiler warnings when trace is not used.+_debug = trace++data TurtleSerializer = TurtleSerializer (Maybe ByteString) PrefixMappings++instance RdfSerializer TurtleSerializer where+  hWriteRdf  (TurtleSerializer docUrl pms) h rdf = _writeRdf h docUrl (addPrefixMappings rdf pms False)+  writeRdf   s = hWriteRdf s stdout+  hWriteH  (TurtleSerializer _ pms) h rdf = writeHeader h (baseUrl rdf) (mergePrefixMappings (prefixMappings rdf) pms)+  writeH   s = hWriteRdf s stdout+  -- TODO: should use mdUrl to render <> where appropriate+  hWriteTs (TurtleSerializer docUrl pms) h = writeTriples h docUrl pms+  writeTs s   = hWriteTs s stdout+  hWriteT  (TurtleSerializer docUrl pms) h = writeTriple h docUrl pms+  writeT  s   = hWriteT s stdout+  hWriteN  (TurtleSerializer docUrl (PrefixMappings pms)) h n = writeNode h docUrl n pms+  writeN  s   = hWriteN s stdout ++-- TODO: writeRdf currently merges standard namespace prefix mappings with+-- the ones that the RDF already contains, so that if the RDF has none+-- (e.g., was parsed from ntriples RDF) the output still uses prefix for+-- common mappings like rdf, owl, and the like. This behavior should be+-- configurable somehow, so that if the user really doesn't want any extra+-- prefix declarations added, that is possible.++_writeRdf :: RDF rdf => Handle -> Maybe ByteString -> rdf -> IO ()+_writeRdf h mdUrl rdf =+  writeHeader h bUrl pms' >> writeTriples h mdUrl pms' ts >> hPutChar h '\n'+  where+    bUrl   = baseUrl rdf+    -- a merged set of prefix mappings using those from the standard_ns_mappings+    -- that are not defined already (union is left-biased).+    pms'   = PrefixMappings $ Map.union (asMap $ prefixMappings rdf) (asMap standard_ns_mappings)+    asMap (PrefixMappings x) = x+    ts     = triplesOf rdf++writeHeader :: Handle -> Maybe BaseUrl -> PrefixMappings -> IO ()+writeHeader h bUrl pms = writeBase h bUrl >> writePrefixes h pms++writeBase :: Handle -> Maybe BaseUrl -> IO ()+writeBase _ Nothing               =+  return ()+writeBase h (Just (BaseUrl bUrl)) =+  hPutStr h "@base " >> hPutChar h '<' >> BL.hPutStr h bUrl >> hPutStr h "> ." >> hPutChar h '\n'++writePrefixes :: Handle -> PrefixMappings -> IO ()+writePrefixes h pms = mapM_ (writePrefix h) (toPMList pms) >> hPutChar h '\n'++writePrefix :: Handle -> (ByteString, ByteString) -> IO ()+writePrefix h (pre, uri) =+  hPutStr h "@prefix " >> BL.hPutStr h pre >> hPutStr h ": " >>+  hPutChar h '<' >> BL.hPutStr h uri >> hPutStr h "> ." >> hPutChar h '\n'++-- We don't really use the map as a map yet, but we reverse the map anyway so that+-- it maps from uri to prefix rather than the usual prefix to uri, since we never need+-- to look anything up by prefix, where as we do use the uri for determining which+-- prefix to use.+writeTriples :: Handle -> Maybe ByteString -> PrefixMappings -> Triples -> IO ()+writeTriples h mdUrl (PrefixMappings pms) ts =+  mapM_ (writeSubjGroup h mdUrl revPms) (groupBy equalSubjects ts)+  where+    revPms = Map.fromList $ map (\(k,v) -> (v,k)) $ Map.toList pms++writeTriple :: Handle -> Maybe ByteString -> PrefixMappings -> Triple -> IO ()+writeTriple h mdUrl (PrefixMappings pms) t = +  w subjectOf >> space >> w predicateOf >> space >> w objectOf+  where+    w :: (Triple -> Node) -> IO ()+    w f = writeNode h mdUrl (f t) pms+    space = hPutChar h ' '++-- Write a group of triples that all have the same subject, with the subject only+-- being output once, and comma or semi-colon used as appropriate.+writeSubjGroup :: Handle -> Maybe ByteString -> Map ByteString ByteString -> Triples -> IO ()+writeSubjGroup _ _    _   []     = return ()+writeSubjGroup h dUrl pms ts@(t:_) =+  writeNode h dUrl (subjectOf t) pms >> hPutChar h ' ' >>+  writePredGroup h dUrl pms (head ts') >>+  mapM_ (\t -> hPutStr h ";\n\t" >> writePredGroup h dUrl pms t) (tail ts') >>+  hPutStrLn h " ."+  where+    ts' = groupBy equalPredicates ts++-- Write a group of triples that all have the same subject and the same predicate,+-- assuming the subject has already been output and only the predicate and objects+-- need to be written.+writePredGroup :: Handle -> Maybe ByteString -> Map ByteString ByteString -> Triples -> IO ()+writePredGroup _  _       _   []     = return ()+writePredGroup h  docUrl pms (t:ts) =+  -- The doesn't rule out <> in either the predicate or object (as well as subject), +  -- so we pass the docUrl through to writeNode in all cases.+  writeNode h docUrl (predicateOf t) pms >> hPutChar h ' ' >> +  writeNode h docUrl (objectOf t) pms >>+  mapM_ (\t -> hPutStr h ", " >> writeNode h docUrl (objectOf t) pms) ts++writeNode :: Handle -> Maybe ByteString -> Node -> Map ByteString ByteString -> IO ()+writeNode h mdUrl node prefixes =+  case node of+    (UNode fs)  -> let currUri = B.reverse $ value fs+                   in case mdUrl of+                        Nothing  -> writeUNodeUri h currUri prefixes+                        Just url -> if url == currUri then hPutStr h "<>" else writeUNodeUri h currUri prefixes+    (BNode gId) -> hPutStrRev h (value gId)+    (BNodeGen i)-> putStr "_:genid" >> hPutStr h (show i)+    (LNode n)   -> writeLValue h n prefixes++writeUNodeUri :: Handle -> ByteString -> Map ByteString ByteString -> IO ()+writeUNodeUri h uri prefixes =+  case mapping of+    Nothing                 -> hPutChar h '<' >> BL.hPutStr h uri >> hPutChar h '>'+    (Just (pre, localName)) -> BL.hPutStr h pre >> hPutChar h ':' >> BL.hPutStr h localName+  where+    mapping         = findMapping prefixes uri++-- Print prefix mappings to stdout for debugging.+_debugPMs     :: Map ByteString ByteString -> IO ()+_debugPMs pms =  mapM_ (\(k, v) -> B.putStr k >> putStr "__" >> B.putStrLn v) (Map.toList pms)++-- Expects a map from uri to prefix, and returns the (prefix, uri_expansion)+-- from the mappings such that uri_expansion is a prefix of uri, or Nothing if+-- there is no such mapping. This function does a linear-time search over the +-- map, but the prefix mappings should always be very small, so it's okay for now.+findMapping :: Map ByteString ByteString -> ByteString -> Maybe (ByteString, ByteString)+findMapping pms uri =+  case mapping of+    Nothing     -> Nothing+    Just (u, p) -> Just (p, B.drop (B.length u) uri) -- empty localName is permitted+  where+    mapping        = find (\(k, _) -> B.isPrefixOf k uri) (Map.toList pms)++--_testPms = Map.fromList [(s2b "http://example.com/ex#", s2b "eg")]++writeLValue :: Handle -> LValue -> Map ByteString ByteString -> IO ()+writeLValue h lv pms =+  case lv of+    (PlainL lit)       -> writeLiteralString h lit+    (PlainLL lit lang) -> writeLiteralString h lit >>+                            hPutStr h "@" >>+                            BL.hPutStr h lang+    (TypedL lit dtype) -> writeLiteralString h lit >>+                            hPutStr h "^^" >>+                            writeUNodeUri h (B.reverse $ value dtype) pms++writeLiteralString:: Handle -> ByteString -> IO ()+writeLiteralString h bs =+  do hPutChar h '"'+     B.foldl' writeChar (return True) bs+     hPutChar h '"'+  where+    writeChar :: IO Bool -> Char -> IO Bool+    writeChar b c =+      case c of+        '\n' ->  b >>= \b' -> when b' (hPutChar h '\\' >> hPutChar h 'n')  >> return True+        '\t' ->  b >>= \b' -> when b' (hPutChar h '\\' >> hPutChar h 't')  >> return True+        '\r' ->  b >>= \b' -> when b' (hPutChar h '\\' >> hPutChar h 'r')  >> return True+        '"'  ->  b >>= \b' -> when b' (hPutChar h '\\' >> hPutChar h '"')  >> return True+        '\\' ->  b >>= \b' -> when b' (hPutChar h '\\' >> hPutChar h '\\') >> return True+        _    ->  b >>= \b' -> when b' (hPutChar  h c)                      >> return True++--subj1 = unode $ s2b "http://example.com/subj"+--pred1 = unode $ s2b "http://example.com/pred"+--obj1  = typedL (s2b "hello, world") (mkFastString $ makeUri xsd $ s2b "")

@@ -0,0 +1,242 @@+-- |An parser for the RDF/XML format +-- <http://www.w3.org/TR/REC-rdf-syntax/>.++module Text.RDF.RDF4H.XmlParser(+  parseXmlRDF, getRDF+) where++import Data.RDF+import qualified Data.Map as Map+import Control.Arrow+import Text.XML.HXT.Core+import Data.ByteString.Lazy.Char8(ByteString)+import Data.String.Utils++-- TODO: Create instance:+--  RdfParse XmlParser++-- |Global state for the parser+data GParseState = GParseState { stateGenId :: Int+                               }+  deriving(Show)++-- |Local state for the parser (dependant on the parent xml elements)+data LParseState = LParseState { stateBaseUrl :: BaseUrl+                               , stateLang :: Maybe String+                               , stateSubject :: Subject+                               }+  deriving(Show)++-- |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 = case runParseArrow of+                                (_,r:_) -> Right r+                                _ -> Left (ParseFailure "XML parsing failed")+  where runParseArrow = runSLA (xread >>> addMetaData bUrl dUrl >>> getRDF) initState (b2s xmlStr)+        initState = GParseState { stateGenId = 0 }++-- |Add a root tag to a given XmlTree to appear as if it was read from a readDocument function+addMetaData :: (ArrowXml a) => Maybe BaseUrl -> Maybe ByteString -> a XmlTree XmlTree+addMetaData bUrlM dUrlM = mkelem "/"+                        ( [ sattr "transfer-Message" "OK"+                          , sattr "transfer-MimeType" "text/rdf"+                          ] ++ mkSource dUrlM ++ mkBase bUrlM+                        )+                        [ arr id ]+  where mkSource (Just dUrl) = [ sattr "source" (b2s dUrl) ]+        mkSource Nothing = []+        mkBase (Just (BaseUrl bUrl)) = [ sattr "transfer-URI" (b2s bUrl) ]+        mkBase Nothing = []++-- |Arrow that translates HXT XmlTree to an RDF representation+getRDF :: forall rdf a. (RDF rdf, ArrowXml a, ArrowState GParseState a) => a XmlTree rdf+getRDF = proc xml -> do+              rdf <- hasName "rdf:RDF" <<< isElem <<< getChildren         -< xml+              bUrl <- arr (BaseUrl . s2b) <<< ((getAttrValue0 "xml:base" <<< isElem <<< getChildren) `orElse` getAttrValue "transfer-URI") -< xml+              prefixMap <- arr toPrefixMap <<< toAttrMap                  -< rdf+              triples <- parseDescription' >. id -< (bUrl, rdf)+              returnA -< mkRdf triples (Just 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)++-- |Read the initial state from an rdf element+parseDescription' :: forall a. (ArrowXml a, ArrowState GParseState a) => a (BaseUrl, XmlTree) Triple+parseDescription' = proc (bUrl, rdf) -> do+                         desc <- isElem <<< getChildren -< rdf+                         state <- arr (\(s, o) -> s { stateSubject = o }) <<< arr fst &&& arr2A mkNode -< (LParseState bUrl Nothing undefined, desc)+                         triple <- parseDescription -< (state, desc)+                         returnA -< triple++-- |Read an rdf:Description tag to its corresponding Triples+parseDescription :: forall a. (ArrowXml a, ArrowState GParseState a) => a (LParseState, XmlTree) Triple+parseDescription = updateState+               >>> (arr2A parsePredicatesFromAttr+                   <+> (second (getChildren >>> isElem) >>> parsePredicatesFromChildren)+                   <+> (second (neg (hasName "rdf:Description")) >>> arr2A readTypeTriple))+               >>. replaceLiElems [] (1 :: Int)+  where readTypeTriple :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple+        readTypeTriple state = getName >>> arr (Triple (stateSubject state) rdfType . 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 _ [] = acc++-- |Parse the current predicate element as a rdf:Description element (used when rdf:parseType = "Resource")+parseAsResource :: forall a. (ArrowXml a, ArrowState GParseState a) => Node -> a (LParseState, XmlTree) Triple+parseAsResource n = updateState+    >>>     (arr2A parsePredicatesFromAttr+        <+> (second getName >>> arr (\(s, p) -> Triple (stateSubject s) ((unode . s2b) p) n))+        <+> (arr (\s -> s { stateSubject = n }) *** (getChildren >>> isElem) >>> parsePredicatesFromChildren))++-- |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+parsePredicatesFromAttr state = getAttrl+    >>> (getName >>> neg isMetaAttr >>> mkUNode) &&& (getChildren >>> getText >>> arr (lnode . plainL . s2b))+    >>> arr (attachSubject (stateSubject state))++-- | Arrow to determine if special processing is required for an attribute+isMetaAttr :: forall a. (ArrowXml a, ArrowState GParseState a) => a String String+isMetaAttr = isA (== "rdf:about")+         <+> isA (== "rdf:nodeID")+         <+> isA (== "rdf:ID")+         <+> isA (== "xml:lang")+         <+> isA (== "rdf:parseType")++-- |Read a children of an rdf:Description element.  These correspond to the Predicate portion of the Triple+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")) :-> (defaultA <+> (mkBlankNode &&& arr id >>> arr2A parseAsResource))+        , second (hasAttrValue "rdf:parseType" (== "Collection")) :-> (listA (defaultA >>> arr id &&& mkBlankNode) >>> mkCollectionTriples >>> unlistA)+        , second (hasAttr "rdf:datatype") :-> arr2A getTypedTriple+        , second (hasAttr "rdf:resource") :-> arr2A getResourceTriple+        , second (hasAttr "rdf:nodeID") :-> arr2A getNodeIdTriple+        , second (hasAttr "rdf:ID") :-> (arr2A mkRelativeNode &&& defaultA >>> arr2A reifyTriple >>> unlistA)+        , second hasPredicateAttr :-> (defaultA <+> (mkBlankNode &&& arr id >>> arr2A parsePredicateAttr))+        , this :-> defaultA+        ]+  where defaultA = proc (state, predXml) -> do+                         p <- arr(unode . s2b) <<< getName -< predXml+                         t <- arr2A (arr2A . parseObjectsFromChildren) <<< second (second getChildren) -< (state, (p, predXml))+                         returnA -< t+        parsePredicateAttr n = (second getName >>> arr (\(s, p) -> Triple (stateSubject s) ((unode . s2b) p) n))+                           <+> (first (arr (\s -> s { stateSubject = n })) >>> arr2A parsePredicatesFromAttr)+        hasPredicateAttr = getAttrl >>> neg (getName >>> isMetaAttr)++parseObjectsFromChildren :: forall a. (ArrowXml a, ArrowState GParseState a)+                         => LParseState -> Predicate -> a XmlTree Triple+parseObjectsFromChildren s p = choiceA+    [ isText :-> (getText >>> arr (Triple (stateSubject s) p . mkLiteralNode s))+    , isElem :-> (hasName "rdf:Description" >>> parseObjectDescription)+    ]+  where parseObjectDescription = proc desc -> do+                                      o <- mkNode s -< desc+                                      t0 <- arr (\(sub, (p, o)) -> Triple sub p o) -< (stateSubject s, (p, o))+                                      t <- arr fst <+> (parseDescription <<< arr snd) -< (t0, (s { stateSubject = o }, desc))+                                      returnA -< t++attachSubject :: Subject -> (Predicate, Object) -> Triple+attachSubject s (p, o) = Triple s p o++reifyTriple :: forall a. (ArrowXml a, ArrowState GParseState a) => Subject -> a Triple Triples+reifyTriple node = arr (\(Triple s p o) -> [ Triple s p o+                                           , Triple node rdfType rdfStatement+                                           , Triple node rdfSubject s+                                           , Triple node rdfPredicate p+                                           , Triple node rdfObject o+                                           ])++-- |Updates the local state at a given node+updateState :: forall a. (ArrowXml a, ArrowState GParseState a)+            => a (LParseState, XmlTree) (LParseState, XmlTree)+updateState = ifA (second (hasAttr "xml:lang")) (arr2A readLang) (arr id)+          >>> ifA (second (hasAttr "xml:base")) (arr2A readBase) (arr id)+  where readLang state = (getAttrValue0 "xml:lang" >>> arr (\lang -> state { stateLang = Just lang } ) ) &&& arr id+        readBase state = (getAttrValue0 "xml:base" >>> arr (\base -> state { stateBaseUrl = (BaseUrl . s2b) base } ) ) &&& arr id++-- |Read a Triple with an rdf:parseType of Literal+parseAsLiteralTriple :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Triple+parseAsLiteralTriple state = (nameToUNode &&& (xshow getChildren >>> arr (mkTypedLiteralNode rdfXmlLiteral)))+    >>> arr (attachSubject (stateSubject state))++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 _ _ o1, n1):(t2, n2):rest) =+            mkCollectionTriples' (Triple n1 rdfFirst o1 : Triple n1 rdfRest n2 : acc) ((t2, n2):rest)+        mkCollectionTriples' acc [(Triple _ _ o1, n1)] =+            Triple n1 rdfFirst o1 : Triple n1 rdfRest rdfNil : acc+        mkCollectionTriples' _ [] = []++-- |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 = nameToUNode &&& (attrExpandURI state "rdf:datatype" &&& xshow getChildren >>> arr (\(t, v) -> mkTypedLiteralNode (mkFastString (s2b t)) v))+    >>> arr (attachSubject (stateSubject state))++getResourceTriple :: forall a. (ArrowXml a, ArrowState GParseState a)+                  => LParseState -> a XmlTree Triple+getResourceTriple state = nameToUNode &&& (attrExpandURI state "rdf:resource" >>> mkUNode)+    >>> arr (attachSubject (stateSubject state))++getNodeIdTriple :: forall a. (ArrowXml a, ArrowState GParseState a)+                => LParseState -> a XmlTree Triple+getNodeIdTriple state = nameToUNode &&& (getAttrValue "rdf:nodeID" >>> arr (bnode . s2b))+    >>> arr (attachSubject (stateSubject state))++-- |Read a Node from the "rdf:about" property or generate a blank node+mkNode :: forall a. (ArrowXml a, ArrowState GParseState a) => LParseState -> a XmlTree Node+mkNode state = choiceA [ hasAttr "rdf:about" :-> (attrExpandURI state "rdf:about" >>> mkUNode)+                       , hasAttr "rdf:resource" :-> (attrExpandURI state "rdf:resource" >>> mkUNode)+                       , hasAttr "rdf:nodeID" :-> (getAttrValue "rdf:nodeID" >>> arr (bnode . s2b))+                       , hasAttr "rdf:ID" :-> mkRelativeNode state+                       , this :-> mkBlankNode+                       ]++rdfXmlLiteral = (mkFastString . s2b) "http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral"+rdfFirst = (unode . s2b) "rdf:first"+rdfRest = (unode . s2b) "rdf:rest"+rdfNil = (unode . s2b) "rdf:nil"+rdfType = (unode . s2b) "rdf:type"+rdfStatement = (unode . s2b) "rdf:Statement"+rdfSubject = (unode . s2b) "rdf:subject"+rdfPredicate = (unode . s2b) "rdf:predicate"+rdfObject = (unode . s2b) "rdf:object"++nameToUNode :: forall a. (ArrowXml a) => a XmlTree Node+nameToUNode = getName >>> mkUNode++attrExpandURI :: forall a. (ArrowXml a) => LParseState -> String -> a XmlTree String+attrExpandURI state attr = getAttrValue attr &&& baseUrl >>> expandURI+  where baseUrl = constA (case stateBaseUrl state of BaseUrl b -> b2s b)++-- |Make a UNode from an absolute string+mkUNode :: forall a. (Arrow a) => a String Node+mkUNode = arr (unode . s2b)++-- |Make a UNode from a rdf:ID element, expanding relative URIs+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)++-- |Make a literal node with the given type and content+mkTypedLiteralNode :: FastString -> String -> Node+mkTypedLiteralNode t content = lnode (typedL (s2b content) t)++-- |Use the given state to create a literal node+mkLiteralNode :: LParseState -> String -> Node+mkLiteralNode (LParseState _ (Just lang) _) content = lnode (plainLL (s2b content) (s2b lang))+mkLiteralNode (LParseState _ Nothing _) content = (lnode . plainL . s2b) content++-- |Generate an RDF blank node with incrementing IDs from the arrow state+mkBlankNode :: forall a b. (ArrowState GParseState a) => a b Node+mkBlankNode = nextState (\gState -> gState { stateGenId = stateGenId gState + 1 })+    >>> arr (BNodeGen . stateGenId)+

@@ -0,0 +1,17 @@+module Main where++import Test.Framework (defaultMain)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Text.RDF.RDF4H.TurtleParser_ConformanceTest as TurtleParser+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 (  TriplesGraph.tests+                   ++ MGraph.tests+                   -- ++ TurtleParser.test -- TODO: Implement TurtleParses `tests'+                   ++ XmlParser.tests+                   )+