|
| 1 | +-------------------------------------------------------------------------------- |
| 2 | +{-# LANGUAGE GeneralizedNewtypeDeriving #-} |
| 3 | +{-# LANGUAGE OverloadedStrings #-} |
| 4 | +{-# LANGUAGE RecordWildCards #-} |
| 5 | +module Patat.Main |
| 6 | + ( main |
| 7 | + ) where |
| 8 | + |
| 9 | + |
| 10 | +-------------------------------------------------------------------------------- |
| 11 | +import Control.Applicative ((<$>), (<*>)) |
| 12 | +import Control.Concurrent (forkIO, threadDelay) |
| 13 | +import qualified Control.Concurrent.Chan as Chan |
| 14 | +import Control.Exception (finally) |
| 15 | +import Control.Monad (forever, unless, when) |
| 16 | +import qualified Data.Aeson.Extended as A |
| 17 | +import Data.Monoid (mempty, (<>)) |
| 18 | +import Data.Time (UTCTime) |
| 19 | +import Data.Version (showVersion) |
| 20 | +import qualified Options.Applicative as OA |
| 21 | +import Patat.AutoAdvance |
| 22 | +import qualified Patat.Images as Images |
| 23 | +import Patat.Presentation |
| 24 | +import qualified Paths_patat |
| 25 | +import Prelude |
| 26 | +import qualified System.Console.ANSI as Ansi |
| 27 | +import System.Directory (doesFileExist, |
| 28 | + getModificationTime) |
| 29 | +import System.Exit (exitFailure, exitSuccess) |
| 30 | +import qualified System.IO as IO |
| 31 | +import qualified Text.Pandoc as Pandoc |
| 32 | +import qualified Text.PrettyPrint.ANSI.Leijen as PP |
| 33 | + |
| 34 | + |
| 35 | +-------------------------------------------------------------------------------- |
| 36 | +data Options = Options |
| 37 | + { oFilePath :: !(Maybe FilePath) |
| 38 | + , oForce :: !Bool |
| 39 | + , oDump :: !Bool |
| 40 | + , oWatch :: !Bool |
| 41 | + , oVersion :: !Bool |
| 42 | + } deriving (Show) |
| 43 | + |
| 44 | + |
| 45 | +-------------------------------------------------------------------------------- |
| 46 | +parseOptions :: OA.Parser Options |
| 47 | +parseOptions = Options |
| 48 | + <$> (OA.optional $ OA.strArgument $ |
| 49 | + OA.metavar "FILENAME" <> |
| 50 | + OA.help "Input file") |
| 51 | + <*> (OA.switch $ |
| 52 | + OA.long "force" <> |
| 53 | + OA.short 'f' <> |
| 54 | + OA.help "Force ANSI terminal" <> |
| 55 | + OA.hidden) |
| 56 | + <*> (OA.switch $ |
| 57 | + OA.long "dump" <> |
| 58 | + OA.short 'd' <> |
| 59 | + OA.help "Just dump all slides and exit" <> |
| 60 | + OA.hidden) |
| 61 | + <*> (OA.switch $ |
| 62 | + OA.long "watch" <> |
| 63 | + OA.short 'w' <> |
| 64 | + OA.help "Watch file for changes") |
| 65 | + <*> (OA.switch $ |
| 66 | + OA.long "version" <> |
| 67 | + OA.help "Display version info and exit" <> |
| 68 | + OA.hidden) |
| 69 | + |
| 70 | + |
| 71 | +-------------------------------------------------------------------------------- |
| 72 | +parserInfo :: OA.ParserInfo Options |
| 73 | +parserInfo = OA.info (OA.helper <*> parseOptions) $ |
| 74 | + OA.fullDesc <> |
| 75 | + OA.header ("patat v" <> showVersion Paths_patat.version) <> |
| 76 | + OA.progDescDoc (Just desc) |
| 77 | + where |
| 78 | + desc = PP.vcat |
| 79 | + [ "Terminal-based presentations using Pandoc" |
| 80 | + , "" |
| 81 | + , "Controls:" |
| 82 | + , "- Next slide: space, enter, l, right, pagedown" |
| 83 | + , "- Previous slide: backspace, h, left, pageup" |
| 84 | + , "- Go forward 10 slides: j, down" |
| 85 | + , "- Go backward 10 slides: k, up" |
| 86 | + , "- First slide: 0" |
| 87 | + , "- Last slide: G" |
| 88 | + , "- Reload file: r" |
| 89 | + , "- Quit: q" |
| 90 | + ] |
| 91 | + |
| 92 | + |
| 93 | +-------------------------------------------------------------------------------- |
| 94 | +parserPrefs :: OA.ParserPrefs |
| 95 | +parserPrefs = OA.prefs OA.showHelpOnError |
| 96 | + |
| 97 | + |
| 98 | +-------------------------------------------------------------------------------- |
| 99 | +errorAndExit :: [String] -> IO a |
| 100 | +errorAndExit msg = do |
| 101 | + mapM_ (IO.hPutStrLn IO.stderr) msg |
| 102 | + exitFailure |
| 103 | + |
| 104 | + |
| 105 | +-------------------------------------------------------------------------------- |
| 106 | +assertAnsiFeatures :: IO () |
| 107 | +assertAnsiFeatures = do |
| 108 | + supports <- Ansi.hSupportsANSI IO.stdout |
| 109 | + unless supports $ errorAndExit |
| 110 | + [ "It looks like your terminal does not support ANSI codes." |
| 111 | + , "If you still want to run the presentation, use `--force`." |
| 112 | + ] |
| 113 | + |
| 114 | + |
| 115 | +-------------------------------------------------------------------------------- |
| 116 | +main :: IO () |
| 117 | +main = do |
| 118 | + options <- OA.customExecParser parserPrefs parserInfo |
| 119 | + |
| 120 | + when (oVersion options) $ do |
| 121 | + putStrLn (showVersion Paths_patat.version) |
| 122 | + putStrLn $ "Using pandoc: " ++ Pandoc.pandocVersion |
| 123 | + exitSuccess |
| 124 | + |
| 125 | + filePath <- case oFilePath options of |
| 126 | + Just fp -> return fp |
| 127 | + Nothing -> OA.handleParseResult $ OA.Failure $ |
| 128 | + OA.parserFailure parserPrefs parserInfo OA.ShowHelpText mempty |
| 129 | + |
| 130 | + errOrPres <- readPresentation filePath |
| 131 | + pres <- either (errorAndExit . return) return errOrPres |
| 132 | + |
| 133 | + unless (oForce options) assertAnsiFeatures |
| 134 | + |
| 135 | + -- (Maybe) initialize images backend. |
| 136 | + images <- traverse Images.new (psImages $ pSettings pres) |
| 137 | + |
| 138 | + if oDump options |
| 139 | + then dumpPresentation pres |
| 140 | + else interactiveLoop options images pres |
| 141 | + where |
| 142 | + interactiveLoop :: Options -> Maybe Images.Handle -> Presentation -> IO () |
| 143 | + interactiveLoop options images pres0 = (`finally` cleanall) $ do |
| 144 | + IO.hSetBuffering IO.stdin IO.NoBuffering |
| 145 | + Ansi.hideCursor |
| 146 | + |
| 147 | + -- Spawn the initial channel that gives us commands based on user input. |
| 148 | + commandChan0 <- Chan.newChan |
| 149 | + _ <- forkIO $ forever $ |
| 150 | + readPresentationCommand IO.stdin >>= Chan.writeChan commandChan0 |
| 151 | + |
| 152 | + -- If an auto delay is set, use 'autoAdvance' to create a new one. |
| 153 | + commandChan <- case psAutoAdvanceDelay (pSettings pres0) of |
| 154 | + Nothing -> return commandChan0 |
| 155 | + Just (A.FlexibleNum delay) -> autoAdvance delay commandChan0 |
| 156 | + |
| 157 | + -- Spawn a thread that adds 'Reload' commands based on the file time. |
| 158 | + mtime0 <- getModificationTime (pFilePath pres0) |
| 159 | + when (oWatch options) $ do |
| 160 | + _ <- forkIO $ watcher commandChan (pFilePath pres0) mtime0 |
| 161 | + return () |
| 162 | + |
| 163 | + let loop :: Presentation -> Maybe String -> IO () |
| 164 | + loop pres mbError = do |
| 165 | + cleanup <- case mbError of |
| 166 | + Nothing -> displayPresentation images pres |
| 167 | + Just err -> displayPresentationError pres err |
| 168 | + |
| 169 | + c <- Chan.readChan commandChan |
| 170 | + update <- updatePresentation c pres |
| 171 | + cleanup |
| 172 | + case update of |
| 173 | + ExitedPresentation -> return () |
| 174 | + UpdatedPresentation pres' -> loop pres' Nothing |
| 175 | + ErroredPresentation err -> loop pres (Just err) |
| 176 | + |
| 177 | + loop pres0 Nothing |
| 178 | + |
| 179 | + cleanall :: IO () |
| 180 | + cleanall = do |
| 181 | + Ansi.showCursor |
| 182 | + Ansi.clearScreen |
| 183 | + Ansi.setCursorPosition 0 0 |
| 184 | + |
| 185 | + |
| 186 | +-------------------------------------------------------------------------------- |
| 187 | +watcher :: Chan.Chan PresentationCommand -> FilePath -> UTCTime -> IO a |
| 188 | +watcher chan filePath mtime0 = do |
| 189 | + -- The extra exists check helps because some editors temporarily make the |
| 190 | + -- file disappear while writing. |
| 191 | + exists <- doesFileExist filePath |
| 192 | + mtime1 <- if exists then getModificationTime filePath else return mtime0 |
| 193 | + |
| 194 | + when (mtime1 > mtime0) $ Chan.writeChan chan Reload |
| 195 | + threadDelay (200 * 1000) |
| 196 | + watcher chan filePath mtime1 |
0 commit comments