diff options
Diffstat (limited to 'Redland')
| -rw-r--r-- | Redland/MidLevel.hs | 32 | ||||
| -rw-r--r-- | Redland/Util.hs | 12 |
2 files changed, 27 insertions, 17 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 |