module TimerWheel.Internal.Micros
  ( Micros (..),
    fromFixed,
    fromSeconds,
    TimerWheel.Internal.Micros.div,
    minus,
    scale,
    sleep,
  )
where

import Control.Concurrent (threadDelay)
import Data.Coerce
import Data.Fixed
import Data.Word

newtype Micros = Micros {Micros -> Word64
unMicros :: Word64}
  deriving stock (Micros -> Micros -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Micros -> Micros -> Bool
$c/= :: Micros -> Micros -> Bool
== :: Micros -> Micros -> Bool
$c== :: Micros -> Micros -> Bool
Eq, Eq Micros
Micros -> Micros -> Bool
Micros -> Micros -> Ordering
Micros -> Micros -> Micros
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
min :: Micros -> Micros -> Micros
$cmin :: Micros -> Micros -> Micros
max :: Micros -> Micros -> Micros
$cmax :: Micros -> Micros -> Micros
>= :: Micros -> Micros -> Bool
$c>= :: Micros -> Micros -> Bool
> :: Micros -> Micros -> Bool
$c> :: Micros -> Micros -> Bool
<= :: Micros -> Micros -> Bool
$c<= :: Micros -> Micros -> Bool
< :: Micros -> Micros -> Bool
$c< :: Micros -> Micros -> Bool
compare :: Micros -> Micros -> Ordering
$ccompare :: Micros -> Micros -> Ordering
Ord)

-- | Precondition: input is >= 0
fromFixed :: Fixed E6 -> Micros
fromFixed :: Fixed E6 -> Micros
fromFixed =
  coerce :: forall a b. Coercible a b => a -> b
coerce @(Integer -> Word64) forall a b. (Integral a, Num b) => a -> b
fromIntegral

fromSeconds :: Fixed E6 -> Micros
fromSeconds :: Fixed E6 -> Micros
fromSeconds seconds :: Fixed E6
seconds@(MkFixed Integer
micros)
  | Integer
micros forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a. HasCallStack => [Char] -> a
error ([Char]
"[timer-wheel] invalid seconds: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Fixed E6
seconds)
  | Bool
otherwise = Word64 -> Micros
Micros (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
micros)

div :: Micros -> Micros -> Micros
div :: Micros -> Micros -> Micros
div =
  coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Integral a => a -> a -> a
Prelude.div @Word64)

minus :: Micros -> Micros -> Micros
minus :: Micros -> Micros -> Micros
minus =
  coerce :: forall a b. Coercible a b => a -> b
coerce ((-) @Word64)

scale :: Int -> Micros -> Micros
scale :: Int -> Micros -> Micros
scale Int
n (Micros Word64
w) =
  Word64 -> Micros
Micros (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Num a => a -> a -> a
* Word64
w)

sleep :: Micros -> IO ()
sleep :: Micros -> IO ()
sleep (Micros Word64
micros) =
  Int -> IO ()
threadDelay (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
micros)