version 0.3.2.00.3.2.0

5 files changed, 58 insertions, 22 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index ae6153f..2a66f1d 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,8 @@
 # Changelog
 
+- 0.3.2.0 (2016-10-20)
+    * Keep running even if errors are encountered during reload.
+
 - 0.3.1.0 (2016-10-18)
     * Fix compilation with `lts-6.22`.
 
diff --git a/patat.cabal b/patat.cabal
index ac8b880..5068a78 100644
--- a/patat.cabal
+++ b/patat.cabal
@@ -1,5 +1,5 @@
 Name:                patat
-Version:             0.3.1.0
+Version:             0.3.2.0
 Synopsis:            Terminal-based presentations using Pandoc
 Description:         Terminal-based presentations using Pandoc
 License:             GPL-2
diff --git a/src/Main.hs b/src/Main.hs
index 4394835..6527cbd 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -11,12 +11,14 @@ import           Control.Concurrent           (forkIO, threadDelay)
 import qualified Control.Concurrent.Chan      as Chan
 import           Control.Monad                (forever, unless, when)
 import           Data.Monoid                  ((<>))
+import           Data.Time                    (UTCTime)
 import           Data.Version                 (showVersion)
 import qualified Options.Applicative          as OA
 import           Patat.Presentation
 import qualified Paths_patat
 import qualified System.Console.ANSI          as Ansi
-import           System.Directory             (getModificationTime)
+import           System.Directory             (doesFileExist,
+                                               getModificationTime)
 import           System.Exit                  (exitFailure)
 import qualified System.IO                    as IO
 import qualified Text.PrettyPrint.ANSI.Leijen as PP
@@ -105,8 +107,8 @@ main = do
     if oDump options
         then dumpPresentation pres
         else interactiveLoop options pres
-
   where
+    interactiveLoop :: Options -> Presentation -> IO ()
     interactiveLoop options pres0 = do
         IO.hSetBuffering IO.stdin IO.NoBuffering
         commandChan <- Chan.newChan
@@ -115,23 +117,34 @@ main = do
             readPresentationCommand >>= Chan.writeChan commandChan
 
         mtime0 <- getModificationTime (pFilePath pres0)
-        let watcher mtime = do
-                mtime' <- getModificationTime (pFilePath pres0)
-                when (mtime' > mtime) $ Chan.writeChan commandChan Reload
-                threadDelay (200 * 1000)
-                watcher mtime'
-
         when (oWatch options) $ do
-            _ <- forkIO $ watcher mtime0
+            _ <- forkIO $ watcher commandChan (pFilePath pres0) mtime0
             return ()
 
-        let loop pres = do
-                displayPresentation pres
+        let loop :: Presentation -> Maybe String -> IO ()
+            loop pres mbError = do
+                case mbError of
+                    Nothing  -> displayPresentation pres
+                    Just err -> displayPresentationError pres err
+
                 c      <- Chan.readChan commandChan
                 update <- updatePresentation c pres
                 case update of
                     ExitedPresentation        -> return ()
-                    UpdatedPresentation pres' -> loop pres'
-                    ErroredPresentation err   -> errorAndExit [err]
+                    UpdatedPresentation pres' -> loop pres' Nothing
+                    ErroredPresentation err   -> loop pres (Just err)
 
-        loop pres0
+        loop pres0 Nothing
+
+
+--------------------------------------------------------------------------------
+watcher :: Chan.Chan PresentationCommand -> FilePath -> UTCTime -> IO a
+watcher chan filePath mtime0 = do
+    -- The extra exists check helps because some editors temporarily make the
+    -- file dissapear while writing.
+    exists <- doesFileExist filePath
+    mtime1 <- if exists then getModificationTime filePath else return mtime0
+
+    when (mtime1 > mtime0) $ Chan.writeChan chan Reload
+    threadDelay (200 * 1000)
+    watcher chan filePath mtime1
diff --git a/src/Patat/Presentation.hs b/src/Patat/Presentation.hs
index bf6c2b3..8da5a30 100644
--- a/src/Patat/Presentation.hs
+++ b/src/Patat/Presentation.hs
@@ -5,6 +5,7 @@ module Patat.Presentation
     , Presentation (..)
     , readPresentation
     , displayPresentation
+    , displayPresentationError
     , dumpPresentation
 
     , PresentationCommand (..)
diff --git a/src/Patat/Presentation/Display.hs b/src/Patat/Presentation/Display.hs
index 942794b..3acf601 100644
--- a/src/Patat/Presentation/Display.hs
+++ b/src/Patat/Presentation/Display.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE RecordWildCards            #-}
 module Patat.Presentation.Display
     ( displayPresentation
+    , displayPresentationError
     , dumpPresentation
     ) where
 
@@ -31,8 +32,10 @@ import           Prelude
 
 
 --------------------------------------------------------------------------------
-displayPresentation :: Presentation -> IO ()
-displayPresentation Presentation {..} = do
+-- | Display something within the presentation borders that draw the title and
+-- the active slide number and so on.
+displayWithBorders :: Presentation -> (Theme -> PP.Doc) -> IO ()
+displayWithBorders Presentation {..} f = do
     Ansi.clearScreen
     Ansi.setCursorPosition 0 0
 
@@ -58,11 +61,7 @@ displayPresentation Presentation {..} = do
         putStrLn ""
         putStrLn ""
 
-    let slide = case drop pActiveSlide pSlides of
-            []      -> mempty
-            (s : _) -> s
-
-    PP.putDoc $ withWrapSettings settings $ prettySlide theme slide
+    PP.putDoc $ withWrapSettings settings $ f theme
     putStrLn ""
 
     let active      = show (pActiveSlide + 1) ++ " / " ++ show (length pSlides)
@@ -76,6 +75,26 @@ displayPresentation Presentation {..} = do
 
 
 --------------------------------------------------------------------------------
+displayPresentation :: Presentation -> IO ()
+displayPresentation pres@Presentation {..} = displayWithBorders pres $ \theme ->
+    let slide = case drop pActiveSlide pSlides of
+            []      -> mempty
+            (s : _) -> s in
+
+    prettySlide theme slide
+
+
+--------------------------------------------------------------------------------
+-- | Displays an error in the place of the presentation.  This is useful if we
+-- want to display an error but keep the presentation running.
+displayPresentationError :: Presentation -> String -> IO ()
+displayPresentationError pres err = displayWithBorders pres $ \Theme {..} ->
+    themed themeStrong "Error occurred in the presentation:" <$$>
+    "" <$$>
+    (PP.string err)
+
+
+--------------------------------------------------------------------------------
 dumpPresentation :: Presentation -> IO ()
 dumpPresentation pres =
     let theme = fromMaybe Theme.defaultTheme (psTheme $ pSettings pres) in