diff options
Diffstat (limited to 'Redland/MidLevel.hs')
| -rw-r--r-- | Redland/MidLevel.hs | 172 |
1 files changed, 143 insertions, 29 deletions
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 |