:clown-face: fixed a test
This commit is contained in:
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
module SPC
|
||||
( -- * SPC startup
|
||||
SPC,
|
||||
@ -93,7 +94,7 @@ type WorkerName = String
|
||||
|
||||
-- | Messages sent to workers. These are sent both by SPC and by
|
||||
-- processes spawned by the workes.
|
||||
data WorkerMsg
|
||||
data WorkerMsg
|
||||
= -- | New job time
|
||||
MsgStartJob SPC (IO ()) JobId
|
||||
|
||||
@ -129,7 +130,6 @@ data SPCState = SPCState
|
||||
spcJobsDone :: [(JobId, JobDoneReason)],
|
||||
spcJobCounter :: JobId,
|
||||
spcWorkers :: [(WorkerName, Worker)]
|
||||
-- TODO: you will need to add more fields.
|
||||
}
|
||||
|
||||
-- | The monad in which the main SPC thread runs. This is a state
|
||||
@ -137,6 +137,7 @@ data SPCState = SPCState
|
||||
newtype SPCM a = SPCM (SPCState -> IO (a, SPCState))
|
||||
|
||||
instance Functor SPCM where
|
||||
fmap :: (a -> b) -> SPCM a -> SPCM b
|
||||
fmap = liftM
|
||||
|
||||
instance Applicative SPCM where
|
||||
@ -213,7 +214,7 @@ handleMsg c = do
|
||||
Just _ -> True
|
||||
_ -> False
|
||||
MsgAddWorker name worker -> do
|
||||
state <- get
|
||||
state <- get
|
||||
put $
|
||||
state
|
||||
{ spcWorkers =
|
||||
@ -230,12 +231,14 @@ handleMsg c = do
|
||||
spcJobsDone =
|
||||
(jobid, Done) : spcJobsDone state
|
||||
}
|
||||
Nothing -> pure ()
|
||||
_ -> pure ()
|
||||
|
||||
deleteJob :: JobId -> [(JobId, (Job, Worker))] -> [(JobId, (Job, Worker))]
|
||||
deleteJob jobid list =
|
||||
case list of
|
||||
[] -> []
|
||||
(jid, (job, w)):l -> if (jid == jobid) then l else (jid,(job,w)):(deleteJob jobid l)
|
||||
(jid, (job, w)):l -> if (jid == jobid) then l else (jid,(job,w)):(deleteJob jobid l)
|
||||
|
||||
startSPC :: IO SPC
|
||||
startSPC = do
|
||||
@ -300,7 +303,7 @@ workerLoop name c = do
|
||||
MsgStartJob (SPC sc) action jobid -> do
|
||||
action
|
||||
sendTo sc $ MsgJobDone jobid
|
||||
|
||||
|
||||
-- | Shut down a running worker. No effect if the worker is already
|
||||
-- terminated.
|
||||
workerStop :: Worker -> IO ()
|
||||
|
@ -33,6 +33,6 @@ tests =
|
||||
testCase "worker-add-2-fail" $ do
|
||||
spc <- startSPC
|
||||
_ <- workerAdd spc "BD-1"
|
||||
w <- workerAdd spc "R5-D4"
|
||||
w <- workerAdd spc "BD-1"
|
||||
isRight w @?= False
|
||||
]
|
||||
|
Reference in New Issue
Block a user