summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordefanor <>2018-02-23 17:54:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-02-23 17:54:00 (GMT)
commit0bb1fe58c5c1d0a81baaf7a5152f7df475c739bb (patch)
tree10a3acf31e949514641857580c6c10e634219692
parent6265a08b8f8625e33d9c50d3529eb7ace92d2727 (diff)
version 0.2.0.00.2.0.0
-rw-r--r--ChangeLog.md6
-rw-r--r--Redland.hs13
-rw-r--r--Redland/LowLevel.hs15
-rw-r--r--Redland/MidLevel.hs28
-rw-r--r--Redland/Util.hs72
-rw-r--r--redland.cabal3
6 files changed, 102 insertions, 35 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
index 6c1f9b9..9d49b9e 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,11 @@
# Revision history for redland
+## 0.2.0.0 -- 2018-02-23
+
+* Support for literal node types/languages.
+* Ord and NFData instances for Node and Triple.
+
+
## 0.1.0.0 -- 2018-02-20
* ChangeLog is introduced.
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..75730a6 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 (Ptr RedlandURI)
+ -- ^ 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..e9f1993 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,29 @@ 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 (ForeignPtr RedlandURI))
+nodeGetLiteralValueDatatypeURI node =
+ withForeignPtr node $ \node' -> do
+ oldURI <- librdf_node_get_literal_value_datatype_uri node'
+ if oldURI == nullPtr
+ then pure Nothing
+ else Just <$> initialize (librdf_new_uri_from_uri oldURI) p_librdf_free_uri
+
+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 9d3744d..e7ac295 100644
--- a/Redland/Util.hs
+++ b/Redland/Util.hs
@@ -12,7 +12,7 @@ module Redland.Util where
import Foreign
import Control.Monad
-import Data.Maybe
+import Control.DeepSeq
import Redland.LowLevel
import Redland.MidLevel
@@ -48,11 +48,24 @@ withStatements world model t f =
-- * RDF term (librdf_node)
+data LiteralNodeType = XMLSchema String
+ | LanguageTag String
+ deriving (Ord, Eq, Show)
+
+instance NFData LiteralNodeType where
+ rnf (XMLSchema s) = rnf s
+ rnf (LanguageTag s) = rnf s
+
-- | Haskell representation of 'RedlandNode'.
data Node = BlankNode String
- | LiteralNode String
+ | LiteralNode String (Maybe LiteralNodeType)
| ResourceNode String
- deriving (Eq, Show)
+ deriving (Ord, Eq, Show)
+
+instance NFData Node where
+ rnf (BlankNode s) = rnf s
+ rnf (LiteralNode s t) = rnf s `seq` rnf t
+ rnf (ResourceNode s) = rnf s
-- | A conversion function.
redlandNodeToNode :: ForeignPtr RedlandNode -> IO Node
@@ -62,7 +75,15 @@ 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
+ nType <- case (litLang, litType) of
+ (Just l, _) -> pure $ Just $ LanguageTag l
+ (_, Just t) -> Just . XMLSchema <$> uriAsString t
+ _ -> pure Nothing
+ pure $ LiteralNode litVal nType
_ -> ResourceNode <$> (nodeGetURI rn >>= uriAsString)
-- | A conversion function.
@@ -70,7 +91,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
@@ -139,7 +166,10 @@ queryResultsToList qr = do
data Triple = Triple { subject :: Maybe Node
, predicate :: Maybe Node
, object :: Maybe Node
- } deriving (Eq, Show)
+ } deriving (Ord, Eq, Show)
+
+instance NFData Triple where
+ rnf (Triple s p o) = rnf s `seq` rnf p `seq` rnf o
-- | A conversion function.
statementToTriple :: ForeignPtr RedlandStatement
@@ -193,21 +223,21 @@ streamToList stream = do
-- | Initializes world, storage, model, and base URI at once.
withWSMU :: String
- -- ^ storage factory
- -> [(String, String)]
- -- ^ storage options
- -> String
- -- ^ storage identifier
- -> String
- -- ^ model options
- -> String
- -- ^ base URI
- -> (ForeignPtr RedlandWorld ->
- ForeignPtr RedlandStorage ->
- ForeignPtr RedlandModel ->
- ForeignPtr RedlandURI ->
- IO a)
- -> IO a
+ -- ^ storage factory
+ -> [(String, String)]
+ -- ^ storage options
+ -> String
+ -- ^ storage identifier
+ -> String
+ -- ^ model options
+ -> String
+ -- ^ base URI
+ -> (ForeignPtr RedlandWorld ->
+ ForeignPtr RedlandStorage ->
+ ForeignPtr RedlandModel ->
+ ForeignPtr RedlandURI ->
+ IO a)
+ -> IO a
withWSMU sFactory sOpt sIdent mOpt bURI f =
withNew redlandWorld $ \world ->
withHash world "memory" sOpt $ \sOpt' ->
diff --git a/redland.cabal b/redland.cabal
index 2f2b314..a6014cd 100644
--- a/redland.cabal
+++ b/redland.cabal
@@ -1,5 +1,5 @@
name: redland
-version: 0.1.0.0
+version: 0.2.0.0
synopsis: Redland RDF library bindings
description: This package provides low-level and mid-level
Redland RDF library bindings, as well as some
@@ -28,6 +28,7 @@ library
, Redland.Util
other-extensions: ForeignFunctionInterface
build-depends: base >=4.9 && <5
+ , deepseq >= 1.4.2.0
default-language: Haskell2010
pkgconfig-depends: raptor2, redland
build-tools: hsc2hs