Finalizers.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-| 
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
, unsafeFromAcquireWithCatch
, 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)
import Control.Exception (try)
import Control.Arrow (left)
import OpenCascade.Internal.Exception (OpenCascadeException)
import Waterfall.Error (WaterfallError (..))

-- | 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 returns a `WaterfallError` if the action throws
{-# NOINLINE unsafeFromAcquireWithCatch #-}
unsafeFromAcquireWithCatch :: Acquire a -> Either WaterfallError a
unsafeFromAcquireWithCatch = 
    left WaterfallError . unsafePerformIO . try . 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