JS: add support for utimes/lutimes/futimes

Author: hsyl20

System/Posix/Files.hsc

@@ -386,7 +386,12 @@ setFileTimes name atime mtime = do
 --
 -- @since 2.7.0.0
 setFileTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()
-#ifdef HAVE_UTIMENSAT
+#if defined(javascript_HOST_ARCH)
+setFileTimesHiRes name atime mtime =
+  withFilePath name $ \s ->
+    throwErrnoPathIfMinus1_ "setFileTimesHiRes" name
+      (js_utimes s (realToFrac atime) (realToFrac mtime))
+#elif defined(HAVE_UTIMENSAT)
 setFileTimesHiRes name atime mtime =
   withFilePath name $ \s ->
     withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
@@ -410,7 +415,12 @@ setFileTimesHiRes name atime mtime =
 --
 -- @since 2.7.0.0
 setSymbolicLinkTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()
-#if HAVE_UTIMENSAT
+#if defined(javascript_HOST_ARCH)
+setSymbolicLinkTimesHiRes name atime mtime =
+  withFilePath name $ \s ->
+    throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
+      js_lutimes s (realToFrac atime) (realToFrac mtime)
+#elif HAVE_UTIMENSAT
 setSymbolicLinkTimesHiRes name atime mtime =
   withFilePath name $ \s ->
     withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
@@ -447,7 +457,11 @@ touchFile name = do
 --
 -- @since 2.7.0.0
 touchSymbolicLink :: FilePath -> IO ()
-#if HAVE_LUTIMES
+#if defined(javascript_HOST_ARCH)
+touchSymbolicLink name =
+  withFilePath name $ \s ->
+    throwErrnoPathIfMinus1_ "touchSymbolicLink" name (js_lutimes s (-1) (-1))
+#elif HAVE_LUTIMES
 touchSymbolicLink name =
   withFilePath name $ \s ->
     throwErrnoPathIfMinus1_ "touchSymbolicLink" name (c_lutimes s nullPtr)

System/Posix/Files/ByteString.hsc

@@ -381,7 +381,12 @@ setFileTimes name atime mtime = do
 -- - HFS+ volumes on OS X truncate the sub-second part of the timestamp.
 --
 setFileTimesHiRes :: RawFilePath -> POSIXTime -> POSIXTime -> IO ()
-#ifdef HAVE_UTIMENSAT
+#if defined(javascript_HOST_ARCH)
+setFileTimesHiRes name atime mtime =
+  withFilePath name $ \s ->
+    throwErrnoPathIfMinus1_ "setFileTimesHiRes" name $
+      js_utimes s (realToFrac atime) (realToFrac mtime)
+#elif defined(HAVE_UTIMENSAT)
 setFileTimesHiRes name atime mtime =
   withFilePath name $ \s ->
     withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
@@ -404,7 +409,12 @@ setFileTimesHiRes name atime mtime =
 -- - HFS+ volumes on OS X truncate the sub-second part of the timestamp.
 --
 setSymbolicLinkTimesHiRes :: RawFilePath -> POSIXTime -> POSIXTime -> IO ()
-#if HAVE_UTIMENSAT
+#if defined(javascript_HOST_ARCH)
+setSymbolicLinkTimesHiRes name atime mtime =
+  withFilePath name $ \s ->
+    throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
+      js_lutimes s (realToFrac atime) (realToFrac mtime)
+#elif HAVE_UTIMENSAT
 setSymbolicLinkTimesHiRes name atime mtime =
   withFilePath name $ \s ->
     withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
@@ -437,7 +447,11 @@ touchFile name = do
 --
 -- Note: calls @lutimes@.
 touchSymbolicLink :: RawFilePath -> IO ()
-#if HAVE_LUTIMES
+#if defined(javascript_HOST_ARCH)
+touchSymbolicLink name =
+  withFilePath name $ \s ->
+    throwErrnoPathIfMinus1_ "touchSymbolicLink" name (js_lutimes s (-1) (-1))
+#elif HAVE_LUTIMES
 touchSymbolicLink name =
   withFilePath name $ \s ->
     throwErrnoPathIfMinus1_ "touchSymbolicLink" name (c_lutimes s nullPtr)

System/Posix/Files/Common.hsc

@@ -74,6 +74,11 @@ module System.Posix.Files.Common (
     CTimeSpec(..),
     toCTimeSpec,
     c_utimensat,
+#endif
+#if defined(javascript_HOST_ARCH)
+    js_futimes,
+    js_utimes,
+    js_lutimes,
 #endif
     CTimeVal(..),
     toCTimeVal,
@@ -509,6 +514,15 @@ foreign import capi unsafe "sys/time.h futimes"
     c_futimes :: CInt -> Ptr CTimeVal -> IO CInt
 #endif
 
+#if defined(javascript_HOST_ARCH)
+foreign import ccall unsafe "js_futimes"
+    js_futimes :: CInt -> CDouble -> CDouble -> IO CInt
+foreign import ccall unsafe "js_lutimes"
+    js_lutimes :: CFilePath -> CDouble -> CDouble -> IO CInt
+foreign import ccall unsafe "js_utimes"
+    js_utimes :: CFilePath -> CDouble -> CDouble -> IO CInt
+#endif
+
 -- | Like 'setFileTimesHiRes' but uses a file descriptor instead of a path.
 -- This operation is not supported on all platforms. On these platforms,
 -- this function will raise an exception.
@@ -521,7 +535,10 @@ foreign import capi unsafe "sys/time.h futimes"
 --
 -- @since 2.7.0.0
 setFdTimesHiRes :: Fd -> POSIXTime -> POSIXTime -> IO ()
-#if HAVE_FUTIMENS
+#if defined(javascript_HOST_ARCH)
+setFdTimesHiRes (Fd fd) atime mtime =
+  throwErrnoIfMinus1_ "setFdTimesHiRes" (js_futimes fd (realToFrac atime) (realToFrac mtime))
+#elif HAVE_FUTIMENS
 setFdTimesHiRes (Fd fd) atime mtime =
   withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
     throwErrnoIfMinus1_ "setFdTimesHiRes" (c_futimens fd times)
@@ -543,7 +560,11 @@ setFdTimesHiRes =
 --
 -- @since 2.7.0.0
 touchFd :: Fd -> IO ()
-#if HAVE_FUTIMES
+#if defined(javascript_HOST_ARCH)
+touchFd (Fd fd) =
+  -- (-1) indicates that current time must be used
+  throwErrnoIfMinus1_ "touchFd" (js_futimes fd (-1) (-1))
+#elif HAVE_FUTIMES
 touchFd (Fd fd) =
   throwErrnoIfMinus1_ "touchFd" (c_futimes fd nullPtr)
 #else

System/Posix/Files/PosixString.hsc

@@ -378,7 +378,12 @@ setFileTimes name atime mtime = do
 -- - HFS+ volumes on OS X truncate the sub-second part of the timestamp.
 --
 setFileTimesHiRes :: PosixPath -> POSIXTime -> POSIXTime -> IO ()
-#ifdef HAVE_UTIMENSAT
+#if defined(javascript_HOST_ARCH)
+setFileTimesHiRes name atime mtime =
+  withFilePath name $ \s ->
+    throwErrnoPathIfMinus1_ "setFileTimesHiRes" name $
+      Common.js_utimes s (realToFrac atime) (realToFrac mtime)
+#elif defined(HAVE_UTIMENSAT)
 setFileTimesHiRes name atime mtime =
   withFilePath name $ \s ->
     withArray [Common.toCTimeSpec atime, Common.toCTimeSpec mtime] $ \times ->

jsbits/time.js

@@ -0,0 +1,41 @@
+function h$js_futimes(fd,atime,mtime) {
+  if (!h$isNode()) {
+    throw "h$js_futimes unsupported";
+  }
+  try {
+    h$fs.futimesSync(fd, atime, mtime);
+  } catch(e) {
+    h$setErrno(e);
+    return -1;
+  }
+  return 0;
+}
+
+function h$js_utimes(path,path_offset,atime,mtime) {
+  if (!h$isNode()) {
+    throw "h$js_utimes unsupported";
+  }
+  try {
+    const d = h$decodeUtf8z(path, path_offset);
+    h$fs.utimesSync(d, atime, mtime);
+  } catch(e) {
+    h$setErrno(e);
+    return -1;
+  }
+  return 0;
+}
+
+function h$js_lutimes(path,path_offset,atime,mtime) {
+  if (!h$isNode()) {
+    throw "h$js_lutimes unsupported";
+  }
+  try {
+    const d = h$decodeUtf8z(path, path_offset);
+    h$fs.lutimesSync(d, atime, mtime);
+  } catch(e) {
+    h$setErrno(e);
+    return -1;
+  }
+  return 0;
+}
+

unix.cabal

@@ -152,9 +152,15 @@ library
     install-includes:
         HsUnix.h
         execvpe.h
-    c-sources:
-        cbits/HsUnix.c
-        cbits/execvpe.c
+
+    if !arch(javascript)
+      c-sources:
+          cbits/HsUnix.c
+          cbits/execvpe.c
+
+    if arch(javascript)
+      js-sources:
+          jsbits/time.js
 
 test-suite unix-tests
     hs-source-dirs: tests