{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Language.JavaScript.Inline.Examples.Stream where

import Control.Exception
import qualified Data.ByteString.Lazy as LBS
import Data.Foldable
import Language.JavaScript.Inline
import Language.JavaScript.Inline.Examples.Utils.LazyIO

lazyStream :: Session -> JSVal -> IO LBS.ByteString
lazyStream :: Session -> JSVal -> IO ByteString
lazyStream Session
_session JSVal
_stream = do
  LazyIO {IO ()
ByteString
IO () -> IO ()
ByteString -> IO ()
SomeException -> IO ()
lazySetFinalizer :: LazyIO -> IO () -> IO ()
lazyOnError :: LazyIO -> SomeException -> IO ()
lazyOnEnd :: LazyIO -> IO ()
lazyOnData :: LazyIO -> ByteString -> IO ()
lazyContent :: LazyIO -> ByteString
lazySetFinalizer :: IO () -> IO ()
lazyOnError :: SomeException -> IO ()
lazyOnEnd :: IO ()
lazyOnData :: ByteString -> IO ()
lazyContent :: ByteString
..} <- IO LazyIO
newLazyIO
  JSVal
_on_data <- Session -> (ByteString -> IO ()) -> IO JSVal
forall f. Export f => Session -> f -> IO JSVal
export Session
_session (ByteString -> IO ()
lazyOnData (ByteString -> IO ())
-> (ByteString -> ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict)
  JSVal
_on_end <- Session -> IO () -> IO JSVal
forall f. Export f => Session -> f -> IO JSVal
export Session
_session IO ()
lazyOnEnd
  JSVal
_on_error <-
    Session -> (EncodedString -> IO ()) -> IO JSVal
forall f. Export f => Session -> f -> IO JSVal
export
      Session
_session
      (SomeException -> IO ()
lazyOnError (SomeException -> IO ())
-> (EncodedString -> SomeException) -> EncodedString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> SomeException
forall e. Exception e => e -> SomeException
toException (IOError -> SomeException)
-> (EncodedString -> IOError) -> EncodedString -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IOError)
-> (EncodedString -> String) -> EncodedString -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Show EncodedString => EncodedString -> String
forall a. Show a => a -> String
show @EncodedString)
  IO () -> IO ()
lazySetFinalizer (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [JSVal] -> (JSVal -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [JSVal
_on_data, JSVal
_on_end, JSVal
_on_error] JSVal -> IO ()
freeJSVal
  Session -> JSExpr -> IO ()
forall a. FromJS a => Session -> JSExpr -> IO a
eval @()
    Session
_session
    [js|
      $_stream.on("data", $_on_data);
      $_stream.on("end", $_on_end);
      $_stream.on("error", $_on_error);
    |]
  ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
lazyContent