📬 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:
@ -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.
|
||||||
|
@ -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
|
||||||
|
]
|
||||||
|
Reference in New Issue
Block a user