summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasperVanDerJeugt <>2016-10-20 08:27:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-10-20 08:27:00 (GMT)
commitbbd085267e4ee57fd8fd77f2471864835658651a (patch)
treee162cf2c699fca0041f0eebe73a7ae7abd88cd72
parent6a1e043bd576e935e3d5dff4712779222148612d (diff)
version 0.3.2.00.3.2.0
-rw-r--r--CHANGELOG.md3
-rw-r--r--patat.cabal2
-rw-r--r--src/Main.hs41
-rw-r--r--src/Patat/Presentation.hs1
-rw-r--r--src/Patat/Presentation/Display.hs33
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