From c74a06e761c3a4616a92fd4d3ad0ac9edb97e06c Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Sun, 29 Apr 2018 13:09:40 +0300
Subject: Introduce InitializerMaybe, initializeMaybe, withNewMaybe

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.
---
 Redland/MidLevel.hs | 32 +++++++++++++++++++++++++-------
 Redland/Util.hs     | 12 ++----------
 redland.cabal       |  2 +-
 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
-- 
cgit v1.2.3