Support literal node types/languages

3 files changed, 55 insertions, 9 deletions

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