{-# LANGUAGE TypeFamilies #-}-- | Contains a class and instance for MonadIO implementations that can be run directly in MonadIO and-- | then reconstructed to the original type, without changing the overall semantics.moduleControl.Monad.IO.Unwrappable(MonadIOUnwrappable,unwrapState,unwrapMonadIO,rewrapMonadIO)whereimportControl.Monad.Trans.ClassimportControl.MonadimportControl.Monad.IO.ClassimportControl.Monad.ErrorimportControl.Monad.ReaderimportControl.Monad.Reader.ClassimportControl.Monad.StateimportControl.Monad.State.ClassimportData.IORefdataSinglea=Singlea-- | Represents a MonadIO where any change further up the monad stack can be-- | represented lower down in the stack.classMonadIOm=>MonadIOUnwrappablemwheretypeMonadIOWrapTypem::*->*typeMonadIOStateTypem::*-- | Sets up state (e.g. an IORef) to be used to simulate the monad from the-- | IO monad.unwrapState::m(MonadIOStateTypem)-- | Maps the monad to only use IO level constructs and the state set up -- | using unwrapState.unwrapMonadIO::MonadIOStateTypem->ma->IO(MonadIOWrapTypema)-- | Reverses a previous unwrapMonadIO operation.rewrapMonadIO::MonadIOStateTypem->MonadIOWrapTypema->mainstanceMonadIOUnwrappableIOwheretypeMonadIOWrapTypeIO=SingletypeMonadIOStateTypeIO=()unwrapState=return()unwrapMonadIO_asIO=liftMSingleasIOrewrapMonadIO_(Singlex)=returnxnewtypeEitherChainabc=EitherChain(a(Eitherbc))instance(Errore,MonadIOm,MonadIOUnwrappablem)=>MonadIOUnwrappable(ErrorTem)wheretypeMonadIOWrapType(ErrorTem)=EitherChain(MonadIOWrapTypem)etypeMonadIOStateType(ErrorTem)=MonadIOStateTypemunwrapState=lift(unwrapState)unwrapMonadIOsm=liftMEitherChain$unwrapMonadIOs(runErrorTm)rewrapMonadIOs(EitherChainv)=ErrorT(rewrapMonadIOsv)instance(MonadIOm,MonadIOUnwrappablem)=>MonadIOUnwrappable(ReaderTrm)wheretypeMonadIOWrapType(ReaderTrm)=MonadIOWrapTypemtypeMonadIOStateType(ReaderTrm)=(r,MonadIOStateTypem)unwrapState=liftM2(,)ask(liftunwrapState)unwrapMonadIO(r,s)m=unwrapMonadIOs(runReaderTmr)rewrapMonadIO(_,s)v=ReaderT(\_->rewrapMonadIOsv)instance(MonadIOm,MonadIOUnwrappablem)=>MonadIOUnwrappable(StateTrm)wheretypeMonadIOWrapType(StateTrm)=MonadIOWrapTypemtypeMonadIOStateType(StateTrm)=(IORefr,MonadIOStateTypem)unwrapState=liftM2(,)(get>>=(liftIO.newIORef))(liftunwrapState)unwrapMonadIO(r,s)m=unwrapMonadIOs$dos0<-liftIO(readIORefr)(a,v')<-runStateTms0liftIO(writeIORefrv')returnarewrapMonadIO(r,s)a=StateT(\_->liftM2(,)(rewrapMonadIOsa)(liftIO.readIORef$r))