{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
--
-- Module      :  Language.Javascript.JSaddle.WebSockets
-- Copyright   :  (c) Hamish Mackenzie
-- License     :  MIT
--
-- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
--
-- |
--
-----------------------------------------------------------------------------

module Language.Javascript.JSaddle.Null (
    run
) where

import Language.Javascript.JSaddle.Types
       (BatchResults(..), JSM, JSStringReceived(..), Batch(..),
        Results(..), Result(..), Command(..))
import Control.Concurrent.Chan (readChan, writeChan, newChan)
import Language.Javascript.JSaddle.Run (runJavaScript)
import Control.Concurrent (forkIO)
import Control.Monad (forever)
import Data.Aeson (Value(..))
import Data.Maybe (mapMaybe)

-- | This is for performance testing JSaddle code that does not need to
-- to read anything back from the JavaScript context.
-- Anthing that does try to read will get JS null, 0 or "" back (depending
-- on how the value is read).
run :: JSM () -> IO ()
run :: JSM () -> IO ()
run JSM ()
f = do
    Chan Batch
batches <- IO (Chan Batch)
forall a. IO (Chan a)
newChan
    (Results -> IO ()
processResult, Results -> IO Batch
_processSyncResult, IO ()
start) <- (Batch -> IO ())
-> JSM () -> IO (Results -> IO (), Results -> IO Batch, IO ())
runJavaScript (Chan Batch -> Batch -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan Batch
batches) JSM ()
f
    ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Chan Batch -> IO Batch
forall a. Chan a -> IO a
readChan Chan Batch
batches IO Batch -> (Batch -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Batch [Either AsyncCommand Command]
commands Bool
_ Int
batchNumber ->
                Results -> IO ()
processResult (Results -> IO ()) -> Results -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> BatchResults -> Results
BatchResults Int
batchNumber (BatchResults -> Results)
-> ([Result] -> BatchResults) -> [Result] -> Results
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JSValueReceived] -> [Result] -> BatchResults
Success [] ([Result] -> Results) -> [Result] -> Results
forall a b. (a -> b) -> a -> b
$ (Either AsyncCommand Command -> Maybe Result)
-> [Either AsyncCommand Command] -> [Result]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case
                        Left AsyncCommand
_ -> Maybe Result
forall a. Maybe a
Nothing
                        Right Command
command -> Result -> Maybe Result
forall a. a -> Maybe a
Just (Result -> Maybe Result) -> Result -> Maybe Result
forall a b. (a -> b) -> a -> b
$
                            case Command
command of
                                DeRefVal JSValueForSend
_ -> JSValueRef -> Text -> Result
DeRefValResult JSValueRef
0 Text
""
                                ValueToBool JSValueForSend
_ -> Bool -> Result
ValueToBoolResult Bool
False
                                ValueToNumber JSValueForSend
_ -> Double -> Result
ValueToNumberResult Double
0
                                ValueToString JSValueForSend
_ -> JSStringReceived -> Result
ValueToStringResult (Text -> JSStringReceived
JSStringReceived Text
"")
                                ValueToJSON JSValueForSend
_ -> JSStringReceived -> Result
ValueToJSONResult (Text -> JSStringReceived
JSStringReceived Text
"null")
                                ValueToJSONValue JSValueForSend
_ -> Value -> Result
ValueToJSONValueResult Value
Null
                                IsNull JSValueForSend
_ -> Bool -> Result
IsNullResult Bool
True
                                IsUndefined JSValueForSend
_ -> Bool -> Result
IsUndefinedResult Bool
False
                                StrictEqual JSValueForSend
_ JSValueForSend
_ -> Bool -> Result
StrictEqualResult Bool
False
                                InstanceOf JSValueForSend
_ JSObjectForSend
_ -> Bool -> Result
InstanceOfResult Bool
False
                                PropertyNames JSObjectForSend
_ -> [JSStringReceived] -> Result
PropertyNamesResult []
                                Command
Sync -> Result
SyncResult) [Either AsyncCommand Command]
commands
    IO ()
start