-- | Timing effects.
module Box.Time
  ( sleep,
    stampNow,
    stampE,
    Gap,
    gaps,
    fromGaps,
    fromGapsNow,
    gapEffect,
    skip,
    replay,
    gapSkipEffect,
    speedEffect,
    speedSkipEffect,
  )
where

import Box.Connectors
import Box.Emitter
import Control.Applicative
import Control.Concurrent
import Control.Monad.State.Lazy
import Data.Bifunctor
import Data.Bool
import Data.Fixed (Fixed (MkFixed))
import Data.Time
import Prelude

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Box
-- >>> import Prelude

-- | Sleep for x seconds.
sleep :: Double -> IO ()
sleep :: Gap -> IO ()
sleep Gap
x = Int -> IO ()
threadDelay (Gap -> Int
forall b. Integral b => Gap -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Gap -> Int) -> Gap -> Int
forall a b. (a -> b) -> a -> b
$ Gap
x Gap -> Gap -> Gap
forall a. Num a => a -> a -> a
* Gap
1e6)

-- | convenience conversion to Double
fromNominalDiffTime :: NominalDiffTime -> Double
fromNominalDiffTime :: NominalDiffTime -> Gap
fromNominalDiffTime NominalDiffTime
t = Integer -> Gap
forall a. Num a => Integer -> a
fromInteger Integer
i Gap -> Gap -> Gap
forall a. Num a => a -> a -> a
* Gap
1e-12
  where
    (MkFixed Integer
i) = NominalDiffTime -> Fixed E12
nominalDiffTimeToSeconds NominalDiffTime
t

-- | convenience conversion from Double
toNominalDiffTime :: Double -> NominalDiffTime
toNominalDiffTime :: Gap -> NominalDiffTime
toNominalDiffTime Gap
x =
  let d0 :: Day
d0 = Integer -> Day
ModifiedJulianDay Integer
0
      days :: Integer
days = Gap -> Integer
forall b. Integral b => Gap -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Gap
x Gap -> Gap -> Gap
forall a. Fractional a => a -> a -> a
/ NominalDiffTime -> Gap
fromNominalDiffTime NominalDiffTime
nominalDay)
      secs :: Gap
secs = Gap
x Gap -> Gap -> Gap
forall a. Num a => a -> a -> a
- Integer -> Gap
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
days Gap -> Gap -> Gap
forall a. Num a => a -> a -> a
* NominalDiffTime -> Gap
fromNominalDiffTime NominalDiffTime
nominalDay
      t0 :: UTCTime
t0 = Day -> DiffTime -> UTCTime
UTCTime Day
d0 (Integer -> DiffTime
picosecondsToDiffTime Integer
0)
      t1 :: UTCTime
t1 = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day -> Day
addDays Integer
days Day
d0) (Integer -> DiffTime
picosecondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ Gap -> Integer
forall b. Integral b => Gap -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Gap
secs Gap -> Gap -> Gap
forall a. Fractional a => a -> a -> a
/ Gap
1.0e-12))
   in UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t1 UTCTime
t0

-- | Add the current time
stampNow :: a -> IO (LocalTime, a)
stampNow :: forall a. a -> IO (LocalTime, a)
stampNow a
a = do
  UTCTime
t <- IO UTCTime
getCurrentTime
  (LocalTime, a) -> IO (LocalTime, a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc UTCTime
t, a
a)

-- | Add the current time stamp.
--
-- @
-- > toListM . stampE <$|> (qList [1..3])
-- [(2022-08-30 01:55:16.517127,1),(2022-08-30 01:55:16.517132,2),(2022-08-30 01:55:16.517135,3)]
-- @
stampE ::
  Emitter IO a ->
  Emitter IO (LocalTime, a)
stampE :: forall a. Emitter IO a -> Emitter IO (LocalTime, a)
stampE = (a -> IO (Maybe (LocalTime, a)))
-> Emitter IO a -> Emitter IO (LocalTime, a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Emitter m a -> Emitter m b
witherE (((LocalTime, a) -> Maybe (LocalTime, a))
-> IO (LocalTime, a) -> IO (Maybe (LocalTime, a))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LocalTime, a) -> Maybe (LocalTime, a)
forall a. a -> Maybe a
Just (IO (LocalTime, a) -> IO (Maybe (LocalTime, a)))
-> (a -> IO (LocalTime, a)) -> a -> IO (Maybe (LocalTime, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (LocalTime, a)
forall a. a -> IO (LocalTime, a)
stampNow)

-- | Usually represents seconds.
type Gap = Double

-- | Convert stamped emitter to gap between emits in seconds
--
-- > toListM <$|> (gaps =<< (fromGapsNow =<< (qList (zip (0:repeat 1) [1..4]))))
-- > [(0.0,1),(1.0,2),(1.0,3),(1.0,4)]
gaps :: Emitter IO (LocalTime, a) -> CoEmitter IO (Gap, a)
gaps :: forall a. Emitter IO (LocalTime, a) -> CoEmitter IO (Gap, a)
gaps Emitter IO (LocalTime, a)
e = Maybe LocalTime
-> Emitter (StateT (Maybe LocalTime) IO) (Gap, a)
-> CoEmitter IO (Gap, a)
forall s a. s -> Emitter (StateT s IO) a -> CoEmitter IO a
evalEmitter Maybe LocalTime
forall a. Maybe a
Nothing (Emitter (StateT (Maybe LocalTime) IO) (Gap, a)
 -> CoEmitter IO (Gap, a))
-> Emitter (StateT (Maybe LocalTime) IO) (Gap, a)
-> CoEmitter IO (Gap, a)
forall a b. (a -> b) -> a -> b
$ StateT (Maybe LocalTime) IO (Maybe (Gap, a))
-> Emitter (StateT (Maybe LocalTime) IO) (Gap, a)
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (StateT (Maybe LocalTime) IO (Maybe (Gap, a))
 -> Emitter (StateT (Maybe LocalTime) IO) (Gap, a))
-> StateT (Maybe LocalTime) IO (Maybe (Gap, a))
-> Emitter (StateT (Maybe LocalTime) IO) (Gap, a)
forall a b. (a -> b) -> a -> b
$ do
  Maybe (LocalTime, a)
r <- IO (Maybe (LocalTime, a))
-> StateT (Maybe LocalTime) IO (Maybe (LocalTime, a))
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Maybe LocalTime) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe (LocalTime, a))
 -> StateT (Maybe LocalTime) IO (Maybe (LocalTime, a)))
-> IO (Maybe (LocalTime, a))
-> StateT (Maybe LocalTime) IO (Maybe (LocalTime, a))
forall a b. (a -> b) -> a -> b
$ Emitter IO (LocalTime, a) -> IO (Maybe (LocalTime, a))
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO (LocalTime, a)
e
  case Maybe (LocalTime, a)
r of
    Maybe (LocalTime, a)
Nothing -> Maybe (Gap, a) -> StateT (Maybe LocalTime) IO (Maybe (Gap, a))
forall a. a -> StateT (Maybe LocalTime) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Gap, a)
forall a. Maybe a
Nothing
    Just (LocalTime, a)
a' -> do
      Maybe LocalTime
t' <- StateT (Maybe LocalTime) IO (Maybe LocalTime)
forall s (m :: * -> *). MonadState s m => m s
get
      let delta :: LocalTime -> Gap
delta LocalTime
u = Gap -> (LocalTime -> Gap) -> Maybe LocalTime -> Gap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Gap
0 (NominalDiffTime -> Gap
fromNominalDiffTime (NominalDiffTime -> Gap)
-> (LocalTime -> NominalDiffTime) -> LocalTime -> Gap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> LocalTime -> NominalDiffTime
diffLocalTime LocalTime
u) Maybe LocalTime
t'
      Maybe LocalTime -> StateT (Maybe LocalTime) IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (LocalTime -> Maybe LocalTime
forall a. a -> Maybe a
Just (LocalTime -> Maybe LocalTime) -> LocalTime -> Maybe LocalTime
forall a b. (a -> b) -> a -> b
$ (LocalTime, a) -> LocalTime
forall a b. (a, b) -> a
fst (LocalTime, a)
a')
      Maybe (Gap, a) -> StateT (Maybe LocalTime) IO (Maybe (Gap, a))
forall a. a -> StateT (Maybe LocalTime) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Gap, a) -> StateT (Maybe LocalTime) IO (Maybe (Gap, a)))
-> Maybe (Gap, a) -> StateT (Maybe LocalTime) IO (Maybe (Gap, a))
forall a b. (a -> b) -> a -> b
$ (Gap, a) -> Maybe (Gap, a)
forall a. a -> Maybe a
Just ((Gap, a) -> Maybe (Gap, a)) -> (Gap, a) -> Maybe (Gap, a)
forall a b. (a -> b) -> a -> b
$ (LocalTime -> Gap) -> (LocalTime, a) -> (Gap, a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first LocalTime -> Gap
delta (LocalTime, a)
a'

-- | Convert gaps in seconds to stamps starting from an initial supplied 'LocalTime'
fromGaps :: LocalTime -> Emitter IO (Gap, a) -> CoEmitter IO (LocalTime, a)
fromGaps :: forall a.
LocalTime -> Emitter IO (Gap, a) -> CoEmitter IO (LocalTime, a)
fromGaps LocalTime
t0 Emitter IO (Gap, a)
e = LocalTime
-> Emitter (StateT LocalTime IO) (LocalTime, a)
-> CoEmitter IO (LocalTime, a)
forall s a. s -> Emitter (StateT s IO) a -> CoEmitter IO a
evalEmitter LocalTime
t0 (Emitter (StateT LocalTime IO) (LocalTime, a)
 -> CoEmitter IO (LocalTime, a))
-> Emitter (StateT LocalTime IO) (LocalTime, a)
-> CoEmitter IO (LocalTime, a)
forall a b. (a -> b) -> a -> b
$ StateT LocalTime IO (Maybe (LocalTime, a))
-> Emitter (StateT LocalTime IO) (LocalTime, a)
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (StateT LocalTime IO (Maybe (LocalTime, a))
 -> Emitter (StateT LocalTime IO) (LocalTime, a))
-> StateT LocalTime IO (Maybe (LocalTime, a))
-> Emitter (StateT LocalTime IO) (LocalTime, a)
forall a b. (a -> b) -> a -> b
$ do
  Maybe (Gap, a)
r <- IO (Maybe (Gap, a)) -> StateT LocalTime IO (Maybe (Gap, a))
forall (m :: * -> *) a. Monad m => m a -> StateT LocalTime m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe (Gap, a)) -> StateT LocalTime IO (Maybe (Gap, a)))
-> IO (Maybe (Gap, a)) -> StateT LocalTime IO (Maybe (Gap, a))
forall a b. (a -> b) -> a -> b
$ Emitter IO (Gap, a) -> IO (Maybe (Gap, a))
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO (Gap, a)
e
  case Maybe (Gap, a)
r of
    Maybe (Gap, a)
Nothing -> Maybe (LocalTime, a) -> StateT LocalTime IO (Maybe (LocalTime, a))
forall a. a -> StateT LocalTime IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (LocalTime, a)
forall a. Maybe a
Nothing
    Just (Gap, a)
a' -> do
      LocalTime
t' <- StateT LocalTime IO LocalTime
forall s (m :: * -> *). MonadState s m => m s
get
      let t'' :: LocalTime
t'' = NominalDiffTime -> LocalTime -> LocalTime
addLocalTime (Gap -> NominalDiffTime
toNominalDiffTime ((Gap, a) -> Gap
forall a b. (a, b) -> a
fst (Gap, a)
a')) LocalTime
t'
      LocalTime -> StateT LocalTime IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put LocalTime
t''
      Maybe (LocalTime, a) -> StateT LocalTime IO (Maybe (LocalTime, a))
forall a. a -> StateT LocalTime IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (LocalTime, a)
 -> StateT LocalTime IO (Maybe (LocalTime, a)))
-> Maybe (LocalTime, a)
-> StateT LocalTime IO (Maybe (LocalTime, a))
forall a b. (a -> b) -> a -> b
$ (LocalTime, a) -> Maybe (LocalTime, a)
forall a. a -> Maybe a
Just (LocalTime
t'', (Gap, a) -> a
forall a b. (a, b) -> b
snd (Gap, a)
a')

-- | Convert gaps in seconds to stamps starting with current time
--
-- > toListM <$|> (fromGapsNow =<< (qList (zip (0:repeat 1) [1..4])))
-- > [(2022-08-30 22:57:33.835228,1),(2022-08-30 22:57:34.835228,2),(2022-08-30 22:57:35.835228,3),(2022-08-30 22:57:36.835228,4)]
fromGapsNow :: Emitter IO (Gap, a) -> CoEmitter IO (LocalTime, a)
fromGapsNow :: forall a. Emitter IO (Gap, a) -> CoEmitter IO (LocalTime, a)
fromGapsNow Emitter IO (Gap, a)
e = do
  UTCTime
t0 <- IO UTCTime -> Codensity IO UTCTime
forall a. IO a -> Codensity IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  LocalTime -> Emitter IO (Gap, a) -> CoEmitter IO (LocalTime, a)
forall a.
LocalTime -> Emitter IO (Gap, a) -> CoEmitter IO (LocalTime, a)
fromGaps (TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc UTCTime
t0) Emitter IO (Gap, a)
e

-- | Convert a (Gap,a) emitter to an a emitter, with delays between emits of the gap.
gapEffect ::
  Emitter IO (Gap, a) ->
  Emitter IO a
gapEffect :: forall a. Emitter IO (Gap, a) -> Emitter IO a
gapEffect Emitter IO (Gap, a)
as =
  IO (Maybe a) -> Emitter IO a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (IO (Maybe a) -> Emitter IO a) -> IO (Maybe a) -> Emitter IO a
forall a b. (a -> b) -> a -> b
$ do
    Maybe (Gap, a)
a <- Emitter IO (Gap, a) -> IO (Maybe (Gap, a))
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO (Gap, a)
as
    case Maybe (Gap, a)
a of
      (Just (Gap
s, a
a')) -> Gap -> IO ()
sleep Gap
s IO () -> IO (Maybe a) -> IO (Maybe a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
a')
      Maybe (Gap, a)
_ -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- | Using the Gap emitter, adjust the Gap for a (Gap, a) emitter
speedEffect ::
  Emitter IO Gap ->
  Emitter IO (Gap, a) ->
  Emitter IO a
speedEffect :: forall a. Emitter IO Gap -> Emitter IO (Gap, a) -> Emitter IO a
speedEffect Emitter IO Gap
speeds Emitter IO (Gap, a)
as =
  IO (Maybe a) -> Emitter IO a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (IO (Maybe a) -> Emitter IO a) -> IO (Maybe a) -> Emitter IO a
forall a b. (a -> b) -> a -> b
$ do
    Maybe Gap
s <- Emitter IO Gap -> IO (Maybe Gap)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO Gap
speeds
    Maybe (Gap, a)
a <- Emitter IO (Gap, a) -> IO (Maybe (Gap, a))
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO (Gap, a)
as
    case (Maybe Gap
s, Maybe (Gap, a)
a) of
      (Just Gap
s', Just (Gap
g, a
a')) -> Gap -> IO ()
sleep (Gap
g Gap -> Gap -> Gap
forall a. Fractional a => a -> a -> a
/ Gap
s') IO () -> IO (Maybe a) -> IO (Maybe a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
a')
      (Maybe Gap, Maybe (Gap, a))
_ -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- | Only add a Gap effect if greater than the Int emitter
--
-- effect is similar to a fast-forward of the first n emits
gapSkipEffect ::
  Emitter IO Int ->
  Emitter IO Gap ->
  CoEmitter IO Gap
gapSkipEffect :: Emitter IO Int -> Emitter IO Gap -> CoEmitter IO Gap
gapSkipEffect Emitter IO Int
n Emitter IO Gap
e = Int -> Emitter (StateT Int IO) Gap -> CoEmitter IO Gap
forall s a. s -> Emitter (StateT s IO) a -> CoEmitter IO a
evalEmitter Int
0 (Emitter (StateT Int IO) Gap -> CoEmitter IO Gap)
-> Emitter (StateT Int IO) Gap -> CoEmitter IO Gap
forall a b. (a -> b) -> a -> b
$ StateT Int IO (Maybe Gap) -> Emitter (StateT Int IO) Gap
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (StateT Int IO (Maybe Gap) -> Emitter (StateT Int IO) Gap)
-> StateT Int IO (Maybe Gap) -> Emitter (StateT Int IO) Gap
forall a b. (a -> b) -> a -> b
$ do
  Maybe Int
n' <- IO (Maybe Int) -> StateT Int IO (Maybe Int)
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Int) -> StateT Int IO (Maybe Int))
-> IO (Maybe Int) -> StateT Int IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Emitter IO Int -> IO (Maybe Int)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO Int
n
  Maybe Gap
e' <- IO (Maybe Gap) -> StateT Int IO (Maybe Gap)
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Gap) -> StateT Int IO (Maybe Gap))
-> IO (Maybe Gap) -> StateT Int IO (Maybe Gap)
forall a b. (a -> b) -> a -> b
$ Emitter IO Gap -> IO (Maybe Gap)
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO Gap
e
  Int
count <- StateT Int IO Int
forall s (m :: * -> *). MonadState s m => m s
get
  (Int -> Int) -> StateT Int IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int
1 +)
  case (Maybe Int
n', Maybe Gap
e') of
    (Maybe Int
_, Maybe Gap
Nothing) -> Maybe Gap -> StateT Int IO (Maybe Gap)
forall a. a -> StateT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Gap
forall a. Maybe a
Nothing
    (Maybe Int
Nothing, Maybe Gap
_) -> Maybe Gap -> StateT Int IO (Maybe Gap)
forall a. a -> StateT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Gap
forall a. Maybe a
Nothing
    (Just Int
n'', Just Gap
e'') ->
      Maybe Gap -> StateT Int IO (Maybe Gap)
forall a. a -> StateT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Gap -> StateT Int IO (Maybe Gap))
-> Maybe Gap -> StateT Int IO (Maybe Gap)
forall a b. (a -> b) -> a -> b
$ Gap -> Maybe Gap
forall a. a -> Maybe a
Just (Gap -> Gap -> Bool -> Gap
forall a. a -> a -> Bool -> a
bool Gap
e'' Gap
0 (Int
n'' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
count))

-- | Only add a Gap if greater than the Int emitter
--
-- effect is similar to a fast-forward of the first n emits
speedSkipEffect ::
  Emitter IO (Int, Gap) ->
  Emitter IO (Gap, a) ->
  CoEmitter IO a
speedSkipEffect :: forall a.
Emitter IO (Int, Gap) -> Emitter IO (Gap, a) -> CoEmitter IO a
speedSkipEffect Emitter IO (Int, Gap)
p Emitter IO (Gap, a)
e = Int -> Emitter (StateT Int IO) a -> CoEmitter IO a
forall s a. s -> Emitter (StateT s IO) a -> CoEmitter IO a
evalEmitter Int
0 (Emitter (StateT Int IO) a -> CoEmitter IO a)
-> Emitter (StateT Int IO) a -> CoEmitter IO a
forall a b. (a -> b) -> a -> b
$ StateT Int IO (Maybe a) -> Emitter (StateT Int IO) a
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (StateT Int IO (Maybe a) -> Emitter (StateT Int IO) a)
-> StateT Int IO (Maybe a) -> Emitter (StateT Int IO) a
forall a b. (a -> b) -> a -> b
$ do
  Maybe (Int, Gap)
p' <- IO (Maybe (Int, Gap)) -> StateT Int IO (Maybe (Int, Gap))
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe (Int, Gap)) -> StateT Int IO (Maybe (Int, Gap)))
-> IO (Maybe (Int, Gap)) -> StateT Int IO (Maybe (Int, Gap))
forall a b. (a -> b) -> a -> b
$ Emitter IO (Int, Gap) -> IO (Maybe (Int, Gap))
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO (Int, Gap)
p
  Maybe (Gap, a)
e' <- IO (Maybe (Gap, a)) -> StateT Int IO (Maybe (Gap, a))
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe (Gap, a)) -> StateT Int IO (Maybe (Gap, a)))
-> IO (Maybe (Gap, a)) -> StateT Int IO (Maybe (Gap, a))
forall a b. (a -> b) -> a -> b
$ Emitter IO (Gap, a) -> IO (Maybe (Gap, a))
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO (Gap, a)
e
  Int
count <- StateT Int IO Int
forall s (m :: * -> *). MonadState s m => m s
get
  (Int -> Int) -> StateT Int IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int
1 +)
  case (Maybe (Int, Gap)
p', Maybe (Gap, a)
e') of
    (Maybe (Int, Gap)
_, Maybe (Gap, a)
Nothing) -> Maybe a -> StateT Int IO (Maybe a)
forall a. a -> StateT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    (Maybe (Int, Gap)
Nothing, Maybe (Gap, a)
_) -> Maybe a -> StateT Int IO (Maybe a)
forall a. a -> StateT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    (Just (Int
n, Gap
s), Just (Gap
g, a
a)) ->
      IO (Maybe a) -> StateT Int IO (Maybe a)
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe a) -> StateT Int IO (Maybe a))
-> IO (Maybe a) -> StateT Int IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ Gap -> IO ()
sleep (Gap -> Gap -> Bool -> Gap
forall a. a -> a -> Bool -> a
bool (Gap
g Gap -> Gap -> Gap
forall a. Fractional a => a -> a -> a
/ Gap
s) Gap
0 (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
count)) IO () -> IO (Maybe a) -> IO (Maybe a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

-- | Ignore the first n gaps and immediately emit them.
skip :: Int -> Emitter IO (Gap, a) -> CoEmitter IO (Gap, a)
skip :: forall a. Int -> Emitter IO (Gap, a) -> CoEmitter IO (Gap, a)
skip Int
sk Emitter IO (Gap, a)
e = Int -> Emitter (StateT Int IO) (Gap, a) -> CoEmitter IO (Gap, a)
forall s a. s -> Emitter (StateT s IO) a -> CoEmitter IO a
evalEmitter (Int
sk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Emitter (StateT Int IO) (Gap, a) -> CoEmitter IO (Gap, a))
-> Emitter (StateT Int IO) (Gap, a) -> CoEmitter IO (Gap, a)
forall a b. (a -> b) -> a -> b
$ StateT Int IO (Maybe (Gap, a)) -> Emitter (StateT Int IO) (Gap, a)
forall (m :: * -> *) a. m (Maybe a) -> Emitter m a
Emitter (StateT Int IO (Maybe (Gap, a))
 -> Emitter (StateT Int IO) (Gap, a))
-> StateT Int IO (Maybe (Gap, a))
-> Emitter (StateT Int IO) (Gap, a)
forall a b. (a -> b) -> a -> b
$ do
  Int
skip' <- StateT Int IO Int
forall s (m :: * -> *). MonadState s m => m s
get
  Maybe (Gap, a)
e' <- IO (Maybe (Gap, a)) -> StateT Int IO (Maybe (Gap, a))
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe (Gap, a)) -> StateT Int IO (Maybe (Gap, a)))
-> IO (Maybe (Gap, a)) -> StateT Int IO (Maybe (Gap, a))
forall a b. (a -> b) -> a -> b
$ Emitter IO (Gap, a) -> IO (Maybe (Gap, a))
forall (m :: * -> *) a. Emitter m a -> m (Maybe a)
emit Emitter IO (Gap, a)
e
  case Maybe (Gap, a)
e' of
    Maybe (Gap, a)
Nothing -> Maybe (Gap, a) -> StateT Int IO (Maybe (Gap, a))
forall a. a -> StateT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Gap, a)
forall a. Maybe a
Nothing
    Just (Gap
secs, a
a) -> do
      case Int
skip' of
        Int
0 -> Maybe (Gap, a) -> StateT Int IO (Maybe (Gap, a))
forall a. a -> StateT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Gap, a) -> Maybe (Gap, a)
forall a. a -> Maybe a
Just (Gap
secs, a
a))
        Int
_ -> do
          Int -> StateT Int IO ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
skip' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          Maybe (Gap, a) -> StateT Int IO (Maybe (Gap, a))
forall a. a -> StateT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Gap, a) -> Maybe (Gap, a)
forall a. a -> Maybe a
Just (Gap
0, a
a))

-- | Replay a stamped emitter, adjusting the speed of the replay.
--
-- > toListM . stampE <$|> (replay 0.1 1 =<< (fromGapsNow =<< (qList (zip (0:repeat 1) [1..4]))))
-- > [(2022-08-31 02:29:39.643831,1),(2022-08-31 02:29:39.643841,2),(2022-08-31 02:29:39.746998,3),(2022-08-31 02:29:39.849615,4)]
replay :: Double -> Int -> Emitter IO (LocalTime, a) -> CoEmitter IO a
replay :: forall a. Gap -> Int -> Emitter IO (LocalTime, a) -> CoEmitter IO a
replay Gap
speed Int
sk Emitter IO (LocalTime, a)
e = Emitter IO (Gap, a) -> Emitter IO a
forall a. Emitter IO (Gap, a) -> Emitter IO a
gapEffect (Emitter IO (Gap, a) -> Emitter IO a)
-> (Emitter IO (Gap, a) -> Emitter IO (Gap, a))
-> Emitter IO (Gap, a)
-> Emitter IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Gap, a) -> (Gap, a))
-> Emitter IO (Gap, a) -> Emitter IO (Gap, a)
forall a b. (a -> b) -> Emitter IO a -> Emitter IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Gap -> Gap) -> (Gap, a) -> (Gap, a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Gap
speed *)) (Emitter IO (Gap, a) -> Emitter IO a)
-> Codensity IO (Emitter IO (Gap, a))
-> Codensity IO (Emitter IO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Emitter IO (Gap, a) -> Codensity IO (Emitter IO (Gap, a))
forall a. Int -> Emitter IO (Gap, a) -> CoEmitter IO (Gap, a)
skip Int
sk (Emitter IO (Gap, a) -> Codensity IO (Emitter IO (Gap, a)))
-> Codensity IO (Emitter IO (Gap, a))
-> Codensity IO (Emitter IO (Gap, a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Emitter IO (LocalTime, a) -> Codensity IO (Emitter IO (Gap, a))
forall a. Emitter IO (LocalTime, a) -> CoEmitter IO (Gap, a)
gaps Emitter IO (LocalTime, a)
e)