From 4e26851fea06a046c1d82625eb41a6bf905bbddc Mon Sep 17 00:00:00 2001
From: Rehno Lindeque <errantkid@gmail.com>
Date: Tue, 5 Jun 2012 01:44:32 -0700
Subject: [PATCH] A better way to do this would be to keep an active flag on
 the file store 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 2d212b0d00625dd82917e99835673581d5625c82.
---
 src/Handler/StorageHandler.hs | 14 ++------------
 src/MessageDispatch.hs        |  8 ++++----
 src/STM/Messages.hs           | 16 ++--------------
 3 files changed, 8 insertions(+), 30 deletions(-)

diff --git a/src/Handler/StorageHandler.hs b/src/Handler/StorageHandler.hs
index 8789e62..deadb09 100644
--- a/src/Handler/StorageHandler.hs
+++ b/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
diff --git a/src/MessageDispatch.hs b/src/MessageDispatch.hs
index f1cd7d6..fdf6a74 100644
--- a/src/MessageDispatch.hs
+++ b/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 
     
diff --git a/src/STM/Messages.hs b/src/STM/Messages.hs
index 12a9e0e..8b51991 100644
--- a/src/STM/Messages.hs
+++ b/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
\ No newline at end of file
+enqueueMessage messages = atomically . (writeTChan messages)