Prepare mechanisms to release AI sessions.

refs #44. Not used yet.

Author: portnov

src/AI/Session.hs

@@ -28,18 +28,36 @@ newAiSession = do
                         }
   return (sessionId, newSession)
 
+releaseAiSession :: AiSessionId -> Checkers ()
+releaseAiSession sessionId = do
+  var <- askSupervisor
+  ok <- liftIO $ atomically $ stateTVar var $ \st -> do
+            case M.lookup sessionId (ssAiSessions st) of
+              Nothing -> (False, st)
+              Just session ->
+                let st' = st {
+                            ssAiSessions = M.delete sessionId (ssAiSessions st)
+                          }
+                in (True, st')
+  when (not ok) $
+    throwError NoSuchAiSession
+
+returnBoard :: AiSession -> Board -> Checkers ()
+returnBoard session board =
+    liftIO $ putMVar (aiResult session) board
+      
 signalStopAiSession :: AiSessionId -> Checkers ()
 signalStopAiSession sessionId = do
   var <- askSupervisor
-  st <- liftIO $ atomically $ readTVar var
+  st <- liftIO $ readTVarIO var
   case M.lookup sessionId (ssAiSessions st) of
     Nothing -> throwError NoSuchAiSession
     Just session -> liftIO $ void $ tryPutMVar (aiStopSignal session) ()
 
 getAiSessionStatus :: AiSessionId -> Checkers AiSessionStatus
 getAiSessionStatus sessionId = do
   var <- askSupervisor
-  st <- liftIO $ atomically $ readTVar var
+  st <- liftIO $ readTVarIO var
   case M.lookup sessionId (ssAiSessions st) of
     Nothing -> return NoAiHere
     Just state -> do

src/Core/Supervisor.hs

@@ -762,7 +762,7 @@ letAiMove separateThread gameId side mbBoard = do
                     $debug "Messages: {}" (Single $ show messages)
                     afterMoveSelected ai storage gameId side board' aiMove
                     queueNotifications (getGameId game) messages
-                    liftIO $ putMVar (aiResult aiSession) board'
+                    returnBoard aiSession board'
                 afterMove gameId side
                 return ()
               return (Just sessionId)