Skip to content

Commit 295369f

Browse files
hsyl20Bodigrim
hsyl20
authored and
Bodigrim
committed
JS: add support for utimes/lutimes/futimes
1 parent 5ff1926 commit 295369f

File tree

6 files changed

+113
-12
lines changed

6 files changed

+113
-12
lines changed

‎System/Posix/Files.hsc

Lines changed: 17 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -386,7 +386,12 @@ setFileTimes name atime mtime = do
386386
--
387387
-- @since 2.7.0.0
388388
setFileTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()
389-
#ifdef HAVE_UTIMENSAT
389+
#if defined(javascript_HOST_ARCH)
390+
setFileTimesHiRes name atime mtime =
391+
withFilePath name $ \s ->
392+
throwErrnoPathIfMinus1_ "setFileTimesHiRes" name
393+
(js_utimes s (realToFrac atime) (realToFrac mtime))
394+
#elif defined(HAVE_UTIMENSAT)
390395
setFileTimesHiRes name atime mtime =
391396
withFilePath name $ \s ->
392397
withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
@@ -410,7 +415,12 @@ setFileTimesHiRes name atime mtime =
410415
--
411416
-- @since 2.7.0.0
412417
setSymbolicLinkTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()
413-
#if HAVE_UTIMENSAT
418+
#if defined(javascript_HOST_ARCH)
419+
setSymbolicLinkTimesHiRes name atime mtime =
420+
withFilePath name $ \s ->
421+
throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
422+
js_lutimes s (realToFrac atime) (realToFrac mtime)
423+
#elif HAVE_UTIMENSAT
414424
setSymbolicLinkTimesHiRes name atime mtime =
415425
withFilePath name $ \s ->
416426
withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
@@ -447,7 +457,11 @@ touchFile name = do
447457
--
448458
-- @since 2.7.0.0
449459
touchSymbolicLink :: FilePath -> IO ()
450-
#if HAVE_LUTIMES
460+
#if defined(javascript_HOST_ARCH)
461+
touchSymbolicLink name =
462+
withFilePath name $ \s ->
463+
throwErrnoPathIfMinus1_ "touchSymbolicLink" name (js_lutimes s (-1) (-1))
464+
#elif HAVE_LUTIMES
451465
touchSymbolicLink name =
452466
withFilePath name $ \s ->
453467
throwErrnoPathIfMinus1_ "touchSymbolicLink" name (c_lutimes s nullPtr)

‎System/Posix/Files/ByteString.hsc

Lines changed: 17 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -381,7 +381,12 @@ setFileTimes name atime mtime = do
381381
-- - HFS+ volumes on OS X truncate the sub-second part of the timestamp.
382382
--
383383
setFileTimesHiRes :: RawFilePath -> POSIXTime -> POSIXTime -> IO ()
384-
#ifdef HAVE_UTIMENSAT
384+
#if defined(javascript_HOST_ARCH)
385+
setFileTimesHiRes name atime mtime =
386+
withFilePath name $ \s ->
387+
throwErrnoPathIfMinus1_ "setFileTimesHiRes" name $
388+
js_utimes s (realToFrac atime) (realToFrac mtime)
389+
#elif defined(HAVE_UTIMENSAT)
385390
setFileTimesHiRes name atime mtime =
386391
withFilePath name $ \s ->
387392
withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
@@ -404,7 +409,12 @@ setFileTimesHiRes name atime mtime =
404409
-- - HFS+ volumes on OS X truncate the sub-second part of the timestamp.
405410
--
406411
setSymbolicLinkTimesHiRes :: RawFilePath -> POSIXTime -> POSIXTime -> IO ()
407-
#if HAVE_UTIMENSAT
412+
#if defined(javascript_HOST_ARCH)
413+
setSymbolicLinkTimesHiRes name atime mtime =
414+
withFilePath name $ \s ->
415+
throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
416+
js_lutimes s (realToFrac atime) (realToFrac mtime)
417+
#elif HAVE_UTIMENSAT
408418
setSymbolicLinkTimesHiRes name atime mtime =
409419
withFilePath name $ \s ->
410420
withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
@@ -437,7 +447,11 @@ touchFile name = do
437447
--
438448
-- Note: calls @lutimes@.
439449
touchSymbolicLink :: RawFilePath -> IO ()
440-
#if HAVE_LUTIMES
450+
#if defined(javascript_HOST_ARCH)
451+
touchSymbolicLink name =
452+
withFilePath name $ \s ->
453+
throwErrnoPathIfMinus1_ "touchSymbolicLink" name (js_lutimes s (-1) (-1))
454+
#elif HAVE_LUTIMES
441455
touchSymbolicLink name =
442456
withFilePath name $ \s ->
443457
throwErrnoPathIfMinus1_ "touchSymbolicLink" name (c_lutimes s nullPtr)

‎System/Posix/Files/Common.hsc

Lines changed: 23 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -74,6 +74,11 @@ module System.Posix.Files.Common (
7474
CTimeSpec(..),
7575
toCTimeSpec,
7676
c_utimensat,
77+
#endif
78+
#if defined(javascript_HOST_ARCH)
79+
js_futimes,
80+
js_utimes,
81+
js_lutimes,
7782
#endif
7883
CTimeVal(..),
7984
toCTimeVal,
@@ -509,6 +514,15 @@ foreign import capi unsafe "sys/time.h futimes"
509514
c_futimes :: CInt -> Ptr CTimeVal -> IO CInt
510515
#endif
511516

517+
#if defined(javascript_HOST_ARCH)
518+
foreign import ccall unsafe "js_futimes"
519+
js_futimes :: CInt -> CDouble -> CDouble -> IO CInt
520+
foreign import ccall unsafe "js_lutimes"
521+
js_lutimes :: CFilePath -> CDouble -> CDouble -> IO CInt
522+
foreign import ccall unsafe "js_utimes"
523+
js_utimes :: CFilePath -> CDouble -> CDouble -> IO CInt
524+
#endif
525+
512526
-- | Like 'setFileTimesHiRes' but uses a file descriptor instead of a path.
513527
-- This operation is not supported on all platforms. On these platforms,
514528
-- this function will raise an exception.
@@ -521,7 +535,10 @@ foreign import capi unsafe "sys/time.h futimes"
521535
--
522536
-- @since 2.7.0.0
523537
setFdTimesHiRes :: Fd -> POSIXTime -> POSIXTime -> IO ()
524-
#if HAVE_FUTIMENS
538+
#if defined(javascript_HOST_ARCH)
539+
setFdTimesHiRes (Fd fd) atime mtime =
540+
throwErrnoIfMinus1_ "setFdTimesHiRes" (js_futimes fd (realToFrac atime) (realToFrac mtime))
541+
#elif HAVE_FUTIMENS
525542
setFdTimesHiRes (Fd fd) atime mtime =
526543
withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
527544
throwErrnoIfMinus1_ "setFdTimesHiRes" (c_futimens fd times)
@@ -543,7 +560,11 @@ setFdTimesHiRes =
543560
--
544561
-- @since 2.7.0.0
545562
touchFd :: Fd -> IO ()
546-
#if HAVE_FUTIMES
563+
#if defined(javascript_HOST_ARCH)
564+
touchFd (Fd fd) =
565+
-- (-1) indicates that current time must be used
566+
throwErrnoIfMinus1_ "touchFd" (js_futimes fd (-1) (-1))
567+
#elif HAVE_FUTIMES
547568
touchFd (Fd fd) =
548569
throwErrnoIfMinus1_ "touchFd" (c_futimes fd nullPtr)
549570
#else

‎System/Posix/Files/PosixString.hsc

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -378,7 +378,12 @@ setFileTimes name atime mtime = do
378378
-- - HFS+ volumes on OS X truncate the sub-second part of the timestamp.
379379
--
380380
setFileTimesHiRes :: PosixPath -> POSIXTime -> POSIXTime -> IO ()
381-
#ifdef HAVE_UTIMENSAT
381+
#if defined(javascript_HOST_ARCH)
382+
setFileTimesHiRes name atime mtime =
383+
withFilePath name $ \s ->
384+
throwErrnoPathIfMinus1_ "setFileTimesHiRes" name $
385+
Common.js_utimes s (realToFrac atime) (realToFrac mtime)
386+
#elif defined(HAVE_UTIMENSAT)
382387
setFileTimesHiRes name atime mtime =
383388
withFilePath name $ \s ->
384389
withArray [Common.toCTimeSpec atime, Common.toCTimeSpec mtime] $ \times ->

‎jsbits/time.js

Lines changed: 41 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,41 @@
1+
function h$js_futimes(fd,atime,mtime) {
2+
if (!h$isNode()) {
3+
throw "h$js_futimes unsupported";
4+
}
5+
try {
6+
h$fs.futimesSync(fd, atime, mtime);
7+
} catch(e) {
8+
h$setErrno(e);
9+
return -1;
10+
}
11+
return 0;
12+
}
13+
14+
function h$js_utimes(path,path_offset,atime,mtime) {
15+
if (!h$isNode()) {
16+
throw "h$js_utimes unsupported";
17+
}
18+
try {
19+
const d = h$decodeUtf8z(path, path_offset);
20+
h$fs.utimesSync(d, atime, mtime);
21+
} catch(e) {
22+
h$setErrno(e);
23+
return -1;
24+
}
25+
return 0;
26+
}
27+
28+
function h$js_lutimes(path,path_offset,atime,mtime) {
29+
if (!h$isNode()) {
30+
throw "h$js_lutimes unsupported";
31+
}
32+
try {
33+
const d = h$decodeUtf8z(path, path_offset);
34+
h$fs.lutimesSync(d, atime, mtime);
35+
} catch(e) {
36+
h$setErrno(e);
37+
return -1;
38+
}
39+
return 0;
40+
}
41+

‎unix.cabal

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -152,9 +152,15 @@ library
152152
install-includes:
153153
HsUnix.h
154154
execvpe.h
155-
c-sources:
156-
cbits/HsUnix.c
157-
cbits/execvpe.c
155+
156+
if !arch(javascript)
157+
c-sources:
158+
cbits/HsUnix.c
159+
cbits/execvpe.c
160+
161+
if arch(javascript)
162+
js-sources:
163+
jsbits/time.js
158164

159165
test-suite unix-tests
160166
hs-source-dirs: tests

0 commit comments

Comments
 (0)