    -- |
    -- Module: Control.FoldDebounce
    -- Description: Fold multiple events that happen in a given period of time
    -- Maintainer: Toshio Ito <debug.ito@gmail.com>
    --
    -- Synopsis:
    --
    -- > module Main (main) where
    -- >
    -- > import System.IO (putStrLn)
    -- > import Control.Concurrent (threadDelay)
    -- >
    -- > import qualified Control.FoldDebounce as Fdeb
    -- >
    -- > printValue :: Int -> IO ()
    -- > printValue v = putStrLn ("value = " ++ show v)
    -- >
    -- > main :: IO ()
    -- > main = do
    -- >   trigger <- Fdeb.new Fdeb.Args { Fdeb.cb = printValue, Fdeb.fold = (+), Fdeb.init = 0 }
    -- >                       Fdeb.def { Fdeb.delay = 500000 }
    -- >   let send' = Fdeb.send trigger
    -- >   send' 1
    -- >   send' 2
    -- >   send' 3
    -- >   threadDelay 1000000 -- During this period, "value = 6" is printed.
    -- >   send' 4
    -- >   threadDelay 1000    -- Nothing is printed.
    -- >   send' 5
    -- >   threadDelay 1000000 -- During this period, "value = 9" is printed.
    -- >   Fdeb.close trigger
    --
    -- This module is similar to "Control.Debounce". It debouces input
    -- events and regulates the frequency at which the action (callback)
    -- is executed.
    --
    -- The difference from "Control.Debounce" is:
    --
    -- * With "Control.Debounce", you cannot pass values to the callback
    -- action. This module folds (accumulates) the input events (type @i@)
    -- and passes the folded output event (type @o@) to the callback.
    --
    -- * "Control.Debounce" immediately runs the callback at the first
    -- input event. This module just starts a timer at the first input,
    -- and runs the callback when the timer expires.
    --
    -- The API and documentation is borrowed from a Perl module called
    -- AnyEvent::Debounce. See <https://metacpan.org/pod/AnyEvent::Debounce>
    --
    --
    module Control.FoldDebounce
        ( -- * Create the trigger
          new
        , Trigger
          -- * Parameter types
        , Args (..)
        , Opts
        , def
          -- ** Accessors for 'Opts'
          -- $opts_accessors
        , delay
        , alwaysResetTimer
          -- ** Preset parameters
        , forStack
        , forMonoid
        , forVoid
          -- * Use the trigger
        , send
          -- * Finish the trigger
        , close
          -- * Exception types
        , OpException (..)
        ) where

    import           Control.Applicative          ((<$>), (<|>))
    import           Control.Concurrent           (forkFinally)
    import           Control.Exception            (Exception, SomeException, bracket)
    import           Control.Monad                (void)
    import           Data.Monoid                  (Monoid, mappend, mempty)
    import           Data.Ratio                   ((%))
    import           Data.Typeable                (Typeable)
    import           Prelude                      hiding (init)

    import           Control.Concurrent.STM       (STM, TChan, TVar, atomically, newTChanIO, newTVarIO,
                                                   readTChan, readTVar, retry, throwSTM, writeTChan,
                                                   writeTVar)
    import           Control.Concurrent.STM.Delay (cancelDelay, newDelay, waitDelay)
    import           Data.Default.Class           (Default (def))
    import           Data.Time                    (UTCTime, addUTCTime, diffUTCTime, getCurrentTime)

    -- | Mandatory parameters for 'new'.
    data Args i o
      = Args
          { -- | The callback to be called when the output event is
            -- emitted. Note that this action is run in a different thread than
            -- the one calling 'send'.
            --
            -- The callback should not throw any exception. In this case, the
            -- 'Trigger' is abnormally closed, causing
            -- 'UnexpectedClosedException' when 'close'.
            forall i o. Args i o -> o -> IO ()
    cb   :: o -> IO ()
            -- | The binary operation of left-fold. The left-fold is evaluated strictly.
          , forall i o. Args i o -> o -> i -> o
    fold :: o -> i -> o
            -- | The initial value of the left-fold.
          , forall i o. Args i o -> o
    init :: o
          }

    -- $opts_accessors
    -- You can update fields in 'Opts' via these accessors.
    --

    -- | Optional parameters for 'new'. You can get the default by 'def'
    -- function.
    data Opts i o
      = Opts
          { -- | The time (in microsecond) to wait after receiving an event
            -- before sending it, in case more events happen in the interim.
            --
            -- Default: 1 second (1000000)
            forall i o. Opts i o -> Int
    delay            :: Int
            -- | Normally, when an event is received and it's the first of a
            -- series, a timer is started, and when that timer expires, all
            -- events are sent. If you set this parameter to True, then
            -- the timer is reset after each event is received.
            --
            -- Default: False
          , forall i o. Opts i o -> Bool
    alwaysResetTimer :: Bool
          }

    instance Default (Opts i o) where
      def :: Opts i o
    def = Opts {
        delay :: Int
    delay = Int
    1000000,
        alwaysResetTimer :: Bool
    alwaysResetTimer = Bool
    False
        }

    -- | 'Args' for stacks. Input events are accumulated in a stack, i.e.,
    -- the last event is at the head of the list.
    forStack :: ([i] -> IO ()) -- ^ 'cb' field.
             -> Args i [i]
    forStack :: forall i. ([i] -> IO ()) -> Args i [i]
    forStack [i] -> IO ()
    mycb = Args { cb :: [i] -> IO ()
    cb = [i] -> IO ()
    mycb, fold :: [i] -> i -> [i]
    fold = ((i -> [i] -> [i]) -> [i] -> i -> [i]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (:)),  init :: [i]
    init = []}

    -- | 'Args' for monoids. Input events are appended to the tail.
    forMonoid :: Monoid i
                 => (i -> IO ()) -- ^ 'cb' field.
                 -> Args i i
    forMonoid :: forall i. Monoid i => (i -> IO ()) -> Args i i
    forMonoid i -> IO ()
    mycb = Args { cb :: i -> IO ()
    cb = i -> IO ()
    mycb, fold :: i -> i -> i
    fold = i -> i -> i
    forall a. Monoid a => a -> a -> a
    mappend, init :: i
    init = i
    forall a. Monoid a => a
    mempty }

    -- | 'Args' that discards input events. Although input events are not
    -- folded, they still start the timer and activate the callback.
    forVoid :: IO () -- ^ 'cb' field.
            -> Args i ()
    forVoid :: forall i. IO () -> Args i ()
    forVoid IO ()
    mycb = Args { cb :: () -> IO ()
    cb = IO () -> () -> IO ()
    forall a b. a -> b -> a
    const IO ()
    mycb, fold :: () -> i -> ()
    fold = (\()
    _ i
    _ -> ()), init :: ()
    init = () }

    type SendTime = UTCTime
    type ExpirationTime = UTCTime

    -- | Internal input to the worker thread.
    data ThreadInput i
      = TIEvent i SendTime -- ^ A new input event is made
      | TIFinish

    -- | Internal state of the worker thread.
    data ThreadState
      = TSOpen -- ^ the thread is open and running
      | TSClosedNormally -- ^ the thread is successfully closed
      | TSClosedAbnormally SomeException

    -- | A trigger to send input events to FoldDebounce. You input data of
    -- type @i@ to the trigger, and it outputs data of type @o@.
    data Trigger i o
      = Trigger
          { forall i o. Trigger i o -> TChan (ThreadInput i)
    trigInput :: TChan (ThreadInput i)
          , forall i o. Trigger i o -> TVar ThreadState
    trigState :: TVar ThreadState
          }

    -- | Create a FoldDebounce trigger.
    new :: Args i o -- ^ mandatory parameters
        -> Opts i o -- ^ optional parameters
        -> IO (Trigger i o) -- ^ action to create the trigger.
    new :: forall i o. Args i o -> Opts i o -> IO (Trigger i o)
    new Args i o
    args Opts i o
    opts = do
      TChan (ThreadInput i)
    chan <- IO (TChan (ThreadInput i))
    forall a. IO (TChan a)
    newTChanIO
      TVar ThreadState
    state_tvar <- ThreadState -> IO (TVar ThreadState)
    forall a. a -> IO (TVar a)
    newTVarIO ThreadState
    TSOpen
      let putState :: ThreadState -> IO ()
    putState = STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ())
    -> (ThreadState -> STM ()) -> ThreadState -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TVar ThreadState -> ThreadState -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar ThreadState
    state_tvar
      IO ThreadId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> (Either SomeException () -> IO ()) -> IO ThreadId
    forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
    forkFinally (Args i o -> Opts i o -> TChan (ThreadInput i) -> IO ()
    forall i o. Args i o -> Opts i o -> TChan (ThreadInput i) -> IO ()
    threadAction Args i o
    args Opts i o
    opts TChan (ThreadInput i)
    chan)
                         ((SomeException -> IO ())
    -> (() -> IO ()) -> Either SomeException () -> IO ()
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (ThreadState -> IO ()
    putState (ThreadState -> IO ())
    -> (SomeException -> ThreadState) -> SomeException -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> ThreadState
    TSClosedAbnormally) (IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ThreadState -> IO ()
    putState ThreadState
    TSClosedNormally))
      Trigger i o -> IO (Trigger i o)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Trigger i o -> IO (Trigger i o))
    -> Trigger i o -> IO (Trigger i o)
    forall a b. (a -> b) -> a -> b
    $ TChan (ThreadInput i) -> TVar ThreadState -> Trigger i o
    forall i o.
    TChan (ThreadInput i) -> TVar ThreadState -> Trigger i o
    Trigger TChan (ThreadInput i)
    chan TVar ThreadState
    state_tvar

    getThreadState :: Trigger i o -> STM ThreadState
    getThreadState :: forall i o. Trigger i o -> STM ThreadState
    getThreadState Trigger i o
    trig = TVar ThreadState -> STM ThreadState
    forall a. TVar a -> STM a
    readTVar (Trigger i o -> TVar ThreadState
    forall i o. Trigger i o -> TVar ThreadState
    trigState Trigger i o
    trig)

    -- | Send an input event.
    --
    -- If the 'Trigger' is already closed, it throws
    -- 'AlreadyClosedException'. If the 'Trigger' has been abnormally
    -- closed, it throws 'UnexpectedClosedException'.
    send :: Trigger i o -> i -> IO ()
    send :: forall i o. Trigger i o -> i -> IO ()
    send Trigger i o
    trig i
    in_event = do
      UTCTime
    send_time <- IO UTCTime
    getCurrentTime
      STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        ThreadState
    state <- Trigger i o -> STM ThreadState
    forall i o. Trigger i o -> STM ThreadState
    getThreadState Trigger i o
    trig
        case ThreadState
    state of
          ThreadState
    TSOpen               -> TChan (ThreadInput i) -> ThreadInput i -> STM ()
    forall a. TChan a -> a -> STM ()
    writeTChan (Trigger i o -> TChan (ThreadInput i)
    forall i o. Trigger i o -> TChan (ThreadInput i)
    trigInput Trigger i o
    trig) (i -> UTCTime -> ThreadInput i
    forall i. i -> UTCTime -> ThreadInput i
    TIEvent i
    in_event UTCTime
    send_time)
          ThreadState
    TSClosedNormally     -> OpException -> STM ()
    forall e a. Exception e => e -> STM a
    throwSTM OpException
    AlreadyClosedException
          TSClosedAbnormally SomeException
    e -> OpException -> STM ()
    forall e a. Exception e => e -> STM a
    throwSTM (OpException -> STM ()) -> OpException -> STM ()
    forall a b. (a -> b) -> a -> b
    $ SomeException -> OpException
    UnexpectedClosedException SomeException
    e

    -- | Close and release the 'Trigger'. If there is a pending output event, the event is fired immediately.
    --
    -- If the 'Trigger' has been abnormally closed, it throws 'UnexpectedClosedException'.
    close :: Trigger i o -> IO ()
    close :: forall i o. Trigger i o -> IO ()
    close Trigger i o
    trig = do
      STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ STM () -> STM ()
    whenOpen (STM () -> STM ()) -> STM () -> STM ()
    forall a b. (a -> b) -> a -> b
    $ TChan (ThreadInput i) -> ThreadInput i -> STM ()
    forall a. TChan a -> a -> STM ()
    writeTChan (Trigger i o -> TChan (ThreadInput i)
    forall i o. Trigger i o -> TChan (ThreadInput i)
    trigInput Trigger i o
    trig) ThreadInput i
    forall i. ThreadInput i
    TIFinish
      STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ STM () -> STM ()
    whenOpen (STM () -> STM ()) -> STM () -> STM ()
    forall a b. (a -> b) -> a -> b
    $ STM ()
    forall a. STM a
    retry -- wait for closing
      where
        whenOpen :: STM () -> STM ()
    whenOpen STM ()
    stm_action = do
          ThreadState
    state <- Trigger i o -> STM ThreadState
    forall i o. Trigger i o -> STM ThreadState
    getThreadState Trigger i o
    trig
          case ThreadState
    state of
            ThreadState
    TSOpen               -> STM ()
    stm_action
            ThreadState
    TSClosedNormally     -> () -> STM ()
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            TSClosedAbnormally SomeException
    e -> OpException -> STM ()
    forall e a. Exception e => e -> STM a
    throwSTM (OpException -> STM ()) -> OpException -> STM ()
    forall a b. (a -> b) -> a -> b
    $ SomeException -> OpException
    UnexpectedClosedException SomeException
    e

    -- | Exception type used by FoldDebounce operations
    data OpException
      = AlreadyClosedException -- ^ You attempted to 'send' after the trigger is already 'close'd.
      | UnexpectedClosedException SomeException -- ^ The 'SomeException' is thrown in the background thread.
      deriving (Int -> OpException -> ShowS
    [OpException] -> ShowS
    OpException -> String
    (Int -> OpException -> ShowS)
    -> (OpException -> String)
    -> ([OpException] -> ShowS)
    -> Show OpException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> OpException -> ShowS
    showsPrec :: Int -> OpException -> ShowS
    $cshow :: OpException -> String
    show :: OpException -> String
    $cshowList :: [OpException] -> ShowS
    showList :: [OpException] -> ShowS
    Show, Typeable)

    instance Exception OpException

    ---

    threadAction :: Args i o -> Opts i o -> TChan (ThreadInput i) -> IO ()
    threadAction :: forall i o. Args i o -> Opts i o -> TChan (ThreadInput i) -> IO ()
    threadAction Args i o
    args Opts i o
    opts TChan (ThreadInput i)
    in_chan = Maybe UTCTime -> Maybe o -> IO ()
    threadAction' Maybe UTCTime
    forall a. Maybe a
    Nothing Maybe o
    forall a. Maybe a
    Nothing where
      threadAction' :: Maybe UTCTime -> Maybe o -> IO ()
    threadAction' Maybe UTCTime
    mexpiration Maybe o
    mout_event = do
        Maybe (ThreadInput i)
    mgot <- TChan (ThreadInput i)
    -> Maybe UTCTime -> IO (Maybe (ThreadInput i))
    forall a. TChan a -> Maybe UTCTime -> IO (Maybe a)
    waitInput TChan (ThreadInput i)
    in_chan Maybe UTCTime
    mexpiration
        case Maybe (ThreadInput i)
    mgot of
          Maybe (ThreadInput i)
    Nothing -> Args i o -> Maybe o -> IO ()
    forall i o. Args i o -> Maybe o -> IO ()
    fireCallback Args i o
    args Maybe o
    mout_event IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe UTCTime -> Maybe o -> IO ()
    threadAction' Maybe UTCTime
    forall a. Maybe a
    Nothing Maybe o
    forall a. Maybe a
    Nothing
          Just (ThreadInput i
    TIFinish) -> Args i o -> Maybe o -> IO ()
    forall i o. Args i o -> Maybe o -> IO ()
    fireCallback Args i o
    args Maybe o
    mout_event
          Just (TIEvent i
    in_event UTCTime
    send_time) ->
            let next_out :: o
    next_out = Args i o -> Maybe o -> i -> o
    forall i o. Args i o -> Maybe o -> i -> o
    doFold Args i o
    args Maybe o
    mout_event i
    in_event
                next_expiration :: UTCTime
    next_expiration = Opts i o -> Maybe UTCTime -> UTCTime -> UTCTime
    forall i o. Opts i o -> Maybe UTCTime -> UTCTime -> UTCTime
    nextExpiration Opts i o
    opts Maybe UTCTime
    mexpiration UTCTime
    send_time
            in o
    next_out o -> IO () -> IO ()
    forall a b. a -> b -> b
    `seq` Maybe UTCTime -> Maybe o -> IO ()
    threadAction' (UTCTime -> Maybe UTCTime
    forall a. a -> Maybe a
    Just UTCTime
    next_expiration) (o -> Maybe o
    forall a. a -> Maybe a
    Just o
    next_out)

    waitInput :: TChan a      -- ^ input channel
              -> Maybe ExpirationTime  -- ^ If 'Nothing', it never times out.
              -> IO (Maybe a) -- ^ 'Nothing' if timed out
    waitInput :: forall a. TChan a -> Maybe UTCTime -> IO (Maybe a)
    waitInput TChan a
    in_chan Maybe UTCTime
    mexpiration = do
      UTCTime
    cur_time <- IO UTCTime
    getCurrentTime
      let mwait_duration :: Maybe Int
    mwait_duration = (UTCTime -> UTCTime -> Int
    `diffTimeUsec` UTCTime
    cur_time) (UTCTime -> Int) -> Maybe UTCTime -> Maybe Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe UTCTime
    mexpiration
      case Maybe Int
    mwait_duration of
        Just Int
    0 -> Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
        Maybe Int
    Nothing -> STM (Maybe a) -> IO (Maybe a)
    forall a. STM a -> IO a
    atomically STM (Maybe a)
    readInputSTM
        Just Int
    dur -> IO Delay
    -> (Delay -> IO ()) -> (Delay -> IO (Maybe a)) -> IO (Maybe a)
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (Int -> IO Delay
    newDelay Int
    dur) Delay -> IO ()
    cancelDelay ((Delay -> IO (Maybe a)) -> IO (Maybe a))
    -> (Delay -> IO (Maybe a)) -> IO (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ \Delay
    timer -> do
          STM (Maybe a) -> IO (Maybe a)
    forall a. STM a -> IO a
    atomically (STM (Maybe a) -> IO (Maybe a)) -> STM (Maybe a) -> IO (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ STM (Maybe a)
    readInputSTM STM (Maybe a) -> STM (Maybe a) -> STM (Maybe a)
    forall a. STM a -> STM a -> STM a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Maybe a -> () -> Maybe a
    forall a b. a -> b -> a
    const Maybe a
    forall a. Maybe a
    Nothing (() -> Maybe a) -> STM () -> STM (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Delay -> STM ()
    waitDelay Delay
    timer)
      where
        readInputSTM :: STM (Maybe a)
    readInputSTM = a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> STM a -> STM (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TChan a -> STM a
    forall a. TChan a -> STM a
    readTChan TChan a
    in_chan

    fireCallback :: Args i o -> Maybe o -> IO ()
    fireCallback :: forall i o. Args i o -> Maybe o -> IO ()
    fireCallback Args i o
    _ Maybe o
    Nothing             = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    fireCallback Args i o
    args (Just o
    out_event) = Args i o -> o -> IO ()
    forall i o. Args i o -> o -> IO ()
    cb Args i o
    args o
    out_event

    doFold :: Args i o -> Maybe o -> i -> o
    doFold :: forall i o. Args i o -> Maybe o -> i -> o
    doFold Args i o
    args Maybe o
    mcurrent i
    in_event = let current :: o
    current = o -> (o -> o) -> Maybe o -> o
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Args i o -> o
    forall i o. Args i o -> o
    init Args i o
    args) o -> o
    forall a. a -> a
    id Maybe o
    mcurrent
                                    in Args i o -> o -> i -> o
    forall i o. Args i o -> o -> i -> o
    fold Args i o
    args o
    current i
    in_event

    noNegative :: Int -> Int
    noNegative :: Int -> Int
    noNegative Int
    x = if Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 then Int
    0 else Int
    x

    diffTimeUsec :: UTCTime -> UTCTime -> Int
    diffTimeUsec :: UTCTime -> UTCTime -> Int
    diffTimeUsec UTCTime
    a UTCTime
    b = Int -> Int
    noNegative (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Rational -> Int
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Rational -> Int) -> Rational -> Int
    forall a b. (a -> b) -> a -> b
    $ (Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    1000000) (Rational -> Rational) -> Rational -> Rational
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> Rational
    forall a. Real a => a -> Rational
    toRational (NominalDiffTime -> Rational) -> NominalDiffTime -> Rational
    forall a b. (a -> b) -> a -> b
    $ UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    a UTCTime
    b

    addTimeUsec :: UTCTime -> Int -> UTCTime
    addTimeUsec :: UTCTime -> Int -> UTCTime
    addTimeUsec UTCTime
    t Int
    d = NominalDiffTime -> UTCTime -> UTCTime
    addUTCTime (Rational -> NominalDiffTime
    forall a. Fractional a => Rational -> a
    fromRational (Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    d Integer -> Integer -> Rational
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    1000000)) UTCTime
    t

    nextExpiration :: Opts i o -> Maybe ExpirationTime -> SendTime -> ExpirationTime
    nextExpiration :: forall i o. Opts i o -> Maybe UTCTime -> UTCTime -> UTCTime
    nextExpiration Opts i o
    opts Maybe UTCTime
    mlast_expiration UTCTime
    send_time
      | Opts i o -> Bool
    forall i o. Opts i o -> Bool
    alwaysResetTimer Opts i o
    opts = UTCTime
    fullDelayed
      | Bool
    otherwise = UTCTime -> (UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe UTCTime
    fullDelayed UTCTime -> UTCTime
    forall a. a -> a
    id (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
    forall a b. (a -> b) -> a -> b
    $ Maybe UTCTime
    mlast_expiration
      where
        fullDelayed :: UTCTime
    fullDelayed = (UTCTime -> Int -> UTCTime
    `addTimeUsec` Opts i o -> Int
    forall i o. Opts i o -> Int
    delay Opts i o
    opts) UTCTime
    send_time