croaring-ffi-1.0: src/Data/Bitmap/Roaring/FFI/Callback.hs

-- | Running Haskell functions as CRoaring iteration callbacks without leaking the function pointer or unwinding an exception through C.
module Data.Bitmap.Roaring.FFI.Callback (with) where

import Control.Exception (SomeException, bracket, catch, evaluate, throwIO)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Foreign.Ptr (FunPtr, Ptr, freeHaskellFunPtr)

-- | An exception from the visiting function stops the iteration as if it had returned 'False', and is rethrown once the iteration has returned.
with
  :: ((element -> Ptr () -> IO Bool) -> IO (FunPtr (element -> Ptr () -> IO Bool)))
  -> (element -> IO Bool)
  -> (FunPtr (element -> Ptr () -> IO Bool) -> IO Bool)
  -> IO Bool
with wrap visit run = do
  failure <- newIORef Nothing
  completed <- bracket (wrap $ callback failure) freeHaskellFunPtr run
  readIORef failure >>= maybe (pure completed) throwIO
  where
    callback failure element _ = (visit element >>= evaluate) `catch` stop failure
    stop :: IORef (Maybe SomeException) -> SomeException -> IO Bool
    stop failure exception = False <$ writeIORef failure (Just exception)