#if __GLASGOW_HASKELL__ >= 704
#endif
module Hails.IterIO.Conversions ( iterIOtoIterLIO
, ioIterRtoLIO
, onumIOtoOnumLIO
, inumIOtoInumLIO
) where
import qualified Data.ByteString.Lazy.Char8 as L
import Data.IORef
import Data.IterIO
import LIO.DCLabel
import LIO.TCB
import Control.Monad
import Control.Monad.Trans
type L = L.ByteString
iterIOtoIterLIO :: (LabelState l p s, ChunkData t)
=> Iter t IO a -> Iter t (LIO l p s) a
iterIOtoIterLIO = adaptIterM rtioTCB
ioIterRtoLIO :: (LabelState l p s, ChunkData t)
=> IterR t IO a -> IterR t (LIO l p s) a
ioIterRtoLIO (Done a (Chunk b c)) = Done a (Chunk b c)
ioIterRtoLIO (IterM m) = IterM $ fmap ioIterRtoLIO $ rtioTCB m
ioIterRtoLIO (IterF next) = IterF $ iterIOtoIterLIO next
ioIterRtoLIO (Fail itf ma mb) = Fail itf ma mb
ioIterRtoLIO (IterC (CtlArg carg f c)) =
let g = \cres -> iterIOtoIterLIO $ f cres
in IterC (CtlArg carg g c)
onumIOtoOnumLIO :: LabelState l p s => Onum L IO L -> Onum L (LIO l p s) a
onumIOtoOnumLIO inO = mkInum $ iterIOtoIterLIO (inO .| dataI)
inumResIOtoIO :: (LabelState l p s, ChunkData tIn, ChunkData tOut)
=> Iter tIn IO (IterR tOut IO a)
-> Iter tIn (LIO l p s) (IterR tOut (LIO l p s) a)
inumResIOtoIO iIn = liftM ioIterRtoLIO $ iterIOtoIterLIO iIn
iterLIOtoIterIO :: (LabelState l p s, ChunkData t)
=> Iter t (LIO l p s) a
-> LIOstate l p s
-> Iter t IO (a, LIOstate l p s)
iterLIOtoIterIO iter0 s0 = adaptIter (\a -> (a, s0)) adapt iter0
where adapt m = lift (runLIO m s0) >>= uncurry iterLIOtoIterIO
inumIOtoInumLIO :: (ChunkData tIn, ChunkData tOut)
=> Inum tIn tOut IO a
-> LIOstate DCLabel TCBPriv ()
-> Inum tIn tOut DC a
inumIOtoInumLIO io12 s0 = \dc1 -> do
ref <- lift $ ioTCB $ newIORef s0
let io1 = do (x, s1) <- iterLIOtoIterIO dc1 s0
liftIO $ writeIORef ref s1
return x
io2 = io12 io1
res <- inumResIOtoIO io2
lift $ do s1 <- ioTCB $ readIORef ref
putTCB s1
return res