{-# LANGUAGE NoImplicitPrelude #-}
-------------------------------------------------------------------------------
-- |
-- Module      :  GHC.Event.TimeOut
-- Copyright   :  (c) Tamar Christina 2018
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  stable
-- Portability :  non-portable
--
-- Common Timer definitions shared between WinIO and RIO.
--
-------------------------------------------------------------------------------

module GHC.Event.TimeOut where

import GHC.IO
import GHC.Base

import qualified GHC.Event.PSQ as Q
import GHC.Event.Unique (Unique)

-- | A priority search queue, with timeouts as priorities.
type TimeoutQueue = Q.PSQ TimeoutCallback

-- |
-- Warning: since the 'TimeoutCallback' is called from the I/O manager, it must
-- not throw an exception or block for a long period of time.  In particular,
-- be wary of 'Control.Exception.throwTo' and 'Control.Concurrent.killThread':
-- if the target thread is making a foreign call, these functions will block
-- until the call completes.
type TimeoutCallback = IO ()

-- | An edit to apply to a 'TimeoutQueue'.
type TimeoutEdit = TimeoutQueue -> TimeoutQueue

-- | A timeout registration cookie.
newtype TimeoutKey = TK Unique
    deriving (TimeoutKey -> TimeoutKey -> Bool
(TimeoutKey -> TimeoutKey -> Bool)
-> (TimeoutKey -> TimeoutKey -> Bool) -> Eq TimeoutKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeoutKey -> TimeoutKey -> Bool
== :: TimeoutKey -> TimeoutKey -> Bool
$c/= :: TimeoutKey -> TimeoutKey -> Bool
/= :: TimeoutKey -> TimeoutKey -> Bool
Eq, Eq TimeoutKey
Eq TimeoutKey
-> (TimeoutKey -> TimeoutKey -> Ordering)
-> (TimeoutKey -> TimeoutKey -> Bool)
-> (TimeoutKey -> TimeoutKey -> Bool)
-> (TimeoutKey -> TimeoutKey -> Bool)
-> (TimeoutKey -> TimeoutKey -> Bool)
-> (TimeoutKey -> TimeoutKey -> TimeoutKey)
-> (TimeoutKey -> TimeoutKey -> TimeoutKey)
-> Ord TimeoutKey
TimeoutKey -> TimeoutKey -> Bool
TimeoutKey -> TimeoutKey -> Ordering
TimeoutKey -> TimeoutKey -> TimeoutKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TimeoutKey -> TimeoutKey -> Ordering
compare :: TimeoutKey -> TimeoutKey -> Ordering
$c< :: TimeoutKey -> TimeoutKey -> Bool
< :: TimeoutKey -> TimeoutKey -> Bool
$c<= :: TimeoutKey -> TimeoutKey -> Bool
<= :: TimeoutKey -> TimeoutKey -> Bool
$c> :: TimeoutKey -> TimeoutKey -> Bool
> :: TimeoutKey -> TimeoutKey -> Bool
$c>= :: TimeoutKey -> TimeoutKey -> Bool
>= :: TimeoutKey -> TimeoutKey -> Bool
$cmax :: TimeoutKey -> TimeoutKey -> TimeoutKey
max :: TimeoutKey -> TimeoutKey -> TimeoutKey
$cmin :: TimeoutKey -> TimeoutKey -> TimeoutKey
min :: TimeoutKey -> TimeoutKey -> TimeoutKey
Ord)