{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Foreign.Prim.WeakPtr
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Foreign.Prim.WeakPtr
  ( Weak(..)
  , mkWeak -- TODO: validate pre ghc-8.2 mkWeak#
  , mkWeakNoFinalizer
  , mkWeakPtr
  , mkWeakPtrNoFinalizer
  , addFinalizer
  , addCFinalizer
  , addCFinalizerEnv
  , deRefWeak
  , finalizeWeak
  ) where

import Control.Monad
import Control.Prim.Monad
import GHC.Weak (Weak(..))
import Foreign.Prim

-- | Same as `System.Mem.Weak.mkWeak`, except it requires a finalizer to be
-- supplied. For a version without finalizers use `mkWeakNoFinalizer`
mkWeak :: MonadUnliftPrim RW m => a -> v -> m b -> m (Weak v)
mkWeak :: a -> v -> m b -> m (Weak v)
mkWeak a
key v
val m b
finalizer =
  m b
-> ((State# RealWorld -> (# State# RealWorld, b #))
    -> State# RealWorld -> (# State# RealWorld, Weak v #))
-> m (Weak v)
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
    -> State# s -> (# State# s, b #))
-> m b
runInPrimBase m b
finalizer (((State# RealWorld -> (# State# RealWorld, b #))
  -> State# RealWorld -> (# State# RealWorld, Weak v #))
 -> m (Weak v))
-> ((State# RealWorld -> (# State# RealWorld, b #))
    -> State# RealWorld -> (# State# RealWorld, Weak v #))
-> m (Weak v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld -> (# State# RealWorld, b #)
f State# RealWorld
s ->
    case a
-> v
-> (State# RealWorld -> (# State# RealWorld, b #))
-> State# RealWorld
-> (# State# RealWorld, Weak# v #)
forall a b c.
a
-> b
-> (State# RealWorld -> (# State# RealWorld, c #))
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
mkWeak# a
key v
val State# RealWorld -> (# State# RealWorld, b #)
f State# RealWorld
s of
      (# State# RealWorld
s', Weak# v
w #) -> (# State# RealWorld
s', Weak# v -> Weak v
forall v. Weak# v -> Weak v
Weak Weak# v
w #)

-- | Similar to `mkWeak`, except it does not require a finalizer.
mkWeakNoFinalizer :: MonadPrim RW m => a -> v -> m (Weak v)
mkWeakNoFinalizer :: a -> v -> m (Weak v)
mkWeakNoFinalizer a
key v
val =
  (State# RealWorld -> (# State# RealWorld, Weak v #)) -> m (Weak v)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# RealWorld -> (# State# RealWorld, Weak v #))
 -> m (Weak v))
-> (State# RealWorld -> (# State# RealWorld, Weak v #))
-> m (Weak v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case a -> v -> State# RealWorld -> (# State# RealWorld, Weak# v #)
forall a b.
a -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #)
mkWeakNoFinalizer# a
key v
val State# RealWorld
s of
      (# State# RealWorld
s', Weak# v
w #) -> (# State# RealWorld
s', Weak# v -> Weak v
forall v. Weak# v -> Weak v
Weak Weak# v
w #)

-- | Same as `System.Mem.Weak.mkWeakPtr`, except it requires a finalizer to be
-- supplied. For a version without finalizers use `mkWeakPtrNoFinalizer`
mkWeakPtr :: MonadUnliftPrim RW m => k -> m b -> m (Weak k)
mkWeakPtr :: k -> m b -> m (Weak k)
mkWeakPtr k
key = k -> k -> m b -> m (Weak k)
forall (m :: * -> *) a v b.
MonadUnliftPrim RealWorld m =>
a -> v -> m b -> m (Weak v)
mkWeak k
key k
key

-- | Similar to `mkWeakPtr`, except it does not require a finalizer.
mkWeakPtrNoFinalizer :: MonadPrim RW m => k -> m (Weak k)
mkWeakPtrNoFinalizer :: k -> m (Weak k)
mkWeakPtrNoFinalizer k
key = k -> k -> m (Weak k)
forall (m :: * -> *) a v.
MonadPrim RealWorld m =>
a -> v -> m (Weak v)
mkWeakNoFinalizer k
key k
key


-- | Same as `System.Mem.Weak.addFinalizer`.
addFinalizer :: MonadUnliftPrim RW m => k -> m b -> m ()
addFinalizer :: k -> m b -> m ()
addFinalizer k
key = m (Weak k) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Weak k) -> m ()) -> (m b -> m (Weak k)) -> m b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> m b -> m (Weak k)
forall (m :: * -> *) k b.
MonadUnliftPrim RealWorld m =>
k -> m b -> m (Weak k)
mkWeakPtr k
key

-- | Add a foreign function finalizer with a single argument
addCFinalizer ::
     MonadPrim RW m
  => FunPtr (Ptr a -> IO ())
     -- ^ Pointer to the C function to be called when finalizers are being invoked
  -> Ptr a
     -- ^ Argument that will be supplied to the finalizer function
  -> Weak v
  -> m Bool
addCFinalizer :: FunPtr (Ptr a -> IO ()) -> Ptr a -> Weak v -> m Bool
addCFinalizer (FunPtr Addr#
faddr#) (Ptr Addr#
addr#) (Weak Weak# v
weak#) =
  (State# RealWorld -> (# State# RealWorld, Bool #)) -> m Bool
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# RealWorld -> (# State# RealWorld, Bool #)) -> m Bool)
-> (State# RealWorld -> (# State# RealWorld, Bool #)) -> m Bool
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case Addr#
-> Addr#
-> Int#
-> Addr#
-> Weak# v
-> State# RealWorld
-> (# State# RealWorld, Int# #)
forall b.
Addr#
-> Addr#
-> Int#
-> Addr#
-> Weak# b
-> State# RealWorld
-> (# State# RealWorld, Int# #)
addCFinalizerToWeak# Addr#
faddr# Addr#
addr# Int#
0# Addr#
nullAddr# Weak# v
weak# State# RealWorld
s of
      (# State# RealWorld
s', Int#
i# #) -> (# State# RealWorld
s', Int# -> Bool
isTrue# Int#
i# #)

-- | Add a foreign function finalizer with two arguments
addCFinalizerEnv ::
     MonadPrim RW m
  => FunPtr (Ptr env -> Ptr a -> IO ())
     -- ^ Pointer to the C function to be called when finalizers are being invoked
  -> Ptr env
     -- ^ First argument that will be supplied to the finalizer function
  -> Ptr a
     -- ^ Second argument that will be supplied to the finalizer function
  -> Weak v
  -> m Bool
addCFinalizerEnv :: FunPtr (Ptr env -> Ptr a -> IO ())
-> Ptr env -> Ptr a -> Weak v -> m Bool
addCFinalizerEnv (FunPtr Addr#
faddr#) (Ptr Addr#
envAddr#) (Ptr Addr#
addr#) (Weak Weak# v
weak#) =
  (State# RealWorld -> (# State# RealWorld, Bool #)) -> m Bool
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# RealWorld -> (# State# RealWorld, Bool #)) -> m Bool)
-> (State# RealWorld -> (# State# RealWorld, Bool #)) -> m Bool
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case Addr#
-> Addr#
-> Int#
-> Addr#
-> Weak# v
-> State# RealWorld
-> (# State# RealWorld, Int# #)
forall b.
Addr#
-> Addr#
-> Int#
-> Addr#
-> Weak# b
-> State# RealWorld
-> (# State# RealWorld, Int# #)
addCFinalizerToWeak# Addr#
faddr# Addr#
addr# Int#
1# Addr#
envAddr# Weak# v
weak# State# RealWorld
s of
      (# State# RealWorld
s', Int#
i# #) -> (# State# RealWorld
s', Int# -> Bool
isTrue# Int#
i# #)

-- | Similar to `System.Mem.Weak.deRefWeak`
deRefWeak :: MonadPrim RW m => Weak v -> m (Maybe v)
deRefWeak :: Weak v -> m (Maybe v)
deRefWeak (Weak Weak# v
weak#) =
  (State# RealWorld -> (# State# RealWorld, Maybe v #))
-> m (Maybe v)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# RealWorld -> (# State# RealWorld, Maybe v #))
 -> m (Maybe v))
-> (State# RealWorld -> (# State# RealWorld, Maybe v #))
-> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case Weak# v -> State# RealWorld -> (# State# RealWorld, Int#, v #)
forall a.
Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, a #)
deRefWeak# Weak# v
weak# State# RealWorld
s of
      (# State# RealWorld
s', Int#
0#, v
_ #) -> (# State# RealWorld
s', Maybe v
forall a. Maybe a
Nothing #)
      (# State# RealWorld
s', Int#
_, v
a #) -> (# State# RealWorld
s', v -> Maybe v
forall a. a -> Maybe a
Just v
a #)


-- | Similar to `System.Mem.Weak.finalize`
finalizeWeak :: MonadPrim RW m => Weak v -> m ()
finalizeWeak :: Weak v -> m ()
finalizeWeak (Weak Weak# v
w) =
  (State# RealWorld -> (# State# RealWorld, () #)) -> m ()
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# RealWorld -> (# State# RealWorld, () #)) -> m ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> m ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
    case Weak# v
-> State# RealWorld
-> (# State# RealWorld, Int#,
      State# RealWorld -> (# State# RealWorld, () #) #)
forall a b.
Weak# a
-> State# RealWorld
-> (# State# RealWorld, Int#,
      State# RealWorld -> (# State# RealWorld, b #) #)
finalizeWeak# Weak# v
w State# RealWorld
s of
      (# State# RealWorld
s1, Int#
0#, State# RealWorld -> (# State# RealWorld, () #)
_ #) -> (# State# RealWorld
s1, () #)
      (# State# RealWorld
s1, Int#
_, State# RealWorld -> (# State# RealWorld, () #)
f #) -> State# RealWorld -> (# State# RealWorld, () #)
f State# RealWorld
s1