module Control.Monad.MultiPass.Instrument.DelayedLift
( DelayedLift
, delayedLift, readST2ArrayMP
)
where
import Control.Monad.ST2
import Control.Monad.MultiPass
import Data.Ix
data DelayedLift r w p1 tc
= DelayedLift
{ delayedLiftInternal ::
!(forall a. p1 (ReadOnlyST2 r a) -> MultiPass r w tc (p1 a))
}
delayedLift
:: Monad p1
=> DelayedLift r w p1 tc
-> p1 (ReadOnlyST2 r a)
-> MultiPass r w tc (p1 a)
delayedLift =
delayedLiftInternal
instance Instrument tc () () (DelayedLift r w Off tc) where
createInstrument _ _ () =
wrapInstrument $ DelayedLift $ \Off ->
return Off
instance Instrument tc () () (DelayedLift r w On tc) where
createInstrument st2ToMP _ () =
wrapInstrument $ DelayedLift $ \(On m) ->
do x <- mkMultiPass $ st2ToMP $ runReadOnlyST2 m
return (On x)
readST2ArrayMP
:: (Ix i, Monad p1)
=> DelayedLift r w p1 tc
-> p1 (ST2Array r w i a)
-> i
-> MultiPass r w tc (p1 a)
readST2ArrayMP dlift xs i =
delayedLift dlift $
do xs' <- xs
return (ReadOnlyST2 $ readST2Array xs' i)