--------------------------------------------------------------------------------
{-# 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, join, 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
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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional forall a b. (a -> b) -> a -> b
$ forall s. IsString s => Mod ArgumentFields s -> Parser s
OA.strArgument forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
OA.metavar FilePath
"FILENAME" forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
OA.action  FilePath
"file" forall a. Semigroup a => a -> a -> a
<>  -- For bash file completion
            forall (f :: * -> *) a. FilePath -> Mod f a
OA.help    FilePath
"Input file")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Mod FlagFields Bool -> Parser Bool
OA.switch forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long    FilePath
"force" forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short   Char
'f' forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. FilePath -> Mod f a
OA.help    FilePath
"Force ANSI terminal" forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. Mod f a
OA.hidden)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Mod FlagFields Bool -> Parser Bool
OA.switch forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long    FilePath
"dump" forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short   Char
'd' forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. FilePath -> Mod f a
OA.help    FilePath
"Just dump all slides and exit" forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. Mod f a
OA.hidden)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Mod FlagFields Bool -> Parser Bool
OA.switch forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long    FilePath
"watch" forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short   Char
'w' forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. FilePath -> Mod f a
OA.help    FilePath
"Watch file for changes")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Mod FlagFields Bool -> Parser Bool
OA.switch forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long    FilePath
"version" forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. FilePath -> Mod f a
OA.help    FilePath
"Display version info and exit" forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. Mod f a
OA.hidden)


--------------------------------------------------------------------------------
parserInfo :: OA.ParserInfo Options
parserInfo :: ParserInfo Options
parserInfo = forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (forall a. Parser (a -> a)
OA.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
parseOptions) forall a b. (a -> b) -> a -> b
$
    forall a. InfoMod a
OA.fullDesc forall a. Semigroup a => a -> a -> a
<>
    forall a. FilePath -> InfoMod a
OA.header (FilePath
"patat v" forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
Paths_patat.version) forall a. Semigroup a => a -> a -> a
<>
    forall a. Maybe Doc -> InfoMod a
OA.progDescDoc (forall a. a -> Maybe a
Just forall {ann}. Doc ann
desc)
  where
    desc :: Doc ann
desc = 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
    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
    forall a. IO a
exitFailure


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

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

    FilePath
filePath <- case Options -> Maybe FilePath
oFilePath Options
options of
        Just FilePath
fp -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
        Maybe FilePath
Nothing -> forall a. ParserResult a -> IO a
OA.handleParseResult forall a b. (a -> b) -> a -> b
$ forall a. ParserFailure ParserHelp -> ParserResult a
OA.Failure forall a b. (a -> b) -> a -> b
$
            forall a.
ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
OA.parserFailure ParserPrefs
parserPrefs ParserInfo Options
parserInfo
            (Maybe FilePath -> ParseError
OA.ShowHelpText forall a. Maybe a
Nothing) forall a. Monoid a => a
mempty

    Either FilePath Presentation
errOrPres <- FilePath -> IO (Either FilePath Presentation)
readPresentation FilePath
filePath
    Presentation
pres      <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. [FilePath] -> IO a
errorAndExit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) forall (m :: * -> *) a. Monad m => a -> m a
return Either FilePath Presentation
errOrPres
    let settings :: PresentationSettings
settings = Presentation -> PresentationSettings
pSettings Presentation
pres

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

    if Options -> Bool
oDump Options
options then
        forall a. Handle -> EncodingFallback -> IO a -> IO a
EncodingFallback.withHandle Handle
IO.stdout (Presentation -> EncodingFallback
pEncodingFallback Presentation
pres) forall a b. (a -> b) -> a -> b
$
        Presentation -> Cleanup
dumpPresentation Presentation
pres
    else
        -- (Maybe) initialize images backend.
        forall settings handle a.
(settings -> (handle -> IO a) -> IO a)
-> Maybe settings -> (Maybe handle -> IO a) -> IO a
withMaybeHandle forall a. ImageSettings -> (Handle -> IO a) -> IO a
Images.withHandle (PresentationSettings -> Maybe ImageSettings
psImages PresentationSettings
settings) forall a b. (a -> b) -> a -> b
$ \Maybe Handle
images ->

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

        -- Read presentation commands
        forall a. (Handle -> IO a) -> (Chan a -> Cleanup) -> Cleanup
interactively (Handle -> IO PresentationCommand
readPresentationCommand) forall a b. (a -> b) -> a -> b
$ \Chan PresentationCommand
commandChan0 ->

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

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

        -- Spawn a thread that adds 'Reload' commands based on the file time.
        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) 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
aView :: AppView
aPresentation :: Presentation
aCommandChan :: Chan AppCommand
aSpeakerNotes :: Maybe SpeakerNotesHandle
aImages :: Maybe Handle
aOptions :: Options
aView :: App -> AppView
aPresentation :: App -> Presentation
aCommandChan :: App -> Chan AppCommand
aSpeakerNotes :: App -> Maybe SpeakerNotesHandle
aImages :: App -> Maybe Handle
aOptions :: App -> Options
..} = do
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe SpeakerNotesHandle
aSpeakerNotes 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    -> 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 -> forall {a}. Monoid a => Doc -> IO a
drawDoc 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NonEmpty.head forall a b. (a -> b) -> a -> b
$ TransitionInstance -> NonEmpty (Matrix, Duration)
tiFrames TransitionInstance
tr
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

    AppCommand
appCmd <- 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 :: AppView
aView = TransitionInstance -> AppView
TransitionView TransitionInstance
tr1}
                Maybe TransitionInstance
Nothing -> App -> Cleanup
loop App
app {aView :: AppView
aView = AppView
PresentationView}
        PresentationCommand PresentationCommand
c -> do
            UpdatedPresentation
update <- PresentationCommand -> Presentation -> IO UpdatedPresentation
updatePresentation PresentationCommand
c Presentation
aPresentation
            case UpdatedPresentation
update of
                UpdatedPresentation
ExitedPresentation       -> 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 :: Presentation
aPresentation = Presentation
pres, aView :: AppView
aView = TransitionInstance -> AppView
TransitionView TransitionInstance
tr}
                    | Bool
otherwise -> App -> Cleanup
loop App
app
                        {aPresentation :: Presentation
aPresentation = Presentation
pres, aView :: AppView
aView = AppView
PresentationView}
                ErroredPresentation FilePath
err  ->
                    App -> Cleanup
loop App
app {aView :: AppView
aView = FilePath -> AppView
ErrorView FilePath
err}
  where
    drawDoc :: Doc -> IO a
drawDoc Doc
doc = forall a. Handle -> EncodingFallback -> IO a -> IO a
EncodingFallback.withHandle
        Handle
IO.stdout (Presentation -> EncodingFallback
pEncodingFallback Presentation
aPresentation) forall a b. (a -> b) -> a -> b
$
        Doc -> Cleanup
PP.putDoc Doc
doc forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Monoid a => a
mempty
    drawImg :: Size -> FilePath -> IO Cleanup
drawImg Size
size FilePath
path =case Maybe Handle
aImages of
        Maybe Handle
Nothing -> forall {a}. Monoid a => Doc -> IO a
drawDoc 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 forall a. Eq a => a -> a -> Bool
== PresentationCommand
Forward
        , Int
oldSlide forall a. Num a => a -> a -> a
+ Int
1 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 forall a. Seq a -> Int -> Maybe a
`Seq.safeIndex` Int
newSlide =
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TransitionGen -> Size -> Doc -> Doc -> IO TransitionInstance
newTransition TransitionGen
tgen Size
size Doc
oldDoc Doc
newDoc
        | Bool
otherwise = 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 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Cleanup -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ do
        Duration -> Cleanup
threadDelayDuration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NonEmpty.head forall a b. (a -> b) -> a -> b
$ TransitionInstance -> NonEmpty (Matrix, Duration)
tiFrames TransitionInstance
tr
        forall a. Chan a -> a -> Cleanup
Chan.writeChan Chan AppCommand
aCommandChan forall a b. (a -> b) -> a -> b
$ TransitionId -> AppCommand
TransitionTick 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 = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket forall {a}. IO (Bool, BufferMode, Chan a)
setup forall {c}. (Bool, BufferMode, c) -> Cleanup
teardown forall a b. (a -> b) -> a -> b
$ \(Bool
_, BufferMode
_, Chan a
chan) ->
    forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync
        (forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ Handle -> IO a
reader Handle
IO.stdin forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 <- 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
        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
    forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (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 forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
mtime0

        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UTCTime
mtime1 forall a. Ord a => a -> a -> Bool
> UTCTime
mtime0) forall a b. (a -> b) -> a -> b
$ forall a. Chan a -> a -> Cleanup
Chan.writeChan Chan cmd
chan cmd
cmd
        Int -> Cleanup
threadDelay (Int
200 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)