UI: Reset the window if nothing is recorded

2 files changed, 38 insertions, 22 deletions

diff --git a/Bustle/UI.hs b/Bustle/UI.hs
index fa5e9f1..ea43fda 100644
--- a/Bustle/UI.hs
+++ b/Bustle/UI.hs
@@ -32,6 +32,7 @@ import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Data.List (intercalate)
 import Data.Time
+import Data.Monoid (mempty)
 
 import Paths_bustle
 import Bustle.Application.Monad
@@ -224,8 +225,11 @@ startRecording = do
     let filename = cacheDir </> yyyy_mm_dd_hh_mm_ss <.> "bustle"
 
     setPage wi PleaseHoldPage
-    embedIO $ \r -> recorderRun filename (Just (wiWindow wi)) (aChallengerAppears wi) $
-          makeCallback (finishedRecording wi filename) r
+    let mwindow = Just (wiWindow wi)
+        progress = aChallengerAppears wi
+        finished = finishedRecording wi filename
+    embedIO $ \r -> recorderRun filename mwindow progress
+                                (\p -> makeCallback (finished p) r)
 
 aChallengerAppears :: WindowInfo
                    -> RendererResult a
@@ -237,17 +241,25 @@ aChallengerAppears wi rr = do
 
 finishedRecording :: WindowInfo
                   -> FilePath
+                  -> Bool
                   -> B ()
-finishedRecording wi tempFilePath = do
-    loadLogWith (return wi) (RecordedLog tempFilePath)
-
-    let saveItem     = wiSave wi
-
-    io $ do
-        widgetSetSensitivity saveItem True
-        onActivateLeaf saveItem $ showSaveDialog wi (return ())
-
-    return ()
+finishedRecording wi tempFilePath producedOutput = do
+    if producedOutput
+      then do
+        -- TODO: There is a noticable lag when reloading big files. It would be
+        -- nice to either make the loading faster, or eliminate the reload.
+        loadLogWith (return wi) (RecordedLog tempFilePath)
+
+        let saveItem     = wiSave wi
+
+        io $ do
+            widgetSetSensitivity saveItem True
+            onActivateLeaf saveItem $ showSaveDialog wi (return ())
+        return ()
+      else do
+        setPage wi InstructionsPage
+        modify $ \s -> s { initialWindow = Just wi }
+        updateDisplayedLog wi (mempty :: RendererResult ())
 
 showSaveDialog :: WindowInfo
                -> IO ()
diff --git a/Bustle/UI/Recorder.hs b/Bustle/UI/Recorder.hs
index 482d4ee..2759927 100644
--- a/Bustle/UI/Recorder.hs
+++ b/Bustle/UI/Recorder.hs
@@ -5,7 +5,7 @@ module Bustle.UI.Recorder
   )
 where
 
-import Control.Monad (when)
+import Control.Monad (when, liftM)
 import Control.Concurrent.MVar
 import qualified Data.Map as Map
 import Data.Map (Map)
@@ -25,18 +25,19 @@ import Bustle.Util
 
 type RecorderIncomingCallback = RendererResult Participants
                              -> IO ()
-type RecorderFinishedCallback = IO ()
+type RecorderFinishedCallback = Bool -- ^ was anything meaningful actually recorded?
+                             -> IO ()
 
 processBatch :: MVar [DetailedMessage]
+             -> MVar Int
              -> Label
              -> RecorderIncomingCallback
              -> IO (IO Bool)
-processBatch pendingRef label incoming = do
+processBatch pendingRef n label incoming = do
     rendererStateRef <- newMVar rendererStateNew
     -- FIXME: this is stupid. If we have to manually combine the outputs, it's
     -- basically just more state.
     rendererResultRef <- newMVar mempty
-    n <- newMVar (0 :: Int)
 
     return $ do
         pending <- takeMVar pendingRef
@@ -47,6 +48,10 @@ processBatch pendingRef label incoming = do
                 let (rr, s') = processSome (reverse pending) [] s
                 return (s', rr)
 
+            oldRR <- takeMVar rendererResultRef
+            let rr' = oldRR `mappend` rr
+            putMVar rendererResultRef rr'
+
             when (not (null (rrShapes rr))) $ do
                 -- If the renderer produced some visible output, count it as a
                 -- message from the user's perspective.
@@ -56,10 +61,7 @@ processBatch pendingRef label incoming = do
                     "Logged <b>" ++ show j ++ "</b> messages…"
                 putMVar n j
 
-            oldRR <- takeMVar rendererResultRef
-            let rr' = oldRR `mappend` rr
-            putMVar rendererResultRef rr'
-            incoming rr'
+                incoming rr'
 
         return True
 
@@ -93,7 +95,8 @@ recorderRun filename mwindow incoming finished = handleGError newFailed $ do
               | otherwise -> return ()
 
     handlerId <- monitor `on` monitorMessageLogged $ updateLabel
-    processor <- processBatch pendingRef label incoming
+    n <- newMVar (0 :: Int)
+    processor <- processBatch pendingRef n label incoming
     processorId <- timeoutAdd processor 200
 
     bar <- progressBarNew
@@ -113,7 +116,8 @@ recorderRun filename mwindow incoming finished = handleGError newFailed $ do
         -- Flush out any last messages from the queue.
         processor
         widgetDestroy dialog
-        finished
+        hadOutput <- liftM (/= 0) (readMVar n)
+        finished hadOutput
 
     widgetShowAll dialog
   where