{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Data.Timeout
  ( TimedOut(..)
  , TimeoutUnit(..)
  , aTimeoutUnit
  , timeoutUnitNanos
  , Timeout(..)
  , aTimeout
  , (#)
  , (#>)
  , (#<)
  , instantly
  ) where

import Prelude hiding (print)
import Data.Typeable (Typeable)
import Data.Ix (Ix)
import Data.Word (Word64)
import Data.Proxy (Proxy(..))
import Data.Monoid (mconcat)
import Data.Textual (Printable(..), Textual(..))
import qualified Data.Textual as DT
import Data.Textual.Fractional (Sign(..), Decimal(..), Optional(..),
                                fractional')
import Text.Printer (Printer(char7, string7), (<>))
import Text.Parser.Combinators ((<?>), unexpected)
import qualified Text.Parser.Char as PC
import Control.Applicative
import Control.Monad (when)
import Control.Exception (Exception)

-- | Exception that is raised when an operation times out.
--   Not used by the package itself, it is here so that users don't need to
--   roll their own exception type every time.
data TimedOut = TimedOut deriving (Typeable, TimedOut -> TimedOut -> Bool
(TimedOut -> TimedOut -> Bool)
-> (TimedOut -> TimedOut -> Bool) -> Eq TimedOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimedOut -> TimedOut -> Bool
== :: TimedOut -> TimedOut -> Bool
$c/= :: TimedOut -> TimedOut -> Bool
/= :: TimedOut -> TimedOut -> Bool
Eq, Int -> TimedOut -> ShowS
[TimedOut] -> ShowS
TimedOut -> String
(Int -> TimedOut -> ShowS)
-> (TimedOut -> String) -> ([TimedOut] -> ShowS) -> Show TimedOut
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimedOut -> ShowS
showsPrec :: Int -> TimedOut -> ShowS
$cshow :: TimedOut -> String
show :: TimedOut -> String
$cshowList :: [TimedOut] -> ShowS
showList :: [TimedOut] -> ShowS
Show)

instance Exception TimedOut

-- | Timeout unit.
data TimeoutUnit = NanoSecond
                 | MicroSecond
                 | MilliSecond
                 | Second
                 | Minute
                 | Hour
                 | Day
                 | Week
                 deriving (Typeable, Int -> TimeoutUnit -> ShowS
[TimeoutUnit] -> ShowS
TimeoutUnit -> String
(Int -> TimeoutUnit -> ShowS)
-> (TimeoutUnit -> String)
-> ([TimeoutUnit] -> ShowS)
-> Show TimeoutUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeoutUnit -> ShowS
showsPrec :: Int -> TimeoutUnit -> ShowS
$cshow :: TimeoutUnit -> String
show :: TimeoutUnit -> String
$cshowList :: [TimeoutUnit] -> ShowS
showList :: [TimeoutUnit] -> ShowS
Show, ReadPrec [TimeoutUnit]
ReadPrec TimeoutUnit
Int -> ReadS TimeoutUnit
ReadS [TimeoutUnit]
(Int -> ReadS TimeoutUnit)
-> ReadS [TimeoutUnit]
-> ReadPrec TimeoutUnit
-> ReadPrec [TimeoutUnit]
-> Read TimeoutUnit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TimeoutUnit
readsPrec :: Int -> ReadS TimeoutUnit
$creadList :: ReadS [TimeoutUnit]
readList :: ReadS [TimeoutUnit]
$creadPrec :: ReadPrec TimeoutUnit
readPrec :: ReadPrec TimeoutUnit
$creadListPrec :: ReadPrec [TimeoutUnit]
readListPrec :: ReadPrec [TimeoutUnit]
Read, TimeoutUnit -> TimeoutUnit -> Bool
(TimeoutUnit -> TimeoutUnit -> Bool)
-> (TimeoutUnit -> TimeoutUnit -> Bool) -> Eq TimeoutUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeoutUnit -> TimeoutUnit -> Bool
== :: TimeoutUnit -> TimeoutUnit -> Bool
$c/= :: TimeoutUnit -> TimeoutUnit -> Bool
/= :: TimeoutUnit -> TimeoutUnit -> Bool
Eq, Eq TimeoutUnit
Eq TimeoutUnit =>
(TimeoutUnit -> TimeoutUnit -> Ordering)
-> (TimeoutUnit -> TimeoutUnit -> Bool)
-> (TimeoutUnit -> TimeoutUnit -> Bool)
-> (TimeoutUnit -> TimeoutUnit -> Bool)
-> (TimeoutUnit -> TimeoutUnit -> Bool)
-> (TimeoutUnit -> TimeoutUnit -> TimeoutUnit)
-> (TimeoutUnit -> TimeoutUnit -> TimeoutUnit)
-> Ord TimeoutUnit
TimeoutUnit -> TimeoutUnit -> Bool
TimeoutUnit -> TimeoutUnit -> Ordering
TimeoutUnit -> TimeoutUnit -> TimeoutUnit
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 :: TimeoutUnit -> TimeoutUnit -> Ordering
compare :: TimeoutUnit -> TimeoutUnit -> Ordering
$c< :: TimeoutUnit -> TimeoutUnit -> Bool
< :: TimeoutUnit -> TimeoutUnit -> Bool
$c<= :: TimeoutUnit -> TimeoutUnit -> Bool
<= :: TimeoutUnit -> TimeoutUnit -> Bool
$c> :: TimeoutUnit -> TimeoutUnit -> Bool
> :: TimeoutUnit -> TimeoutUnit -> Bool
$c>= :: TimeoutUnit -> TimeoutUnit -> Bool
>= :: TimeoutUnit -> TimeoutUnit -> Bool
$cmax :: TimeoutUnit -> TimeoutUnit -> TimeoutUnit
max :: TimeoutUnit -> TimeoutUnit -> TimeoutUnit
$cmin :: TimeoutUnit -> TimeoutUnit -> TimeoutUnit
min :: TimeoutUnit -> TimeoutUnit -> TimeoutUnit
Ord, TimeoutUnit
TimeoutUnit -> TimeoutUnit -> Bounded TimeoutUnit
forall a. a -> a -> Bounded a
$cminBound :: TimeoutUnit
minBound :: TimeoutUnit
$cmaxBound :: TimeoutUnit
maxBound :: TimeoutUnit
Bounded, Ord TimeoutUnit
Ord TimeoutUnit =>
((TimeoutUnit, TimeoutUnit) -> [TimeoutUnit])
-> ((TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Int)
-> ((TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Int)
-> ((TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Bool)
-> ((TimeoutUnit, TimeoutUnit) -> Int)
-> ((TimeoutUnit, TimeoutUnit) -> Int)
-> Ix TimeoutUnit
(TimeoutUnit, TimeoutUnit) -> Int
(TimeoutUnit, TimeoutUnit) -> [TimeoutUnit]
(TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Bool
(TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (TimeoutUnit, TimeoutUnit) -> [TimeoutUnit]
range :: (TimeoutUnit, TimeoutUnit) -> [TimeoutUnit]
$cindex :: (TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Int
index :: (TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Int
$cunsafeIndex :: (TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Int
unsafeIndex :: (TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Int
$cinRange :: (TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Bool
inRange :: (TimeoutUnit, TimeoutUnit) -> TimeoutUnit -> Bool
$crangeSize :: (TimeoutUnit, TimeoutUnit) -> Int
rangeSize :: (TimeoutUnit, TimeoutUnit) -> Int
$cunsafeRangeSize :: (TimeoutUnit, TimeoutUnit) -> Int
unsafeRangeSize :: (TimeoutUnit, TimeoutUnit) -> Int
Ix, Int -> TimeoutUnit
TimeoutUnit -> Int
TimeoutUnit -> [TimeoutUnit]
TimeoutUnit -> TimeoutUnit
TimeoutUnit -> TimeoutUnit -> [TimeoutUnit]
TimeoutUnit -> TimeoutUnit -> TimeoutUnit -> [TimeoutUnit]
(TimeoutUnit -> TimeoutUnit)
-> (TimeoutUnit -> TimeoutUnit)
-> (Int -> TimeoutUnit)
-> (TimeoutUnit -> Int)
-> (TimeoutUnit -> [TimeoutUnit])
-> (TimeoutUnit -> TimeoutUnit -> [TimeoutUnit])
-> (TimeoutUnit -> TimeoutUnit -> [TimeoutUnit])
-> (TimeoutUnit -> TimeoutUnit -> TimeoutUnit -> [TimeoutUnit])
-> Enum TimeoutUnit
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TimeoutUnit -> TimeoutUnit
succ :: TimeoutUnit -> TimeoutUnit
$cpred :: TimeoutUnit -> TimeoutUnit
pred :: TimeoutUnit -> TimeoutUnit
$ctoEnum :: Int -> TimeoutUnit
toEnum :: Int -> TimeoutUnit
$cfromEnum :: TimeoutUnit -> Int
fromEnum :: TimeoutUnit -> Int
$cenumFrom :: TimeoutUnit -> [TimeoutUnit]
enumFrom :: TimeoutUnit -> [TimeoutUnit]
$cenumFromThen :: TimeoutUnit -> TimeoutUnit -> [TimeoutUnit]
enumFromThen :: TimeoutUnit -> TimeoutUnit -> [TimeoutUnit]
$cenumFromTo :: TimeoutUnit -> TimeoutUnit -> [TimeoutUnit]
enumFromTo :: TimeoutUnit -> TimeoutUnit -> [TimeoutUnit]
$cenumFromThenTo :: TimeoutUnit -> TimeoutUnit -> TimeoutUnit -> [TimeoutUnit]
enumFromThenTo :: TimeoutUnit -> TimeoutUnit -> TimeoutUnit -> [TimeoutUnit]
Enum)

-- | 'TimeoutUnit' proxy value.
aTimeoutUnit ∷ Proxy TimeoutUnit
aTimeoutUnit :: Proxy TimeoutUnit
aTimeoutUnit = Proxy TimeoutUnit
forall {k} (t :: k). Proxy t
Proxy

instance Printable TimeoutUnit where
  print :: forall p. Printer p => TimeoutUnit -> p
print TimeoutUnit
NanoSecond  = String -> p
forall p. Printer p => String -> p
string7 String
"ns"
  print TimeoutUnit
MicroSecond = String -> p
forall p. Printer p => String -> p
string7 String
"us"
  print TimeoutUnit
MilliSecond = String -> p
forall p. Printer p => String -> p
string7 String
"ms"
  print TimeoutUnit
Second      = Char -> p
forall p. Printer p => Char -> p
char7 Char
's'
  print TimeoutUnit
Minute      = Char -> p
forall p. Printer p => Char -> p
char7 Char
'm'
  print TimeoutUnit
Hour        = Char -> p
forall p. Printer p => Char -> p
char7 Char
'h'
  print TimeoutUnit
Day         = Char -> p
forall p. Printer p => Char -> p
char7 Char
'd'
  print TimeoutUnit
Week        = Char -> p
forall p. Printer p => Char -> p
char7 Char
'w'
  {-# INLINABLE print #-}

instance Textual TimeoutUnit where
  textual :: forall (μ :: * -> *). (Monad μ, CharParsing μ) => μ TimeoutUnit
textual = (μ TimeoutUnit -> String -> μ TimeoutUnit
forall a. μ a -> String -> μ a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"timeout unit") (μ TimeoutUnit -> μ TimeoutUnit) -> μ TimeoutUnit -> μ TimeoutUnit
forall a b. (a -> b) -> a -> b
$ do
    Char
c ← String -> μ Char
forall (m :: * -> *). CharParsing m => String -> m Char
PC.oneOf String
"numshdw" 
    case Char
c of
      Char
'n' → Char -> μ Char
forall (m :: * -> *). CharParsing m => Char -> m Char
PC.char Char
's' μ Char -> μ TimeoutUnit -> μ TimeoutUnit
forall a b. μ a -> μ b -> μ b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TimeoutUnit -> μ TimeoutUnit
forall a. a -> μ a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeoutUnit
NanoSecond
      Char
'u' → Char -> μ Char
forall (m :: * -> *). CharParsing m => Char -> m Char
PC.char Char
's' μ Char -> μ TimeoutUnit -> μ TimeoutUnit
forall a b. μ a -> μ b -> μ b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TimeoutUnit -> μ TimeoutUnit
forall a. a -> μ a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeoutUnit
MicroSecond
      Char
'm' → TimeoutUnit -> (Char -> TimeoutUnit) -> Maybe Char -> TimeoutUnit
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TimeoutUnit
Minute (TimeoutUnit -> Char -> TimeoutUnit
forall a b. a -> b -> a
const TimeoutUnit
MilliSecond) (Maybe Char -> TimeoutUnit) -> μ (Maybe Char) -> μ TimeoutUnit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> μ Char -> μ (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> μ Char
forall (m :: * -> *). CharParsing m => Char -> m Char
PC.char Char
's')
      Char
's' → TimeoutUnit -> μ TimeoutUnit
forall a. a -> μ a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeoutUnit
Second
      Char
'h' → TimeoutUnit -> μ TimeoutUnit
forall a. a -> μ a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeoutUnit
Hour
      Char
'd' → TimeoutUnit -> μ TimeoutUnit
forall a. a -> μ a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeoutUnit
Day
      Char
_   → TimeoutUnit -> μ TimeoutUnit
forall a. a -> μ a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeoutUnit
Week

-- | Amount of nanoseconds in a timeout unit.
timeoutUnitNanos ∷ TimeoutUnit → Word64
timeoutUnitNanos :: TimeoutUnit -> Word64
timeoutUnitNanos TimeoutUnit
NanoSecond  = Word64
1
timeoutUnitNanos TimeoutUnit
MicroSecond = Word64
1000
timeoutUnitNanos TimeoutUnit
MilliSecond = Word64
1000000
timeoutUnitNanos TimeoutUnit
Second      = Word64
1000000000
timeoutUnitNanos TimeoutUnit
Minute      = Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000000000
timeoutUnitNanos TimeoutUnit
Hour        = Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000000000
timeoutUnitNanos TimeoutUnit
Day         = Word64
24 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000000000
timeoutUnitNanos TimeoutUnit
Week        = Word64
7 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
24 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000000000
{-# INLINABLE timeoutUnitNanos #-}

-- | Timeout in nanoseconds. The 'Printable' instance renders timeouts as
--   series of /Amount/@Unit@ tokens, e.g.
--
--   @
--      'DT.toString' (/1/ \# 'Day' + /1500/ \# 'MilliSecond') = /"1d1s500ms"/
--   @
--
--   The full list of timeout unit abbreviations:
--  
--     * 'NanoSecond' - /ns/
--
--     * 'MicroSecond' - /us/
--
--     * 'MilliSecond' - /ms/
--
--     * 'Second' - /s/
--
--     * 'Minute' - /m/
--
--     * 'Hour' - /h/
--
--     * 'Day' - /d/
--
--     * 'Week' - /w/
--
--   The 'Textual' instance accepts this syntax and allows decimal
--   fractions to be used as amounts:
--
--   @
--     'fmap' 'DT.toString' ('DT.fromStringAs' 'aTimeout' /"1m1.5s0.2us"/) = 'Just' /"1m1s500ms200ns"/
--   @
newtype Timeout = Timeout Word64
  deriving (Typeable, Int -> Timeout -> ShowS
[Timeout] -> ShowS
Timeout -> String
(Int -> Timeout -> ShowS)
-> (Timeout -> String) -> ([Timeout] -> ShowS) -> Show Timeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timeout -> ShowS
showsPrec :: Int -> Timeout -> ShowS
$cshow :: Timeout -> String
show :: Timeout -> String
$cshowList :: [Timeout] -> ShowS
showList :: [Timeout] -> ShowS
Show, ReadPrec [Timeout]
ReadPrec Timeout
Int -> ReadS Timeout
ReadS [Timeout]
(Int -> ReadS Timeout)
-> ReadS [Timeout]
-> ReadPrec Timeout
-> ReadPrec [Timeout]
-> Read Timeout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Timeout
readsPrec :: Int -> ReadS Timeout
$creadList :: ReadS [Timeout]
readList :: ReadS [Timeout]
$creadPrec :: ReadPrec Timeout
readPrec :: ReadPrec Timeout
$creadListPrec :: ReadPrec [Timeout]
readListPrec :: ReadPrec [Timeout]
Read,  Timeout -> Timeout -> Bool
(Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool) -> Eq Timeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timeout -> Timeout -> Bool
== :: Timeout -> Timeout -> Bool
$c/= :: Timeout -> Timeout -> Bool
/= :: Timeout -> Timeout -> Bool
Eq, Eq Timeout
Eq Timeout =>
(Timeout -> Timeout -> Ordering)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Bool)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> Ord Timeout
Timeout -> Timeout -> Bool
Timeout -> Timeout -> Ordering
Timeout -> Timeout -> Timeout
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 :: Timeout -> Timeout -> Ordering
compare :: Timeout -> Timeout -> Ordering
$c< :: Timeout -> Timeout -> Bool
< :: Timeout -> Timeout -> Bool
$c<= :: Timeout -> Timeout -> Bool
<= :: Timeout -> Timeout -> Bool
$c> :: Timeout -> Timeout -> Bool
> :: Timeout -> Timeout -> Bool
$c>= :: Timeout -> Timeout -> Bool
>= :: Timeout -> Timeout -> Bool
$cmax :: Timeout -> Timeout -> Timeout
max :: Timeout -> Timeout -> Timeout
$cmin :: Timeout -> Timeout -> Timeout
min :: Timeout -> Timeout -> Timeout
Ord, Timeout
Timeout -> Timeout -> Bounded Timeout
forall a. a -> a -> Bounded a
$cminBound :: Timeout
minBound :: Timeout
$cmaxBound :: Timeout
maxBound :: Timeout
Bounded, Ord Timeout
Ord Timeout =>
((Timeout, Timeout) -> [Timeout])
-> ((Timeout, Timeout) -> Timeout -> Int)
-> ((Timeout, Timeout) -> Timeout -> Int)
-> ((Timeout, Timeout) -> Timeout -> Bool)
-> ((Timeout, Timeout) -> Int)
-> ((Timeout, Timeout) -> Int)
-> Ix Timeout
(Timeout, Timeout) -> Int
(Timeout, Timeout) -> [Timeout]
(Timeout, Timeout) -> Timeout -> Bool
(Timeout, Timeout) -> Timeout -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
$crange :: (Timeout, Timeout) -> [Timeout]
range :: (Timeout, Timeout) -> [Timeout]
$cindex :: (Timeout, Timeout) -> Timeout -> Int
index :: (Timeout, Timeout) -> Timeout -> Int
$cunsafeIndex :: (Timeout, Timeout) -> Timeout -> Int
unsafeIndex :: (Timeout, Timeout) -> Timeout -> Int
$cinRange :: (Timeout, Timeout) -> Timeout -> Bool
inRange :: (Timeout, Timeout) -> Timeout -> Bool
$crangeSize :: (Timeout, Timeout) -> Int
rangeSize :: (Timeout, Timeout) -> Int
$cunsafeRangeSize :: (Timeout, Timeout) -> Int
unsafeRangeSize :: (Timeout, Timeout) -> Int
Ix, Int -> Timeout
Timeout -> Int
Timeout -> [Timeout]
Timeout -> Timeout
Timeout -> Timeout -> [Timeout]
Timeout -> Timeout -> Timeout -> [Timeout]
(Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Int -> Timeout)
-> (Timeout -> Int)
-> (Timeout -> [Timeout])
-> (Timeout -> Timeout -> [Timeout])
-> (Timeout -> Timeout -> [Timeout])
-> (Timeout -> Timeout -> Timeout -> [Timeout])
-> Enum Timeout
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Timeout -> Timeout
succ :: Timeout -> Timeout
$cpred :: Timeout -> Timeout
pred :: Timeout -> Timeout
$ctoEnum :: Int -> Timeout
toEnum :: Int -> Timeout
$cfromEnum :: Timeout -> Int
fromEnum :: Timeout -> Int
$cenumFrom :: Timeout -> [Timeout]
enumFrom :: Timeout -> [Timeout]
$cenumFromThen :: Timeout -> Timeout -> [Timeout]
enumFromThen :: Timeout -> Timeout -> [Timeout]
$cenumFromTo :: Timeout -> Timeout -> [Timeout]
enumFromTo :: Timeout -> Timeout -> [Timeout]
$cenumFromThenTo :: Timeout -> Timeout -> Timeout -> [Timeout]
enumFromThenTo :: Timeout -> Timeout -> Timeout -> [Timeout]
Enum,
            Integer -> Timeout
Timeout -> Timeout
Timeout -> Timeout -> Timeout
(Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Timeout -> Timeout)
-> (Integer -> Timeout)
-> Num Timeout
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Timeout -> Timeout -> Timeout
+ :: Timeout -> Timeout -> Timeout
$c- :: Timeout -> Timeout -> Timeout
- :: Timeout -> Timeout -> Timeout
$c* :: Timeout -> Timeout -> Timeout
* :: Timeout -> Timeout -> Timeout
$cnegate :: Timeout -> Timeout
negate :: Timeout -> Timeout
$cabs :: Timeout -> Timeout
abs :: Timeout -> Timeout
$csignum :: Timeout -> Timeout
signum :: Timeout -> Timeout
$cfromInteger :: Integer -> Timeout
fromInteger :: Integer -> Timeout
Num, Num Timeout
Ord Timeout
(Num Timeout, Ord Timeout) => (Timeout -> Rational) -> Real Timeout
Timeout -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Timeout -> Rational
toRational :: Timeout -> Rational
Real, Enum Timeout
Real Timeout
(Real Timeout, Enum Timeout) =>
(Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> Timeout)
-> (Timeout -> Timeout -> (Timeout, Timeout))
-> (Timeout -> Timeout -> (Timeout, Timeout))
-> (Timeout -> Integer)
-> Integral Timeout
Timeout -> Integer
Timeout -> Timeout -> (Timeout, Timeout)
Timeout -> Timeout -> Timeout
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: Timeout -> Timeout -> Timeout
quot :: Timeout -> Timeout -> Timeout
$crem :: Timeout -> Timeout -> Timeout
rem :: Timeout -> Timeout -> Timeout
$cdiv :: Timeout -> Timeout -> Timeout
div :: Timeout -> Timeout -> Timeout
$cmod :: Timeout -> Timeout -> Timeout
mod :: Timeout -> Timeout -> Timeout
$cquotRem :: Timeout -> Timeout -> (Timeout, Timeout)
quotRem :: Timeout -> Timeout -> (Timeout, Timeout)
$cdivMod :: Timeout -> Timeout -> (Timeout, Timeout)
divMod :: Timeout -> Timeout -> (Timeout, Timeout)
$ctoInteger :: Timeout -> Integer
toInteger :: Timeout -> Integer
Integral)

-- | 'Timeout' proxy value.
aTimeout ∷ Proxy Timeout
aTimeout :: Proxy Timeout
aTimeout = Proxy Timeout
forall {k} (t :: k). Proxy t
Proxy

infix 9 #
infix 8 #>, #<

-- | Convert the given number of timeout units to 'Timeout'.
(#) ∷ Word64 → TimeoutUnit → Timeout
Word64
n # :: Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
u = Word64 -> Timeout
Timeout (Word64 -> Timeout) -> Word64 -> Timeout
forall a b. (a -> b) -> a -> b
$ Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* TimeoutUnit -> Word64
timeoutUnitNanos TimeoutUnit
u
{-# INLINE (#) #-}

-- | Extract number of units (rounding up).
(#>) ∷ Timeout → TimeoutUnit → Word64
(Timeout Word64
tt) #> :: Timeout -> TimeoutUnit -> Word64
#> TimeoutUnit
u = if Word64
r Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then Word64
q else Word64
q Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
  where (Word64
q, Word64
r) = Word64
tt Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` TimeoutUnit -> Word64
timeoutUnitNanos TimeoutUnit
u
{-# INLINE (#>) #-}

-- | Extract number of units (rounding down).
(#<) ∷ Timeout → TimeoutUnit → Word64
(Timeout Word64
tt) #< :: Timeout -> TimeoutUnit -> Word64
#< TimeoutUnit
u = Word64
tt Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`quot` TimeoutUnit -> Word64
timeoutUnitNanos TimeoutUnit
u
{-# INLINE (#<) #-}

instance Printable Timeout where
  print :: forall p. Printer p => Timeout -> p
print (Timeout Word64
tt) =
      if [p] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [p]
ss then String -> p
forall p. Printer p => String -> p
string7 String
"0ns" else [p] -> p
forall a. Monoid a => [a] -> a
mconcat ([p] -> [p]
forall a. [a] -> [a]
reverse [p]
ss)
    where
      ss :: [p]
ss = (Word64, [p]) -> [p]
forall a b. (a, b) -> b
snd ((Word64, [p]) -> [p]) -> (Word64, [p]) -> [p]
forall a b. (a -> b) -> a -> b
$ (([TimeoutUnit] -> (Word64, [p])) -> [TimeoutUnit] -> (Word64, [p])
forall a b. (a -> b) -> a -> b
$ TimeoutUnit -> [TimeoutUnit]
forall a. Enum a => a -> [a]
enumFrom TimeoutUnit
NanoSecond) (([TimeoutUnit] -> (Word64, [p])) -> (Word64, [p]))
-> ([TimeoutUnit] -> (Word64, [p])) -> (Word64, [p])
forall a b. (a -> b) -> a -> b
$ ((TimeoutUnit -> (Word64, [p]) -> (Word64, [p]))
-> (Word64, [p]) -> [TimeoutUnit] -> (Word64, [p])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
`foldr` (Word64
tt, [])) ((TimeoutUnit -> (Word64, [p]) -> (Word64, [p]))
 -> [TimeoutUnit] -> (Word64, [p]))
-> (TimeoutUnit -> (Word64, [p]) -> (Word64, [p]))
-> [TimeoutUnit]
-> (Word64, [p])
forall a b. (a -> b) -> a -> b
$ \TimeoutUnit
u (Word64
t, [p]
ss') →
        let (Word64
q, Word64
r) = Word64
t Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` TimeoutUnit -> Word64
timeoutUnitNanos TimeoutUnit
u in
          (Word64
r, if Word64
q Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then [p]
ss' else (Word64 -> p
forall α p. (Printable α, Printer p) => α -> p
forall p. Printer p => Word64 -> p
print Word64
q p -> p -> p
forall a. Semigroup a => a -> a -> a
<> TimeoutUnit -> p
forall α p. (Printable α, Printer p) => α -> p
forall p. Printer p => TimeoutUnit -> p
print TimeoutUnit
u) p -> [p] -> [p]
forall a. a -> [a] -> [a]
: [p]
ss')

instance Textual Timeout where
  textual :: forall (μ :: * -> *). (Monad μ, CharParsing μ) => μ Timeout
textual = (μ Timeout -> String -> μ Timeout
forall a. μ a -> String -> μ a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"timeout") (μ Timeout -> μ Timeout) -> μ Timeout -> μ Timeout
forall a b. (a -> b) -> a -> b
$ do
      Rational
a ← μ Rational
amount
      TimeoutUnit
u ← μ TimeoutUnit
forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
forall (μ :: * -> *). (Monad μ, CharParsing μ) => μ TimeoutUnit
textual
      let r :: Rational
r = Rational
a Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Word64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeoutUnit -> Word64
timeoutUnitNanos TimeoutUnit
u) ∷ Rational
      if TimeoutUnit
u TimeoutUnit -> TimeoutUnit -> Bool
forall a. Eq a => a -> a -> Bool
== TimeoutUnit
forall a. Bounded a => a
minBound then Rational -> μ Timeout
forall {m :: * -> *} {p}. (Monad m, RealFrac p) => p -> m Timeout
result Rational
r else TimeoutUnit -> Rational -> μ Timeout
go TimeoutUnit
u Rational
r
    where
      amount :: μ Rational
amount = μ Sign
-> Decimal -> Optional -> μ () -> μ (Maybe Sign) -> μ Rational
forall s α (μ :: * -> *).
(PositionalSystem s, Fractional α, Monad μ, CharParsing μ) =>
μ Sign -> s -> Optional -> μ () -> μ (Maybe Sign) -> μ α
fractional' (Sign -> μ Sign
forall a. a -> μ a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sign
NonNegative) Decimal
Decimal Optional
Required
                           (Char -> μ Char
forall (m :: * -> *). CharParsing m => Char -> m Char
PC.char Char
'.' μ Char -> μ () -> μ ()
forall a b. μ a -> μ b -> μ b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> μ ()
forall a. a -> μ a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Maybe Sign -> μ (Maybe Sign)
forall a. a -> μ a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Sign
forall a. Maybe a
Nothing)
      go :: TimeoutUnit -> Rational -> μ Timeout
go TimeoutUnit
u Rational
r = do
        Maybe Rational
ma ← μ Rational -> μ (Maybe Rational)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional μ Rational
amount
        case Maybe Rational
ma of
          Maybe Rational
Nothing → Rational -> μ Timeout
forall {m :: * -> *} {p}. (Monad m, RealFrac p) => p -> m Timeout
result Rational
r
          Just Rational
a → do
            TimeoutUnit
u' ← μ TimeoutUnit
forall α (μ :: * -> *). (Textual α, Monad μ, CharParsing μ) => μ α
forall (μ :: * -> *). (Monad μ, CharParsing μ) => μ TimeoutUnit
textual
            Bool -> μ () -> μ ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TimeoutUnit
u' TimeoutUnit -> TimeoutUnit -> Bool
forall a. Ord a => a -> a -> Bool
>= TimeoutUnit
u) (μ () -> μ ()) -> μ () -> μ ()
forall a b. (a -> b) -> a -> b
$ String -> μ ()
forall a. String -> μ a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected String
"timeout units must get smaller"
            let r' :: Rational
r' = Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
a Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Word64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TimeoutUnit -> Word64
timeoutUnitNanos TimeoutUnit
u')
            if TimeoutUnit
u' TimeoutUnit -> TimeoutUnit -> Bool
forall a. Eq a => a -> a -> Bool
== TimeoutUnit
forall a. Bounded a => a
minBound then Rational -> μ Timeout
forall {m :: * -> *} {p}. (Monad m, RealFrac p) => p -> m Timeout
result Rational
r' else TimeoutUnit -> Rational -> μ Timeout
go TimeoutUnit
u' Rational
r'
      result :: p -> m Timeout
result p
r = let c :: Integer
c = p -> Integer
forall b. Integral b => p -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling p
r ∷ Integer in
                   if (Integer
c ∷ Integer) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound ∷ Word64)
                   then Timeout -> m Timeout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Timeout
forall a. Bounded a => a
maxBound
                   else Timeout -> m Timeout
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Timeout -> m Timeout) -> Timeout -> m Timeout
forall a b. (a -> b) -> a -> b
$ Word64 -> Timeout
Timeout (Word64 -> Timeout) -> Word64 -> Timeout
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c

-- | Zero timeout. The event in question should occur immediately.
instantly ∷ Timeout
instantly :: Timeout
instantly = Word64 -> Timeout
Timeout Word64
0
{-# INLINE instantly #-}