diff --git a/lib/Data/Time/Clock/Internal/CTimespec.hsc b/lib/Data/Time/Clock/Internal/CTimespec.hsc
index e06ad4763d3621b5db7a8b6e01253286a1b57a06..6d1b517f1574e5e0c79b45e6af3d16f4fe654e22 100644
--- a/lib/Data/Time/Clock/Internal/CTimespec.hsc
+++ b/lib/Data/Time/Clock/Internal/CTimespec.hsc
@@ -30,11 +30,22 @@ instance Storable CTimespec where
         #{poke struct timespec, tv_sec } p s
         #{poke struct timespec, tv_nsec} p ns
 
+#if defined(javascript_HOST_ARCH)
+
+foreign import ccall unsafe "time.h clock_gettime"
+    clock_gettime :: ClockID -> Ptr CTimespec -> IO CInt
+foreign import ccall unsafe "time.h clock_getres"
+    clock_getres :: ClockID -> Ptr CTimespec -> IO CInt
+
+#else
+
 foreign import capi unsafe "time.h clock_gettime"
     clock_gettime :: ClockID -> Ptr CTimespec -> IO CInt
 foreign import capi unsafe "time.h clock_getres"
     clock_getres :: ClockID -> Ptr CTimespec -> IO CInt
 
+#endif
+
 -- | Get the resolution of the given clock.
 clockGetRes :: ClockID -> IO (Either Errno CTimespec)
 clockGetRes clockid = alloca $ \ptspec -> do
diff --git a/lib/Data/Time/Clock/Internal/CTimeval.hs b/lib/Data/Time/Clock/Internal/CTimeval.hs
index e888478fd808060616ea09c7fe72bdbd7c5f3862..38f1f15f69cb4a483845b1405c739abd5a295b2e 100644
--- a/lib/Data/Time/Clock/Internal/CTimeval.hs
+++ b/lib/Data/Time/Clock/Internal/CTimeval.hs
@@ -1,6 +1,8 @@
-{-# LANGUAGE CApiFFI #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
+#if !defined(javascript_HOST_ARCH)
+{-# LANGUAGE CApiFFI #-}
+#endif
 
 module Data.Time.Clock.Internal.CTimeval where
 
@@ -24,8 +26,16 @@ instance Storable CTimeval where
         pokeElemOff (castPtr p) 0 s
         pokeElemOff (castPtr p) 1 mus
 
+#if defined(javascript_HOST_ARCH)
+
+foreign import ccall unsafe "sys/time.h gettimeofday" gettimeofday :: Ptr CTimeval -> Ptr () -> IO CInt
+
+#else
+
 foreign import capi unsafe "sys/time.h gettimeofday" gettimeofday :: Ptr CTimeval -> Ptr () -> IO CInt
 
+#endif
+
 -- | Get the current POSIX time from the system clock.
 getCTimeval :: IO CTimeval
 getCTimeval =