{-| Module: Waterfall.Internal.Finalizers These functions exist because the underlying `opencascade-hs` library, makes heavy use of `Data.Acquire` from `resourcet` to handle memory management. However `waterfall-cad` does not (at the highest level) keep values in the `Acquire` monad. (This is required to support functions like `Waterfall.Solids.volume`, which return pure Haskell primitives.) -} module Waterfall.Internal.Finalizers ( unsafeFromAcquire , unsafeFromAcquireT , fromAcquire , fromAcquireT , toAcquire ) where import System.IO.Unsafe (unsafePerformIO) import Control.Monad.Trans.Resource (runResourceT, unprotect) import Data.Acquire (Acquire, mkAcquire, allocateAcquire) import System.Mem.Weak (addFinalizer) import Control.Monad.Primitive (touch) import Control.Monad.IO.Class (liftIO) import Data.Maybe (fromMaybe) import Control.Monad (forM, when) import Data.IORef (newIORef, atomicModifyIORef) -- | Convert a resource in the `Data.Acquire.Acquire` monad to a value in IO -- the `free` action of the resource is called when the underlying value goes out of scope of the Haskell garbage collection -- so may run at an unpredictable time. fromAcquire :: Acquire a -> IO a fromAcquire a = runResourceT $ do (releaseKey, v) <- allocateAcquire a release <- fromMaybe (pure ()) <$> unprotect releaseKey liftIO $ addFinalizer v release return v -- | variant of `fromAcquire` which registers the finalizer on the _value_ in a container -- as opposed to the container itself -- this is useful for wrapping IO actions that return the type `IO (Maybe a)` where the `Maybe` will often be finalized well before the value -- or `IO [a]` where the List will be finalized first fromAcquireT :: Traversable f => Acquire (f a) -> IO (f a) fromAcquireT a = runResourceT $ do (releaseKey, v) <- allocateAcquire a release <- fromMaybe (pure ()) <$> unprotect releaseKey ref <- liftIO $ newIORef (length v) let finalize = do isLast <- atomicModifyIORef ref (\count -> (count - 1, count == 1)) when isLast release forM v $ \v' -> do liftIO $ addFinalizer v' finalize return v' -- | Converting to a value in the `Data.Acquire.Acquire` monad, to a raw value. -- Analagous to calling `unsafePerformIO` to extract a value in the `IO` monad. -- The same constraints as apply to `unsafePerformIO` apply to this method. -- That is, it should only be used on "philosophically pure" actions. -- -- The `free` action of the resource is called when the underlying value goes out of scope of the Haskell garbage collection, -- so may run at an unpredictable time. {-# NOINLINE unsafeFromAcquire #-} unsafeFromAcquire :: Acquire a -> a unsafeFromAcquire = unsafePerformIO . fromAcquire -- | Version of `unsafeFromAcquire` which registers the finalizer on the _value_ in a container {-# NOINLINE unsafeFromAcquireT #-} unsafeFromAcquireT :: (Traversable t) => Acquire (t a) -> t a unsafeFromAcquireT = unsafePerformIO . fromAcquireT -- | Add a pure value (which may or may not have been generated by `unsafeFromAcquire`) back into the Acquire monad. -- Using this action _should_ prevent the underlying value from going out of GC scope untill the resource is freed. toAcquire :: a -> Acquire a toAcquire value = mkAcquire (pure value) touch