@@ -0,0 +1,56 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+-----------------------------------------------------------------------------
4+--
5+-- Module : Language.Javascript.JSaddle.WebSockets
6+-- Copyright : (c) Hamish Mackenzie
7+-- License : MIT
8+--
9+-- Maintainer : Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.Javascript.JSaddle.Null (
16+ run
17+) where
18+
19+import Language.Javascript.JSaddle.Types
20+ (BatchResults(..), JSM, JSStringReceived(..), Batch(..),
21+ Results(..), Result(..), Command(..))
22+import Control.Concurrent.Chan (readChan, writeChan, newChan)
23+import Language.Javascript.JSaddle.Run (runJavaScript)
24+import Control.Concurrent (forkIO)
25+import Control.Monad (forever)
26+import Data.Aeson (Value(..))
27+import Data.Maybe (mapMaybe)
28+
29+-- | This is for performance testing JSaddle code that does not need to
30+-- to read anything back from the JavaScript context.
31+-- Anthing that does try to read will get JS null, 0 or "" back (depending
32+-- on how the value is read).
33+run :: JSM () -> IO ()
34+run f = do
35+ batches <- newChan
36+ (processResult, _processSyncResult, start) <- runJavaScript (writeChan batches) f
37+ _ <- forkIO $ forever $
38+ readChan batches >>= \case
39+ Batch commands _ batchNumber ->
40+ processResult $ BatchResults batchNumber . Success $ mapMaybe (\case
41+ Left _ -> Nothing
42+ Right command -> Just $
43+ case command of
44+ DeRefVal _ -> DeRefValResult 0 ""
45+ ValueToBool _ -> ValueToBoolResult False
46+ ValueToNumber _ -> ValueToNumberResult 0
47+ ValueToString _ -> ValueToStringResult (JSStringReceived "")
48+ ValueToJSON _ -> ValueToJSONResult (JSStringReceived "null")
49+ ValueToJSONValue _ -> ValueToJSONValueResult Null
50+ IsNull _ -> IsNullResult True
51+ IsUndefined _ -> IsUndefinedResult False
52+ StrictEqual _ _ -> StrictEqualResult False
53+ InstanceOf _ _ -> InstanceOfResult False
54+ PropertyNames _ -> PropertyNamesResult []
55+ Sync -> SyncResult) commands
56+ start