diff options
| -rw-r--r-- | Redland.hs | 13 | ||||
| -rw-r--r-- | Redland/LowLevel.hs | 15 | ||||
| -rw-r--r-- | Redland/MidLevel.hs | 24 | ||||
| -rw-r--r-- | Redland/Util.hs | 25 |
4 files changed, 61 insertions, 16 deletions
@@ -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 |