{-# LANGUAGE StrictData #-} {-# LANGUAGE TupleSections #-} module Language.JavaScript.Inline.Examples.Utils.LazyIO where import Control.Concurrent.STM import Control.Concurrent.STM.TMQueue import Control.Exception import Control.Monad import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy.Internal as LBS import Data.IORef import System.IO.Unsafe data LazyIO = LazyIO { LazyIO -> ByteString lazyContent :: ~LBS.ByteString, LazyIO -> ByteString -> IO () lazyOnData :: BS.ByteString -> IO (), LazyIO -> IO () lazyOnEnd :: IO (), LazyIO -> SomeException -> IO () lazyOnError :: SomeException -> IO (), LazyIO -> IO () -> IO () lazySetFinalizer :: IO () -> IO () } newLazyIO :: IO LazyIO newLazyIO :: IO LazyIO newLazyIO = do TMQueue ByteString q <- IO (TMQueue ByteString) forall a. IO (TMQueue a) newTMQueueIO let w :: IO ByteString w = do Maybe ByteString r <- STM (Maybe ByteString) -> IO (Maybe ByteString) forall a. STM a -> IO a atomically (STM (Maybe ByteString) -> IO (Maybe ByteString)) -> STM (Maybe ByteString) -> IO (Maybe ByteString) forall a b. (a -> b) -> a -> b $ TMQueue ByteString -> STM (Maybe ByteString) forall a. TMQueue a -> STM (Maybe a) readTMQueue TMQueue ByteString q case Maybe ByteString r of Just ByteString c -> do ByteString cs <- IO ByteString -> IO ByteString forall a. IO a -> IO a unsafeInterleaveIO IO ByteString w ByteString -> IO ByteString forall (f :: * -> *) a. Applicative f => a -> f a pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString forall a b. (a -> b) -> a -> b $ ByteString -> ByteString -> ByteString LBS.Chunk ByteString c ByteString cs Maybe ByteString _ -> ByteString -> IO ByteString forall (f :: * -> *) a. Applicative f => a -> f a pure ByteString LBS.Empty ByteString s <- IO ByteString -> IO ByteString forall a. IO a -> IO a unsafeInterleaveIO IO ByteString w IORef (IO ()) fin_ref <- IO () -> IO (IORef (IO ())) forall a. a -> IO (IORef a) newIORef (() -> IO () forall (f :: * -> *) a. Applicative f => a -> f a pure ()) let fin :: IO () fin = IO (IO ()) -> IO () forall (m :: * -> *) a. Monad m => m (m a) -> m a join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO () forall a b. (a -> b) -> a -> b $ IORef (IO ()) -> (IO () -> (IO (), IO ())) -> IO (IO ()) forall a b. IORef a -> (a -> (a, b)) -> IO b atomicModifyIORef' IORef (IO ()) fin_ref (() -> IO () forall (f :: * -> *) a. Applicative f => a -> f a pure (),) LazyIO -> IO LazyIO forall (f :: * -> *) a. Applicative f => a -> f a pure LazyIO :: ByteString -> (ByteString -> IO ()) -> IO () -> (SomeException -> IO ()) -> (IO () -> IO ()) -> LazyIO LazyIO { lazyContent :: ByteString lazyContent = ByteString s, lazyOnData :: ByteString -> IO () lazyOnData = STM () -> IO () forall a. STM a -> IO a atomically (STM () -> IO ()) -> (ByteString -> STM ()) -> ByteString -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . TMQueue ByteString -> ByteString -> STM () forall a. TMQueue a -> a -> STM () writeTMQueue TMQueue ByteString q, lazyOnEnd :: IO () lazyOnEnd = do STM () -> IO () forall a. STM a -> IO a atomically (STM () -> IO ()) -> STM () -> IO () forall a b. (a -> b) -> a -> b $ TMQueue ByteString -> STM () forall a. TMQueue a -> STM () closeTMQueue TMQueue ByteString q IO () fin, lazyOnError :: SomeException -> IO () lazyOnError = \(SomeException e err) -> do STM () -> IO () forall a. STM a -> IO a atomically (STM () -> IO ()) -> STM () -> IO () forall a b. (a -> b) -> a -> b $ do TMQueue ByteString -> ByteString -> STM () forall a. TMQueue a -> a -> STM () writeTMQueue TMQueue ByteString q (e -> ByteString forall a e. Exception e => e -> a throw e err) TMQueue ByteString -> STM () forall a. TMQueue a -> STM () closeTMQueue TMQueue ByteString q IO () fin, lazySetFinalizer :: IO () -> IO () lazySetFinalizer = IORef (IO ()) -> IO () -> IO () forall a. IORef a -> a -> IO () atomicWriteIORef IORef (IO ()) fin_ref }