{-# LANGUAGE CPP #-}

module Foundation.Time.StopWatch
    ( StopWatchPrecise
    , startPrecise
    , stopPrecise
    ) where

import Basement.Imports
import Basement.Types.Ptr
import Foundation.Time.Types
import Basement.Block.Mutable
import Foundation.Numerical
import Foreign.Storable

#if defined(mingw32_HOST_OS)
import System.Win32.Time
import Basement.Monad
import Basement.IntegralConv
import System.IO.Unsafe
#elif defined(darwin_HOST_OS)
import Foundation.System.Bindings.Macos
import Basement.IntegralConv
import System.IO.Unsafe
import Basement.Types.OffsetSize
#else
import Foundation.System.Bindings.Time
import Basement.Monad
import Basement.Types.OffsetSize
#endif

-- | A precise stop watch
--
-- The precision is higher than a normal stopwatch, but
-- also on some system it might not be able to record
-- longer period of time accurately (possibly wrapping)
newtype StopWatchPrecise =
#if defined(darwin_HOST_OS)
    StopWatchPrecise Word64
#elif defined(mingw32_HOST_OS)
    -- contain 2 LARGE_INTEGER (int64_t)
    StopWatchPrecise (MutableBlock Word8 (PrimState IO))
#else
    -- contains 2 timespec (16 bytes)
    StopWatchPrecise (MutableBlock Word8 (PrimState IO))
#endif

#if defined(mingw32_HOST_OS)
initPrecise :: Word64
initPrecise = unsafePerformIO $ integralDownsize <$> queryPerformanceFrequency
{-# NOINLINE initPrecise #-}
#elif defined(darwin_HOST_OS)
initPrecise :: (Word64, Word64)
initPrecise = unsafePerformIO $ do
    mti <- newPinned (sizeOfCSize size_MachTimebaseInfo)
    withMutablePtr mti $ \p -> do
        sysMacos_timebase_info (castPtr p)
        let p32 = castPtr p :: Ptr Word32
        !n <- peek (p32 `ptrPlus` ofs_MachTimebaseInfo_numer)
        !d <- peek (p32 `ptrPlus` ofs_MachTimebaseInfo_denom)
        pure (integralUpsize n, integralUpsize d)
{-# NOINLINE initPrecise #-}
#endif

-- | Create a new precise stop watch
--
-- record the time at start of call
startPrecise :: IO StopWatchPrecise
startPrecise :: IO StopWatchPrecise
startPrecise = do
#if defined(mingw32_HOST_OS)
    blk <- newPinned 16
    _ <- withMutablePtr blk $ \p -> do
          ticks <- integralDownsize <$> queryPerformanceCounter :: IO Word64
          let p64 = castPtr p :: Ptr Word64
          poke (p64 `ptrPlus` 8) ticks
          pure p
    pure (StopWatchPrecise blk)
#elif defined(darwin_HOST_OS)
    StopWatchPrecise <$> sysMacos_absolute_time
#else
    MutableBlock Word8 RealWorld
blk <- CountOf Word8 -> IO (MutableBlock Word8 (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
newPinned (CSize -> CountOf Word8
sizeOfCSize (CSize
size_CTimeSpec CSize -> CSize -> CSize
forall a. Additive a => a -> a -> a
+ CSize
size_CTimeSpec))
    CInt
_err1 <- MutableBlock Word8 (PrimState IO)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
withMutablePtr MutableBlock Word8 RealWorld
MutableBlock Word8 (PrimState IO)
blk ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
        CInt -> Ptr CTimeSpec -> IO CInt
sysTimeClockGetTime CInt
sysTime_CLOCK_MONOTONIC (Ptr Word8 -> Ptr CTimeSpec
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p Ptr CTimeSpec -> CSize -> Ptr CTimeSpec
forall a. Ptr a -> CSize -> Ptr a
`ptrPlusCSz` CSize
size_CTimeSpec)
    StopWatchPrecise -> IO StopWatchPrecise
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MutableBlock Word8 (PrimState IO) -> StopWatchPrecise
StopWatchPrecise MutableBlock Word8 RealWorld
MutableBlock Word8 (PrimState IO)
blk)
#endif

-- | Get the number of nano seconds since the call to `startPrecise`
stopPrecise :: StopWatchPrecise -> IO NanoSeconds
stopPrecise :: StopWatchPrecise -> IO NanoSeconds
stopPrecise (StopWatchPrecise MutableBlock Word8 (PrimState IO)
blk) = do
#if defined(mingw32_HOST_OS)
    withMutablePtr blk $ \p -> do
        end <- integralDownsize <$> queryPerformanceCounter
        let p64 = castPtr p :: Ptr Word64
        start <- peek (p64 `ptrPlus` 8)
        pure $ NanoSeconds ((end - start) * secondInNano `div` initPrecise)
#elif defined(darwin_HOST_OS)
    end <- sysMacos_absolute_time
    pure $ NanoSeconds $ case initPrecise of
        (1,1)         -> end - blk
        (numer,denom) -> ((end - blk) * numer) `div` denom
#else
    MutableBlock Word8 (PrimState IO)
-> (Ptr Word8 -> IO NanoSeconds) -> IO NanoSeconds
forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
withMutablePtr MutableBlock Word8 (PrimState IO)
blk ((Ptr Word8 -> IO NanoSeconds) -> IO NanoSeconds)
-> (Ptr Word8 -> IO NanoSeconds) -> IO NanoSeconds
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
        CInt
_err1 <- CInt -> Ptr CTimeSpec -> IO CInt
sysTimeClockGetTime CInt
sysTime_CLOCK_MONOTONIC (Ptr Word8 -> Ptr CTimeSpec
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p)
        let p64 :: Ptr Word64
p64 = Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p :: Ptr Word64
        Word64
endSec    <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
p64
        Word64
startSec  <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word64
p64 Ptr Word64 -> CSize -> Ptr Word64
forall a. Ptr a -> CSize -> Ptr a
`ptrPlusCSz` CSize
size_CTimeSpec)
        Word64
endNSec   <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word64
p64 Ptr Word64 -> Offset Word8 -> Ptr Word64
forall a. Ptr a -> Offset Word8 -> Ptr a
`ptrPlus` Offset Word8
ofs_CTimeSpec_NanoSeconds)
        Word64
startNSec <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word64
p64 Ptr Word64 -> Offset Word8 -> Ptr Word64
forall a. Ptr a -> Offset Word8 -> Ptr a
`ptrPlus` (CountOf Word8 -> Offset Word8
forall a. CountOf a -> Offset a
sizeAsOffset (CSize -> CountOf Word8
sizeOfCSize CSize
size_CTimeSpec) Offset Word8 -> Offset Word8 -> Offset Word8
forall a. Additive a => a -> a -> a
+ Offset Word8
ofs_CTimeSpec_NanoSeconds))
        NanoSeconds -> IO NanoSeconds
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NanoSeconds -> IO NanoSeconds) -> NanoSeconds -> IO NanoSeconds
forall a b. (a -> b) -> a -> b
$ Word64 -> NanoSeconds
NanoSeconds (Word64 -> NanoSeconds) -> Word64 -> NanoSeconds
forall a b. (a -> b) -> a -> b
$ (Word64
endSec Word64 -> Word64 -> Word64
forall a. Multiplicative a => a -> a -> a
* Word64
secondInNano Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ Word64
endNSec) Word64 -> Word64 -> Difference Word64
forall a. Subtractive a => a -> a -> Difference a
- (Word64
startSec Word64 -> Word64 -> Word64
forall a. Multiplicative a => a -> a -> a
* Word64
secondInNano Word64 -> Word64 -> Word64
forall a. Additive a => a -> a -> a
+ Word64
startNSec)
#endif

#if !defined(darwin_HOST_OS)
secondInNano :: Word64
secondInNano :: Word64
secondInNano = Word64
1000000000
#endif