{-| 
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
, fromAcquire
, fromAcquireMay
, 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)

-- | 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 :: forall a. Acquire a -> IO a
fromAcquire Acquire a
a = ResourceT IO a -> IO a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO a -> IO a) -> ResourceT IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    (ReleaseKey
releaseKey, a
v) <- Acquire a -> ResourceT IO (ReleaseKey, a)
forall (m :: * -> *) a.
MonadResource m =>
Acquire a -> m (ReleaseKey, a)
allocateAcquire Acquire a
a
    IO ()
release <- IO () -> Maybe (IO ()) -> IO ()
forall a. a -> Maybe a -> a
fromMaybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Maybe (IO ()) -> IO ())
-> ResourceT IO (Maybe (IO ())) -> ResourceT IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReleaseKey -> ResourceT IO (Maybe (IO ()))
forall (m :: * -> *). MonadIO m => ReleaseKey -> m (Maybe (IO ()))
unprotect ReleaseKey
releaseKey
    IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ a -> IO () -> IO ()
forall key. key -> IO () -> IO ()
addFinalizer a
v IO ()
release
    a -> ResourceT IO a
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v

    
-- | variant of `fromAcquire` which registers the finalizer on the _value_ in a `Maybe` 
-- as opposed to the maybe 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
fromAcquireMay :: Acquire (Maybe a) -> IO (Maybe a) 
fromAcquireMay :: forall a. Acquire (Maybe a) -> IO (Maybe a)
fromAcquireMay Acquire (Maybe a)
a = ResourceT IO (Maybe a) -> IO (Maybe a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (Maybe a) -> IO (Maybe a))
-> ResourceT IO (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
    (ReleaseKey
releaseKey, Maybe a
v) <- Acquire (Maybe a) -> ResourceT IO (ReleaseKey, Maybe a)
forall (m :: * -> *) a.
MonadResource m =>
Acquire a -> m (ReleaseKey, a)
allocateAcquire Acquire (Maybe a)
a
    IO ()
release <- IO () -> Maybe (IO ()) -> IO ()
forall a. a -> Maybe a -> a
fromMaybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Maybe (IO ()) -> IO ())
-> ResourceT IO (Maybe (IO ())) -> ResourceT IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReleaseKey -> ResourceT IO (Maybe (IO ()))
forall (m :: * -> *). MonadIO m => ReleaseKey -> m (Maybe (IO ()))
unprotect ReleaseKey
releaseKey
    case Maybe a
v of
        Maybe a
Nothing -> IO (Maybe a) -> ResourceT IO (Maybe a)
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> ResourceT IO (Maybe a))
-> IO (Maybe a) -> ResourceT IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a
forall a. Maybe a
Nothing Maybe a -> IO () -> IO (Maybe a)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IO ()
release
        Just a
v' -> do
            IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ a -> IO () -> IO ()
forall key. key -> IO () -> IO ()
addFinalizer a
v' IO ()
release
            Maybe a -> ResourceT IO (Maybe a)
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> ResourceT IO (Maybe a))
-> (a -> Maybe a) -> a -> ResourceT IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> ResourceT IO (Maybe a)) -> a -> ResourceT IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a
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 :: forall a. Acquire a -> a
unsafeFromAcquire = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> (Acquire a -> IO a) -> Acquire a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acquire a -> IO a
forall a. Acquire a -> IO a
fromAcquire

-- | 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 :: forall a. a -> Acquire a
toAcquire a
value = IO a -> (a -> IO ()) -> Acquire a
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value) a -> IO ()
forall (m :: * -> *) a. PrimMonad m => a -> m ()
touch