-- |
-- Module      : Foundation.Timing
-- License     : BSD-style
-- Maintainer  : Foundation maintainers
--
-- An implementation of a timing framework
--
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Foundation.Time.Types
    ( NanoSeconds(..)
    , Seconds(..)
    ) where

import           Data.Proxy
import           Basement.Imports
import           Basement.PrimType
import           Foundation.Numerical
import           Data.Coerce

-- | An amount of nanoseconds
newtype NanoSeconds = NanoSeconds Word64
    deriving (Int -> NanoSeconds -> ShowS
[NanoSeconds] -> ShowS
NanoSeconds -> String
(Int -> NanoSeconds -> ShowS)
-> (NanoSeconds -> String)
-> ([NanoSeconds] -> ShowS)
-> Show NanoSeconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NanoSeconds] -> ShowS
$cshowList :: [NanoSeconds] -> ShowS
show :: NanoSeconds -> String
$cshow :: NanoSeconds -> String
showsPrec :: Int -> NanoSeconds -> ShowS
$cshowsPrec :: Int -> NanoSeconds -> ShowS
Show,NanoSeconds -> NanoSeconds -> Bool
(NanoSeconds -> NanoSeconds -> Bool)
-> (NanoSeconds -> NanoSeconds -> Bool) -> Eq NanoSeconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NanoSeconds -> NanoSeconds -> Bool
$c/= :: NanoSeconds -> NanoSeconds -> Bool
== :: NanoSeconds -> NanoSeconds -> Bool
$c== :: NanoSeconds -> NanoSeconds -> Bool
Eq,Eq NanoSeconds
Eq NanoSeconds
-> (NanoSeconds -> NanoSeconds -> Ordering)
-> (NanoSeconds -> NanoSeconds -> Bool)
-> (NanoSeconds -> NanoSeconds -> Bool)
-> (NanoSeconds -> NanoSeconds -> Bool)
-> (NanoSeconds -> NanoSeconds -> Bool)
-> (NanoSeconds -> NanoSeconds -> NanoSeconds)
-> (NanoSeconds -> NanoSeconds -> NanoSeconds)
-> Ord NanoSeconds
NanoSeconds -> NanoSeconds -> Bool
NanoSeconds -> NanoSeconds -> Ordering
NanoSeconds -> NanoSeconds -> NanoSeconds
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 :: NanoSeconds -> NanoSeconds -> NanoSeconds
$cmin :: NanoSeconds -> NanoSeconds -> NanoSeconds
max :: NanoSeconds -> NanoSeconds -> NanoSeconds
$cmax :: NanoSeconds -> NanoSeconds -> NanoSeconds
>= :: NanoSeconds -> NanoSeconds -> Bool
$c>= :: NanoSeconds -> NanoSeconds -> Bool
> :: NanoSeconds -> NanoSeconds -> Bool
$c> :: NanoSeconds -> NanoSeconds -> Bool
<= :: NanoSeconds -> NanoSeconds -> Bool
$c<= :: NanoSeconds -> NanoSeconds -> Bool
< :: NanoSeconds -> NanoSeconds -> Bool
$c< :: NanoSeconds -> NanoSeconds -> Bool
compare :: NanoSeconds -> NanoSeconds -> Ordering
$ccompare :: NanoSeconds -> NanoSeconds -> Ordering
$cp1Ord :: Eq NanoSeconds
Ord,NanoSeconds
n -> NanoSeconds -> NanoSeconds
NanoSeconds -> NanoSeconds -> NanoSeconds
NanoSeconds
-> (NanoSeconds -> NanoSeconds -> NanoSeconds)
-> (forall n. IsNatural n => n -> NanoSeconds -> NanoSeconds)
-> Additive NanoSeconds
forall a.
a
-> (a -> a -> a)
-> (forall n. IsNatural n => n -> a -> a)
-> Additive a
forall n. IsNatural n => n -> NanoSeconds -> NanoSeconds
scale :: n -> NanoSeconds -> NanoSeconds
$cscale :: forall n. IsNatural n => n -> NanoSeconds -> NanoSeconds
+ :: NanoSeconds -> NanoSeconds -> NanoSeconds
$c+ :: NanoSeconds -> NanoSeconds -> NanoSeconds
azero :: NanoSeconds
$cazero :: NanoSeconds
Additive,Int -> NanoSeconds
NanoSeconds -> Int
NanoSeconds -> [NanoSeconds]
NanoSeconds -> NanoSeconds
NanoSeconds -> NanoSeconds -> [NanoSeconds]
NanoSeconds -> NanoSeconds -> NanoSeconds -> [NanoSeconds]
(NanoSeconds -> NanoSeconds)
-> (NanoSeconds -> NanoSeconds)
-> (Int -> NanoSeconds)
-> (NanoSeconds -> Int)
-> (NanoSeconds -> [NanoSeconds])
-> (NanoSeconds -> NanoSeconds -> [NanoSeconds])
-> (NanoSeconds -> NanoSeconds -> [NanoSeconds])
-> (NanoSeconds -> NanoSeconds -> NanoSeconds -> [NanoSeconds])
-> Enum NanoSeconds
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NanoSeconds -> NanoSeconds -> NanoSeconds -> [NanoSeconds]
$cenumFromThenTo :: NanoSeconds -> NanoSeconds -> NanoSeconds -> [NanoSeconds]
enumFromTo :: NanoSeconds -> NanoSeconds -> [NanoSeconds]
$cenumFromTo :: NanoSeconds -> NanoSeconds -> [NanoSeconds]
enumFromThen :: NanoSeconds -> NanoSeconds -> [NanoSeconds]
$cenumFromThen :: NanoSeconds -> NanoSeconds -> [NanoSeconds]
enumFrom :: NanoSeconds -> [NanoSeconds]
$cenumFrom :: NanoSeconds -> [NanoSeconds]
fromEnum :: NanoSeconds -> Int
$cfromEnum :: NanoSeconds -> Int
toEnum :: Int -> NanoSeconds
$ctoEnum :: Int -> NanoSeconds
pred :: NanoSeconds -> NanoSeconds
$cpred :: NanoSeconds -> NanoSeconds
succ :: NanoSeconds -> NanoSeconds
$csucc :: NanoSeconds -> NanoSeconds
Enum,NanoSeconds
NanoSeconds -> NanoSeconds -> Bounded NanoSeconds
forall a. a -> a -> Bounded a
maxBound :: NanoSeconds
$cmaxBound :: NanoSeconds
minBound :: NanoSeconds
$cminBound :: NanoSeconds
Bounded)


instance PrimType NanoSeconds where
    type PrimSize NanoSeconds = 8
    primSizeInBytes :: Proxy NanoSeconds -> CountOf Word8
primSizeInBytes Proxy NanoSeconds
_        = Proxy Word64 -> CountOf Word8
forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (Proxy Word64
forall k (t :: k). Proxy t
Proxy :: Proxy Word64)
    primShiftToBytes :: Proxy NanoSeconds -> Int
primShiftToBytes Proxy NanoSeconds
_       = Proxy Word64 -> Int
forall ty. PrimType ty => Proxy ty -> Int
primShiftToBytes (Proxy Word64
forall k (t :: k). Proxy t
Proxy :: Proxy Word64)
    primBaUIndex :: ByteArray# -> Offset NanoSeconds -> NanoSeconds
primBaUIndex ByteArray#
ba Offset NanoSeconds
ofs      = ByteArray# -> Offset NanoSeconds -> NanoSeconds
forall ty. PrimType ty => ByteArray# -> Offset ty -> ty
primBaUIndex ByteArray#
ba (Offset NanoSeconds -> Offset NanoSeconds
coerce Offset NanoSeconds
ofs)
    primMbaURead :: MutableByteArray# (PrimState prim)
-> Offset NanoSeconds -> prim NanoSeconds
primMbaURead MutableByteArray# (PrimState prim)
mba Offset NanoSeconds
ofs     = MutableByteArray# (PrimState prim)
-> Offset NanoSeconds -> prim NanoSeconds
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> prim ty
primMbaURead MutableByteArray# (PrimState prim)
mba (Offset NanoSeconds -> Offset NanoSeconds
coerce Offset NanoSeconds
ofs)
    primMbaUWrite :: MutableByteArray# (PrimState prim)
-> Offset NanoSeconds -> NanoSeconds -> prim ()
primMbaUWrite MutableByteArray# (PrimState prim)
mba Offset NanoSeconds
ofs NanoSeconds
v  = MutableByteArray# (PrimState prim)
-> Offset Word64 -> Word64 -> prim ()
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
primMbaUWrite MutableByteArray# (PrimState prim)
mba (Offset NanoSeconds -> Offset Word64
coerce Offset NanoSeconds
ofs) (NanoSeconds -> Word64
coerce NanoSeconds
v :: Word64)
    primAddrIndex :: Addr# -> Offset NanoSeconds -> NanoSeconds
primAddrIndex Addr#
addr Offset NanoSeconds
ofs   = Addr# -> Offset NanoSeconds -> NanoSeconds
forall ty. PrimType ty => Addr# -> Offset ty -> ty
primAddrIndex Addr#
addr (Offset NanoSeconds -> Offset NanoSeconds
coerce Offset NanoSeconds
ofs)
    primAddrRead :: Addr# -> Offset NanoSeconds -> prim NanoSeconds
primAddrRead Addr#
addr Offset NanoSeconds
ofs    = Addr# -> Offset NanoSeconds -> prim NanoSeconds
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
Addr# -> Offset ty -> prim ty
primAddrRead Addr#
addr (Offset NanoSeconds -> Offset NanoSeconds
coerce Offset NanoSeconds
ofs)
    primAddrWrite :: Addr# -> Offset NanoSeconds -> NanoSeconds -> prim ()
primAddrWrite Addr#
addr Offset NanoSeconds
ofs NanoSeconds
v = Addr# -> Offset Word64 -> Word64 -> prim ()
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
Addr# -> Offset ty -> ty -> prim ()
primAddrWrite Addr#
addr (Offset NanoSeconds -> Offset Word64
coerce Offset NanoSeconds
ofs) (NanoSeconds -> Word64
coerce NanoSeconds
v :: Word64)

-- | An amount of seconds
newtype Seconds = Seconds Word64
    deriving (Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
(Int -> Seconds -> ShowS)
-> (Seconds -> String) -> ([Seconds] -> ShowS) -> Show Seconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seconds] -> ShowS
$cshowList :: [Seconds] -> ShowS
show :: Seconds -> String
$cshow :: Seconds -> String
showsPrec :: Int -> Seconds -> ShowS
$cshowsPrec :: Int -> Seconds -> ShowS
Show,Seconds -> Seconds -> Bool
(Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool) -> Eq Seconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seconds -> Seconds -> Bool
$c/= :: Seconds -> Seconds -> Bool
== :: Seconds -> Seconds -> Bool
$c== :: Seconds -> Seconds -> Bool
Eq,Eq Seconds
Eq Seconds
-> (Seconds -> Seconds -> Ordering)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> Ord Seconds
Seconds -> Seconds -> Bool
Seconds -> Seconds -> Ordering
Seconds -> Seconds -> Seconds
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 :: Seconds -> Seconds -> Seconds
$cmin :: Seconds -> Seconds -> Seconds
max :: Seconds -> Seconds -> Seconds
$cmax :: Seconds -> Seconds -> Seconds
>= :: Seconds -> Seconds -> Bool
$c>= :: Seconds -> Seconds -> Bool
> :: Seconds -> Seconds -> Bool
$c> :: Seconds -> Seconds -> Bool
<= :: Seconds -> Seconds -> Bool
$c<= :: Seconds -> Seconds -> Bool
< :: Seconds -> Seconds -> Bool
$c< :: Seconds -> Seconds -> Bool
compare :: Seconds -> Seconds -> Ordering
$ccompare :: Seconds -> Seconds -> Ordering
$cp1Ord :: Eq Seconds
Ord,Seconds
n -> Seconds -> Seconds
Seconds -> Seconds -> Seconds
Seconds
-> (Seconds -> Seconds -> Seconds)
-> (forall n. IsNatural n => n -> Seconds -> Seconds)
-> Additive Seconds
forall a.
a
-> (a -> a -> a)
-> (forall n. IsNatural n => n -> a -> a)
-> Additive a
forall n. IsNatural n => n -> Seconds -> Seconds
scale :: n -> Seconds -> Seconds
$cscale :: forall n. IsNatural n => n -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c+ :: Seconds -> Seconds -> Seconds
azero :: Seconds
$cazero :: Seconds
Additive,Int -> Seconds
Seconds -> Int
Seconds -> [Seconds]
Seconds -> Seconds
Seconds -> Seconds -> [Seconds]
Seconds -> Seconds -> Seconds -> [Seconds]
(Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Int -> Seconds)
-> (Seconds -> Int)
-> (Seconds -> [Seconds])
-> (Seconds -> Seconds -> [Seconds])
-> (Seconds -> Seconds -> [Seconds])
-> (Seconds -> Seconds -> Seconds -> [Seconds])
-> Enum Seconds
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Seconds -> Seconds -> Seconds -> [Seconds]
$cenumFromThenTo :: Seconds -> Seconds -> Seconds -> [Seconds]
enumFromTo :: Seconds -> Seconds -> [Seconds]
$cenumFromTo :: Seconds -> Seconds -> [Seconds]
enumFromThen :: Seconds -> Seconds -> [Seconds]
$cenumFromThen :: Seconds -> Seconds -> [Seconds]
enumFrom :: Seconds -> [Seconds]
$cenumFrom :: Seconds -> [Seconds]
fromEnum :: Seconds -> Int
$cfromEnum :: Seconds -> Int
toEnum :: Int -> Seconds
$ctoEnum :: Int -> Seconds
pred :: Seconds -> Seconds
$cpred :: Seconds -> Seconds
succ :: Seconds -> Seconds
$csucc :: Seconds -> Seconds
Enum,Seconds
Seconds -> Seconds -> Bounded Seconds
forall a. a -> a -> Bounded a
maxBound :: Seconds
$cmaxBound :: Seconds
minBound :: Seconds
$cminBound :: Seconds
Bounded)

instance PrimType Seconds where
    type PrimSize Seconds    = 8
    primSizeInBytes :: Proxy Seconds -> CountOf Word8
primSizeInBytes Proxy Seconds
_        = Proxy Word64 -> CountOf Word8
forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (Proxy Word64
forall k (t :: k). Proxy t
Proxy :: Proxy Word64)
    primShiftToBytes :: Proxy Seconds -> Int
primShiftToBytes Proxy Seconds
_       = Proxy Word64 -> Int
forall ty. PrimType ty => Proxy ty -> Int
primShiftToBytes (Proxy Word64
forall k (t :: k). Proxy t
Proxy :: Proxy Word64)
    primBaUIndex :: ByteArray# -> Offset Seconds -> Seconds
primBaUIndex ByteArray#
ba Offset Seconds
ofs      = ByteArray# -> Offset Seconds -> Seconds
forall ty. PrimType ty => ByteArray# -> Offset ty -> ty
primBaUIndex ByteArray#
ba (Offset Seconds -> Offset Seconds
coerce Offset Seconds
ofs)
    primMbaURead :: MutableByteArray# (PrimState prim)
-> Offset Seconds -> prim Seconds
primMbaURead MutableByteArray# (PrimState prim)
mba Offset Seconds
ofs     = MutableByteArray# (PrimState prim)
-> Offset Seconds -> prim Seconds
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> prim ty
primMbaURead MutableByteArray# (PrimState prim)
mba (Offset Seconds -> Offset Seconds
coerce Offset Seconds
ofs)
    primMbaUWrite :: MutableByteArray# (PrimState prim)
-> Offset Seconds -> Seconds -> prim ()
primMbaUWrite MutableByteArray# (PrimState prim)
mba Offset Seconds
ofs Seconds
v  = MutableByteArray# (PrimState prim)
-> Offset Word64 -> Word64 -> prim ()
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
primMbaUWrite MutableByteArray# (PrimState prim)
mba (Offset Seconds -> Offset Word64
coerce Offset Seconds
ofs) (Seconds -> Word64
coerce Seconds
v :: Word64)
    primAddrIndex :: Addr# -> Offset Seconds -> Seconds
primAddrIndex Addr#
addr Offset Seconds
ofs   = Addr# -> Offset Seconds -> Seconds
forall ty. PrimType ty => Addr# -> Offset ty -> ty
primAddrIndex Addr#
addr (Offset Seconds -> Offset Seconds
coerce Offset Seconds
ofs)
    primAddrRead :: Addr# -> Offset Seconds -> prim Seconds
primAddrRead Addr#
addr Offset Seconds
ofs    = Addr# -> Offset Seconds -> prim Seconds
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
Addr# -> Offset ty -> prim ty
primAddrRead Addr#
addr (Offset Seconds -> Offset Seconds
coerce Offset Seconds
ofs)
    primAddrWrite :: Addr# -> Offset Seconds -> Seconds -> prim ()
primAddrWrite Addr#
addr Offset Seconds
ofs Seconds
v = Addr# -> Offset Word64 -> Word64 -> prim ()
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
Addr# -> Offset ty -> ty -> prim ()
primAddrWrite Addr#
addr (Offset Seconds -> Offset Word64
coerce Offset Seconds
ofs) (Seconds -> Word64
coerce Seconds
v :: Word64)