--------------------------------------------------------------------------------
{-# 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.Functor                 (($>))
import qualified Data.Text                    as T
import           Data.Time                    (UTCTime)
import           Data.Version                 (showVersion)
import qualified Options.Applicative          as OA
import           Patat.AutoAdvance
import qualified Patat.Images                 as Images
import           Patat.Presentation
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
import qualified Text.PrettyPrint.ANSI.Leijen as PPL


--------------------------------------------------------------------------------
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
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> FilePath
$cshow :: Options -> FilePath
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> 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. FilePath -> Mod f a
OA.help    FilePath
"Input file")
    Parser (Bool -> Bool -> Bool -> Bool -> Options)
-> Parser Bool -> Parser (Bool -> Bool -> Bool -> Options)
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 (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 (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 (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 (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
PPL.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 :: [FilePath] -> IO a
errorAndExit [FilePath]
msg = do
    (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> FilePath -> IO ()
IO.hPutStrLn Handle
IO.stderr) [FilePath]
msg
    IO a
forall a. IO a
exitFailure


--------------------------------------------------------------------------------
assertAnsiFeatures :: IO ()
assertAnsiFeatures :: IO ()
assertAnsiFeatures = do
    Bool
supports <- Handle -> IO Bool
Ansi.hSupportsANSI Handle
IO.stdout
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
supports (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO ()
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 :: IO ()
main = do
    Options
options <- ParserPrefs -> ParserInfo Options -> IO Options
forall a. ParserPrefs -> ParserInfo a -> IO a
OA.customExecParser ParserPrefs
parserPrefs ParserInfo Options
parserInfo

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
oVersion Options
options) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        FilePath -> IO ()
putStrLn (Version -> FilePath
showVersion Version
Paths_patat.version)
        FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Using pandoc: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
Pandoc.pandocVersion
        IO ()
forall a. IO a
exitSuccess

    FilePath
filePath <- case Options -> Maybe FilePath
oFilePath Options
options of
        Just FilePath
fp -> FilePath -> IO FilePath
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 ParseError
OA.ShowHelpText [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 (m :: * -> *) a. Monad m => a -> m a
return) Presentation -> IO Presentation
forall (m :: * -> *) a. Monad m => a -> m a
return Either FilePath Presentation
errOrPres

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
oForce Options
options) IO ()
assertAnsiFeatures

    -- (Maybe) initialize images backend.
    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)
traverse ImageSettings -> IO Handle
Images.new (PresentationSettings -> Maybe ImageSettings
psImages (PresentationSettings -> Maybe ImageSettings)
-> PresentationSettings -> Maybe ImageSettings
forall a b. (a -> b) -> a -> b
$ Presentation -> PresentationSettings
pSettings Presentation
pres)

    if Options -> Bool
oDump Options
options
        then Presentation -> IO ()
dumpPresentation Presentation
pres
        else Options -> Maybe Handle -> Presentation -> IO ()
interactiveLoop Options
options Maybe Handle
images Presentation
pres
  where
    interactiveLoop :: Options -> Maybe Images.Handle -> Presentation -> IO ()
    interactiveLoop :: Options -> Maybe Handle -> Presentation -> IO ()
interactiveLoop Options
options Maybe Handle
images Presentation
pres0 =
        (Handle -> IO PresentationCommand)
-> (Chan PresentationCommand -> IO ()) -> IO ()
forall a. (Handle -> IO a) -> (Chan a -> IO ()) -> IO ()
interactively Handle -> IO PresentationCommand
readPresentationCommand ((Chan PresentationCommand -> IO ()) -> IO ())
-> (Chan PresentationCommand -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Chan PresentationCommand
commandChan0 -> do

        -- If an auto delay is set, use 'autoAdvance' to create a new one.
        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 (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

        -- Spawn a thread that adds 'Reload' commands based on the file time.
        UTCTime
mtime0 <- FilePath -> IO UTCTime
getModificationTime (Presentation -> FilePath
pFilePath Presentation
pres0)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
oWatch Options
options) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Chan PresentationCommand -> FilePath -> UTCTime -> IO ()
forall a. Chan PresentationCommand -> FilePath -> UTCTime -> IO a
watcher Chan PresentationCommand
commandChan (Presentation -> FilePath
pFilePath Presentation
pres0) UTCTime
mtime0
            () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        let loop :: Presentation -> Maybe String -> IO ()
            loop :: Presentation -> Maybe FilePath -> IO ()
loop Presentation
pres Maybe FilePath
mbError = do
                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

                IO ()
Ansi.clearScreen
                Int -> Int -> IO ()
Ansi.setCursorPosition Int
0 Int
0
                IO ()
cleanup <- case Display
display of
                    DisplayDoc Doc
doc -> Doc -> IO ()
PP.putDoc Doc
doc IO () -> IO () -> IO (IO ())
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IO ()
forall a. Monoid a => a
mempty
                    DisplayImage FilePath
path -> case Maybe Handle
images of
                        Maybe Handle
Nothing -> do
                            Doc -> IO ()
PP.putDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Size -> Presentation -> FilePath -> Doc
displayPresentationError
                                 Size
size Presentation
pres FilePath
"image backend not initialized"
                            IO () -> IO (IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure IO ()
forall a. Monoid a => a
mempty
                        Just Handle
img -> do
                            FilePath -> IO ()
putStrLn FilePath
""
                            Handle -> IO ()
IO.hFlush Handle
IO.stdout
                            Handle -> FilePath -> IO (IO ())
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
                IO ()
cleanup
                case UpdatedPresentation
update of
                    UpdatedPresentation
ExitedPresentation        -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    UpdatedPresentation Presentation
pres' -> Presentation -> Maybe FilePath -> IO ()
loop Presentation
pres' Maybe FilePath
forall a. Maybe a
Nothing
                    ErroredPresentation FilePath
err   -> Presentation -> Maybe FilePath -> IO ()
loop Presentation
pres (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
err)

        Presentation -> Maybe FilePath -> IO ()
loop Presentation
pres0 Maybe FilePath
forall a. Maybe a
Nothing


--------------------------------------------------------------------------------
-- | Utility for dealing with pecularities of stdin & interactive applications
-- on the terminal.  Tries to restore the original state of the terminal as much
-- as possible.
interactively
    :: (IO.Handle -> IO a)
    -- ^ Reads a command from stdin (or from some other IO).  This will be
    -- interrupted by 'killThread' when the application finishes.
    -> (Chan a -> IO ())
    -- ^ Application to run.
    -> IO ()
    -- ^ Returns when application finishes.
interactively :: (Handle -> IO a) -> (Chan a -> IO ()) -> IO ()
interactively Handle -> IO a
reader Chan a -> IO ()
app = IO (Bool, BufferMode, ThreadId, Chan a)
-> ((Bool, BufferMode, ThreadId, Chan a) -> IO ())
-> ((Bool, BufferMode, ThreadId, Chan a) -> IO ())
-> IO ()
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) -> IO ()
forall d. (Bool, BufferMode, ThreadId, d) -> IO ()
teardown (((Bool, BufferMode, ThreadId, Chan a) -> IO ()) -> IO ())
-> ((Bool, BufferMode, ThreadId, Chan a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Bool
_, BufferMode
_, ThreadId
_, Chan a
chan) -> Chan a -> IO ()
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 -> IO ()
IO.hSetEcho      Handle
IO.stdin Bool
False
        Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
IO.stdin BufferMode
IO.NoBuffering
        IO ()
Ansi.hideCursor
        ThreadId
readerThreadId <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Handle -> IO a
reader Handle
IO.stdin IO a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Chan a -> a -> IO ()
forall a. Chan a -> a -> IO ()
Chan.writeChan Chan a
chan
        (Bool, BufferMode, ThreadId, Chan a)
-> IO (Bool, BufferMode, ThreadId, Chan a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
echo, BufferMode
buff, ThreadId
readerThreadId, Chan a
chan)

    teardown :: (Bool, BufferMode, ThreadId, d) -> IO ()
teardown (Bool
echo, BufferMode
buff, ThreadId
readerThreadId, d
_chan) = do
        IO ()
Ansi.showCursor
        IO ()
Ansi.clearScreen
        Int -> Int -> IO ()
Ansi.setCursorPosition Int
0 Int
0
        ThreadId -> IO ()
killThread ThreadId
readerThreadId
        Handle -> Bool -> IO ()
IO.hSetEcho      Handle
IO.stdin Bool
echo
        Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
IO.stdin BufferMode
buff


--------------------------------------------------------------------------------
watcher :: Chan.Chan PresentationCommand -> FilePath -> UTCTime -> IO a
watcher :: Chan PresentationCommand -> FilePath -> UTCTime -> IO a
watcher Chan PresentationCommand
chan FilePath
filePath UTCTime
mtime0 = do
    -- The extra exists check helps because some editors temporarily make the
    -- file disappear while writing.
    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 (m :: * -> *) a. Monad m => a -> m a
return UTCTime
mtime0

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UTCTime
mtime1 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
mtime0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Chan PresentationCommand -> PresentationCommand -> IO ()
forall a. Chan a -> a -> IO ()
Chan.writeChan Chan PresentationCommand
chan PresentationCommand
Reload
    Int -> IO ()
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