summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Redland/LowLevel.hs73
-rw-r--r--Redland/MidLevel.hs172
-rw-r--r--Redland/Util.hs108
3 files changed, 303 insertions, 50 deletions
diff --git a/Redland/LowLevel.hs b/Redland/LowLevel.hs
index 388a387..07f20af 100644
--- a/Redland/LowLevel.hs
+++ b/Redland/LowLevel.hs
@@ -135,6 +135,11 @@ foreign import ccall "librdf_free_node"
foreign import ccall "redland.h &librdf_free_node"
p_librdf_free_node :: FinalizerPtr RedlandNode
+foreign import ccall "librdf_new_node_from_node"
+ librdf_new_node_from_node
+ :: Ptr RedlandNode
+ -- ^ old node
+ -> IO (Ptr RedlandNode)
foreign import ccall "librdf_new_node_from_blank_identifier"
librdf_new_node_from_blank_identifier
:: Ptr RedlandWorld
@@ -230,6 +235,20 @@ foreign import ccall "librdf_parser_parse_string_into_model"
-> IO CInt
-- ^ non-zero on failure
+-- librdf_parser_guess_name always fails, skipping it
+
+foreign import ccall "librdf_parser_guess_name2"
+ librdf_parser_guess_name2
+ :: Ptr RedlandWorld
+ -> CString
+ -- ^ MIME type or NULL
+ -> CString
+ -- ^ content buffer or NULL
+ -> CString
+ -- ^ content identifier or NULL
+ -> IO CString
+ -- ^ parser name or NULL
+
-- * Querying
@@ -313,6 +332,50 @@ foreign import ccall "librdf_free_statement"
foreign import ccall "redland.h &librdf_free_statement"
p_librdf_free_statement :: FinalizerPtr RedlandStatement
+-- | "The node objects become owned by the new statement (or freed on
+-- error)."
+foreign import ccall "librdf_new_statement_from_nodes"
+ librdf_new_statement_from_nodes
+ :: Ptr RedlandWorld
+ -> Ptr RedlandNode
+ -> Ptr RedlandNode
+ -> Ptr RedlandNode
+ -> IO (Ptr RedlandStatement)
+foreign import ccall "librdf_new_statement_from_statement"
+ librdf_new_statement_from_statement
+ :: Ptr RedlandStatement
+ -> IO (Ptr RedlandStatement)
+
+foreign import ccall "librdf_statement_get_subject"
+ librdf_statement_get_subject
+ :: Ptr RedlandStatement
+ -> IO (Ptr RedlandNode)
+ -- ^ the returned node is shared, should be copied
+foreign import ccall "librdf_statement_set_subject"
+ librdf_statement_set_subject
+ :: Ptr RedlandStatement
+ -> Ptr RedlandNode
+ -- ^ becomes owned by the statement
+ -> IO ()
+foreign import ccall "librdf_statement_get_predicate"
+ librdf_statement_get_predicate
+ :: Ptr RedlandStatement
+ -> IO (Ptr RedlandNode)
+foreign import ccall "librdf_statement_set_predicate"
+ librdf_statement_set_predicate
+ :: Ptr RedlandStatement
+ -> Ptr RedlandNode
+ -> IO ()
+foreign import ccall "librdf_statement_get_object"
+ librdf_statement_get_object
+ :: Ptr RedlandStatement
+ -> IO (Ptr RedlandNode)
+foreign import ccall "librdf_statement_set_object"
+ librdf_statement_set_object
+ :: Ptr RedlandStatement
+ -> Ptr RedlandNode
+ -> IO ()
+
-- * Triple stores
@@ -356,6 +419,16 @@ foreign import ccall "librdf_free_stream"
foreign import ccall "redland.h &librdf_free_stream"
p_librdf_free_stream :: FinalizerPtr RedlandStream
+foreign import ccall "librdf_stream_end"
+ librdf_stream_end :: Ptr RedlandStream -> IO CInt
+foreign import ccall "librdf_stream_next"
+ librdf_stream_next :: Ptr RedlandStream -> IO CInt
+foreign import ccall "librdf_stream_get_object"
+ librdf_stream_get_object
+ :: Ptr RedlandStream
+ -> IO (Ptr RedlandStatement)
+ -- ^ a shared statement, should be copied
+
-- * URI
diff --git a/Redland/MidLevel.hs b/Redland/MidLevel.hs
index f8aa546..fb3367a 100644
--- a/Redland/MidLevel.hs
+++ b/Redland/MidLevel.hs
@@ -6,8 +6,9 @@ Portability : non-portable (GHC extensions are used)
Mid-level <http://librdf.org/docs/api/index.html Redland RDF library>
bindings: using Haskell naming conventions, common Haskell types,
-'ForeignPtr' with finalizers, exceptions. Closely follows the original
-API otherwise.
+'ForeignPtr' with finalizers, exceptions, copied structures (as
+opposed to the shared ones, as nodes in statement-related functions in
+the C API). Closely follows the original API otherwise.
-}
@@ -16,9 +17,11 @@ module Redland.MidLevel where
import Foreign
import Foreign.C
import Control.Exception
+import Control.Monad
import Redland.LowLevel
+
-- * Exceptions
data RedlandException = InitializationException
@@ -63,7 +66,7 @@ perform a = do
-- | Initializes a Redland object, performs an action over it, makes
-- sure to call 'finalizeForeignPtr' afterwards.
withNew :: Initializer a -> (ForeignPtr a -> IO b) -> IO b
-withNew i f = bracket i finalizeForeignPtr f
+withNew i = bracket i finalizeForeignPtr
-- | An abstraction to use with 'withCString' and 'withForeignPtr'.
withNullablePtr :: (a -> (Ptr b -> c) -> c) -> Maybe a -> (Ptr b -> c) -> c
@@ -73,12 +76,15 @@ withNullablePtr f (Just x) a = f x a
-- | Checks whether a 'CString' is NULL, frees if it not, returns a
-- Haskell 'String'.
maybeCString :: CString -> IO (Maybe String)
-maybeCString cStr
+maybeCString cStr = do
+ r <- maybeSharedCString cStr
+ free cStr
+ pure r
+
+maybeSharedCString :: CString -> IO (Maybe String)
+maybeSharedCString cStr
| cStr == nullPtr = pure Nothing
- | otherwise = do
- r <- peekCString cStr
- free cStr
- pure $ pure r
+ | otherwise = Just <$> peekCString cStr
-- | Like 'maybeCString', but requires a string to be there, and
-- throws 'StringOperationException' if it isn't.
@@ -134,8 +140,7 @@ hashGet :: ForeignPtr RedlandHash
-> IO (Maybe String)
hashGet hash key =
withForeignPtr hash $ \hash' ->
- withCString key $ \key' ->
- librdf_hash_get hash' key' >>= maybeCString
+ withCString key $ librdf_hash_get hash' >=> maybeCString
hashGetDel :: ForeignPtr RedlandHash
-- ^ hash
@@ -144,8 +149,7 @@ hashGetDel :: ForeignPtr RedlandHash
-> IO (Maybe String)
hashGetDel hash key =
withForeignPtr hash $ \hash' ->
- withCString key $ \key' ->
- librdf_hash_get_del hash' key' >>= maybeCString
+ withCString key $ librdf_hash_get_del hash' >=> maybeCString
-- * RDF Graph (librdf_model)
@@ -214,6 +218,11 @@ redlandNode world =
withForeignPtr world $ \world' ->
initialize (librdf_new_node world') p_librdf_free_node
+nodeFromNode :: ForeignPtr RedlandNode -> Initializer RedlandNode
+nodeFromNode node =
+ withForeignPtr node $ \node' ->
+ initialize (librdf_new_node_from_node node') p_librdf_free_node
+
nodeFromBlankIdentifier :: ForeignPtr RedlandWorld
-> Maybe String
-> Initializer RedlandNode
@@ -269,13 +278,13 @@ nodeFromURIString world uriStr =
nodeGetBlankIdentifier :: ForeignPtr RedlandNode -> IO String
nodeGetBlankIdentifier node =
- withForeignPtr node $ \node' ->
- librdf_node_get_blank_identifier node' >>= justSharedCString
+ withForeignPtr node $
+ librdf_node_get_blank_identifier >=> justSharedCString
nodeGetLiteralValue :: ForeignPtr RedlandNode -> IO String
nodeGetLiteralValue node =
- withForeignPtr node $ \node' ->
- librdf_node_get_literal_value node' >>= justSharedCString
+ withForeignPtr node $
+ librdf_node_get_literal_value >=> justSharedCString
nodeGetURI :: ForeignPtr RedlandNode -> Initializer RedlandURI
nodeGetURI node =
@@ -297,8 +306,7 @@ nodeIsResource node =
nodeToString :: ForeignPtr RedlandNode -> IO String
nodeToString node =
- withForeignPtr node $ \node' ->
- librdf_node_to_string node' >>= justCString
+ withForeignPtr node $ librdf_node_to_string >=> justCString
-- * Parsers
@@ -336,6 +344,21 @@ parseStringIntoModel parser str uri model =
withForeignPtr model $ \model' ->
perform $ librdf_parser_parse_string_into_model parser' str' uri' model'
+parserGuessName2 :: ForeignPtr RedlandWorld
+ -> Maybe String
+ -- ^ MIME type
+ -> Maybe String
+ -- ^ content
+ -> Maybe String
+ -- ^ content identifier
+ -> IO (Maybe String)
+parserGuessName2 world mime content contentId =
+ withForeignPtr world $ \world' ->
+ withNullablePtr withCString mime $ \mime' ->
+ withNullablePtr withCString content $ \content' ->
+ withNullablePtr withCString contentId $
+ librdf_parser_guess_name2 world' mime' content' >=> maybeSharedCString
+
-- * Querying
@@ -363,18 +386,17 @@ redlandQuery world lang langURI query baseURI =
queryResultsGetCount :: ForeignPtr RedlandQueryResults -> IO Int
queryResultsGetCount results =
- withForeignPtr results $ \results' ->
- fromIntegral <$> librdf_query_results_get_count results'
+ withForeignPtr results $ fmap fromIntegral . librdf_query_results_get_count
-queryResultsNext :: ForeignPtr RedlandQueryResults -> IO Bool
+queryResultsNext :: ForeignPtr RedlandQueryResults
+ -> IO Bool
+ -- ^ 'True' if it's not finished.
queryResultsNext results =
- withForeignPtr results $ \results' ->
- (== 0) <$> librdf_query_results_next results'
+ withForeignPtr results $ fmap (== 0) . librdf_query_results_next
queryResultsFinished :: ForeignPtr RedlandQueryResults -> IO Bool
queryResultsFinished results =
- withForeignPtr results $ \results' ->
- (/= 0) <$> librdf_query_results_finished results'
+ withForeignPtr results $ fmap (/= 0) . librdf_query_results_finished
-- | Acts as a 'RedlandNode' initializer.
queryResultsGetBindingValue :: ForeignPtr RedlandQueryResults
@@ -408,8 +430,8 @@ queryResultsGetBindingValueByName results name =
queryResultsGetBindingsCount :: ForeignPtr RedlandQueryResults
-> IO Int
queryResultsGetBindingsCount results =
- withForeignPtr results $ \results' ->
- fromIntegral <$> librdf_query_results_get_bindings_count results'
+ withForeignPtr results $
+ fmap fromIntegral . librdf_query_results_get_bindings_count
-- | Acts as a 'RedlandQueryResults' initializer.
queryExecute :: ForeignPtr RedlandQuery
@@ -428,6 +450,78 @@ redlandStatement world =
withForeignPtr world $ \world' ->
initialize (librdf_new_statement world') p_librdf_free_statement
+statementFromNodes :: ForeignPtr RedlandWorld
+ -> Maybe (ForeignPtr RedlandNode)
+ -- ^ subject
+ -> Maybe (ForeignPtr RedlandNode)
+ -- ^ predicate
+ -> Maybe (ForeignPtr RedlandNode)
+ -- ^ object
+ -> Initializer RedlandStatement
+statementFromNodes world subject predicate object =
+ withForeignPtr world $ \world' ->
+ withNullablePtr withForeignPtr subject $ \subject' ->
+ withNullablePtr withForeignPtr predicate $ \predicate' ->
+ withNullablePtr withForeignPtr object $ \object' -> do
+ sCopy <- librdf_new_node_from_node subject'
+ pCopy <- librdf_new_node_from_node predicate'
+ oCopy <- librdf_new_node_from_node object'
+ initialize
+ (librdf_new_statement_from_nodes world' sCopy pCopy oCopy)
+ p_librdf_free_statement
+
+-- | An abstraction used for getting statement components.
+statementGet :: (Ptr RedlandStatement -> IO (Ptr RedlandNode))
+ -> ForeignPtr RedlandStatement
+ -> IO (Maybe (ForeignPtr RedlandNode))
+statementGet f statement =
+ withForeignPtr statement $ \statement' -> do
+ oldNode <- f statement'
+ if oldNode == nullPtr
+ then pure Nothing
+ else Just <$>
+ initialize (librdf_new_node_from_node oldNode) p_librdf_free_node
+
+-- | An abstraction used for setting statement components.
+statementSet :: (Ptr RedlandStatement -> Ptr RedlandNode -> IO ())
+ -> ForeignPtr RedlandStatement
+ -> Maybe (ForeignPtr RedlandNode)
+ -> IO ()
+statementSet f statement node =
+ withForeignPtr statement $ \statement' ->
+ case node of
+ Nothing -> f statement' nullPtr
+ Just node' -> withForeignPtr node' $ \node'' -> do
+ nodeCopy <- librdf_new_node_from_node node''
+ f statement' nodeCopy
+
+statementGetSubject :: ForeignPtr RedlandStatement
+ -> IO (Maybe (ForeignPtr RedlandNode))
+statementGetSubject = statementGet librdf_statement_get_subject
+
+statementSetSubject :: ForeignPtr RedlandStatement
+ -> Maybe (ForeignPtr RedlandNode)
+ -> IO ()
+statementSetSubject = statementSet librdf_statement_set_subject
+
+statementGetPredicate :: ForeignPtr RedlandStatement
+ -> IO (Maybe (ForeignPtr RedlandNode))
+statementGetPredicate = statementGet librdf_statement_get_predicate
+
+statementSetPredicate :: ForeignPtr RedlandStatement
+ -> Maybe (ForeignPtr RedlandNode)
+ -> IO ()
+statementSetPredicate = statementSet librdf_statement_set_predicate
+
+statementGetObject :: ForeignPtr RedlandStatement
+ -> IO (Maybe (ForeignPtr RedlandNode))
+statementGetObject = statementGet librdf_statement_get_object
+
+statementSetObject :: ForeignPtr RedlandStatement
+ -> Maybe (ForeignPtr RedlandNode)
+ -> IO ()
+statementSetObject = statementSet librdf_statement_set_object
+
-- * Triple stores
@@ -468,6 +562,27 @@ redlandStorageWithOptions world sname name opt =
p_librdf_free_storage
+-- * Stream of triples (librdf_statement)
+
+streamEnd :: ForeignPtr RedlandStream -> IO Bool
+streamEnd stream =
+ withForeignPtr stream $ fmap (/= 0) . librdf_stream_end
+
+streamNext :: ForeignPtr RedlandStream
+ -> IO Bool
+ -- ^ 'True' if it's not finished.
+streamNext stream =
+ withForeignPtr stream $ fmap (== 0) . librdf_stream_next
+
+streamGetObject :: ForeignPtr RedlandStream
+ -> Initializer RedlandStatement
+streamGetObject stream =
+ withForeignPtr stream $ \stream' -> do
+ statement <- librdf_stream_get_object stream'
+ initialize (librdf_new_statement_from_statement statement)
+ p_librdf_free_statement
+
+
-- * URI
redlandURI :: ForeignPtr RedlandWorld
@@ -487,5 +602,4 @@ uriFromURI uri =
uriAsString :: ForeignPtr RedlandURI -> IO String
uriAsString uri =
- withForeignPtr uri $ \uri' ->
- librdf_uri_as_string uri' >>= justSharedCString
+ withForeignPtr uri $ librdf_uri_as_string >=> justSharedCString
diff --git a/Redland/Util.hs b/Redland/Util.hs
index 0472dde..3d34206 100644
--- a/Redland/Util.hs
+++ b/Redland/Util.hs
@@ -11,7 +11,8 @@ Utility functions based on mid-level bindings.
module Redland.Util where
import Foreign
-import Control.Exception
+import Control.Monad
+import Data.Maybe
import Redland.LowLevel
import Redland.MidLevel
@@ -30,6 +31,19 @@ withHash world factory l f =
f hash
+-- * RDF Graph (librdf_model)
+
+withStatements :: ForeignPtr RedlandWorld
+ -> ForeignPtr RedlandModel
+ -> Triple
+ -> ([Triple] -> IO a)
+ -> IO a
+withStatements world model t f =
+ withNew (tripleToStatement world t) $ \statement ->
+ withNew (modelFindStatements model statement) $
+ streamToList >=> f
+
+
-- * RDF term (librdf_node)
data Node = BlankNode String
@@ -47,28 +61,29 @@ redlandNodeToNode rn = do
(_, True, _) -> LiteralNode <$> nodeGetLiteralValue rn
_ -> ResourceNode <$> (nodeGetURI rn >>= uriAsString)
+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 (ResourceNode s) =
+ withNew (redlandURI world s) $ nodeFromURI world
+
-- * Parsers
-- | Tries different parsers until one of them succeeds.
-tryParseStringIntoModel :: ForeignPtr RedlandWorld
- -> [String]
- -- ^ parsers to try
- -> ForeignPtr RedlandModel
- -> ForeignPtr RedlandURI
- -- ^ base URI
- -> String
- -- ^ string to parse
- -> IO ()
-tryParseStringIntoModel world (parser:parsers) model uri str =
- handle tryNext $
- withNew (redlandParser world (Just parser) Nothing Nothing) $ \parser ->
- parseStringIntoModel parser str uri model
- where
- tryNext :: RedlandException -> IO ()
- tryNext (OperationException _) = tryParseStringIntoModel world parsers model uri str
- tryNext e = throw e
-tryParseStringIntoModel world [] model uri str = throw ParseFailure
+guessingParseStringIntoModel :: ForeignPtr RedlandWorld
+ -> ForeignPtr RedlandModel
+ -> ForeignPtr RedlandURI
+ -- ^ base URI
+ -> String
+ -- ^ string to parse
+ -> IO ()
+guessingParseStringIntoModel world model uri str = do
+ parser <- parserGuessName2 world Nothing (Just str) Nothing
+ withNew (redlandParser world parser Nothing Nothing) $ \p ->
+ parseStringIntoModel p str uri model
-- * Querying
@@ -85,8 +100,7 @@ withQuery :: ForeignPtr RedlandWorld
-> IO a
withQuery world model ql qs bURI f =
withNew (redlandQuery world ql Nothing qs bURI) $ \query ->
- withNew (modelQueryExecute model query) $ \results ->
- queryResultsToList results >>= f
+ withNew (modelQueryExecute model query) $ queryResultsToList >=> f
-- * Query results
@@ -112,6 +126,58 @@ queryResultsToList qr = do
pure (name, val)
+-- * RDF Triple (librdf_statement)
+
+data Triple = Triple { subject :: Maybe Node
+ , predicate :: Maybe Node
+ , object :: Maybe Node
+ } deriving (Eq, Show)
+
+statementToTriple :: ForeignPtr RedlandStatement
+ -> IO Triple
+statementToTriple statement = do
+ s <- componentToTriple statementGetSubject
+ p <- componentToTriple statementGetPredicate
+ o <- componentToTriple statementGetObject
+ pure $ Triple s p o
+ where
+ componentToTriple :: (ForeignPtr RedlandStatement ->
+ IO (Maybe (ForeignPtr RedlandNode)))
+ -> IO (Maybe Node)
+ componentToTriple f = do
+ c <- f statement
+ case c of
+ Just c' -> Just <$> redlandNodeToNode c'
+ Nothing -> pure Nothing
+
+tripleToStatement :: ForeignPtr RedlandWorld
+ -> Triple
+ -> Initializer RedlandStatement
+tripleToStatement world (Triple s p o) = do
+ statement <- redlandStatement world
+ let maybeSet f mn = case mn of
+ Just n -> withNew (nodeToRedlandNode world n) $ \n' ->
+ f statement (Just n')
+ Nothing -> pure ()
+ maybeSet statementSetSubject s
+ maybeSet statementSetPredicate p
+ maybeSet statementSetObject o
+ pure statement
+
+-- * Stream of triples (librdf_statement)
+
+streamToList :: ForeignPtr RedlandStream -> IO [Triple]
+streamToList stream = do
+ done <- streamEnd stream
+ if done
+ then pure []
+ else do
+ triple <- streamGetObject stream >>= statementToTriple
+ next <- streamNext stream
+ rest <- if next then streamToList stream else pure []
+ pure (triple : rest)
+
+
-- * Other
-- | Initializes world, storage, model, and base URI at once.
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-25 02:00:00 +0000