{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Control.Prim.Monad.Unsafe
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Control.Prim.Monad.Unsafe
  ( unsafePrim
  , unsafePrim_
  , unsafePrimBase
  , unsafePrimBase_
  , unsafePrimBaseToPrim
  , unsafePrimBaseToIO
  , unsafePrimBaseToST
  , unsafeIOToPrim
  , unsafeSTToPrim
  , unsafeLiftPrimBase
  , noDuplicatePrim
  , unsafeDupablePerformPrimBase
  -- * Inline
  , unsafeInlineIO
  , unsafeInlineST
  , unsafeInlinePrimBase
  -- * Interleave
  , unsafeInterleavePrimBase
  , unsafeDupableInterleavePrimBase
  -- * Re-exports
  , unsafePerformIO
  , unsafeDupablePerformIO
  , unsafeInterleaveIO
  , unsafeDupableInterleaveIO
  ) where

import System.IO.Unsafe
import Control.Prim.Monad.Internal
import GHC.IO
import GHC.Exts

-- | Coerce the state token of prim operation and wrap it into a `MonadPrim` action.
--
-- === Highly unsafe!
--
-- @since 0.3.0
unsafePrim :: MonadPrim s m => (State# s' -> (# State# s', a #)) -> m a
unsafePrim :: (State# s' -> (# State# s', a #)) -> m a
unsafePrim State# s' -> (# State# s', a #)
m = (State# s -> (# State# s, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s' -> (# State# s', a #)) -> State# s -> (# State# s, a #)
unsafeCoerce# State# s' -> (# State# s', a #)
m)
{-# INLINE unsafePrim #-}


-- | Coerce the state token of prim operation and wrap it into a `MonadPrim` action.
--
-- === Highly unsafe!
--
-- @since 0.3.0
unsafePrim_ :: MonadPrim s m => (State# s' -> State# s') -> m ()
unsafePrim_ :: (State# s' -> State# s') -> m ()
unsafePrim_ State# s' -> State# s'
m = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ ((State# s' -> State# s') -> State# s -> State# s
unsafeCoerce# State# s' -> State# s'
m)
{-# INLINE unsafePrim_ #-}


-- | Unwrap any `MonadPrimBase` action while coercing the state token
--
-- === Highly unsafe!
unsafePrimBase :: MonadPrimBase s' m => m a -> State# s -> (# State# s, a #)
unsafePrimBase :: m a -> State# s -> (# State# s, a #)
unsafePrimBase m a
m = (State# s' -> (# State# s', a #)) -> State# s -> (# State# s, a #)
unsafeCoerce# (m a -> State# s' -> (# State# s', a #)
forall s (m :: * -> *) a.
MonadPrimBase s m =>
m a -> State# s -> (# State# s, a #)
primBase m a
m)
{-# INLINE unsafePrimBase #-}

-- | Unwrap any `MonadPrimBase` action that does not return anything, while coercing the
-- state token
--
-- === Highly unsafe!
unsafePrimBase_ :: MonadPrimBase s' m => m () -> State# s -> State# s
unsafePrimBase_ :: m () -> State# s -> State# s
unsafePrimBase_ m ()
m = (State# s' -> State# s') -> State# s -> State# s
unsafeCoerce# (m () -> State# s' -> State# s'
forall s (m :: * -> *).
MonadPrimBase s m =>
m () -> State# s -> State# s
primBase_ m ()
m)
{-# INLINE unsafePrimBase_ #-}

-- | Convert a `MonadPrimBase` action to another `MonadPrim` while coercing the state token.
--
-- === Highly unsafe!
unsafePrimBaseToPrim :: (MonadPrimBase sn n, MonadPrim sm m) => n a -> m a
unsafePrimBaseToPrim :: n a -> m a
unsafePrimBaseToPrim n a
m = (State# sm -> (# State# sm, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# sn -> (# State# sn, a #))
-> State# sm -> (# State# sm, a #)
unsafeCoerce# (n a -> State# sn -> (# State# sn, a #)
forall s (m :: * -> *) a.
MonadPrimBase s m =>
m a -> State# s -> (# State# s, a #)
primBase n a
m))
{-# INLINE unsafePrimBaseToPrim #-}

-- | Convert a `MonadPrimBase` action to `ST` while coercing the state token @s@.
--
-- === Highly unsafe!
unsafePrimBaseToST :: MonadPrimBase sm m => m a -> ST s a
unsafePrimBaseToST :: m a -> ST s a
unsafePrimBaseToST = m a -> ST s a
forall sn (n :: * -> *) sm (m :: * -> *) a.
(MonadPrimBase sn n, MonadPrim sm m) =>
n a -> m a
unsafePrimBaseToPrim
{-# INLINE unsafePrimBaseToST #-}

-- | Convert a `MonadPrimBase` action to `IO` while coercing the state token to `RealWorld`.
--
-- === Highly unsafe!
unsafePrimBaseToIO :: MonadPrimBase s m => m a -> IO a
unsafePrimBaseToIO :: m a -> IO a
unsafePrimBaseToIO = m a -> IO a
forall sn (n :: * -> *) sm (m :: * -> *) a.
(MonadPrimBase sn n, MonadPrim sm m) =>
n a -> m a
unsafePrimBaseToPrim
{-# INLINE unsafePrimBaseToIO #-}

-- | Convert an `IO` action to some `MonadPrim` while coercing the state token.
--
-- === Highly unsafe!
--
-- It is similar to `Control.Monad.ST.Unsafe.unsafeSTToIO`, except resulting action can be
-- any other `MonadPrim` action, therefore it is a lot more dangerous.
unsafeIOToPrim :: MonadPrim s m => IO a -> m a
unsafeIOToPrim :: IO a -> m a
unsafeIOToPrim = IO a -> m a
forall sn (n :: * -> *) sm (m :: * -> *) a.
(MonadPrimBase sn n, MonadPrim sm m) =>
n a -> m a
unsafePrimBaseToPrim
{-# INLINE unsafeIOToPrim #-}

-- | Convert an `ST` action to some `MonadPrim` while coercing the state token.
--
-- === Highly unsafe!
unsafeSTToPrim :: MonadPrim s' m => ST s a -> m a
unsafeSTToPrim :: ST s a -> m a
unsafeSTToPrim = ST s a -> m a
forall sn (n :: * -> *) sm (m :: * -> *) a.
(MonadPrimBase sn n, MonadPrim sm m) =>
n a -> m a
unsafePrimBaseToPrim
{-# INLINE unsafeSTToPrim #-}

-- | Same as `GHC.IO.noDuplicate`, except works in any `MonadPrim`.
noDuplicatePrim :: MonadPrim s m => m ()
#if __GLASGOW_HASKELL__ >= 802
noDuplicatePrim :: m ()
noDuplicatePrim = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ State# s -> State# s
forall d. State# d -> State# d
noDuplicate#
#else
noDuplicatePrim = unsafeIOToPrim $ prim_ noDuplicate#
#endif


-- | Same as `unsafeDupablePerformIO`, except works not only with `IO`, but with other
-- `MonadPrimBase` actions as well. Reading and writing values into memory is safe, as
-- long as writing action is idempotent. On the other hand things like memory or resource
-- allocation, exceptions handling are not safe at all, since supplied action can be run
-- multiple times and a copy interrupted at will.
unsafeDupablePerformPrimBase :: MonadPrimBase s m => m a -> a
unsafeDupablePerformPrimBase :: m a -> a
unsafeDupablePerformPrimBase m a
m = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (m a -> IO a
forall s (m :: * -> *) a. MonadPrimBase s m => m a -> IO a
unsafePrimBaseToIO m a
m)

-- | Take an `IO` and compute it as a pure value, while inlining the action itself.
--
-- === Ridiculously unsafe!
--
-- This is even more unsafe then both `unsafePerformIO` and `unsafeDupableInterleaveIO`.
--
-- The only time it is really safe to use is on idempotent action that only read values
-- from memory, but do note do any mutation, allocation and certainly not interaction with
-- real world.
--
-- In
-- [`bytestring`](https://github.com/haskell/bytestring/blob/95fe6bdf13c9cc86c1c880164f7844d61d989574/Data/ByteString/Internal.hs#L566-L592)
-- it is known as `accursedUnutterablePerformIO`. Here are some resources that discuss
-- it's unsafety:
--
-- * [Stack overflow question](https://stackoverflow.com/questions/61021205/what-is-the-difference-between-unsafedupableperformio-and-accursedunutterableper)
-- * [Reddit discussion](https://www.reddit.com/r/haskell/comments/2cbgpz/flee_traveller_flee_or_you_will_be_corrupted_and/)
--
unsafeInlineIO :: IO a -> a
unsafeInlineIO :: IO a -> a
unsafeInlineIO (IO State# RealWorld -> (# State# RealWorld, a #)
m) = case State# RealWorld -> (# State# RealWorld, a #)
m State# RealWorld
realWorld# of (# State# RealWorld
_, a
r #) -> a
r
{-# INLINE unsafeInlineIO #-}

-- | Take an `ST` and compute it as a pure value, while inlining the action itself. Same
-- as `unsafeInlineIO`.
--
-- === Ridiculously unsafe!
unsafeInlineST :: ST s a -> a
unsafeInlineST :: ST s a -> a
unsafeInlineST = ST s a -> a
forall s (m :: * -> *) a. MonadPrimBase s m => m a -> a
unsafeInlinePrimBase
{-# INLINE unsafeInlineST #-}


-- | Take any `MonadPrimBase` action and compute it as a pure value, while inlining the
-- action. Same as `unsafeInlineIO`, but applied to any `MonadPrimBase` action.
--
-- === Ridiculously unsafe!
unsafeInlinePrimBase :: MonadPrimBase s m => m a -> a
unsafeInlinePrimBase :: m a -> a
unsafeInlinePrimBase m a
m = IO a -> a
forall a. IO a -> a
unsafeInlineIO (m a -> IO a
forall s (m :: * -> *) a. MonadPrimBase s m => m a -> IO a
unsafePrimBaseToIO m a
m)
{-# INLINE unsafeInlinePrimBase #-}


-- | Same as `unsafeInterleaveIO`, except works in any `MonadPrimBase`
unsafeInterleavePrimBase :: MonadPrimBase s m => m a -> m a
unsafeInterleavePrimBase :: m a -> m a
unsafeInterleavePrimBase m a
x = m a -> m a
forall s (m :: * -> *) a. MonadPrimBase s m => m a -> m a
unsafeDupableInterleavePrimBase (m ()
forall s (m :: * -> *). MonadPrim s m => m ()
noDuplicatePrim m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
x)
{-# INLINE unsafeInterleavePrimBase #-}


-- | Same as `unsafeDupableInterleaveIO`, except works in any `MonadPrimBase`
unsafeDupableInterleavePrimBase :: MonadPrimBase s m => m a -> m a
unsafeDupableInterleavePrimBase :: m a -> m a
unsafeDupableInterleavePrimBase m a
x =
  (State# s -> (# State# s, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, a #)) -> m a)
-> (State# s -> (# State# s, a #)) -> m a
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    let r :: a
r = case m a -> State# s -> (# State# s, a #)
forall s (m :: * -> *) a.
MonadPrimBase s m =>
m a -> State# s -> (# State# s, a #)
primBase m a
x State# s
s of
              (# State# s
_, a
res #) -> a
res
     in (# State# s
s, a
r #)
{-# NOINLINE unsafeDupableInterleavePrimBase #-}

-- | A version of `liftPrimBase` that coerce the state token.
--
-- === Highly unsafe!
--
unsafeLiftPrimBase :: forall sn n sm m a. (MonadPrimBase sn n, MonadPrim sm m) => n a -> m a
unsafeLiftPrimBase :: n a -> m a
unsafeLiftPrimBase n a
m = (State# sm -> (# State# sm, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim (n a -> State# sm -> (# State# sm, a #)
forall s' (m :: * -> *) a s.
MonadPrimBase s' m =>
m a -> State# s -> (# State# s, a #)
unsafePrimBase n a
m)
{-# INLINE unsafeLiftPrimBase #-}