A better way to do this would be to keep an active flag on the file s…

…tore instead so that message processing can be delayed or possibly handled selectively...

Revert "Clear the client message queue when access to the root directory is lost"

This reverts commit 2d212b0.

src/Handler/StorageHandler.hs

@@ -9,20 +9,10 @@ import WebsocketApp (Clients)
 import qualified STM.Clients
 import qualified STM.FileStore as STM (FileStore)
 import qualified STM.FileStore
-import qualified STM.Messages as STM (Messages)
-import qualified STM.Messages
 
-reloadWatchPath :: Clients -> STM.FileStore -> STM.Messages -> IO ()
-reloadWatchPath clients fileStore clientMessages = do
-  -- Try to reload the file store
+reloadWatchPath :: Clients -> STM.FileStore -> IO ()
+reloadWatchPath clients fileStore = do
   errorOrFiles <- try $ STM.FileStore.reload fileStore
-  -- Clear all of the unprocessed client messages if the root directory was moved out
-  -- TODO: We should also ignore all message we receive from any client until they acknowledge
-  --       a Reload message with the "RestoredRootDirectory" event...
-  case errorOrFiles of
-    Left _ -> STM.Messages.clearMessages clientMessages
-    Right _ -> return ()
-  -- Broadcast a reload command to all of the clients 
   STM.Clients.broadcastMessage clients $ case errorOrFiles of
     Left _ -> ReloadFiles MovedOutRootDirectory []
     Right files -> ReloadFiles RestoredRootDirectory files

src/MessageDispatch.hs

@@ -35,14 +35,14 @@ dispatch serverStateT clients fileStore serverMessages clientMessages = do
               else return Nothing
   -- Process the message, dispatching it to the relevant handler
   case maybeMessage of
-    Just message -> (processMessage clients fileStore clientMessages message) >> return True
+    Just message -> (processMessage clients fileStore message) >> return True
     Nothing -> return False
 
-processMessage :: Clients -> STM.FileStore -> STM.Messages -> Message -> IO ()
-processMessage clients fileStore clientMessages message =
+processMessage :: Clients -> STM.FileStore -> Message -> IO ()
+processMessage clients fileStore message =
   case message of
     -- Server messages
-    ReloadWatchPath -> reloadWatchPath clientMessages
+    ReloadWatchPath -> reloadWatchPath
     LoadFile _ _ -> loadFile message
     -- Client messages 
 

src/STM/Messages.hs

@@ -1,9 +1,8 @@
-module STM.Messages (Messages, newIO, enqueueMessage, clearMessages) where
+module STM.Messages (Messages, newIO, enqueueMessage) where
 
 -- Standard modules
 import Control.Concurrent.STM (atomically)
 import Control.Concurrent.STM.TChan
-import Control.Monad (unless)
 
 -- Application modules
 import Message
@@ -16,15 +15,4 @@ newIO = newTChanIO
 
 -- Add a message to the queue as a single atomic transaction
 enqueueMessage :: Messages -> Message -> IO ()
-enqueueMessage m = atomically . (writeTChan m)
-
--- Clear all the messages from the queue without processing them using multiple atomic operations 
-clearMessages :: Messages -> IO ()
-clearMessages m = do
-  done <- atomically $ do 
-    isEmpty <- isEmptyTChan m
-    unless isEmpty $ readTChan m >> return ()
-    return isEmpty
-  if done
-    then return ()
-    else clearMessages m
+enqueueMessage messages = atomically . (writeTChan messages)