module Control.Monad.Trans.Order.Lazy.Internals (
OrderT (OrderT),
OrderRep (OrderRep),
emptyOrderRep,
Gate,
withRawOrder
) where
import Control.Monad
import Control.Applicative
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Control.Monad.Trans.State.Lazy
import Control.Monad.ST
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad.Trans.Order.Raw
import System.IO.Unsafe
newtype OrderT o m a = OrderT (StateT (OrderRep o) m a) deriving (
Functor,
Applicative,
Alternative,
Monad,
MonadPlus,
MonadTrans,
MonadIO)
data OrderRep o = OrderRep (RawAlgorithm o RealWorld) (Gate o)
emptyOrderRep :: (forall s . RawAlgorithm o s) -> OrderRep o
emptyOrderRep rawAlg = unsafePerformIO $ do
rawOrder <- stToIO (newOrder rawAlg)
gate <- newGate rawOrder
return (OrderRep rawAlg gate)
newtype Gate a = Gate (MVar (RawOrder a RealWorld))
newGate :: RawOrder a RealWorld -> IO (Gate a)
newGate = fmap Gate . newMVar
withRawOrder :: Gate a -> (RawOrder a RealWorld -> IO r) -> IO r
withRawOrder (Gate mVar) cont = bracket (takeMVar mVar) (putMVar mVar) cont