-- | Memory management utilities.
module Hercules.CNix.Memory
  ( -- * Free after use
    Delete (..),
    withDelete,

    -- * Free on GC
    Finalizer (..),
    toForeignPtr,

    -- * Nullable pointers
    forNonNull,
    traverseNonNull,
  )
where

import Foreign (FinalizerPtr, ForeignPtr, newForeignPtr, nullPtr)
import Protolude

-- | Types whose memory / resources can be freed in a consistent way.
class Delete a where
  delete :: Ptr a -> IO ()

-- | Obtain a pointer to a resource and run an action with it.
withDelete :: (Delete a) => IO (Ptr a) -> (Ptr a -> IO b) -> IO b
withDelete :: forall a b. Delete a => IO (Ptr a) -> (Ptr a -> IO b) -> IO b
withDelete IO (Ptr a)
make = IO (Ptr a) -> (Ptr a -> IO ()) -> (Ptr a -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr a)
make Ptr a -> IO ()
forall a. Delete a => Ptr a -> IO ()
delete

-- | Like 'Delete', but the design of finalizers favors that we implement it
-- by means of a function pointer instead of a Haskell function. That way, it
-- can be run during GC, without the need for a separate thread and such.
--
-- NOTE: This should always return a CAF, to avoid repeated allocation,
-- initialization, etc.
--
-- Example:
--
-- @
-- instance Finalizer CStdString where
--   finalizer = finalize
--
-- finalize :: FinalizerPtr CStdString
-- {-# NOINLINE finalize #-}
-- finalize =
--   unsafePerformIO
--     [C.exp|
--       void (*)(std::string *) {
--         [](std::string *v) {
--           delete v;
--         }
--       }
--     |]
-- @
class Finalizer a where
  finalizer :: FinalizerPtr a

-- | Construct a 'ForeignPtr' using 'finalizer'.
-- This takes ownership of the pointer, so it must only be called once per pointer.
toForeignPtr :: (Finalizer a) => Ptr a -> IO (ForeignPtr a)
toForeignPtr :: forall a. Finalizer a => Ptr a -> IO (ForeignPtr a)
toForeignPtr Ptr a
ptr = FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr a
forall a. Finalizer a => FinalizerPtr a
finalizer Ptr a
ptr

-- Pointer utilities

-- | Turn an action on pointer into an action that returns 'Nothing' iff the pointer is 'nullPtr'.
--
-- Same as 'flip' 'forNonNull'.
traverseNonNull :: (Applicative m) => (Ptr a -> m b) -> Ptr a -> m (Maybe b)
traverseNonNull :: forall (m :: * -> *) a b.
Applicative m =>
(Ptr a -> m b) -> Ptr a -> m (Maybe b)
traverseNonNull Ptr a -> m b
f Ptr a
p = if Ptr a
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr then Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing else b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> m b -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> m b
f Ptr a
p

-- | Run an action with a pointer, if it is not 'nullPtr'.
--
-- Same as 'flip' 'traverseNonNull'.
forNonNull :: (Applicative m) => Ptr a -> (Ptr a -> m b) -> m (Maybe b)
forNonNull :: forall (m :: * -> *) a b.
Applicative m =>
Ptr a -> (Ptr a -> m b) -> m (Maybe b)
forNonNull = ((Ptr a -> m b) -> Ptr a -> m (Maybe b))
-> Ptr a -> (Ptr a -> m b) -> m (Maybe b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Ptr a -> m b) -> Ptr a -> m (Maybe b)
forall (m :: * -> *) a b.
Applicative m =>
(Ptr a -> m b) -> Ptr a -> m (Maybe b)
traverseNonNull