{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# OPTIONS_HADDOCK not-home #-}
module Effectful.Internal.Utils
  ( weakThreadId
  , eqThreadId

  -- * Strict 'IORef'
  , IORef'
  , newIORef'
  , readIORef'
  , writeIORef'

  -- * Strict 'MVar'
  , MVar'
  , toMVar'
  , newMVar'
  , readMVar'
  , modifyMVar'
  , modifyMVar_'

  -- * Utils for 'Any'
  , Any
  , toAny
  , fromAny
  ) where

import Control.Concurrent.MVar
import Data.IORef
import Foreign.C.Types
import GHC.Conc.Sync (ThreadId(..))
import GHC.Exts (Any, ThreadId#)
import Unsafe.Coerce (unsafeCoerce)

-- | Get an id of a thread that doesn't prevent its garbage collection.
weakThreadId :: ThreadId -> Int
weakThreadId :: ThreadId -> Int
weakThreadId (ThreadId ThreadId#
t#) = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ThreadId# -> CLong
rts_getThreadId ThreadId#
t#

foreign import ccall unsafe "rts_getThreadId"
#if __GLASGOW_HASKELL__ >= 904
  -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6163
  rts_getThreadId :: ThreadId# -> CULLong
#elif __GLASGOW_HASKELL__ >= 900
  -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1254
  rts_getThreadId :: ThreadId# -> CLong
#else
  rts_getThreadId :: ThreadId# -> CInt
#endif

-- | 'Eq' instance for 'ThreadId' is broken in GHC < 9, see
-- https://gitlab.haskell.org/ghc/ghc/-/issues/16761 for more info.
eqThreadId :: ThreadId -> ThreadId -> Bool
eqThreadId :: ThreadId -> ThreadId -> Bool
eqThreadId (ThreadId ThreadId#
t1#) (ThreadId ThreadId#
t2#) = ThreadId# -> ThreadId# -> CLong
eq_thread ThreadId#
t1# ThreadId#
t2# forall a. Eq a => a -> a -> Bool
== CLong
1

foreign import ccall unsafe "effectful_eq_thread"
  eq_thread :: ThreadId# -> ThreadId# -> CLong

----------------------------------------

-- | A strict variant of 'IORef'.
newtype IORef' a = IORef' (IORef a)

newIORef' :: a -> IO (IORef' a)
newIORef' :: forall a. a -> IO (IORef' a)
newIORef' a
a = a
a seq :: forall a b. a -> b -> b
`seq` (forall a. IORef a -> IORef' a
IORef' forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef a
a)

readIORef' :: IORef' a -> IO a
readIORef' :: forall a. IORef' a -> IO a
readIORef' (IORef' IORef a
var) = forall a. IORef a -> IO a
readIORef IORef a
var

writeIORef' :: IORef' a -> a -> IO ()
writeIORef' :: forall a. IORef' a -> a -> IO ()
writeIORef' (IORef' IORef a
var) a
a = a
a seq :: forall a b. a -> b -> b
`seq` forall a. IORef a -> a -> IO ()
writeIORef IORef a
var a
a

----------------------------------------

-- | A strict variant of 'MVar'.
newtype MVar' a = MVar' (MVar a)

toMVar' :: MVar a -> IO (MVar' a)
toMVar' :: forall a. MVar a -> IO (MVar' a)
toMVar' MVar a
var = do
  let var' :: MVar' a
var' = forall a. MVar a -> MVar' a
MVar' MVar a
var
  forall a. MVar' a -> (a -> IO a) -> IO ()
modifyMVar_' MVar' a
var' forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure MVar' a
var'

newMVar' :: a -> IO (MVar' a)
newMVar' :: forall a. a -> IO (MVar' a)
newMVar' a
a = a
a seq :: forall a b. a -> b -> b
`seq` (forall a. MVar a -> MVar' a
MVar' forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (MVar a)
newMVar a
a)

readMVar' :: MVar' a -> IO a
readMVar' :: forall a. MVar' a -> IO a
readMVar' (MVar' MVar a
var) = forall a. MVar a -> IO a
readMVar MVar a
var

modifyMVar' :: MVar' a -> (a -> IO (a, r)) -> IO r
modifyMVar' :: forall a r. MVar' a -> (a -> IO (a, r)) -> IO r
modifyMVar' (MVar' MVar a
var) a -> IO (a, r)
action = forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar a
var forall a b. (a -> b) -> a -> b
$ \a
a0 -> do
  (a
a, r
r) <- a -> IO (a, r)
action a
a0
  a
a seq :: forall a b. a -> b -> b
`seq` forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a
a, r
r)
{-# INLINE modifyMVar' #-}

modifyMVar_' :: MVar' a -> (a -> IO a) -> IO ()
modifyMVar_' :: forall a. MVar' a -> (a -> IO a) -> IO ()
modifyMVar_' (MVar' MVar a
var) a -> IO a
action = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar a
var forall a b. (a -> b) -> a -> b
$ \a
a0 -> do
  a
a <- a -> IO a
action a
a0
  a
a seq :: forall a b. a -> b -> b
`seq` forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a
{-# INLINE modifyMVar_' #-}

----------------------------------------

toAny :: a -> Any
toAny :: forall a. a -> Any
toAny = forall a b. a -> b
unsafeCoerce

fromAny :: Any -> a
fromAny :: forall a. Any -> a
fromAny = forall a b. a -> b
unsafeCoerce