{-# LANGUAGE InstanceSigs        #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Control.Monad.Class.MonadST (MonadST (..)) where

import Control.Monad.Reader

import Control.Monad.Primitive
import Control.Monad.ST (ST)


-- | This class is for abstracting over 'stToIO' which allows running 'ST'
-- actions in 'IO'. In this case it is to allow running 'ST' actions within
-- another monad @m@.
--
-- The normal type of 'stToIO' is:
--
-- > stToIO :: ST RealWorld a -> IO a
--
-- We have two approaches to abstracting over this, a new and an older
-- (deprecated) method. The new method borrows the @primitive@ package's
-- 'PrimMonad' and 'PrimState' type family. This gives us:
--
-- > stToIO :: ST (PrimState m) a -> m a
--
-- Which for 'IO' is exactly the same as above. For 'ST' it is identity, while
-- for @IOSim@ it is
--
-- > stToIO :: ST s a -> IOSim s a
--
-- The older (deprecated) method is tricky because we need to not care about
-- both the @IO@, and also the @RealWorld@, and it does so avoiding mentioning
-- any @s@ type (which is what the 'PrimState' type family gives access to).
-- The solution is to write an action that is given the @liftST@ as an argument
-- and where that action itself is polymorphic in the @s@ parameter. This
-- allows us to instantiate it with @RealWorld@ in the @IO@ case, and the local
-- @s@ in a case where we are embedding into another @ST@ action.
--
class PrimMonad m => MonadST m where
  -- | @since 1.4.1.0
  stToIO :: ST (PrimState m) a -> m a

  -- | Deprecated. Use 'stToIO' instead.
  withLiftST :: (forall s. (forall a. ST s a -> m a) -> b) -> b
  withLiftST = \forall s. (forall a. ST s a -> m a) -> b
k -> (forall a. ST (PrimState m) a -> m a) -> b
forall s. (forall a. ST s a -> m a) -> b
k ST (PrimState m) a -> m a
forall a. ST (PrimState m) a -> m a
forall (m :: * -> *) a. MonadST m => ST (PrimState m) a -> m a
stToIO

{-# DEPRECATED withLiftST "Use the simpler 'stToIO' instead." #-}

instance MonadST IO where
  stToIO :: forall a. ST (PrimState IO) a -> IO a
stToIO = ST (PrimState IO) a -> IO a
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim

instance MonadST (ST s) where
  stToIO :: forall a. ST (PrimState (ST s)) a -> ST s a
stToIO = ST (PrimState (ST s)) a -> ST s a
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim
  withLiftST :: forall b. (forall s. (forall a. ST s a -> ST s a) -> b) -> b
withLiftST = \forall s. (forall a. ST s a -> ST s a) -> b
f -> (forall a. ST s a -> ST s a) -> b
forall s. (forall a. ST s a -> ST s a) -> b
f ST s a -> ST s a
forall a. a -> a
forall a. ST s a -> ST s a
id

instance (MonadST m, PrimMonad m) => MonadST (ReaderT r m) where
  stToIO :: ST (PrimState m) a -> ReaderT r m a
  stToIO :: forall a. ST (PrimState m) a -> ReaderT r m a
stToIO ST (PrimState m) a
f = m a -> ReaderT r m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST (PrimState m) a -> m a
forall (m :: * -> *) a. PrimMonad m => ST (PrimState m) a -> m a
stToPrim ST (PrimState m) a
f)

  withLiftST :: forall b. (forall s. (forall a. ST s a -> ReaderT r m a) -> b) -> b
withLiftST forall s. (forall a. ST s a -> ReaderT r m a) -> b
f = (forall s. (forall a. ST s a -> m a) -> b) -> b
forall b. (forall s. (forall a. ST s a -> m a) -> b) -> b
forall (m :: * -> *) b.
MonadST m =>
(forall s. (forall a. ST s a -> m a) -> b) -> b
withLiftST ((forall s. (forall a. ST s a -> m a) -> b) -> b)
-> (forall s. (forall a. ST s a -> m a) -> b) -> b
forall a b. (a -> b) -> a -> b
$ \forall a. ST s a -> m a
g -> (forall a. ST s a -> ReaderT r m a) -> b
forall s. (forall a. ST s a -> ReaderT r m a) -> b
f (m a -> ReaderT r m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a)
-> (ST s a -> m a) -> ST s a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST s a -> m a
forall a. ST s a -> m a
g)