{-# 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
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
<>
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
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 ->
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 ->
forall a. (Handle -> IO a) -> (Chan a -> Cleanup) -> Cleanup
interactively (Handle -> IO PresentationCommand
readPresentationCommand) forall a b. (a -> b) -> a -> b
$ \Chan PresentationCommand
commandChan0 ->
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 ->
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 ->
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
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 = 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
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
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)