{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Patat.Main
( main
) where
import Control.Concurrent (forkIO, killThread,
threadDelay)
import Control.Concurrent.Chan (Chan)
import qualified Control.Concurrent.Chan as Chan
import Control.Exception (bracket)
import Control.Monad (forever, unless, when)
import qualified Data.Aeson.Extended as A
import Data.Foldable (for_)
import Data.Functor (($>))
import Data.Time (UTCTime)
import Data.Version (showVersion)
import qualified Options.Applicative as OA
import qualified Options.Applicative.Help.Pretty as OA.PP
import Patat.AutoAdvance
import qualified Patat.EncodingFallback as EncodingFallback
import qualified Patat.Images as Images
import Patat.Presentation
import qualified Patat.Presentation.SpeakerNotes as SpeakerNotes
import qualified Patat.PrettyPrint as PP
import qualified Paths_patat
import Prelude
import qualified System.Console.ANSI as Ansi
import System.Directory (doesFileExist,
getModificationTime)
import System.Exit (exitFailure, exitSuccess)
import qualified System.IO as IO
import qualified Text.Pandoc as Pandoc
data Options = Options
{ Options -> Maybe FilePath
oFilePath :: !(Maybe FilePath)
, Options -> Bool
oForce :: !Bool
, Options -> Bool
oDump :: !Bool
, Options -> Bool
oWatch :: !Bool
, Options -> Bool
oVersion :: !Bool
} deriving (Int -> Options -> ShowS
[Options] -> ShowS
Options -> FilePath
(Int -> Options -> ShowS)
-> (Options -> FilePath) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Options -> ShowS
showsPrec :: Int -> Options -> ShowS
$cshow :: Options -> FilePath
show :: Options -> FilePath
$cshowList :: [Options] -> ShowS
showList :: [Options] -> ShowS
Show)
parseOptions :: OA.Parser Options
parseOptions :: Parser Options
parseOptions = Maybe FilePath -> Bool -> Bool -> Bool -> Bool -> Options
Options
(Maybe FilePath -> Bool -> Bool -> Bool -> Bool -> Options)
-> Parser (Maybe FilePath)
-> Parser (Bool -> Bool -> Bool -> Bool -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (Parser FilePath -> Parser (Maybe FilePath))
-> Parser FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
OA.strArgument (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$
FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
OA.metavar FilePath
"FILENAME" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
OA.action FilePath
"file" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Input file")
Parser (Bool -> Bool -> Bool -> Bool -> Options)
-> Parser Bool -> Parser (Bool -> Bool -> Bool -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Mod FlagFields Bool -> Parser Bool
OA.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"force" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'f' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Force ANSI terminal" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
OA.hidden)
Parser (Bool -> Bool -> Bool -> Options)
-> Parser Bool -> Parser (Bool -> Bool -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Mod FlagFields Bool -> Parser Bool
OA.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"dump" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'd' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Just dump all slides and exit" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
OA.hidden)
Parser (Bool -> Bool -> Options)
-> Parser Bool -> Parser (Bool -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Mod FlagFields Bool -> Parser Bool
OA.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"watch" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'w' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Watch file for changes")
Parser (Bool -> Options) -> Parser Bool -> Parser Options
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Mod FlagFields Bool -> Parser Bool
OA.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"version" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Display version info and exit" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
OA.hidden)
parserInfo :: OA.ParserInfo Options
parserInfo :: ParserInfo Options
parserInfo = Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (Parser (Options -> Options)
forall a. Parser (a -> a)
OA.helper Parser (Options -> Options) -> Parser Options -> Parser Options
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
parseOptions) (InfoMod Options -> ParserInfo Options)
-> InfoMod Options -> ParserInfo Options
forall a b. (a -> b) -> a -> b
$
InfoMod Options
forall a. InfoMod a
OA.fullDesc InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<>
FilePath -> InfoMod Options
forall a. FilePath -> InfoMod a
OA.header (FilePath
"patat v" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
Paths_patat.version) InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<>
Maybe Doc -> InfoMod Options
forall a. Maybe Doc -> InfoMod a
OA.progDescDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just Doc
desc)
where
desc :: Doc
desc = [Doc] -> Doc
OA.PP.vcat
[ Doc
"Terminal-based presentations using Pandoc"
, Doc
""
, Doc
"Controls:"
, Doc
"- Next slide: space, enter, l, right, pagedown"
, Doc
"- Previous slide: backspace, h, left, pageup"
, Doc
"- Go forward 10 slides: j, down"
, Doc
"- Go backward 10 slides: k, up"
, Doc
"- First slide: 0"
, Doc
"- Last slide: G"
, Doc
"- Jump to slide N: N followed by enter"
, Doc
"- Reload file: r"
, Doc
"- Quit: q"
]
parserPrefs :: OA.ParserPrefs
parserPrefs :: ParserPrefs
parserPrefs = PrefsMod -> ParserPrefs
OA.prefs PrefsMod
OA.showHelpOnError
errorAndExit :: [String] -> IO a
errorAndExit :: forall a. [FilePath] -> IO a
errorAndExit [FilePath]
msg = do
(FilePath -> Cleanup) -> [FilePath] -> Cleanup
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> FilePath -> Cleanup
IO.hPutStrLn Handle
IO.stderr) [FilePath]
msg
IO a
forall a. IO a
exitFailure
assertAnsiFeatures :: IO ()
assertAnsiFeatures :: Cleanup
assertAnsiFeatures = do
Bool
supports <- Handle -> IO Bool
Ansi.hSupportsANSI Handle
IO.stdout
Bool -> Cleanup -> Cleanup
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
supports (Cleanup -> Cleanup) -> Cleanup -> Cleanup
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Cleanup
forall a. [FilePath] -> IO a
errorAndExit
[ FilePath
"It looks like your terminal does not support ANSI codes."
, FilePath
"If you still want to run the presentation, use `--force`."
]
main :: IO ()
main :: Cleanup
main = do
Options
options <- ParserPrefs -> ParserInfo Options -> IO Options
forall a. ParserPrefs -> ParserInfo a -> IO a
OA.customExecParser ParserPrefs
parserPrefs ParserInfo Options
parserInfo
Bool -> Cleanup -> Cleanup
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
oVersion Options
options) (Cleanup -> Cleanup) -> Cleanup -> Cleanup
forall a b. (a -> b) -> a -> b
$ do
FilePath -> Cleanup
putStrLn (FilePath -> Cleanup) -> FilePath -> Cleanup
forall a b. (a -> b) -> a -> b
$ Version -> FilePath
showVersion Version
Paths_patat.version
FilePath -> Cleanup
putStrLn (FilePath -> Cleanup) -> FilePath -> Cleanup
forall a b. (a -> b) -> a -> b
$ FilePath
"Using pandoc: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
Pandoc.pandocVersion
Cleanup
forall a. IO a
exitSuccess
FilePath
filePath <- case Options -> Maybe FilePath
oFilePath Options
options of
Just FilePath
fp -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
Maybe FilePath
Nothing -> ParserResult FilePath -> IO FilePath
forall a. ParserResult a -> IO a
OA.handleParseResult (ParserResult FilePath -> IO FilePath)
-> ParserResult FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ ParserFailure ParserHelp -> ParserResult FilePath
forall a. ParserFailure ParserHelp -> ParserResult a
OA.Failure (ParserFailure ParserHelp -> ParserResult FilePath)
-> ParserFailure ParserHelp -> ParserResult FilePath
forall a b. (a -> b) -> a -> b
$
ParserPrefs
-> ParserInfo Options
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
forall a.
ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
OA.parserFailure ParserPrefs
parserPrefs ParserInfo Options
parserInfo
(Maybe FilePath -> ParseError
OA.ShowHelpText Maybe FilePath
forall a. Maybe a
Nothing) [Context]
forall a. Monoid a => a
mempty
Either FilePath Presentation
errOrPres <- FilePath -> IO (Either FilePath Presentation)
readPresentation FilePath
filePath
Presentation
pres <- (FilePath -> IO Presentation)
-> (Presentation -> IO Presentation)
-> Either FilePath Presentation
-> IO Presentation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([FilePath] -> IO Presentation
forall a. [FilePath] -> IO a
errorAndExit ([FilePath] -> IO Presentation)
-> (FilePath -> [FilePath]) -> FilePath -> IO Presentation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return) Presentation -> IO Presentation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either FilePath Presentation
errOrPres
Bool -> Cleanup -> Cleanup
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
oForce Options
options) Cleanup
assertAnsiFeatures
Maybe Handle
images <- (ImageSettings -> IO Handle)
-> Maybe ImageSettings -> IO (Maybe Handle)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ImageSettings -> IO Handle
Images.new (Maybe ImageSettings -> IO (Maybe Handle))
-> Maybe ImageSettings -> IO (Maybe Handle)
forall a b. (a -> b) -> a -> b
$ PresentationSettings -> Maybe ImageSettings
psImages (PresentationSettings -> Maybe ImageSettings)
-> PresentationSettings -> Maybe ImageSettings
forall a b. (a -> b) -> a -> b
$ Presentation -> PresentationSettings
pSettings Presentation
pres
(Settings -> (Handle -> Cleanup) -> Cleanup)
-> Maybe Settings -> (Maybe Handle -> Cleanup) -> Cleanup
forall settings handle a.
(settings -> (handle -> IO a) -> IO a)
-> Maybe settings -> (Maybe handle -> IO a) -> IO a
withMaybeHandle Settings -> (Handle -> Cleanup) -> Cleanup
forall a. Settings -> (Handle -> IO a) -> IO a
SpeakerNotes.with
(PresentationSettings -> Maybe Settings
psSpeakerNotes (PresentationSettings -> Maybe Settings)
-> PresentationSettings -> Maybe Settings
forall a b. (a -> b) -> a -> b
$ Presentation -> PresentationSettings
pSettings Presentation
pres) ((Maybe Handle -> Cleanup) -> Cleanup)
-> (Maybe Handle -> Cleanup) -> Cleanup
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
speakerNotes ->
if Options -> Bool
oDump Options
options then
Handle -> EncodingFallback -> Cleanup -> Cleanup
forall a. Handle -> EncodingFallback -> IO a -> IO a
EncodingFallback.withHandle Handle
IO.stdout (Presentation -> EncodingFallback
pEncodingFallback Presentation
pres) (Cleanup -> Cleanup) -> Cleanup -> Cleanup
forall a b. (a -> b) -> a -> b
$
Presentation -> Cleanup
dumpPresentation Presentation
pres
else
Options -> Maybe Handle -> Maybe Handle -> Presentation -> Cleanup
interactiveLoop Options
options Maybe Handle
images Maybe Handle
speakerNotes Presentation
pres
where
interactiveLoop
:: Options -> Maybe Images.Handle -> Maybe SpeakerNotes.Handle
-> Presentation -> IO ()
interactiveLoop :: Options -> Maybe Handle -> Maybe Handle -> Presentation -> Cleanup
interactiveLoop Options
options Maybe Handle
images Maybe Handle
speakerNotes Presentation
pres0 =
(Handle -> IO PresentationCommand)
-> (Chan PresentationCommand -> Cleanup) -> Cleanup
forall a. (Handle -> IO a) -> (Chan a -> Cleanup) -> Cleanup
interactively Handle -> IO PresentationCommand
readPresentationCommand ((Chan PresentationCommand -> Cleanup) -> Cleanup)
-> (Chan PresentationCommand -> Cleanup) -> Cleanup
forall a b. (a -> b) -> a -> b
$ \Chan PresentationCommand
commandChan0 -> do
Chan PresentationCommand
commandChan <- case PresentationSettings -> Maybe (FlexibleNum Int)
psAutoAdvanceDelay (Presentation -> PresentationSettings
pSettings Presentation
pres0) of
Maybe (FlexibleNum Int)
Nothing -> Chan PresentationCommand -> IO (Chan PresentationCommand)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Chan PresentationCommand
commandChan0
Just (A.FlexibleNum Int
delay) -> Int -> Chan PresentationCommand -> IO (Chan PresentationCommand)
autoAdvance Int
delay Chan PresentationCommand
commandChan0
UTCTime
mtime0 <- FilePath -> IO UTCTime
getModificationTime (Presentation -> FilePath
pFilePath Presentation
pres0)
Bool -> Cleanup -> Cleanup
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
oWatch Options
options) (Cleanup -> Cleanup) -> Cleanup -> Cleanup
forall a b. (a -> b) -> a -> b
$ do
ThreadId
_ <- Cleanup -> IO ThreadId
forkIO (Cleanup -> IO ThreadId) -> Cleanup -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Chan PresentationCommand -> FilePath -> UTCTime -> Cleanup
forall a. Chan PresentationCommand -> FilePath -> UTCTime -> IO a
watcher Chan PresentationCommand
commandChan (Presentation -> FilePath
pFilePath Presentation
pres0) UTCTime
mtime0
() -> Cleanup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let loop :: Presentation -> Maybe String -> IO ()
loop :: Presentation -> Maybe FilePath -> Cleanup
loop Presentation
pres Maybe FilePath
mbError = do
Maybe Handle -> (Handle -> Cleanup) -> Cleanup
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Handle
speakerNotes ((Handle -> Cleanup) -> Cleanup) -> (Handle -> Cleanup) -> Cleanup
forall a b. (a -> b) -> a -> b
$ \Handle
sn -> Handle -> EncodingFallback -> SpeakerNotes -> Cleanup
SpeakerNotes.write Handle
sn
(Presentation -> EncodingFallback
pEncodingFallback Presentation
pres)
(Presentation -> SpeakerNotes
activeSpeakerNotes Presentation
pres)
Size
size <- Presentation -> IO Size
getDisplaySize Presentation
pres
let display :: Display
display = case Maybe FilePath
mbError of
Maybe FilePath
Nothing -> Size -> Presentation -> Display
displayPresentation Size
size Presentation
pres
Just FilePath
err -> Doc -> Display
DisplayDoc (Doc -> Display) -> Doc -> Display
forall a b. (a -> b) -> a -> b
$
Size -> Presentation -> FilePath -> Doc
displayPresentationError Size
size Presentation
pres FilePath
err
Cleanup
Ansi.clearScreen
Int -> Int -> Cleanup
Ansi.setCursorPosition Int
0 Int
0
Cleanup
cleanup <- case Display
display of
DisplayDoc Doc
doc -> Handle -> EncodingFallback -> IO Cleanup -> IO Cleanup
forall a. Handle -> EncodingFallback -> IO a -> IO a
EncodingFallback.withHandle
Handle
IO.stdout (Presentation -> EncodingFallback
pEncodingFallback Presentation
pres) (IO Cleanup -> IO Cleanup) -> IO Cleanup -> IO Cleanup
forall a b. (a -> b) -> a -> b
$
Doc -> Cleanup
PP.putDoc Doc
doc Cleanup -> Cleanup -> IO Cleanup
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Cleanup
forall a. Monoid a => a
mempty
DisplayImage FilePath
path -> case Maybe Handle
images of
Maybe Handle
Nothing -> do
Doc -> Cleanup
PP.putDoc (Doc -> Cleanup) -> Doc -> Cleanup
forall a b. (a -> b) -> a -> b
$ Size -> Presentation -> FilePath -> Doc
displayPresentationError
Size
size Presentation
pres FilePath
"image backend not initialized"
Cleanup -> IO Cleanup
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cleanup
forall a. Monoid a => a
mempty
Just Handle
img -> do
FilePath -> Cleanup
putStrLn FilePath
""
Handle -> Cleanup
IO.hFlush Handle
IO.stdout
Handle -> FilePath -> IO Cleanup
Images.drawImage Handle
img FilePath
path
PresentationCommand
c <- Chan PresentationCommand -> IO PresentationCommand
forall a. Chan a -> IO a
Chan.readChan Chan PresentationCommand
commandChan
UpdatedPresentation
update <- PresentationCommand -> Presentation -> IO UpdatedPresentation
updatePresentation PresentationCommand
c Presentation
pres
Cleanup
cleanup
case UpdatedPresentation
update of
UpdatedPresentation
ExitedPresentation -> () -> Cleanup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UpdatedPresentation Presentation
pres' -> Presentation -> Maybe FilePath -> Cleanup
loop Presentation
pres' Maybe FilePath
forall a. Maybe a
Nothing
ErroredPresentation FilePath
err -> Presentation -> Maybe FilePath -> Cleanup
loop Presentation
pres (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
err)
Presentation -> Maybe FilePath -> Cleanup
loop Presentation
pres0 Maybe FilePath
forall a. Maybe a
Nothing
interactively
:: (IO.Handle -> IO a)
-> (Chan a -> IO ())
-> IO ()
interactively :: forall a. (Handle -> IO a) -> (Chan a -> Cleanup) -> Cleanup
interactively Handle -> IO a
reader Chan a -> Cleanup
app = IO (Bool, BufferMode, ThreadId, Chan a)
-> ((Bool, BufferMode, ThreadId, Chan a) -> Cleanup)
-> ((Bool, BufferMode, ThreadId, Chan a) -> Cleanup)
-> Cleanup
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Bool, BufferMode, ThreadId, Chan a)
setup (Bool, BufferMode, ThreadId, Chan a) -> Cleanup
forall {d}. (Bool, BufferMode, ThreadId, d) -> Cleanup
teardown (((Bool, BufferMode, ThreadId, Chan a) -> Cleanup) -> Cleanup)
-> ((Bool, BufferMode, ThreadId, Chan a) -> Cleanup) -> Cleanup
forall a b. (a -> b) -> a -> b
$ \(Bool
_, BufferMode
_, ThreadId
_, Chan a
chan) -> Chan a -> Cleanup
app Chan a
chan
where
setup :: IO (Bool, BufferMode, ThreadId, Chan a)
setup = do
Chan a
chan <- IO (Chan a)
forall a. IO (Chan a)
Chan.newChan
Bool
echo <- Handle -> IO Bool
IO.hGetEcho Handle
IO.stdin
BufferMode
buff <- Handle -> IO BufferMode
IO.hGetBuffering Handle
IO.stdin
Handle -> Bool -> Cleanup
IO.hSetEcho Handle
IO.stdin Bool
False
Handle -> BufferMode -> Cleanup
IO.hSetBuffering Handle
IO.stdin BufferMode
IO.NoBuffering
Cleanup
Ansi.hideCursor
ThreadId
readerThreadId <- Cleanup -> IO ThreadId
forkIO (Cleanup -> IO ThreadId) -> Cleanup -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Cleanup -> Cleanup
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Cleanup -> Cleanup) -> Cleanup -> Cleanup
forall a b. (a -> b) -> a -> b
$
Handle -> IO a
reader Handle
IO.stdin IO a -> (a -> Cleanup) -> Cleanup
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Chan a -> a -> Cleanup
forall a. Chan a -> a -> Cleanup
Chan.writeChan Chan a
chan
(Bool, BufferMode, ThreadId, Chan a)
-> IO (Bool, BufferMode, ThreadId, Chan a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
echo, BufferMode
buff, ThreadId
readerThreadId, Chan a
chan)
teardown :: (Bool, BufferMode, ThreadId, d) -> Cleanup
teardown (Bool
echo, BufferMode
buff, ThreadId
readerThreadId, d
_chan) = do
Cleanup
Ansi.showCursor
Cleanup
Ansi.clearScreen
Int -> Int -> Cleanup
Ansi.setCursorPosition Int
0 Int
0
ThreadId -> Cleanup
killThread ThreadId
readerThreadId
Handle -> Bool -> Cleanup
IO.hSetEcho Handle
IO.stdin Bool
echo
Handle -> BufferMode -> Cleanup
IO.hSetBuffering Handle
IO.stdin BufferMode
buff
watcher :: Chan.Chan PresentationCommand -> FilePath -> UTCTime -> IO a
watcher :: forall a. Chan PresentationCommand -> FilePath -> UTCTime -> IO a
watcher Chan PresentationCommand
chan FilePath
filePath UTCTime
mtime0 = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
filePath
UTCTime
mtime1 <- if Bool
exists then FilePath -> IO UTCTime
getModificationTime FilePath
filePath else UTCTime -> IO UTCTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
mtime0
Bool -> Cleanup -> Cleanup
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UTCTime
mtime1 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
mtime0) (Cleanup -> Cleanup) -> Cleanup -> Cleanup
forall a b. (a -> b) -> a -> b
$ Chan PresentationCommand -> PresentationCommand -> Cleanup
forall a. Chan a -> a -> Cleanup
Chan.writeChan Chan PresentationCommand
chan PresentationCommand
Reload
Int -> Cleanup
threadDelay (Int
200 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
Chan PresentationCommand -> FilePath -> UTCTime -> IO a
forall a. Chan PresentationCommand -> FilePath -> UTCTime -> IO a
watcher Chan PresentationCommand
chan FilePath
filePath UTCTime
mtime1
withMaybeHandle
:: (settings -> (handle -> IO a) -> IO a)
-> Maybe settings
-> (Maybe handle -> IO a)
-> IO a
withMaybeHandle :: forall settings handle a.
(settings -> (handle -> IO a) -> IO a)
-> Maybe settings -> (Maybe handle -> IO a) -> IO a
withMaybeHandle settings -> (handle -> IO a) -> IO a
_ Maybe settings
Nothing Maybe handle -> IO a
f = Maybe handle -> IO a
f Maybe handle
forall a. Maybe a
Nothing
withMaybeHandle settings -> (handle -> IO a) -> IO a
impl (Just settings
settings) Maybe handle -> IO a
f = settings -> (handle -> IO a) -> IO a
impl settings
settings (Maybe handle -> IO a
f (Maybe handle -> IO a)
-> (handle -> Maybe handle) -> handle -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. handle -> Maybe handle
forall a. a -> Maybe a
Just)