summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2018-04-29 13:09:40 +0300
committerdefanor <defanor@uberspace.net>2018-04-29 13:09:40 +0300
commitc74a06e761c3a4616a92fd4d3ad0ac9edb97e06c (patch)
tree945ed71395959dd70589f1f291d6a82dc735287a
parentf9d699facc2a48022d44a67b6ef8eb76a6ca1233 (diff)
Introduce InitializerMaybe, initializeMaybe, withNewMaybeHEADmaster
So that it's easier to use it safely: apparently the recently found segfault was caused by improper order of freeing the resources, while withNew/withNewMaybe help to ensure the correct order.
-rw-r--r--Redland/MidLevel.hs32
-rw-r--r--Redland/Util.hs12
-rw-r--r--redland.cabal2
3 files changed, 28 insertions, 18 deletions
diff --git a/Redland/MidLevel.hs b/Redland/MidLevel.hs
index e9f1993..8dd463f 100644
--- a/Redland/MidLevel.hs
+++ b/Redland/MidLevel.hs
@@ -44,6 +44,7 @@ instance Exception RedlandException
-- todo: move these into a separate module?
type Initializer a = IO (ForeignPtr a)
+type InitializerMaybe a = IO (Maybe (ForeignPtr a))
-- | Initializes a Redland object, throws 'InitializationException' on
-- failure (i.e., if NULL is returned).
@@ -54,6 +55,15 @@ initialize i f = do
then throw InitializationException
else newForeignPtr f p
+-- | Initializes a Redland object, returns 'Nothing' on failure (i.e.,
+-- if NULL is returned).
+initializeMaybe :: IO (Ptr a) -> FinalizerPtr a -> InitializerMaybe a
+initializeMaybe i f = do
+ p <- i
+ if p == nullPtr
+ then pure Nothing
+ else Just <$> newForeignPtr f p
+
-- | Performs an operation, throws 'OperationException' on failure
-- (i.e., on non-zero return value).
perform :: IO CInt -> IO ()
@@ -68,6 +78,17 @@ perform a = do
withNew :: Initializer a -> (ForeignPtr a -> IO b) -> IO b
withNew i = bracket i finalizeForeignPtr
+-- | Same as 'withNew', but for 'InitializerMaybe'.
+withNewMaybe :: InitializerMaybe a -> (ForeignPtr a -> IO b) -> IO (Maybe b)
+withNewMaybe i f = do
+ mfptr <- i
+ case mfptr of
+ Nothing -> pure Nothing
+ Just fptr -> do
+ ret <- f fptr
+ finalizeForeignPtr fptr
+ pure $ Just ret
+
-- | 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
@@ -489,14 +510,11 @@ statementFromNodes world subject predicate object =
-- | An abstraction used for getting statement components.
statementGet :: (Ptr RedlandStatement -> IO (Ptr RedlandNode))
-> ForeignPtr RedlandStatement
- -> IO (Maybe (ForeignPtr RedlandNode))
+ -> InitializerMaybe 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
+ initializeMaybe (librdf_new_node_from_node oldNode) p_librdf_free_node
-- | An abstraction used for setting statement components.
statementSet :: (Ptr RedlandStatement -> Ptr RedlandNode -> IO ())
@@ -512,7 +530,7 @@ statementSet f statement node =
f statement' nodeCopy
statementGetSubject :: ForeignPtr RedlandStatement
- -> IO (Maybe (ForeignPtr RedlandNode))
+ -> InitializerMaybe RedlandNode
statementGetSubject = statementGet librdf_statement_get_subject
statementSetSubject :: ForeignPtr RedlandStatement
@@ -521,7 +539,7 @@ statementSetSubject :: ForeignPtr RedlandStatement
statementSetSubject = statementSet librdf_statement_set_subject
statementGetPredicate :: ForeignPtr RedlandStatement
- -> IO (Maybe (ForeignPtr RedlandNode))
+ -> InitializerMaybe RedlandNode
statementGetPredicate = statementGet librdf_statement_get_predicate
statementSetPredicate :: ForeignPtr RedlandStatement
diff --git a/Redland/Util.hs b/Redland/Util.hs
index c7862be..0c294ab 100644
--- a/Redland/Util.hs
+++ b/Redland/Util.hs
@@ -181,17 +181,9 @@ statementToTriple statement = do
pure $ Triple s p o
where
componentToTriple :: (ForeignPtr RedlandStatement ->
- IO (Maybe (ForeignPtr RedlandNode)))
+ InitializerMaybe RedlandNode)
-> IO (Maybe Node)
- componentToTriple f = do
- c <- f statement
- case c of
- Just c' -> do
- n <- redlandNodeToNode c'
- -- segfaulting without finalization here, not sure why.
- finalizeForeignPtr c'
- pure $ Just n
- Nothing -> pure Nothing
+ componentToTriple f = withNewMaybe (f statement) redlandNodeToNode
-- | A conversion function.
tripleToStatement :: ForeignPtr RedlandWorld
diff --git a/redland.cabal b/redland.cabal
index 982dfd4..8e11ef1 100644
--- a/redland.cabal
+++ b/redland.cabal
@@ -1,5 +1,5 @@
name: redland
-version: 0.2.0.2
+version: 0.2.0.3
synopsis: Redland RDF library bindings
description: This package provides low-level and mid-level
Redland RDF library bindings, as well as some