--------------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
module Patat.Main
    ( main
    ) where


--------------------------------------------------------------------------------
import           Control.Concurrent               (forkIO, threadDelay)
import qualified Control.Concurrent.Async         as Async
import           Control.Concurrent.Chan.Extended (Chan)
import qualified Control.Concurrent.Chan.Extended as Chan
import           Control.Exception                (bracket)
import           Control.Monad                    (forever, unless, void, when)
import qualified Data.Aeson.Extended              as A
import           Data.Foldable                    (for_)
import           Data.Functor                     (($>))
import qualified Data.List.NonEmpty               as NonEmpty
import qualified Data.Sequence.Extended           as Seq
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.Comments      as Comments
import qualified Patat.PrettyPrint                as PP
import           Patat.PrettyPrint.Matrix         (hPutMatrix)
import           Patat.Transition
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
<>  -- For bash file completion
            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
forall {ann}. Doc ann
desc)
  where
    desc :: Doc ann
desc = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
OA.PP.vcat
        [ Doc ann
"Terminal-based presentations using Pandoc"
        , Doc ann
""
        , Doc ann
"Controls:"
        , Doc ann
"- Next slide:             space, enter, l, right, pagedown"
        , Doc ann
"- Previous slide:         backspace, h, left, pageup"
        , Doc ann
"- Go forward 10 slides:   j, down"
        , Doc ann
"- Go backward 10 slides:  k, up"
        , Doc ann
"- First slide:            0"
        , Doc ann
"- Last slide:             G"
        , Doc ann
"- Jump to slide N:        N followed by enter"
        , Doc ann
"- Reload file:            r"
        , Doc ann
"- 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`."
        ]


--------------------------------------------------------------------------------
data App = App
    { App -> Options
aOptions      :: Options
    , App -> Maybe Handle
aImages       :: Maybe Images.Handle
    , App -> Maybe SpeakerNotesHandle
aSpeakerNotes :: Maybe Comments.SpeakerNotesHandle
    , App -> Chan AppCommand
aCommandChan  :: Chan AppCommand
    , App -> Presentation
aPresentation :: Presentation
    , App -> AppView
aView         :: AppView
    }


--------------------------------------------------------------------------------
data AppView
    = PresentationView
    | ErrorView String
    | TransitionView TransitionInstance


--------------------------------------------------------------------------------
data AppCommand = PresentationCommand PresentationCommand | TransitionTick TransitionId


--------------------------------------------------------------------------------
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
    let settings :: PresentationSettings
settings = Presentation -> PresentationSettings
pSettings Presentation
pres

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

    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
        -- (Maybe) initialize images backend.
        (ImageSettings -> (Handle -> Cleanup) -> Cleanup)
-> Maybe ImageSettings -> (Maybe Handle -> Cleanup) -> Cleanup
forall settings handle a.
(settings -> (handle -> IO a) -> IO a)
-> Maybe settings -> (Maybe handle -> IO a) -> IO a
withMaybeHandle ImageSettings -> (Handle -> Cleanup) -> Cleanup
forall a. ImageSettings -> (Handle -> IO a) -> IO a
Images.withHandle (PresentationSettings -> Maybe ImageSettings
psImages PresentationSettings
settings) ((Maybe Handle -> Cleanup) -> Cleanup)
-> (Maybe Handle -> Cleanup) -> Cleanup
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
images ->

        -- (Maybe) initialize speaker notes.
        (SpeakerNotesSettings
 -> (SpeakerNotesHandle -> Cleanup) -> Cleanup)
-> Maybe SpeakerNotesSettings
-> (Maybe SpeakerNotesHandle -> Cleanup)
-> Cleanup
forall settings handle a.
(settings -> (handle -> IO a) -> IO a)
-> Maybe settings -> (Maybe handle -> IO a) -> IO a
withMaybeHandle SpeakerNotesSettings -> (SpeakerNotesHandle -> Cleanup) -> Cleanup
forall a.
SpeakerNotesSettings -> (SpeakerNotesHandle -> IO a) -> IO a
Comments.withSpeakerNotesHandle
            (PresentationSettings -> Maybe SpeakerNotesSettings
psSpeakerNotes PresentationSettings
settings) ((Maybe SpeakerNotesHandle -> Cleanup) -> Cleanup)
-> (Maybe SpeakerNotesHandle -> Cleanup) -> Cleanup
forall a b. (a -> b) -> a -> b
$ \Maybe SpeakerNotesHandle
speakerNotes ->

        -- Read presentation commands
        (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 ->

        -- If an auto delay is set, use 'autoAdvance' to create a new one.
        Maybe Int
-> Chan PresentationCommand
-> (Chan PresentationCommand -> Cleanup)
-> Cleanup
forall a.
Maybe Int
-> Chan PresentationCommand
-> (Chan PresentationCommand -> IO a)
-> IO a
maybeAutoAdvance
            (FlexibleNum Int -> Int
forall a. FlexibleNum a -> a
A.unFlexibleNum (FlexibleNum Int -> Int) -> Maybe (FlexibleNum Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PresentationSettings -> Maybe (FlexibleNum Int)
psAutoAdvanceDelay PresentationSettings
settings)
            Chan PresentationCommand
commandChan0 ((Chan PresentationCommand -> Cleanup) -> Cleanup)
-> (Chan PresentationCommand -> Cleanup) -> Cleanup
forall a b. (a -> b) -> a -> b
$ \Chan PresentationCommand
commandChan1 ->

        -- Change to AppCommand
        (PresentationCommand -> AppCommand)
-> Chan PresentationCommand
-> (Chan AppCommand -> Cleanup)
-> Cleanup
forall a b r. (a -> b) -> Chan a -> (Chan b -> IO r) -> IO r
Chan.withMapChan PresentationCommand -> AppCommand
PresentationCommand Chan PresentationCommand
commandChan1 ((Chan AppCommand -> Cleanup) -> Cleanup)
-> (Chan AppCommand -> Cleanup) -> Cleanup
forall a b. (a -> b) -> a -> b
$ \Chan AppCommand
commandChan ->

        -- Spawn a thread that adds 'Reload' commands based on the file time.
        Bool
-> Chan AppCommand -> FilePath -> AppCommand -> Cleanup -> Cleanup
forall cmd a. Bool -> Chan cmd -> FilePath -> cmd -> IO a -> IO a
withWatcher (Options -> Bool
oWatch Options
options) Chan AppCommand
commandChan (Presentation -> FilePath
pFilePath Presentation
pres)
            (PresentationCommand -> AppCommand
PresentationCommand PresentationCommand
Reload) (Cleanup -> Cleanup) -> Cleanup -> Cleanup
forall a b. (a -> b) -> a -> b
$

        App -> Cleanup
loop App
            { aOptions :: Options
aOptions      = Options
options
            , aImages :: Maybe Handle
aImages       = Maybe Handle
images
            , aSpeakerNotes :: Maybe SpeakerNotesHandle
aSpeakerNotes = Maybe SpeakerNotesHandle
speakerNotes
            , aCommandChan :: Chan AppCommand
aCommandChan  = Chan AppCommand
commandChan
            , aPresentation :: Presentation
aPresentation = Presentation
pres
            , aView :: AppView
aView         = AppView
PresentationView
            }


--------------------------------------------------------------------------------
loop :: App -> IO ()
loop :: App -> Cleanup
loop app :: App
app@App {Maybe Handle
Maybe SpeakerNotesHandle
Chan AppCommand
Presentation
AppView
Options
aOptions :: App -> Options
aImages :: App -> Maybe Handle
aSpeakerNotes :: App -> Maybe SpeakerNotesHandle
aCommandChan :: App -> Chan AppCommand
aPresentation :: App -> Presentation
aView :: App -> AppView
aOptions :: Options
aImages :: Maybe Handle
aSpeakerNotes :: Maybe SpeakerNotesHandle
aCommandChan :: Chan AppCommand
aPresentation :: Presentation
aView :: AppView
..} = do
    Maybe SpeakerNotesHandle
-> (SpeakerNotesHandle -> Cleanup) -> Cleanup
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe SpeakerNotesHandle
aSpeakerNotes ((SpeakerNotesHandle -> Cleanup) -> Cleanup)
-> (SpeakerNotesHandle -> Cleanup) -> Cleanup
forall a b. (a -> b) -> a -> b
$ \SpeakerNotesHandle
sn -> SpeakerNotesHandle -> EncodingFallback -> SpeakerNotes -> Cleanup
Comments.writeSpeakerNotes SpeakerNotesHandle
sn
        (Presentation -> EncodingFallback
pEncodingFallback Presentation
aPresentation)
        (Presentation -> SpeakerNotes
activeSpeakerNotes Presentation
aPresentation)

    Size
size <- Presentation -> IO Size
getPresentationSize Presentation
aPresentation
    Cleanup
Ansi.clearScreen
    Int -> Int -> Cleanup
Ansi.setCursorPosition Int
0 Int
0
    Cleanup
cleanup <- case AppView
aView of
        AppView
PresentationView -> case Size -> Presentation -> Display
displayPresentation Size
size Presentation
aPresentation of
            DisplayDoc Doc
doc    -> Doc -> IO Cleanup
forall {a}. Monoid a => Doc -> IO a
drawDoc Doc
doc
            DisplayImage FilePath
path -> Size -> FilePath -> IO Cleanup
drawImg Size
size FilePath
path
        ErrorView FilePath
err -> Doc -> IO Cleanup
forall {a}. Monoid a => Doc -> IO a
drawDoc (Doc -> IO Cleanup) -> Doc -> IO Cleanup
forall a b. (a -> b) -> a -> b
$
                Size -> Presentation -> FilePath -> Doc
displayPresentationError Size
size Presentation
aPresentation FilePath
err
        TransitionView TransitionInstance
tr -> do
            Size -> Matrix -> Cleanup
drawMatrix (TransitionInstance -> Size
tiSize TransitionInstance
tr) (Matrix -> Cleanup)
-> (NonEmpty (Matrix, Duration) -> Matrix)
-> NonEmpty (Matrix, Duration)
-> Cleanup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Matrix, Duration) -> Matrix
forall a b. (a, b) -> a
fst ((Matrix, Duration) -> Matrix)
-> (NonEmpty (Matrix, Duration) -> (Matrix, Duration))
-> NonEmpty (Matrix, Duration)
-> Matrix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Matrix, Duration) -> (Matrix, Duration)
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty (Matrix, Duration) -> Cleanup)
-> NonEmpty (Matrix, Duration) -> Cleanup
forall a b. (a -> b) -> a -> b
$ TransitionInstance -> NonEmpty (Matrix, Duration)
tiFrames TransitionInstance
tr
            Cleanup -> IO Cleanup
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cleanup
forall a. Monoid a => a
mempty

    AppCommand
appCmd <- Chan AppCommand -> IO AppCommand
forall a. Chan a -> IO a
Chan.readChan Chan AppCommand
aCommandChan
    Cleanup
cleanup
    case AppCommand
appCmd of
        TransitionTick TransitionId
eid -> case AppView
aView of
            AppView
PresentationView -> App -> Cleanup
loop App
app
            ErrorView FilePath
_      -> App -> Cleanup
loop App
app
            TransitionView TransitionInstance
tr0  -> case TransitionId -> TransitionInstance -> Maybe TransitionInstance
stepTransition TransitionId
eid TransitionInstance
tr0 of
                Just TransitionInstance
tr1 -> do
                    TransitionInstance -> Cleanup
scheduleTransitionTick TransitionInstance
tr1
                    App -> Cleanup
loop App
app {aView = TransitionView tr1}
                Maybe TransitionInstance
Nothing -> App -> Cleanup
loop App
app {aView = PresentationView}
        PresentationCommand PresentationCommand
c -> do
            UpdatedPresentation
update <- PresentationCommand -> Presentation -> IO UpdatedPresentation
updatePresentation PresentationCommand
c Presentation
aPresentation
            case UpdatedPresentation
update of
                UpdatedPresentation
ExitedPresentation       -> () -> Cleanup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                UpdatedPresentation Presentation
pres
                    | Just IO TransitionInstance
tgen <- PresentationCommand
-> Size
-> Presentation
-> Presentation
-> Maybe (IO TransitionInstance)
mbTransition PresentationCommand
c Size
size Presentation
aPresentation Presentation
pres -> do
                        TransitionInstance
tr <- IO TransitionInstance
tgen
                        TransitionInstance -> Cleanup
scheduleTransitionTick TransitionInstance
tr
                        App -> Cleanup
loop App
app
                            {aPresentation = pres, aView = TransitionView tr}
                    | Bool
otherwise -> App -> Cleanup
loop App
app
                        {aPresentation = pres, aView = PresentationView}
                ErroredPresentation FilePath
err  ->
                    App -> Cleanup
loop App
app {aView = ErrorView err}
  where
    drawDoc :: Doc -> IO a
drawDoc Doc
doc = Handle -> EncodingFallback -> IO a -> IO a
forall a. Handle -> EncodingFallback -> IO a -> IO a
EncodingFallback.withHandle
        Handle
IO.stdout (Presentation -> EncodingFallback
pEncodingFallback Presentation
aPresentation) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$
        Doc -> Cleanup
PP.putDoc Doc
doc Cleanup -> a -> IO a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
forall a. Monoid a => a
mempty
    drawImg :: Size -> FilePath -> IO Cleanup
drawImg Size
size FilePath
path =case Maybe Handle
aImages of
        Maybe Handle
Nothing -> Doc -> IO Cleanup
forall {a}. Monoid a => Doc -> IO a
drawDoc (Doc -> IO Cleanup) -> Doc -> IO Cleanup
forall a b. (a -> b) -> a -> b
$ Size -> Presentation -> FilePath -> Doc
displayPresentationError
            Size
size Presentation
aPresentation FilePath
"image backend not initialized"
        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
    drawMatrix :: Size -> Matrix -> Cleanup
drawMatrix Size
size Matrix
raster = Handle -> Size -> Matrix -> Cleanup
hPutMatrix Handle
IO.stdout Size
size Matrix
raster

    mbTransition :: PresentationCommand
-> Size
-> Presentation
-> Presentation
-> Maybe (IO TransitionInstance)
mbTransition PresentationCommand
c Size
size Presentation
old Presentation
new
        | PresentationCommand
c PresentationCommand -> PresentationCommand -> Bool
forall a. Eq a => a -> a -> Bool
== PresentationCommand
Forward
        , Int
oldSlide Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
newSlide
        , DisplayDoc Doc
oldDoc <- Size -> Presentation -> Display
displayPresentation Size
size Presentation
old
        , DisplayDoc Doc
newDoc <- Size -> Presentation -> Display
displayPresentation Size
size Presentation
new
        , Just (Just TransitionGen
tgen) <- Presentation -> Seq (Maybe TransitionGen)
pTransitionGens Presentation
new Seq (Maybe TransitionGen) -> Int -> Maybe (Maybe TransitionGen)
forall a. Seq a -> Int -> Maybe a
`Seq.safeIndex` Int
newSlide =
            IO TransitionInstance -> Maybe (IO TransitionInstance)
forall a. a -> Maybe a
Just (IO TransitionInstance -> Maybe (IO TransitionInstance))
-> IO TransitionInstance -> Maybe (IO TransitionInstance)
forall a b. (a -> b) -> a -> b
$ TransitionGen -> Size -> Doc -> Doc -> IO TransitionInstance
newTransition TransitionGen
tgen Size
size Doc
oldDoc Doc
newDoc
        | Bool
otherwise = Maybe (IO TransitionInstance)
forall a. Maybe a
Nothing
      where
        (Int
oldSlide, Int
_) = Presentation -> (Int, Int)
pActiveFragment Presentation
old
        (Int
newSlide, Int
_) = Presentation -> (Int, Int)
pActiveFragment Presentation
new

    scheduleTransitionTick :: TransitionInstance -> Cleanup
scheduleTransitionTick TransitionInstance
tr = IO ThreadId -> Cleanup
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> Cleanup) -> IO ThreadId -> Cleanup
forall a b. (a -> b) -> a -> b
$ Cleanup -> IO ThreadId
forkIO (Cleanup -> IO ThreadId) -> Cleanup -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
        Duration -> Cleanup
threadDelayDuration (Duration -> Cleanup)
-> (NonEmpty (Matrix, Duration) -> Duration)
-> NonEmpty (Matrix, Duration)
-> Cleanup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Matrix, Duration) -> Duration
forall a b. (a, b) -> b
snd ((Matrix, Duration) -> Duration)
-> (NonEmpty (Matrix, Duration) -> (Matrix, Duration))
-> NonEmpty (Matrix, Duration)
-> Duration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Matrix, Duration) -> (Matrix, Duration)
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty (Matrix, Duration) -> Cleanup)
-> NonEmpty (Matrix, Duration) -> Cleanup
forall a b. (a -> b) -> a -> b
$ TransitionInstance -> NonEmpty (Matrix, Duration)
tiFrames TransitionInstance
tr
        Chan AppCommand -> AppCommand -> Cleanup
forall a. Chan a -> a -> Cleanup
Chan.writeChan Chan AppCommand
aCommandChan (AppCommand -> Cleanup) -> AppCommand -> Cleanup
forall a b. (a -> b) -> a -> b
$ TransitionId -> AppCommand
TransitionTick (TransitionId -> AppCommand) -> TransitionId -> AppCommand
forall a b. (a -> b) -> a -> b
$ TransitionInstance -> TransitionId
tiId TransitionInstance
tr


--------------------------------------------------------------------------------
-- | 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 :: forall a. (Handle -> IO a) -> (Chan a -> Cleanup) -> Cleanup
interactively Handle -> IO a
reader Chan a -> Cleanup
app = IO (Bool, BufferMode, Chan a)
-> ((Bool, BufferMode, Chan a) -> Cleanup)
-> ((Bool, BufferMode, Chan a) -> Cleanup)
-> Cleanup
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Bool, BufferMode, Chan a)
forall {a}. IO (Bool, BufferMode, Chan a)
setup (Bool, BufferMode, Chan a) -> Cleanup
forall {c}. (Bool, BufferMode, c) -> Cleanup
teardown (((Bool, BufferMode, Chan a) -> Cleanup) -> Cleanup)
-> ((Bool, BufferMode, Chan a) -> Cleanup) -> Cleanup
forall a b. (a -> b) -> a -> b
$ \(Bool
_, BufferMode
_, Chan a
chan) ->
    IO Any -> (Async Any -> Cleanup) -> Cleanup
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync
        (Cleanup -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Cleanup -> IO Any) -> Cleanup -> IO Any
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)
        (\Async Any
_ -> Chan a -> Cleanup
app Chan a
chan)
  where
    setup :: IO (Bool, BufferMode, 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
        (Bool, BufferMode, Chan a) -> IO (Bool, BufferMode, Chan a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
echo, BufferMode
buff, Chan a
chan)

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


--------------------------------------------------------------------------------
withWatcher
    :: Bool -> Chan.Chan cmd -> FilePath -> cmd -> IO a -> IO a
withWatcher :: forall cmd a. Bool -> Chan cmd -> FilePath -> cmd -> IO a -> IO a
withWatcher Bool
False Chan cmd
_    FilePath
_        cmd
_   IO a
mx = IO a
mx
withWatcher Bool
True  Chan cmd
chan FilePath
filePath cmd
cmd IO a
mx = do
    UTCTime
mtime0 <- FilePath -> IO UTCTime
getModificationTime FilePath
filePath
    IO Any -> (Async Any -> IO a) -> IO a
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (UTCTime -> IO Any
forall {b}. UTCTime -> IO b
watcher UTCTime
mtime0) (\Async Any
_ -> IO a
mx)
  where
    watcher :: UTCTime -> IO b
watcher 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 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 cmd -> cmd -> Cleanup
forall a. Chan a -> a -> Cleanup
Chan.writeChan Chan cmd
chan cmd
cmd
        Int -> Cleanup
threadDelay (Int
200 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
        UTCTime -> IO b
watcher UTCTime
mtime1


--------------------------------------------------------------------------------
-- | Wrapper for optional handles.
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)