📬 nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare nightmare

This commit is contained in:
2024-10-16 16:54:24 +02:00
parent 46154359eb
commit 7f0191098e
2 changed files with 36 additions and 13 deletions

View File

@ -95,7 +95,7 @@ type WorkerName = String
-- processes spawned by the workes. -- processes spawned by the workes.
data WorkerMsg data WorkerMsg
= -- | New job time = -- | New job time
MsgStartJob (IO ()) JobId MsgStartJob SPC (IO ()) JobId
-- Messages sent to SPC. -- Messages sent to SPC.
data SPCMsg data SPCMsg
@ -173,12 +173,6 @@ io m = SPCM $ \state -> do
runSPCM :: SPCState -> SPCM a -> IO a runSPCM :: SPCState -> SPCM a -> IO a
runSPCM state (SPCM f) = fst <$> f state runSPCM state (SPCM f) = fst <$> f state
schedule :: SPCM ()
schedule = undefined
jobDone :: JobId -> JobDoneReason -> SPCM ()
jobDone = undefined
workerIsIdle :: WorkerName -> Worker -> SPCM () workerIsIdle :: WorkerName -> Worker -> SPCM ()
workerIsIdle = undefined workerIsIdle = undefined
@ -188,13 +182,9 @@ workerIsGone = undefined
checkTimeouts :: SPCM () checkTimeouts :: SPCM ()
checkTimeouts = pure () -- change in Task 4 checkTimeouts = pure () -- change in Task 4
workerExists :: WorkerName -> SPCM Bool
workerExists = undefined
handleMsg :: Chan SPCMsg -> SPCM () handleMsg :: Chan SPCMsg -> SPCM ()
handleMsg c = do handleMsg c = do
checkTimeouts checkTimeouts
schedule
msg <- io $ receive c msg <- io $ receive c
case msg of case msg of
MsgJobAdd job rsvp -> do MsgJobAdd job rsvp -> do
@ -307,7 +297,9 @@ workerLoop name c = do
msg <- receive c msg <- receive c
case msg of case msg of
-- stuff happening here -- stuff happening here
MsgStartJob action jobid -> -- do stuff MsgStartJob (SPC sc) action jobid -> do
action
sendTo sc $ MsgJobDone jobid
-- | Shut down a running worker. No effect if the worker is already -- | Shut down a running worker. No effect if the worker is already
-- terminated. -- terminated.

View File

@ -4,12 +4,43 @@ import Control.Concurrent (threadDelay)
import Control.Monad (forM, forM_, replicateM) import Control.Monad (forM, forM_, replicateM)
import Data.IORef import Data.IORef
import SPC import SPC
import GenServer
import Test.Tasty (TestTree, localOption, mkTimeout, testGroup) import Test.Tasty (TestTree, localOption, mkTimeout, testGroup)
import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) import Test.Tasty.HUnit (assertFailure, testCase, (@?=))
import Data.Either (isRight)
tests :: TestTree tests :: TestTree
tests = tests =
localOption (mkTimeout 3000000) $ localOption (mkTimeout 3000000) $
testGroup testGroup
"SPC (core)" "SPC (core)"
[] [
testCase "worker-add" $ do
spc <- startSPC
w <- workerAdd spc "Nikolaj"
isRight w @?= True,
testCase "worker-add-2" $ do
spc <- startSPC
_ <- workerAdd spc "Nikolaj"
w <- workerAdd spc "Alba"
isRight w @?= True,
testCase "worker-add-3" $ do
spc <- startSPC
_ <- workerAdd spc "Nikolaj"
_ <- workerAdd spc "Alba"
w <- workerAdd spc "Sebastian"
isRight w @?= True,
testCase "worker-add-2-fail" $ do
spc <- startSPC
_ <- workerAdd spc "Nikolaj"
w <- workerAdd spc "Nikolaj"
isRight w @?= False,
testCase "worker-job" $ do
spc <- startSPC
w <- workerAdd spc "Nikolaj"
ref <- newIORef False
case spc of (SPC c) -> sendTo c (writeIORef ref True) 1
isRight w @?= True
v <- readIORef ref
v @?= True
]