From b52e6bf3822150fbca9a6aadd3ce73dcdf7ed0ad Mon Sep 17 00:00:00 2001 From: defanor Date: Wed, 21 Feb 2018 18:36:52 +0300 Subject: Initial commit The bindings are incomplete, but usable at this point. --- Redland/LowLevel.hs | 382 ++++++++++++++++++++++++++++++++++++++++ Redland/MidLevel.hs | 491 ++++++++++++++++++++++++++++++++++++++++++++++++++++ Redland/Util.hs | 140 +++++++++++++++ 3 files changed, 1013 insertions(+) create mode 100644 Redland/LowLevel.hs create mode 100644 Redland/MidLevel.hs create mode 100644 Redland/Util.hs (limited to 'Redland') diff --git a/Redland/LowLevel.hs b/Redland/LowLevel.hs new file mode 100644 index 0000000..388a387 --- /dev/null +++ b/Redland/LowLevel.hs @@ -0,0 +1,382 @@ +{- | +Module : Redland.LowLevel +Maintainer : defanor +Stability : unstable +Portability : non-portable (GHC extensions are used) + +Low-level +bindings, a straightforward translation. + +-} + +{-# LANGUAGE ForeignFunctionInterface #-} + +module Redland.LowLevel where + +import Foreign +import Foreign.C + + +-- * World + +data RedlandWorld + +foreign import ccall "librdf_new_world" + librdf_new_world :: IO (Ptr RedlandWorld) +foreign import ccall "librdf_free_world" + librdf_free_world :: Ptr RedlandWorld -> IO () +foreign import ccall "redland.h &librdf_free_world" + p_librdf_free_world :: FinalizerPtr RedlandWorld + +foreign import ccall "librdf_world_open" + librdf_world_open :: Ptr RedlandWorld -> IO () + + +-- * Hashes + +data RedlandHash + +foreign import ccall "librdf_new_hash" + librdf_new_hash + :: Ptr RedlandWorld + -- ^ world + -> CString + -- ^ name + -> IO (Ptr RedlandHash) +foreign import ccall "librdf_free_hash" + librdf_free_hash :: Ptr RedlandHash -> IO () +foreign import ccall "redland.h &librdf_free_hash" + p_librdf_free_hash :: FinalizerPtr RedlandHash + +foreign import ccall "librdf_hash_put_strings" + librdf_hash_put_strings + :: Ptr RedlandHash + -- ^ hash + -> CString + -- ^ key + -> CString + -- ^ value + -> IO CInt + -- ^ non-zero on failure +foreign import ccall "librdf_hash_get" + librdf_hash_get + :: Ptr RedlandHash + -- ^ hash + -> CString + -- ^ key + -> IO CString + -- ^ must be freed by the caller +foreign import ccall "librdf_hash_get_del" + librdf_hash_get_del + :: Ptr RedlandHash + -- ^ hash + -> CString + -- ^ key + -> IO CString + -- ^ must be freed by the caller + + +-- * RDF Graph (librdf_model) + +data RedlandModel + +foreign import ccall "librdf_new_model" + librdf_new_model + :: Ptr RedlandWorld + -- ^ world + -> Ptr RedlandStorage + -- ^ storage + -> CString + -- ^ options + -> IO (Ptr RedlandModel) +foreign import ccall "librdf_free_model" + librdf_free_model :: Ptr RedlandModel -> IO () +foreign import ccall "redland.h &librdf_free_model" + p_librdf_free_model :: FinalizerPtr RedlandModel + +foreign import ccall "librdf_model_query_execute" + librdf_model_query_execute + :: Ptr RedlandModel + -- ^ model + -> Ptr RedlandQuery + -- ^ query + -> IO (Ptr RedlandQueryResults) + -- ^ NULL on failure +foreign import ccall "librdf_model_sync" + librdf_model_sync :: Ptr RedlandModel -> IO CInt +foreign import ccall "librdf_model_load" + librdf_model_load + :: Ptr RedlandModel + -> Ptr RedlandURI + -- ^ source URI + -> CString + -- ^ parser name, can be NULL + -> CString + -- ^ MIME type, can be NULL + -> Ptr RedlandURI + -- ^ type URI, can be NULL + -> IO CInt + +foreign import ccall "librdf_model_find_statements" + librdf_model_find_statements + :: Ptr RedlandModel + -> Ptr RedlandStatement + -> IO (Ptr RedlandStream) + + +-- * RDF term (librdf_node) + +data RedlandNode + +foreign import ccall "librdf_new_node" + librdf_new_node :: Ptr RedlandWorld -> IO (Ptr RedlandNode) +foreign import ccall "librdf_free_node" + librdf_free_node :: Ptr RedlandNode -> IO () +foreign import ccall "redland.h &librdf_free_node" + p_librdf_free_node :: FinalizerPtr RedlandNode + +foreign import ccall "librdf_new_node_from_blank_identifier" + librdf_new_node_from_blank_identifier + :: Ptr RedlandWorld + -> CString + -- ^ blank node identifier, can be NULL + -> IO (Ptr RedlandNode) +foreign import ccall "librdf_new_node_from_literal" + librdf_new_node_from_literal + :: Ptr RedlandWorld + -> CString + -- ^ string value + -> CString + -- ^ literal XML language, can be NULL + -> CInt + -- ^ non-zero if literal is XML + -> IO (Ptr RedlandNode) +foreign import ccall "librdf_new_node_from_typed_literal" + librdf_new_node_from_typed_literal + :: Ptr RedlandWorld + -> CString + -- ^ string value + -> CString + -- ^ literal XML language, can be NULL + -> Ptr RedlandURI + -- ^ typed literal datatype URI, can be NULL + -> IO (Ptr RedlandNode) +foreign import ccall "librdf_new_node_from_uri" + librdf_new_node_from_uri + :: Ptr RedlandWorld + -> Ptr RedlandURI + -> IO (Ptr RedlandNode) +foreign import ccall "librdf_new_node_from_uri_string" + librdf_new_node_from_uri_string + :: Ptr RedlandWorld + -> CString + -> IO (Ptr RedlandNode) + +foreign import ccall "librdf_node_get_blank_identifier" + librdf_node_get_blank_identifier + :: Ptr RedlandNode + -> IO CString + -- ^ identifier +foreign import ccall "librdf_node_get_literal_value" + librdf_node_get_literal_value + :: Ptr RedlandNode + -> IO CString + -- ^ Literal value, must be copied +foreign import ccall "librdf_node_get_uri" + librdf_node_get_uri + :: Ptr RedlandNode + -> IO (Ptr RedlandURI) + -- ^ URI, must be copied +foreign import ccall "librdf_node_is_blank" + librdf_node_is_blank :: Ptr RedlandNode -> IO CInt +foreign import ccall "librdf_node_is_literal" + librdf_node_is_literal :: Ptr RedlandNode -> IO CInt +foreign import ccall "librdf_node_is_resource" + librdf_node_is_resource :: Ptr RedlandNode -> IO CInt +foreign import ccall "librdf_node_to_string" + librdf_node_to_string :: Ptr RedlandNode -> IO CString + + +-- * Parsers + +data RedlandParser + +foreign import ccall "librdf_new_parser" + librdf_new_parser + :: Ptr RedlandWorld + -- ^ world + -> CString + -- ^ name + -> CString + -- ^ MIME type + -> Ptr RedlandURI + -- ^ type URI + -> IO (Ptr RedlandParser) +foreign import ccall "librdf_free_parser" + librdf_free_parser :: Ptr RedlandParser -> IO () +foreign import ccall "redland.h &librdf_free_parser" + p_librdf_free_parser :: FinalizerPtr RedlandParser + +foreign import ccall "librdf_parser_parse_string_into_model" + librdf_parser_parse_string_into_model + :: Ptr RedlandParser + -- ^ parser + -> CString + -- ^ string to parse + -> Ptr RedlandURI + -- ^ base URI + -> Ptr RedlandModel + -- ^ model + -> IO CInt + -- ^ non-zero on failure + + +-- * Querying + +data RedlandQuery + +foreign import ccall "librdf_new_query" + librdf_new_query + :: Ptr RedlandWorld + -> CString + -- ^ language name + -> Ptr RedlandURI + -- ^ language URI (can be NULL) + -> CString + -- ^ query string + -> Ptr RedlandURI + -- ^ base URI (can be NULL) + -> IO (Ptr RedlandQuery) +foreign import ccall "librdf_free_query" + librdf_free_query :: Ptr RedlandQuery -> IO () +foreign import ccall "redland.h &librdf_free_query" + p_librdf_free_query :: FinalizerPtr RedlandQuery + +foreign import ccall "librdf_query_execute" + librdf_query_execute + :: Ptr RedlandQuery + -- ^ query + -> Ptr RedlandModel + -- ^ model + -> IO (Ptr RedlandQueryResults) + -- ^ NULL on failure + + +-- * Query results + +data RedlandQueryResults + +foreign import ccall "librdf_free_query_results" + librdf_free_query_results :: Ptr RedlandQueryResults -> IO () +foreign import ccall "redland.h &librdf_free_query_results" + p_librdf_free_query_results :: FinalizerPtr RedlandQueryResults + +foreign import ccall "librdf_query_results_get_count" + librdf_query_results_get_count :: Ptr RedlandQueryResults -> IO CInt +foreign import ccall "librdf_query_results_next" + librdf_query_results_next :: Ptr RedlandQueryResults -> IO CInt +foreign import ccall "librdf_query_results_finished" + librdf_query_results_finished :: Ptr RedlandQueryResults -> IO CInt +foreign import ccall "librdf_query_results_get_binding_value" + librdf_query_results_get_binding_value + :: Ptr RedlandQueryResults + -- ^ results + -> CInt + -- ^ offset + -> IO (Ptr RedlandNode) +foreign import ccall "librdf_query_results_get_binding_name" + librdf_query_results_get_binding_name + :: Ptr RedlandQueryResults + -- ^ results + -> CInt + -- ^ offset + -> IO CString +foreign import ccall "librdf_query_results_get_binding_value_by_name" + librdf_query_results_get_binding_value_by_name + :: Ptr RedlandQueryResults + -- ^ results + -> CString + -- ^ variable name + -> IO (Ptr RedlandNode) +foreign import ccall "librdf_query_results_get_bindings_count" + librdf_query_results_get_bindings_count :: Ptr RedlandQueryResults -> IO CInt + + +-- * RDF Triple (librdf_statement) + +data RedlandStatement + +foreign import ccall "librdf_new_statement" + librdf_new_statement :: Ptr RedlandWorld -> IO (Ptr RedlandStatement) +foreign import ccall "librdf_free_statement" + librdf_free_statement :: Ptr RedlandStatement -> IO () +foreign import ccall "redland.h &librdf_free_statement" + p_librdf_free_statement :: FinalizerPtr RedlandStatement + + +-- * Triple stores + +data RedlandStorage + +foreign import ccall "librdf_new_storage" + librdf_new_storage + :: Ptr RedlandWorld + -- ^ world + -> CString + -- ^ storage type name (e.g., "hashes") + -> CString + -- ^ storage identifier + -> CString + -- ^ options + -> IO (Ptr RedlandStorage) +foreign import ccall "librdf_free_storage" + librdf_free_storage :: Ptr RedlandStorage -> IO () +foreign import ccall "redland.h &librdf_free_storage" + p_librdf_free_storage :: FinalizerPtr RedlandStorage + +foreign import ccall "librdf_new_storage_with_options" + librdf_new_storage_with_options + :: Ptr RedlandWorld + -- ^ world + -> CString + -- ^ storage type name (e.g., "hashes") + -> CString + -- ^ storage identifier + -> Ptr RedlandHash + -- ^ options + -> IO (Ptr RedlandStorage) + + +-- * Stream of triples (librdf_statement) + +data RedlandStream + +foreign import ccall "librdf_free_stream" + librdf_free_stream :: Ptr RedlandStream -> IO () +foreign import ccall "redland.h &librdf_free_stream" + p_librdf_free_stream :: FinalizerPtr RedlandStream + + +-- * URI + +data RedlandURI + +foreign import ccall "librdf_new_uri" + librdf_new_uri + :: Ptr RedlandWorld + -- ^ world + -> CString + -- ^ URI string + -> IO (Ptr RedlandURI) +foreign import ccall "librdf_free_uri" + librdf_free_uri :: Ptr RedlandURI -> IO () +foreign import ccall "redland.h &librdf_free_uri" + p_librdf_free_uri :: FinalizerPtr RedlandURI + +foreign import ccall "librdf_new_uri_from_uri" + librdf_new_uri_from_uri + :: Ptr RedlandURI + -- ^ old URI + -> IO (Ptr RedlandURI) +foreign import ccall "librdf_uri_as_string" + librdf_uri_as_string :: Ptr RedlandURI -> IO CString diff --git a/Redland/MidLevel.hs b/Redland/MidLevel.hs new file mode 100644 index 0000000..f8aa546 --- /dev/null +++ b/Redland/MidLevel.hs @@ -0,0 +1,491 @@ +{- | +Module : Redland.MidLevel +Maintainer : defanor +Stability : unstable +Portability : non-portable (GHC extensions are used) + +Mid-level +bindings: using Haskell naming conventions, common Haskell types, +'ForeignPtr' with finalizers, exceptions. Closely follows the original +API otherwise. + +-} + +module Redland.MidLevel where + +import Foreign +import Foreign.C +import Control.Exception + +import Redland.LowLevel + +-- * Exceptions + +data RedlandException = InitializationException + -- ^ Happens when an initializer returns NULL. + -- Gets thrown by 'initialize'. + | OperationException Int + -- ^ Happens on non-zero return value where a + -- zero is expected. Gets thrown by 'perform'. + | StringOperationException + -- ^ Gets thrown by 'justCString' and + -- 'justSharedCString'. + | ParseFailure + deriving Show + +instance Exception RedlandException + + +-- * FFI utility functions + +-- todo: move these into a separate module? + +type Initializer a = IO (ForeignPtr a) + +-- | Initializes a Redland object, throws 'InitializationException' on +-- failure (i.e., if NULL is returned). +initialize :: IO (Ptr a) -> FinalizerPtr a -> Initializer a +initialize i f = do + p <- i + if p == nullPtr + then throw InitializationException + else newForeignPtr f p + +-- | Performs an operation, throws 'OperationException' on failure +-- (i.e., on non-zero return value). +perform :: IO CInt -> IO () +perform a = do + r <- fromIntegral <$> a + if r == 0 + then pure () + else throw (OperationException r) + +-- | 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 + +-- | An abstraction to use with 'withCString' and 'withForeignPtr'. +withNullablePtr :: (a -> (Ptr b -> c) -> c) -> Maybe a -> (Ptr b -> c) -> c +withNullablePtr _ Nothing a = a nullPtr +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 + | cStr == nullPtr = pure Nothing + | otherwise = do + r <- peekCString cStr + free cStr + pure $ pure r + +-- | Like 'maybeCString', but requires a string to be there, and +-- throws 'StringOperationException' if it isn't. +justCString :: CString -> IO String +justCString cStr = do + r <- justSharedCString cStr + free cStr + pure r + +-- | Like 'justCString', but doesn't 'free' the C string. +justSharedCString :: CString -> IO String +justSharedCString cStr + | cStr == nullPtr = throw StringOperationException + | otherwise = peekCString cStr + + +-- * World + +-- not calling librdf_world_open +redlandWorld :: Initializer RedlandWorld +redlandWorld = initialize librdf_new_world p_librdf_free_world + + +-- * Hashes + +redlandHash :: ForeignPtr RedlandWorld + -- ^ world + -> String + -- ^ hash factory name (e.g., "memory") + -> Initializer RedlandHash +redlandHash world name = + withForeignPtr world $ \world' -> + withCString name $ \name' -> + initialize (librdf_new_hash world' name') p_librdf_free_hash + +hashPutStrings :: ForeignPtr RedlandHash + -- ^ hash + -> String + -- ^ key + -> String + -- ^ value + -> IO () +hashPutStrings hash key value = + withForeignPtr hash $ \hash' -> + withCString key $ \key' -> + withCString value $ \value' -> + perform $ librdf_hash_put_strings hash' key' value' + +hashGet :: ForeignPtr RedlandHash + -- ^ hash + -> String + -- ^ key + -> IO (Maybe String) +hashGet hash key = + withForeignPtr hash $ \hash' -> + withCString key $ \key' -> + librdf_hash_get hash' key' >>= maybeCString + +hashGetDel :: ForeignPtr RedlandHash + -- ^ hash + -> String + -- ^ key + -> IO (Maybe String) +hashGetDel hash key = + withForeignPtr hash $ \hash' -> + withCString key $ \key' -> + librdf_hash_get_del hash' key' >>= maybeCString + + +-- * RDF Graph (librdf_model) + +redlandModel :: ForeignPtr RedlandWorld + -- ^ world + -> ForeignPtr RedlandStorage + -- ^ storage + -> String + -- ^ options + -> Initializer RedlandModel + -- ^ model +redlandModel world storage opt = + withForeignPtr world $ \world' -> + withForeignPtr storage $ \storage' -> + withCString opt $ \opt' -> + initialize (librdf_new_model world' storage' opt') p_librdf_free_model + +-- | Acts as a 'RedlandQueryResults' initializer. +modelQueryExecute :: ForeignPtr RedlandModel + -> ForeignPtr RedlandQuery + -> Initializer RedlandQueryResults +modelQueryExecute model query = + withForeignPtr model $ \model' -> + withForeignPtr query $ \query' -> + initialize (librdf_model_query_execute model' query') + p_librdf_free_query_results + +-- | Acts as a 'RedlandStream' initializer. +modelFindStatements :: ForeignPtr RedlandModel + -> ForeignPtr RedlandStatement + -> Initializer RedlandStream +modelFindStatements model statement = + withForeignPtr model $ \model' -> + withForeignPtr statement $ \statement' -> + initialize (librdf_model_find_statements model' statement') + p_librdf_free_stream + +modelSync :: ForeignPtr RedlandModel -> IO () +modelSync model = + withForeignPtr model $ \model' -> + perform $ librdf_model_sync model' + +modelLoad :: ForeignPtr RedlandModel + -> ForeignPtr RedlandURI + -- ^ source URI + -> Maybe String + -- ^ parser name + -> Maybe String + -- ^ MIME type + -> Maybe (ForeignPtr RedlandURI) + -- ^ type URI + -> IO () +modelLoad model source parser mime tURI = + withForeignPtr model $ \model' -> + withForeignPtr source $ \source' -> + withNullablePtr withCString parser $ \parser' -> + withNullablePtr withCString mime $ \mime' -> + withNullablePtr withForeignPtr tURI $ \tURI' -> + perform $ librdf_model_load model' source' parser' mime' tURI' + +-- * RDF term (librdf_node) + +redlandNode :: ForeignPtr RedlandWorld -> Initializer RedlandNode +redlandNode world = + withForeignPtr world $ \world' -> + initialize (librdf_new_node world') p_librdf_free_node + +nodeFromBlankIdentifier :: ForeignPtr RedlandWorld + -> Maybe String + -> Initializer RedlandNode +nodeFromBlankIdentifier world identifier = + withForeignPtr world $ \world' -> + withNullablePtr withCString identifier $ \identifier' -> + initialize (librdf_new_node_from_blank_identifier world' identifier') + p_librdf_free_node + +nodeFromLiteral :: ForeignPtr RedlandWorld + -> String + -> Maybe String + -> Bool + -> Initializer RedlandNode +nodeFromLiteral world val xmlLang isXML = + withForeignPtr world $ \world' -> + withCString val $ \val' -> + withNullablePtr withCString xmlLang $ \xmlLang' -> + let isXML' = if isXML then 1 else 0 in + initialize (librdf_new_node_from_literal world' val' xmlLang' isXML') + p_librdf_free_node + +nodeFromTypedLiteral :: ForeignPtr RedlandWorld + -> String + -> Maybe String + -> Maybe (ForeignPtr RedlandURI) + -> Initializer RedlandNode +nodeFromTypedLiteral world val xmlLang litType = + 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') + p_librdf_free_node + +nodeFromURI :: ForeignPtr RedlandWorld + -> ForeignPtr RedlandURI + -> Initializer RedlandNode +nodeFromURI world uri = + withForeignPtr world $ \world' -> + withForeignPtr uri $ \uri' -> + initialize (librdf_new_node_from_uri world' uri') + p_librdf_free_node + +nodeFromURIString :: ForeignPtr RedlandWorld + -> String + -> Initializer RedlandNode +nodeFromURIString world uriStr = + withForeignPtr world $ \world' -> + withCString uriStr $ \uriStr' -> + initialize (librdf_new_node_from_uri_string world' uriStr') + p_librdf_free_node + +nodeGetBlankIdentifier :: ForeignPtr RedlandNode -> IO String +nodeGetBlankIdentifier node = + withForeignPtr node $ \node' -> + librdf_node_get_blank_identifier node' >>= justSharedCString + +nodeGetLiteralValue :: ForeignPtr RedlandNode -> IO String +nodeGetLiteralValue node = + withForeignPtr node $ \node' -> + librdf_node_get_literal_value node' >>= justSharedCString + +nodeGetURI :: ForeignPtr RedlandNode -> Initializer RedlandURI +nodeGetURI node = + withForeignPtr node $ \node' -> do + oldURI <- librdf_node_get_uri node' + initialize (librdf_new_uri_from_uri oldURI) p_librdf_free_uri + +nodeIsBlank :: ForeignPtr RedlandNode -> IO Bool +nodeIsBlank node = + withForeignPtr node $ fmap (/= 0) . librdf_node_is_blank + +nodeIsLiteral :: ForeignPtr RedlandNode -> IO Bool +nodeIsLiteral node = + withForeignPtr node $ fmap (/= 0) . librdf_node_is_literal + +nodeIsResource :: ForeignPtr RedlandNode -> IO Bool +nodeIsResource node = + withForeignPtr node $ fmap (/= 0) . librdf_node_is_resource + +nodeToString :: ForeignPtr RedlandNode -> IO String +nodeToString node = + withForeignPtr node $ \node' -> + librdf_node_to_string node' >>= justCString + + +-- * Parsers + +redlandParser :: ForeignPtr RedlandWorld + -- ^ world + -> Maybe String + -- ^ parser name (e.g., "rdfxml", "turtle") + -> Maybe String + -- ^ MIME type + -> Maybe (ForeignPtr RedlandURI) + -- ^ type URI + -> Initializer RedlandParser +redlandParser world name mimeType uri = + withForeignPtr world $ \world' -> + withNullablePtr withCString name $ \name' -> + withNullablePtr withCString mimeType $ \mimeType' -> + withNullablePtr withForeignPtr uri $ \uri' -> + initialize (librdf_new_parser world' name' mimeType' uri') + p_librdf_free_parser + +parseStringIntoModel :: ForeignPtr RedlandParser + -- ^ parser + -> String + -- ^ string to parse + -> ForeignPtr RedlandURI + -- ^ base URI + -> ForeignPtr RedlandModel + -- ^ model + -> IO () +parseStringIntoModel parser str uri model = + withForeignPtr parser $ \parser' -> + withCString str $ \str' -> + withForeignPtr uri $ \uri' -> + withForeignPtr model $ \model' -> + perform $ librdf_parser_parse_string_into_model parser' str' uri' model' + + +-- * Querying + +redlandQuery :: ForeignPtr RedlandWorld + -> String + -- ^ language name + -> Maybe (ForeignPtr RedlandURI) + -- ^ language URI + -> String + -- ^ query string + -> Maybe (ForeignPtr RedlandURI) + -- ^ base URI + -> Initializer RedlandQuery +redlandQuery world lang langURI query baseURI = + withForeignPtr world $ \world' -> + withCString lang $ \lang' -> + withNullablePtr withForeignPtr langURI $ \langURI' -> + withCString query $ \query' -> + withNullablePtr withForeignPtr baseURI $ \baseURI' -> + initialize (librdf_new_query world' lang' langURI' query' baseURI') + p_librdf_free_query + + +-- * Query results + +queryResultsGetCount :: ForeignPtr RedlandQueryResults -> IO Int +queryResultsGetCount results = + withForeignPtr results $ \results' -> + fromIntegral <$> librdf_query_results_get_count results' + +queryResultsNext :: ForeignPtr RedlandQueryResults -> IO Bool +queryResultsNext results = + withForeignPtr results $ \results' -> + (== 0) <$> librdf_query_results_next results' + +queryResultsFinished :: ForeignPtr RedlandQueryResults -> IO Bool +queryResultsFinished results = + withForeignPtr results $ \results' -> + (/= 0) <$> librdf_query_results_finished results' + +-- | Acts as a 'RedlandNode' initializer. +queryResultsGetBindingValue :: ForeignPtr RedlandQueryResults + -> Int + -> Initializer RedlandNode +queryResultsGetBindingValue results offset = + withForeignPtr results $ \results' -> + initialize + (librdf_query_results_get_binding_value results' (fromIntegral offset)) + p_librdf_free_node + +queryResultsGetBindingName :: ForeignPtr RedlandQueryResults + -> Int + -> IO String +queryResultsGetBindingName results offset = + withForeignPtr results $ \results' -> + librdf_query_results_get_binding_name results' (fromIntegral offset) + >>= justSharedCString + +-- | Acts as a 'RedlandNode' initializer. +queryResultsGetBindingValueByName :: ForeignPtr RedlandQueryResults + -> String + -> Initializer RedlandNode +queryResultsGetBindingValueByName results name = + withForeignPtr results $ \results' -> + withCString name $ \name' -> + initialize + (librdf_query_results_get_binding_value_by_name results' name') + p_librdf_free_node + +queryResultsGetBindingsCount :: ForeignPtr RedlandQueryResults + -> IO Int +queryResultsGetBindingsCount results = + withForeignPtr results $ \results' -> + fromIntegral <$> librdf_query_results_get_bindings_count results' + +-- | Acts as a 'RedlandQueryResults' initializer. +queryExecute :: ForeignPtr RedlandQuery + -> ForeignPtr RedlandModel + -> Initializer RedlandQueryResults +queryExecute query model = + withForeignPtr query $ \query' -> + withForeignPtr model $ \model' -> + initialize (librdf_query_execute query' model') p_librdf_free_query_results + + +-- * RDF Triple (librdf_statement) + +redlandStatement :: ForeignPtr RedlandWorld -> Initializer RedlandStatement +redlandStatement world = + withForeignPtr world $ \world' -> + initialize (librdf_new_statement world') p_librdf_free_statement + + +-- * Triple stores + +redlandStorage :: ForeignPtr RedlandWorld + -- ^ world + -> String + -- ^ storage type name ("hashes", "memory", "file", + -- etc) + -> String + -- ^ storage identifier + -> String + -- ^ options + -> Initializer RedlandStorage +redlandStorage world sname name opt = + withForeignPtr world $ \world' -> + withCString sname $ \sname' -> + withCString name $ \name' -> + withCString opt $ \opt' -> + initialize (librdf_new_storage world' sname' name' opt') + p_librdf_free_storage + +redlandStorageWithOptions :: ForeignPtr RedlandWorld + -- ^ world + -> String + -- ^ storage type name ("hashes", "memory", + -- "file", etc) + -> String + -- ^ storage identifier + -> ForeignPtr RedlandHash + -- ^ options + -> Initializer RedlandStorage +redlandStorageWithOptions world sname name opt = + withForeignPtr world $ \world' -> + withCString sname $ \sname' -> + withCString name $ \name' -> + withForeignPtr opt $ \opt' -> + initialize (librdf_new_storage_with_options world' sname' name' opt') + p_librdf_free_storage + + +-- * URI + +redlandURI :: ForeignPtr RedlandWorld + -- ^ world + -> String + -- ^ URI string + -> Initializer RedlandURI +redlandURI world uriStr = + withForeignPtr world $ \world' -> + withCString uriStr $ \uriStr' -> + initialize (librdf_new_uri world' uriStr') p_librdf_free_uri + +uriFromURI :: ForeignPtr RedlandURI -> Initializer RedlandURI +uriFromURI uri = + withForeignPtr uri $ \uri' -> + initialize (librdf_new_uri_from_uri uri') p_librdf_free_uri + +uriAsString :: ForeignPtr RedlandURI -> IO String +uriAsString uri = + withForeignPtr uri $ \uri' -> + librdf_uri_as_string uri' >>= justSharedCString diff --git a/Redland/Util.hs b/Redland/Util.hs new file mode 100644 index 0000000..0472dde --- /dev/null +++ b/Redland/Util.hs @@ -0,0 +1,140 @@ +{- | +Module : Redland.Util +Maintainer : defanor +Stability : unstable +Portability : non-portable (GHC extensions are used) + +Utility functions based on mid-level bindings. + +-} + +module Redland.Util where + +import Foreign +import Control.Exception + +import Redland.LowLevel +import Redland.MidLevel + + +-- * Hashes + +withHash :: ForeignPtr RedlandWorld + -> String + -> [(String, String)] + -> (ForeignPtr RedlandHash -> IO a) + -> IO a +withHash world factory l f = + withNew (redlandHash world factory) $ \hash -> do + mapM_ (uncurry (hashPutStrings hash)) l + f hash + + +-- * RDF term (librdf_node) + +data Node = BlankNode String + | LiteralNode String + | ResourceNode String + deriving (Eq, Show) + +redlandNodeToNode :: ForeignPtr RedlandNode -> IO Node +redlandNodeToNode rn = do + isBlank <- nodeIsBlank rn + isLiteral <- nodeIsLiteral rn + isResource <- nodeIsResource rn + case (isBlank, isLiteral, isResource) of + (True, _, _) -> BlankNode <$> nodeGetBlankIdentifier rn + (_, True, _) -> LiteralNode <$> nodeGetLiteralValue rn + _ -> ResourceNode <$> (nodeGetURI rn >>= uriAsString) + + +-- * 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 + + +-- * Querying + +withQuery :: ForeignPtr RedlandWorld + -> ForeignPtr RedlandModel + -> String + -- ^ query language + -> String + -- ^ query string + -> Maybe (ForeignPtr RedlandURI) + -- ^ base URI + -> (QueryResults -> IO a) + -> 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 + + +-- * Query results + +type QueryResults = [[(String, Node)]] + +queryResultsToList :: ForeignPtr RedlandQueryResults -> IO QueryResults +queryResultsToList qr = do + done <- queryResultsFinished qr + if done + then pure [] + else do + bindingCnt <- queryResultsGetBindingsCount qr + bindings <- mapM readBinding [0..bindingCnt - 1] + next <- queryResultsNext qr + rest <- if next then queryResultsToList qr else pure [] + pure (bindings : rest) + where + readBinding :: Int -> IO (String, Node) + readBinding n = do + name <- queryResultsGetBindingName qr n + val <- queryResultsGetBindingValue qr n >>= redlandNodeToNode + pure (name, val) + + +-- * Other + +-- | 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 +withWSMU sFactory sOpt sIdent mOpt bURI f = + withNew redlandWorld $ \world -> + withHash world "memory" sOpt $ \sOpt' -> + withNew (redlandStorageWithOptions world sFactory sIdent sOpt') $ \storage -> + withNew (redlandModel world storage mOpt) $ \model -> + withNew (redlandURI world bURI) $ \uri -> + f world storage model uri -- cgit v1.2.3