patat 0.3.1.0 → 0.3.2.0

raw patch · 5 files changed

+58/−22 lines, 5 files

Files

• CHANGELOG.md +3/−0
• patat.cabal +1/−1
• src/Main.hs +27/−14
• src/Patat/Presentation.hs +1/−0
• src/Patat/Presentation/Display.hs +26/−7

@@ -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`. 

@@ -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

@@ -11,12 +11,14 @@ 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 @@     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 @@             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

@@ -5,6 +5,7 @@     , Presentation (..)     , readPresentation     , displayPresentation+    , displayPresentationError     , dumpPresentation      , PresentationCommand (..)

@@ -4,6 +4,7 @@ {-# LANGUAGE RecordWildCards            #-} module Patat.Presentation.Display     ( displayPresentation+    , displayPresentationError     , dumpPresentation     ) where @@ -31,8 +32,10 @@   ---------------------------------------------------------------------------------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 @@         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)@@ -73,6 +72,26 @@     Ansi.setCursorColumn (columns - activeWidth - 1)     PP.putDoc $ borders $ PP.string active     putStrLn ""+++--------------------------------------------------------------------------------+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)   --------------------------------------------------------------------------------