module Data.Timeout (
TimeoutUnit(..),
timeoutUnitNanos,
Timeout(..),
(#),
(#>),
(#<),
instantly
) where
import Data.Typeable (Typeable)
import Data.Ix (Ix)
import Data.Word (Word64)
import Data.List (intercalate)
data TimeoutUnit = NanoSecond
| MicroSecond
| MilliSecond
| Second
| Minute
| Hour
| Day
| Week
deriving (Typeable, Eq, Ord, Bounded, Ix, Enum)
timeoutUnitNanos ∷ TimeoutUnit → Word64
timeoutUnitNanos NanoSecond = 1
timeoutUnitNanos MicroSecond = 1000
timeoutUnitNanos MilliSecond = 1000000
timeoutUnitNanos Second = 1000000000
timeoutUnitNanos Minute = 60 * 1000000000
timeoutUnitNanos Hour = 60 * 60 * 1000000000
timeoutUnitNanos Day = 24 * 60 * 60 * 1000000000
timeoutUnitNanos Week = 7 * 24 * 60 * 60 * 1000000000
newtype Timeout = Timeout Word64
deriving (Typeable, Eq, Ord, Bounded, Ix, Enum, Num, Real, Integral)
infix 9 #
infix 8 #>, #<
(#) ∷ Word64 → TimeoutUnit → Timeout
n # u = Timeout $ n * timeoutUnitNanos u
(#>) ∷ Timeout → TimeoutUnit → Word64
(Timeout tt) #> u = if r == 0 then q else q + 1
where (q, r) = tt `quotRem` timeoutUnitNanos u
(#<) ∷ Timeout → TimeoutUnit → Word64
(Timeout tt) #< u = tt `quot` timeoutUnitNanos u
timeoutUnitAbbr ∷ TimeoutUnit → String
timeoutUnitAbbr NanoSecond = "ns"
timeoutUnitAbbr MicroSecond = "us"
timeoutUnitAbbr MilliSecond = "ms"
timeoutUnitAbbr Second = "s"
timeoutUnitAbbr Minute = "m"
timeoutUnitAbbr Hour = "h"
timeoutUnitAbbr Day = "d"
timeoutUnitAbbr Week = "w"
instance Show Timeout where
show (Timeout tt) =
if null ss then "instant" else intercalate " " (reverse ss)
where
ss = snd $ ($ enumFrom NanoSecond) $ (`foldr` (tt, [])) $ \u (t, ss') →
let (q, r) = t `quotRem` timeoutUnitNanos u
abbr = timeoutUnitAbbr u in
(r, if q == 0 then ss' else (show q ++ " " ++ abbr) : ss')
instantly ∷ Timeout
instantly = 0 # NanoSecond