[commit: packages/directory] master: Implement setAccessTime (b6aca5d)
git at git.haskell.org
git at git.haskell.org
Fri Dec 18 09:51:56 UTC 2015
Repository : ssh://git@git.haskell.org/directory
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/b6aca5dd793444d6dee0c22953d524720a9ca177/directory
>---------------------------------------------------------------
commit b6aca5dd793444d6dee0c22953d524720a9ca177
Author: Phil Ruffwind <rf at rufflewind.com>
Date: Fri Jun 5 16:33:55 2015 -0400
Implement setAccessTime
>---------------------------------------------------------------
b6aca5dd793444d6dee0c22953d524720a9ca177
System/Directory.hs | 78 +++++++++++++++++++++++++++++++++++++++++------------
changelog.md | 2 +-
tests/FileTime.hs | 31 ++++++++++++++++-----
3 files changed, 86 insertions(+), 25 deletions(-)
diff --git a/System/Directory.hs b/System/Directory.hs
index e1b7bfd..3fe8406 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -78,6 +78,7 @@ module System.Directory
, getAccessTime
, getModificationTime
+ , setAccessTime
, setModificationTime
) where
@@ -92,6 +93,7 @@ import Data.Maybe
, maybeToList
#endif
)
+import Data.Tuple (swap)
import System.FilePath
import System.IO
@@ -1183,10 +1185,9 @@ getFileTime isMtime path = modifyIOError (`ioeSetFileName` path) $
bracket (openFileHandle path' Win32.gENERIC_READ)
Win32.closeHandle $ \ handle ->
alloca $ \ time -> do
- Win32.failIf_ not "" $
- Win32.c_GetFileTime handle nullPtr
- (if isMtime then nullPtr else time)
- (if isMtime then time else nullPtr)
+ Win32.failIf_ not "" .
+ uncurry (Win32.c_GetFileTime handle nullPtr) $
+ swapIf isMtime (time, nullPtr)
windowsToPosixTime <$> peek time
#else
getTime = convertTime <$> Posix.getFileStatus path'
@@ -1199,6 +1200,34 @@ getFileTime isMtime path = modifyIOError (`ioeSetFileName` path) $
# endif
#endif
+-- | Change the time at which the file or directory was last accessed.
+--
+-- The operation may fail with:
+--
+-- * 'isPermissionError' if the user is not permitted to alter the
+-- access time; or
+--
+-- * 'isDoesNotExistError' if the file or directory does not exist.
+--
+-- Some caveats for POSIX systems:
+--
+-- * Not all systems support @utimensat@, in which case the function can only
+-- emulate the behavior by reading the modification time and then setting
+-- both the access and modification times together. On systems where
+-- @utimensat@ is supported, the access time is set atomically with
+-- nanosecond precision.
+--
+-- * If compiled against a version of @unix@ prior to @2.7.0.0@, the function
+-- would not be able to set timestamps with sub-second resolution. In this
+-- case, there would also be loss of precision in the modification time.
+--
+-- /Since: 1.2.3.0/
+--
+setAccessTime :: FilePath -> UTCTime -> IO ()
+setAccessTime path =
+ modifyIOError (`ioeSetLocation` "setAccessTime") .
+ setFileTime False path
+
-- | Change the time at which the file or directory was last modified.
--
-- The operation may fail with:
@@ -1223,39 +1252,54 @@ getFileTime isMtime path = modifyIOError (`ioeSetFileName` path) $
-- /Since: 1.2.3.0/
--
setModificationTime :: FilePath -> UTCTime -> IO ()
-setModificationTime path mtime =
- modifyIOError ((`ioeSetLocation` "setModificationTime") .
- (`ioeSetFileName` path)) setTime
+setModificationTime path =
+ modifyIOError (`ioeSetLocation` "setModificationTime") .
+ setFileTime True path
+
+setFileTime :: Bool -> FilePath -> UTCTime -> IO ()
+setFileTime isMtime path = modifyIOError (`ioeSetFileName` path) .
+ setTime . utcTimeToPOSIXSeconds
where
path' = normalise path -- handle empty paths
- mtime' = utcTimeToPOSIXSeconds mtime
#ifdef mingw32_HOST_OS
- setTime =
+ setTime time =
bracket (openFileHandle path' Win32.gENERIC_WRITE)
Win32.closeHandle $ \ handle ->
- with (posixToWindowsTime mtime') $ \ mtime'' ->
- Win32.failIf_ not "" (Win32.c_SetFileTime handle nullPtr nullPtr mtime'')
+ with (posixToWindowsTime time) $ \ time' ->
+ Win32.failIf_ not "" .
+ uncurry (Win32.c_SetFileTime handle nullPtr) $
+ swapIf isMtime (time', nullPtr)
#elif defined HAVE_UTIMENSAT
- setTime =
+ setTime time =
withFilePath path' $ \ path'' ->
- withArray [utimeOmit, toCTimeSpec mtime'] $ \ times ->
+ withArray [atime, mtime] $ \ times ->
throwErrnoPathIfMinus1_ "" path' $
c_utimensat c_AT_FDCWD path'' times 0
+ where (atime, mtime) = swapIf isMtime (toCTimeSpec time, utimeOmit)
#else
- setTime = do
+ setTime time = do
stat <- Posix.getFileStatus path'
- setFileTimes path' (accessTime stat) (convertTime mtime')
+ uncurry (setFileTimes path') $
+ swapIf isMtime (convertTime time, otherTime stat)
# if MIN_VERSION_unix(2, 7, 0)
- accessTime = Posix.accessTimeHiRes
setFileTimes = Posix.setFileTimesHiRes
convertTime = id
+ otherTime = if isMtime
+ then Posix.accessTimeHiRes
+ else Posix.modificationTimeHiRes
# else
- accessTime = Posix.accessTime
setFileTimes = Posix.setFileTimes
convertTime = fromInteger . truncate
+ otherTime = if isMtime
+ then Posix.accessTime
+ else Posix.modificationTime
# endif
#endif
+swapIf :: Bool -> (a, a) -> (a, a)
+swapIf True = swap
+swapIf False = id
+
#ifdef mingw32_HOST_OS
-- | Difference between the Windows and POSIX epochs in units of 100ns.
windowsPosixEpochDifference :: Num a => a
diff --git a/changelog.md b/changelog.md
index 1b455c4..1d886f9 100644
--- a/changelog.md
+++ b/changelog.md
@@ -9,7 +9,7 @@ Changelog for the [`directory`][1] package
* Implement `setModificationTime` counterpart to `getModificationTime`
([#13](https://github.com/haskell/directory/issues/13))
- * Implement `getAccessTime`
+ * Implement `getAccessTime` and `setAccessTime`
* Fix `canonicalizePath` so that it always returns a reasonable result even
if the path is inaccessible and will not throw exceptions unless the
diff --git a/tests/FileTime.hs b/tests/FileTime.hs
index 580aa7d..b2e980e 100644
--- a/tests/FileTime.hs
+++ b/tests/FileTime.hs
@@ -9,28 +9,45 @@ import qualified Data.Time.Clock as Time
main :: TestEnv -> IO ()
main _t = do
now <- Time.getCurrentTime
- let someTimeAgo = Time.addUTCTime (-3600) now
+ let someTimeAgo = Time.addUTCTime (-3600) now
+ someTimeAgo' = Time.addUTCTime (-7200) now
T(expectIOErrorType) () isDoesNotExistError $
getAccessTime "nonexistent-file"
T(expectIOErrorType) () isDoesNotExistError $
+ setAccessTime "nonexistent-file" someTimeAgo
+ T(expectIOErrorType) () isDoesNotExistError $
getModificationTime "nonexistent-file"
T(expectIOErrorType) () isDoesNotExistError $
setModificationTime "nonexistent-file" someTimeAgo
writeFile "foo" ""
- for_ [ ("foo", someTimeAgo)
- , (".", someTimeAgo)
- , ("", someTimeAgo) ] $ \ (file, mtime1) -> do
+ for_ [ "foo", ".", "" ] $ \ file -> do
+ let mtime = someTimeAgo
+ atime = someTimeAgo'
atime1 <- getAccessTime file
- setModificationTime file mtime1
+
+ setModificationTime file mtime
+
atime2 <- getAccessTime file
mtime2 <- getModificationTime file
-- modification time should be set with at worst 1 sec resolution
- T(expectNearTime) ("mtime", file) mtime1 mtime2 1
+ T(expectNearTime) file mtime mtime2 1
-- access time should not change, although it may lose some precision
-- on POSIX systems without 'utimensat'
- T(expectNearTime) ("atime", file) atime1 atime2 1
+ T(expectNearTime) file atime1 atime2 1
+
+ setAccessTime file atime
+
+ atime3 <- getAccessTime file
+ mtime3 <- getModificationTime file
+
+ -- access time should be set with at worst 1 sec resolution
+ T(expectNearTime) file atime atime3 1
+
+ -- modification time should not change, although it may lose some precision
+ -- on POSIX systems without 'utimensat'
+ T(expectNearTime) file mtime2 mtime3 1
More information about the ghc-commits
mailing list