diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc index 3e982f78..75877189 100644 --- a/System/Posix/Files.hsc +++ b/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) diff --git a/System/Posix/Files/ByteString.hsc b/System/Posix/Files/ByteString.hsc index 5430f836..1c7b5a06 100644 --- a/System/Posix/Files/ByteString.hsc +++ b/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) diff --git a/System/Posix/Files/Common.hsc b/System/Posix/Files/Common.hsc index 61f19da3..b03859a1 100644 --- a/System/Posix/Files/Common.hsc +++ b/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 diff --git a/System/Posix/Files/PosixString.hsc b/System/Posix/Files/PosixString.hsc index 2d72ce9d..2873827f 100644 --- a/System/Posix/Files/PosixString.hsc +++ b/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 -> diff --git a/jsbits/time.js b/jsbits/time.js new file mode 100644 index 00000000..e53c9a11 --- /dev/null +++ b/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; +} + diff --git a/unix.cabal b/unix.cabal index a04052c9..2e8f0888 100644 --- a/unix.cabal +++ b/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