summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2018-02-21 18:36:52 +0300
committerdefanor <defanor@uberspace.net>2018-02-21 18:36:52 +0300
commitb52e6bf3822150fbca9a6aadd3ce73dcdf7ed0ad (patch)
tree5a095150a93cb21957984004c975232d0bf1e1cd
downloadredland-b52e6bf3822150fbca9a6aadd3ce73dcdf7ed0ad.zip
redland-b52e6bf3822150fbca9a6aadd3ce73dcdf7ed0ad.tar.gz
redland-b52e6bf3822150fbca9a6aadd3ce73dcdf7ed0ad.tar.bz2
Initial commit
The bindings are incomplete, but usable at this point.
-rw-r--r--ChangeLog.md5
-rw-r--r--LICENSE30
-rw-r--r--Redland.hs4
-rw-r--r--Redland/LowLevel.hs382
-rw-r--r--Redland/MidLevel.hs491
-rw-r--r--Redland/Util.hs140
-rw-r--r--redland.cabal24
7 files changed, 1076 insertions, 0 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..6c1f9b9
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,5 @@
+# Revision history for redland
+
+## 0.1.0.0 -- 2018-02-20
+
+* ChangeLog is introduced.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..710a3ab
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2018, defanor
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of defanor nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Redland.hs b/Redland.hs
new file mode 100644
index 0000000..397da47
--- /dev/null
+++ b/Redland.hs
@@ -0,0 +1,4 @@
+module Redland where
+
+import Redland.MidLevel
+import Redland.Util
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 <defanor@uberspace.net>
+Stability : unstable
+Portability : non-portable (GHC extensions are used)
+
+Low-level <http://librdf.org/docs/api/index.html Redland RDF library>
+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 <defanor@uberspace.net>
+Stability : unstable
+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.
+
+-}
+
+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 <defanor@uberspace.net>
+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
diff --git a/redland.cabal b/redland.cabal
new file mode 100644
index 0000000..7f44cd2
--- /dev/null
+++ b/redland.cabal
@@ -0,0 +1,24 @@
+name: redland
+version: 0.1.0.0
+synopsis: Redland RDF library bindings
+description: Redland RDF library bindings
+license: BSD3
+license-file: LICENSE
+author: defanor
+maintainer: defanor@uberspace.net
+category: Database
+build-type: Simple
+extra-source-files: ChangeLog.md
+cabal-version: >=1.10
+
+library
+ exposed-modules: Redland
+ , Redland.LowLevel
+ , Redland.MidLevel
+ , Redland.Util
+ other-extensions: ForeignFunctionInterface
+ build-depends: base >=4.9 && <5
+ default-language: Haskell2010
+ pkgconfig-depends: raptor2, redland
+ build-tools: hsc2hs
+ ghc-options: -Wall