[commit: packages/directory] master: Add getAccessTime (4ac04a8)

git at git.haskell.org git at git.haskell.org
Fri Dec 18 09:50:53 UTC 2015


Repository : ssh://git@git.haskell.org/directory

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/4ac04a820b2f8c822b0ba78c515fdf0e7afa03bd/directory

>---------------------------------------------------------------

commit 4ac04a820b2f8c822b0ba78c515fdf0e7afa03bd
Author: Phil Ruffwind <rf at rufflewind.com>
Date:   Fri May 29 20:31:58 2015 -0400

    Add getAccessTime


>---------------------------------------------------------------

4ac04a820b2f8c822b0ba78c515fdf0e7afa03bd
 System/Directory.hs                        | 43 ++++++++++++++++++++++++------
 changelog.md                               |  2 ++
 tests/{ModificationTime.hs => FileTime.hs} |  8 +++++-
 tests/Main.hs                              |  4 +--
 4 files changed, 46 insertions(+), 11 deletions(-)

diff --git a/System/Directory.hs b/System/Directory.hs
index 9aba011..faddfe3 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -79,6 +79,7 @@ module System.Directory
 
     -- * Timestamps
 
+    , getAccessTime
     , getModificationTime
     , setModificationTime
 
@@ -1114,6 +1115,25 @@ openFileHandle path mode = Win32.createFile path mode share Nothing
              .|. Win32.fILE_FLAG_BACKUP_SEMANTICS -- required for directories
 #endif
 
+-- | Obtain the time at which the file or directory was last accessed.
+--
+-- The operation may fail with:
+--
+-- * 'isPermissionError' if the user is not permitted to read
+--   the access time; or
+--
+-- * 'isDoesNotExistError' if the file or directory does not exist.
+--
+-- Caveat for POSIX systems: This function returns a timestamp with sub-second
+-- resolution only if this package is compiled against @unix-2.6.0.0@ or later
+-- and the underlying filesystem supports them.
+--
+-- /Since: 1.2.3.0/
+--
+getAccessTime :: FilePath -> IO UTCTime
+getAccessTime = modifyIOError (`ioeSetLocation` "getAccessTime") .
+                getFileTime False
+
 -- | Obtain the time at which the file or directory was last modified.
 --
 -- The operation may fail with:
@@ -1128,24 +1148,31 @@ openFileHandle path mode = Win32.createFile path mode share Nothing
 -- and the underlying filesystem supports them.
 --
 getModificationTime :: FilePath -> IO UTCTime
-getModificationTime path =
-  modifyIOError (`ioeSetLocation` "getModificationTime") $
-  posixSecondsToUTCTime <$> getTime
+getModificationTime = modifyIOError (`ioeSetLocation` "getModificationTime") .
+                      getFileTime True
+
+getFileTime :: Bool -> FilePath -> IO UTCTime
+getFileTime isMtime path = posixSecondsToUTCTime <$> getTime
   where
     path' = normalise path              -- handle empty paths
 #ifdef mingw32_HOST_OS
     getTime =
       bracket (openFileHandle path' Win32.gENERIC_READ)
               Win32.closeHandle $ \ handle ->
-      alloca $ \ mtime -> do
-        Win32.failIf_ not "" (Win32.c_GetFileTime handle nullPtr nullPtr mtime)
-        windowsToPosixTime <$> peek mtime
+      alloca $ \ time -> do
+        Win32.failIf_ not "" $
+          Win32.c_GetFileTime handle nullPtr
+            (if isMtime then nullPtr else time)
+            (if isMtime then time    else nullPtr)
+        windowsToPosixTime <$> peek time
 #else
     getTime = convertTime <$> Posix.getFileStatus path'
 # if MIN_VERSION_unix(2, 6, 0)
-    convertTime = Posix.modificationTimeHiRes
+    convertTime = if isMtime then Posix.modificationTimeHiRes
+                             else Posix.accessTimeHiRes
 # else
-    convertTime = realToFrac . Posix.modificationTime
+    convertTime = realToFrac . if isMtime then Posix.modificationTime
+                                          else Posix.accessTime
 # endif
 #endif
 
diff --git a/changelog.md b/changelog.md
index 67724a6..05e9c51 100644
--- a/changelog.md
+++ b/changelog.md
@@ -9,6 +9,8 @@ Changelog for the [`directory`][1] package
   * Implement `setModificationTime` counterpart to `getModificationTime`
     ([#13](https://github.com/haskell/directory/issues/13))
 
+  * Implement `getAccessTime`
+
 ## 1.2.2.1 (Apr 2015)
 
   * Fix dependency problem on NixOS when building with tests
diff --git a/tests/ModificationTime.hs b/tests/FileTime.hs
similarity index 69%
rename from tests/ModificationTime.hs
rename to tests/FileTime.hs
index 0d4735a..c830864 100644
--- a/tests/ModificationTime.hs
+++ b/tests/FileTime.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-module ModificationTime where
+module FileTime where
 #include "util.inl"
 import System.Directory
 import Data.Foldable (for_)
@@ -15,8 +15,14 @@ main _t = do
        , (".",   someTimeAgo)
        , ("",    someTimeAgo) ] $ \ (file, mtime1) -> do
 
+    atime1 <- getAccessTime file
     setModificationTime file mtime1
+    atime2 <- getAccessTime file
     mtime2 <- getModificationTime file
 
     -- modification time should be set with at worst 1 sec resolution
     T(expectNearTime) ("mtime", file) mtime1 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
diff --git a/tests/Main.hs b/tests/Main.hs
index 11effa9..dba7706 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -1,7 +1,7 @@
 module Main (main) where
 import qualified Util as T
-import qualified ModificationTime
+import qualified FileTime
 
 main :: IO ()
 main = T.testMain $ \ _t -> do
-  T.isolatedRun _t "ModificationTime" ModificationTime.main
+  T.isolatedRun _t "FileTime" FileTime.main



More information about the ghc-commits mailing list