diff --git a/a6/src/SPC.hs b/a6/src/SPC.hs index bbfd428..1d4faf3 100644 --- a/a6/src/SPC.hs +++ b/a6/src/SPC.hs @@ -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 () diff --git a/a6/src/SPC_Tests.hs b/a6/src/SPC_Tests.hs index 7976232..a55ed40 100644 --- a/a6/src/SPC_Tests.hs +++ b/a6/src/SPC_Tests.hs @@ -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 ]