{-# LANGUAGE CPP #-}
{-# LANGUAGE JavaScriptFFI #-}

{-# OPTIONS_HADDOCK hide #-} -- for doctests

module Chronos.Internal.CTimespec
  (
#ifndef mingw32_HOST_OS
    getPosixNanoseconds
#ifndef ghcjs_HOST_OS
  , CTimespec(..)
#endif
#endif
  ) where

import Foreign
import Foreign.C

#if defined(ghcjs_HOST_OS)

foreign import javascript unsafe "Date.now()" currentSeconds :: IO Double
getPosixNanoseconds :: IO Int64
getPosixNanoseconds = do
  x <- currentSeconds
  pure $ fromIntegral $ 1000000 * (round x)

#elif defined(mingw32_HOST_OS)

#else

data CTimespec = CTimespec
  { CTimespec -> CTime
ctimespecSeconds :: {-# UNPACK #-} !CTime
  , CTimespec -> CLong
ctimespecNanoseconds :: {-# UNPACK #-} !CLong
  }

instance Storable CTimespec where
    sizeOf :: CTimespec -> Int
sizeOf CTimespec
_ = (Int
16)
    alignment :: CTimespec -> Int
alignment CTimespec
_ = CLong -> Int
forall a. Storable a => a -> Int
alignment (CLong
forall a. HasCallStack => a
undefined :: CLong)
    peek :: Ptr CTimespec -> IO CTimespec
peek Ptr CTimespec
p = do
        CTime
s  <- (\Ptr CTimespec
hsc_ptr -> Ptr CTimespec -> Int -> IO CTime
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CTimespec
hsc_ptr Int
0) Ptr CTimespec
p
        CLong
ns <- (\Ptr CTimespec
hsc_ptr -> Ptr CTimespec -> Int -> IO CLong
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CTimespec
hsc_ptr Int
8) Ptr CTimespec
p
        CTimespec -> IO CTimespec
forall (m :: * -> *) a. Monad m => a -> m a
return (CTime -> CLong -> CTimespec
CTimespec CTime
s CLong
ns)
    poke :: Ptr CTimespec -> CTimespec -> IO ()
poke Ptr CTimespec
p (CTimespec CTime
s CLong
ns) = do
        (\Ptr CTimespec
hsc_ptr -> Ptr CTimespec -> Int -> CTime -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CTimespec
hsc_ptr Int
0) Ptr CTimespec
p CTime
s
        (\Ptr CTimespec
hsc_ptr -> Ptr CTimespec -> Int -> CLong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CTimespec
hsc_ptr Int
8) Ptr CTimespec
p CLong
ns

#ifdef darwin_HOST_OS
foreign import ccall unsafe "cbits/hs-time.c clock_gettime"
    clock_gettime :: Int32 -> Ptr CTimespec -> IO CInt
#else
foreign import ccall unsafe "time.h clock_gettime"
    clock_gettime :: Int32 -> Ptr CTimespec -> IO CInt
#endif

-- | Get the current POSIX time from the system clock.
getPosixNanoseconds :: IO Int64
getPosixNanoseconds :: IO Int64
getPosixNanoseconds = do
  CTimespec (CTime Int64
s) (CLong Int64
ns) <- (Ptr CTimespec -> IO CTimespec) -> IO CTimespec
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CTimespec -> IO CTimespec) -> IO CTimespec)
-> (Ptr CTimespec -> IO CTimespec) -> IO CTimespec
forall a b. (a -> b) -> a -> b
$ \Ptr CTimespec
ptspec -> do
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"clock_gettime" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
      Int32 -> Ptr CTimespec -> IO CInt
clock_gettime Int32
0 Ptr CTimespec
ptspec
    Ptr CTimespec -> IO CTimespec
forall a. Storable a => Ptr a -> IO a
peek Ptr CTimespec
ptspec
  -- On most 64-bit platforms, the uses of fromIntegral here end up
  -- being i64->i64, but on 32-bit platforms, they are i32->i64.
  Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000000000) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
ns)

#endif