From 46154359eb1ff2b0b42c3a7d2b9ea1e76d6b3d90 Mon Sep 17 00:00:00 2001
From: NikolajDanger <nikolaj@ingemanngade.net>
Date: Wed, 16 Oct 2024 16:15:38 +0200
Subject: [PATCH] :mailbox_with_mail: help

---
 a6/{a6-handout => }/a6.cabal         |  0
 a6/{a6-handout => }/runtests.hs      |  0
 a6/{a6-handout => }/src/GenServer.hs |  0
 a6/{a6-handout => }/src/SPC.hs       | 70 ++++++++++++++++++++++++++--
 a6/{a6-handout => }/src/SPC_Tests.hs |  0
 5 files changed, 65 insertions(+), 5 deletions(-)
 rename a6/{a6-handout => }/a6.cabal (100%)
 rename a6/{a6-handout => }/runtests.hs (100%)
 rename a6/{a6-handout => }/src/GenServer.hs (100%)
 rename a6/{a6-handout => }/src/SPC.hs (77%)
 rename a6/{a6-handout => }/src/SPC_Tests.hs (100%)

diff --git a/a6/a6-handout/a6.cabal b/a6/a6.cabal
similarity index 100%
rename from a6/a6-handout/a6.cabal
rename to a6/a6.cabal
diff --git a/a6/a6-handout/runtests.hs b/a6/runtests.hs
similarity index 100%
rename from a6/a6-handout/runtests.hs
rename to a6/runtests.hs
diff --git a/a6/a6-handout/src/GenServer.hs b/a6/src/GenServer.hs
similarity index 100%
rename from a6/a6-handout/src/GenServer.hs
rename to a6/src/GenServer.hs
diff --git a/a6/a6-handout/src/SPC.hs b/a6/src/SPC.hs
similarity index 77%
rename from a6/a6-handout/src/SPC.hs
rename to a6/src/SPC.hs
index 2f90853..988dbf5 100644
--- a/a6/a6-handout/src/SPC.hs
+++ b/a6/src/SPC.hs
@@ -24,6 +24,8 @@ import Control.Concurrent
   ( forkIO,
     killThread,
     threadDelay,
+    newChan,
+    readChan
   )
 import Control.Monad (ap, forever, liftM, void)
 import GenServer
@@ -91,7 +93,9 @@ type WorkerName = String
 
 -- | Messages sent to workers. These are sent both by SPC and by
 -- processes spawned by the workes.
-data WorkerMsg -- TODO: add messages.
+data WorkerMsg 
+  = -- | New job time
+    MsgStartJob (IO ()) JobId
 
 -- Messages sent to SPC.
 data SPCMsg
@@ -105,6 +109,12 @@ data SPCMsg
     MsgJobWait JobId (ReplyChan JobDoneReason)
   | -- | Some time has passed.
     MsgTick
+  | -- | Ask if worker exists
+    MsgWorkerExists WorkerName (ReplyChan Bool)
+  | -- | Add a new worker
+    MsgAddWorker WorkerName Worker
+  | -- | Worker finished job
+    MsgJobDone JobId
 
 -- | A handle to the SPC instance.
 data SPC = SPC (Server SPCMsg)
@@ -115,9 +125,10 @@ data Worker = Worker (Server WorkerMsg)
 -- | The central state. Must be protected from the bourgeoisie.
 data SPCState = SPCState
   { spcJobsPending :: [(JobId, Job)],
-    spcJobsRunning :: [(JobId, Job)],
+    spcJobsRunning :: [(JobId, (Job, Worker))],
     spcJobsDone :: [(JobId, JobDoneReason)],
-    spcJobCounter :: JobId
+    spcJobCounter :: JobId,
+    spcWorkers :: [(WorkerName, Worker)]
     -- TODO: you will need to add more fields.
   }
 
@@ -206,6 +217,35 @@ handleMsg c = do
         (_, Just _, _) -> JobRunning
         (_, _, Just r) -> JobDone r
         _ -> JobUnknown
+    MsgWorkerExists name rsvp -> do
+      state <- get
+      io $ reply rsvp $ case (lookup name $ spcWorkers state) of
+        Just _ -> True
+        _ -> False
+    MsgAddWorker name worker -> do
+      state <- get      
+      put $
+        state
+          { spcWorkers =
+              (name, worker) : spcWorkers state
+          }
+    MsgJobDone jobid -> do
+      state <- get
+      case (lookup jobid $ spcJobsRunning state) of
+        Just (job, worker) -> do
+          put $
+            state
+              { spcJobsRunning =
+                  deleteJob jobid (spcJobsRunning state),
+                spcJobsDone =
+                  (jobid, Done) : spcJobsDone state
+              }
+
+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) 
 
 startSPC :: IO SPC
 startSPC = do
@@ -214,7 +254,8 @@ startSPC = do
           { spcJobCounter = JobId 0,
             spcJobsPending = [],
             spcJobsRunning = [],
-            spcJobsDone = []
+            spcJobsDone = [],
+            spcWorkers = []
           }
   c <- spawn $ \c -> runSPCM initial_state $ forever $ handleMsg c
   void $ spawn $ timer c
@@ -247,8 +288,27 @@ jobCancel (SPC c) jobid =
 -- | Add a new worker with this name. Fails with 'Left' if a worker
 -- with that name already exists.
 workerAdd :: SPC -> WorkerName -> IO (Either String Worker)
-workerAdd = undefined
+workerAdd (SPC c) name = do
+  exists <- requestReply c $ MsgWorkerExists name
+  if exists
+    then pure $ Left "Worker with given name already exist"
+  else do
+    worker <- workerSpawn name
+    sendTo c $ MsgAddWorker name worker
+    pure $ Right worker
 
+workerSpawn :: WorkerName -> IO Worker
+workerSpawn name = do
+  w <- spawn $ workerLoop name
+  pure $ Worker w
+
+workerLoop :: WorkerName -> Chan WorkerMsg -> IO ()
+workerLoop name c = do
+  msg <- receive c
+  case msg of
+    -- stuff happening here
+    MsgStartJob action jobid -> -- do stuff
+  
 -- | Shut down a running worker. No effect if the worker is already
 -- terminated.
 workerStop :: Worker -> IO ()
diff --git a/a6/a6-handout/src/SPC_Tests.hs b/a6/src/SPC_Tests.hs
similarity index 100%
rename from a6/a6-handout/src/SPC_Tests.hs
rename to a6/src/SPC_Tests.hs