    {-# 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