module Patat.AutoAdvance
( maybeAutoAdvance
, autoAdvance
) where
import Control.Concurrent (threadDelay)
import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.Chan as Chan
import Control.Monad (forever)
import qualified Data.IORef as IORef
import Data.Time (diffUTCTime, getCurrentTime)
import Patat.Presentation (PresentationCommand (..))
maybeAutoAdvance
:: Maybe Int
-> Chan.Chan PresentationCommand
-> (Chan.Chan PresentationCommand -> IO a)
-> IO a
maybeAutoAdvance :: forall a.
Maybe Int
-> Chan PresentationCommand
-> (Chan PresentationCommand -> IO a)
-> IO a
maybeAutoAdvance Maybe Int
Nothing Chan PresentationCommand
chan Chan PresentationCommand -> IO a
f = Chan PresentationCommand -> IO a
f Chan PresentationCommand
chan
maybeAutoAdvance (Just Int
delaySeconds) Chan PresentationCommand
chan Chan PresentationCommand -> IO a
f = forall a.
Int
-> Chan PresentationCommand
-> (Chan PresentationCommand -> IO a)
-> IO a
autoAdvance Int
delaySeconds Chan PresentationCommand
chan Chan PresentationCommand -> IO a
f
autoAdvance
:: Int
-> Chan.Chan PresentationCommand
-> (Chan.Chan PresentationCommand -> IO a)
-> IO a
autoAdvance :: forall a.
Int
-> Chan PresentationCommand
-> (Chan PresentationCommand -> IO a)
-> IO a
autoAdvance Int
delaySeconds Chan PresentationCommand
existingChan Chan PresentationCommand -> IO a
f = do
let delay :: Int
delay = Int
delaySeconds forall a. Num a => a -> a -> a
* Int
1000
Chan PresentationCommand
newChan <- forall a. IO (Chan a)
Chan.newChan
IORef UTCTime
latestCommandAt <- forall a. a -> IO (IORef a)
IORef.newIORef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
(forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
PresentationCommand
cmd <- forall a. Chan a -> IO a
Chan.readChan Chan PresentationCommand
existingChan
IO UTCTime
getCurrentTime forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef UTCTime
latestCommandAt
forall a. Chan a -> a -> IO ()
Chan.writeChan Chan PresentationCommand
newChan PresentationCommand
cmd) forall a b. IO a -> (Async a -> IO b) -> IO b
`Async.withAsync` \Async Any
_ ->
(forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
UTCTime
current <- IO UTCTime
getCurrentTime
UTCTime
latest <- forall a. IORef a -> IO a
IORef.readIORef IORef UTCTime
latestCommandAt
let elapsed :: Int
elapsed = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ NominalDiffTime
1000 forall a. Num a => a -> a -> a
* (UTCTime
current UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
latest) :: Int
if Int
elapsed forall a. Ord a => a -> a -> Bool
>= Int
delay
then do
forall a. Chan a -> a -> IO ()
Chan.writeChan Chan PresentationCommand
newChan PresentationCommand
Forward
forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef UTCTime
latestCommandAt UTCTime
current
Int -> IO ()
threadDelay (Int
delay forall a. Num a => a -> a -> a
* Int
1000)
else do
let wait :: Int
wait = Int
delay forall a. Num a => a -> a -> a
- Int
elapsed
Int -> IO ()
threadDelay (Int
wait forall a. Num a => a -> a -> a
* Int
1000)) forall a b. IO a -> (Async a -> IO b) -> IO b
`Async.withAsync` \Async Any
_ ->
Chan PresentationCommand -> IO a
f Chan PresentationCommand
newChan