{-# 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
      }