summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Redland.hs13
-rw-r--r--Redland/LowLevel.hs15
-rw-r--r--Redland/MidLevel.hs24
-rw-r--r--Redland/Util.hs25
4 files changed, 61 insertions, 16 deletions
diff --git a/Redland.hs b/Redland.hs
index 4bfa88d..79a2665 100644
--- a/Redland.hs
+++ b/Redland.hs
@@ -55,13 +55,12 @@ descriptions.
It prints the following:
-> [("foo",ResourceNode "http://www.dajobe.org/"),("bar",ResourceNode "http://purl.org/dc/elements/1.1/title"),("baz",LiteralNode "Dave Beckett's Home Page")]
-> [("foo",ResourceNode "http://www.dajobe.org/"),("bar",ResourceNode "http://purl.org/dc/elements/1.1/creator"),("baz",LiteralNode "Dave Beckett")]
-> [("foo",ResourceNode "http://www.dajobe.org/"),("bar",ResourceNode "http://purl.org/dc/elements/1.1/description"),("baz",LiteralNode "The generic home page of Dave Beckett.")]
-> Triple {subject = Just (ResourceNode "http://www.dajobe.org/"), predicate = Just (ResourceNode "http://purl.org/dc/elements/1.1/title"), object = Just (LiteralNode "Dave Beckett's Home Page")}
-> Triple {subject = Just (ResourceNode "http://www.dajobe.org/"), predicate = Just (ResourceNode "http://purl.org/dc/elements/1.1/creator"), object = Just (LiteralNode "Dave Beckett")}
-> Triple {subject = Just (ResourceNode "http://www.dajobe.org/"), predicate = Just (ResourceNode "http://purl.org/dc/elements/1.1/description"), object = Just (LiteralNode "The generic home page of Dave Beckett.")}
-
+> [("foo",ResourceNode "http://www.dajobe.org/"),("bar",ResourceNode "http://purl.org/dc/elements/1.1/title"),("baz",LiteralNode "Dave Beckett's Home Page" Nothing)]
+> [("foo",ResourceNode "http://www.dajobe.org/"),("bar",ResourceNode "http://purl.org/dc/elements/1.1/creator"),("baz",LiteralNode "Dave Beckett" Nothing)]
+> [("foo",ResourceNode "http://www.dajobe.org/"),("bar",ResourceNode "http://purl.org/dc/elements/1.1/description"),("baz",LiteralNode "The generic home page of Dave Beckett." Nothing)]
+> Triple {subject = Just (ResourceNode "http://www.dajobe.org/"), predicate = Just (ResourceNode "http://purl.org/dc/elements/1.1/title"), object = Just (LiteralNode "Dave Beckett's Home Page" Nothing)}
+> Triple {subject = Just (ResourceNode "http://www.dajobe.org/"), predicate = Just (ResourceNode "http://purl.org/dc/elements/1.1/creator"), object = Just (LiteralNode "Dave Beckett" Nothing)}
+> Triple {subject = Just (ResourceNode "http://www.dajobe.org/"), predicate = Just (ResourceNode "http://purl.org/dc/elements/1.1/description"), object = Just (LiteralNode "The generic home page of Dave Beckett." Nothing)}
-}
diff --git a/Redland/LowLevel.hs b/Redland/LowLevel.hs
index 07f20af..7be277a 100644
--- a/Redland/LowLevel.hs
+++ b/Redland/LowLevel.hs
@@ -187,6 +187,21 @@ foreign import ccall "librdf_node_get_literal_value"
:: Ptr RedlandNode
-> IO CString
-- ^ Literal value, must be copied
+foreign import ccall "librdf_node_get_literal_value_language"
+ librdf_node_get_literal_value_language
+ :: Ptr RedlandNode
+ -> IO CString
+ -- ^ Literal language value, must be copied
+foreign import ccall "librdf_node_get_literal_value_datatype_uri"
+ librdf_node_get_literal_value_datatype_uri
+ :: Ptr RedlandNode
+ -> IO CString
+ -- ^ Literal datatype URI, must be copied
+foreign import ccall "librdf_node_get_literal_value_is_wf_xml"
+ librdf_node_get_literal_value_is_wf_xml
+ :: Ptr RedlandNode
+ -> IO CInt
+ -- ^ 0 if it's not well formed XML
foreign import ccall "librdf_node_get_uri"
librdf_node_get_uri
:: Ptr RedlandNode
diff --git a/Redland/MidLevel.hs b/Redland/MidLevel.hs
index fb3367a..c8e9aa6 100644
--- a/Redland/MidLevel.hs
+++ b/Redland/MidLevel.hs
@@ -250,12 +250,12 @@ nodeFromTypedLiteral :: ForeignPtr RedlandWorld
-> Maybe String
-> Maybe (ForeignPtr RedlandURI)
-> Initializer RedlandNode
-nodeFromTypedLiteral world val xmlLang litType =
+nodeFromTypedLiteral world val xmlLang uri =
withForeignPtr world $ \world' ->
withCString val $ \val' ->
withNullablePtr withCString xmlLang $ \xmlLang' ->
- withNullablePtr withForeignPtr litType $ \litType' ->
- initialize (librdf_new_node_from_typed_literal world' val' xmlLang' litType')
+ withNullablePtr withForeignPtr uri $ \uri' ->
+ initialize (librdf_new_node_from_typed_literal world' val' xmlLang' uri')
p_librdf_free_node
nodeFromURI :: ForeignPtr RedlandWorld
@@ -278,13 +278,25 @@ nodeFromURIString world uriStr =
nodeGetBlankIdentifier :: ForeignPtr RedlandNode -> IO String
nodeGetBlankIdentifier node =
- withForeignPtr node $
- librdf_node_get_blank_identifier >=> justSharedCString
+ withForeignPtr node $ librdf_node_get_blank_identifier >=> justSharedCString
nodeGetLiteralValue :: ForeignPtr RedlandNode -> IO String
nodeGetLiteralValue node =
+ withForeignPtr node $ librdf_node_get_literal_value >=> justSharedCString
+
+nodeGetLiteralValueLanguage :: ForeignPtr RedlandNode -> IO (Maybe String)
+nodeGetLiteralValueLanguage node =
withForeignPtr node $
- librdf_node_get_literal_value >=> justSharedCString
+ librdf_node_get_literal_value_language >=> maybeSharedCString
+
+nodeGetLiteralValueDatatypeURI :: ForeignPtr RedlandNode -> IO (Maybe String)
+nodeGetLiteralValueDatatypeURI node =
+ withForeignPtr node $
+ librdf_node_get_literal_value_datatype_uri >=> maybeSharedCString
+
+nodeGetLiteralValueIsWellFormedXML :: ForeignPtr RedlandNode -> IO Bool
+nodeGetLiteralValueIsWellFormedXML node =
+ withForeignPtr node $ fmap (/= 0) . librdf_node_get_literal_value_is_wf_xml
nodeGetURI :: ForeignPtr RedlandNode -> Initializer RedlandURI
nodeGetURI node =
diff --git a/Redland/Util.hs b/Redland/Util.hs
index 2bcd947..962bf2e 100644
--- a/Redland/Util.hs
+++ b/Redland/Util.hs
@@ -47,9 +47,13 @@ withStatements world model t f =
-- * RDF term (librdf_node)
+data LiteralNodeType = XMLSchema String
+ | LanguageTag String
+ deriving (Ord, Eq, Show)
+
-- | Haskell representation of 'RedlandNode'.
data Node = BlankNode String
- | LiteralNode String
+ | LiteralNode String (Maybe LiteralNodeType)
| ResourceNode String
deriving (Ord, Eq, Show)
@@ -61,7 +65,16 @@ redlandNodeToNode rn = do
isResource <- nodeIsResource rn
case (isBlank, isLiteral, isResource) of
(True, _, _) -> BlankNode <$> nodeGetBlankIdentifier rn
- (_, True, _) -> LiteralNode <$> nodeGetLiteralValue rn
+ (_, True, _) -> do
+ litVal <- nodeGetLiteralValue rn
+ litLang <- nodeGetLiteralValueLanguage rn
+ litType <- nodeGetLiteralValueDatatypeURI rn
+ litXML <- nodeGetLiteralValueIsWellFormedXML rn
+ let nType = case (litLang, litType) of
+ (Just l, _) -> Just $ LanguageTag l
+ (_, Just t) -> Just $ XMLSchema t
+ _ -> Nothing
+ pure $ LiteralNode litVal nType
_ -> ResourceNode <$> (nodeGetURI rn >>= uriAsString)
-- | A conversion function.
@@ -69,7 +82,13 @@ nodeToRedlandNode :: ForeignPtr RedlandWorld
-> Node
-> Initializer RedlandNode
nodeToRedlandNode world (BlankNode s) = nodeFromBlankIdentifier world (Just s)
-nodeToRedlandNode world (LiteralNode s) = nodeFromLiteral world s Nothing False
+nodeToRedlandNode world (LiteralNode s (Just (LanguageTag l))) =
+ nodeFromTypedLiteral world s (Just l) Nothing
+nodeToRedlandNode world (LiteralNode s (Just (XMLSchema uri))) =
+ withNew (redlandURI world uri) $ \uri' ->
+ nodeFromTypedLiteral world s Nothing (Just uri')
+nodeToRedlandNode world (LiteralNode s Nothing) =
+ nodeFromTypedLiteral world s Nothing Nothing
nodeToRedlandNode world (ResourceNode s) =
withNew (redlandURI world s) $ nodeFromURI world