{-# LANGUAGE Rank2Types #-}
module Control.Monad.ST.Strict (
   ST, runST, fixST,

   RealWorld, stToIO,

   unsafeInterleaveST,
   unsafeIOToST,
   unsafeSTToIO,
   ) where

import Control.Monad.Fix (MonadFix, mfix, )
import Control.Applicative (Applicative(pure, (<*>)), )
import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO, )
import System.IO (fixIO, )


-- * The 'ST' Monad

newtype ST s a = ST {unST :: IO a}

instance Functor (ST s) where
   fmap f (ST st) = ST (fmap f st)

instance Applicative (ST s) where
   pure f = ST (pure f)
   ST f <*> ST x = ST (f <*> x)

instance Monad (ST s) where
   return f = ST (return f)
   fail str = ST (fail str)
   ST x >> ST y = ST (x >> y)
   ST x >>= k = ST (unST . k =<< x)


runST :: (forall s. ST s a) -> a
runST st = unsafePerformIO (unST st)

fixST :: (a -> ST s a) -> ST s a
fixST f = ST (fixIO (unST . f))

instance MonadFix (ST s) where
   mfix = fixST


-- * Converting 'ST' to 'IO'

data RealWorld = RealWorld

stToIO :: ST RealWorld a -> IO a
stToIO = unST


-- * Unsafe operations

unsafeInterleaveST :: ST s a -> ST s a
unsafeInterleaveST (ST st) =
   ST (unsafeInterleaveIO st)

unsafeIOToST :: IO a -> ST s a
unsafeIOToST = ST

unsafeSTToIO :: ST s a -> IO a
unsafeSTToIO = unST