<commit_before>{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Main where

import Control.Distributed.Process
import Control.Distributed.Process.Node
import Control.Distributed.Process.Platform
  ( Routable(..)
  , Resolvable(..)
  , Observable(..)
  , Channel
  )
import qualified Control.Distributed.Process.Platform (__remoteTable)
import Control.Distributed.Process.Platform.Execution.EventManager hiding (start)
import Control.Distributed.Process.Platform.Execution.Exchange
import Control.Distributed.Process.Platform.Execution.Exchange.Router
import qualified Control.Distributed.Process.Platform.Execution.EventManager as EventManager
  ( start
  )
-- import Control.Distributed.Process.Platform.Execution.Exchange.Broadcast (monitor)
import Control.Distributed.Process.Platform.Test
-- import Control.Distributed.Process.Platform.Time
-- import Control.Distributed.Process.Platform.Timer
import Control.Monad (void)
import Control.Rematch (equalTo)

#if ! MIN_VERSION_base(4,6,0)
import Prelude hiding (catch, drop)
#else
import Prelude hiding (drop)
#endif

import Data.Maybe (catMaybes)
import qualified Network.Transport as NT
import Test.Framework as TF (testGroup, Test)
import Test.Framework.Providers.HUnit
import TestUtils

testKeyBasedRouting :: TestResult Bool -> Process ()
testKeyBasedRouting result = do
  (sp, rp) <- newChan :: Process (Channel Int)
  rex <- messageKeyRouter PayloadOnly
  void $ spawnLocal $ do
    bindKey "foobar" rex
    receiveWait [ match (\(s :: Int) -> sendChan sp s) ]

  -- TODO: This is hanging...... Looks like it's because binding is async!!!

  routeMessage rex (createMessage "foobar" [] (123 :: Int))

  stash result . (== (123 :: Int)) =<< receiveChan rp

testSimpleEventHandling :: TestResult Bool -> Process ()
testSimpleEventHandling result = do
  (sp, rp) <- newChan
  (sigStart, recvStart) <- newChan
  em <- EventManager.start
  Just pid <- resolve em
  void $ monitor pid

  -- Note that in our init (state) function, we write a "start signal"
  -- here; Without a start signal, the message sent to the event manager
  -- (via notify) would race with the addHandler registration.
  pid <- addHandler em (myHandler sp) (sendChan sigStart ())<commit_msg>Use spawnSignalled in our Router tests to avoid a silly race<commit_after>{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Main where

import Control.Distributed.Process
import Control.Distributed.Process.Node
import Control.Distributed.Process.Platform
  ( Routable(..)
  , Resolvable(..)
  , Observable(..)
  , Channel
  , spawnSignalled
  )
import qualified Control.Distributed.Process.Platform (__remoteTable)
import Control.Distributed.Process.Platform.Execution.EventManager hiding (start)
import Control.Distributed.Process.Platform.Execution.Exchange
import Control.Distributed.Process.Platform.Execution.Exchange.Router
import qualified Control.Distributed.Process.Platform.Execution.EventManager as EventManager
  ( start
  )
-- import Control.Distributed.Process.Platform.Execution.Exchange.Broadcast (monitor)
import Control.Distributed.Process.Platform.Test
-- import Control.Distributed.Process.Platform.Time
-- import Control.Distributed.Process.Platform.Timer
import Control.Monad (void)
import Control.Rematch (equalTo)

#if ! MIN_VERSION_base(4,6,0)
import Prelude hiding (catch, drop)
#else
import Prelude hiding (drop)
#endif

import Data.Maybe (catMaybes)
import qualified Network.Transport as NT
import Test.Framework as TF (testGroup, Test)
import Test.Framework.Providers.HUnit
import TestUtils

testKeyBasedRouting :: TestResult Bool -> Process ()
testKeyBasedRouting result = do
  (sp, rp) <- newChan :: Process (Channel Int)
  rex <- messageKeyRouter PayloadOnly

  -- Since the /router/ doesn't offer a syncrhonous start
  -- option, we use spawnSignalled to get the same effect,
  -- making it more likely (though it's not guaranteed) that
  -- the spawned process will be bound to the routing exchange
  -- prior to our evaluating 'routeMessage' below.
  void $ spawnSignalled (bindKey "foobar" rex) $ const $ do
    receiveWait [ match (\(s :: Int) -> sendChan sp s) ]

  routeMessage rex (createMessage "foobar" [] (123 :: Int))
  stash result . (== (123 :: Int)) =<< receiveChan rp

testSimpleEventHandling :: TestResult Bool -> Process ()
testSimpleEventHandling result = do
  (sp, rp) <- newChan
  (sigStart, recvStart) <- newChan
  em <- EventManager.start
  Just pid <- resolve em
  void $ monitor pid

  -- Note that in our init (state) function, we write a "start signal"
  -- here; Without a start signal, the message sent to the event manager
  -- (via notify) would race with the addHandler registration.
  pid <- addHandler em (myHandler sp) (sendChan sigStart ())
{'fraction_non_alphanumeric': 0.1045619701251514, 'fraction_numerical': 0.0036334275333064193, 'mean_word_length': 4.327956989247312, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 9, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7210449', 'n_tokens_mistral': 1481, 'n_tokens_neox': 1417, 'n_words': 441}