touch files with high-resolution timestamp

Needs unix 2.7.2, but that was included in ghc 8.0.1 (and much older)
so not really a new dep.
This commit is contained in:
Joey Hess 2018-10-29 22:22:36 -04:00
parent 94b7968f1f
commit 5d97898a7c
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 19 additions and 26 deletions

View file

@ -287,7 +287,7 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
-- touch symlink to have same time as the original file,
-- as provided in the InodeCache
case mcache of
Just c -> liftIO $ touch file (TimeSpec $ inodeCacheToMtime c) False
Just c -> liftIO $ touch file (inodeCacheToMtime c) False
Nothing -> noop
return l

View file

@ -93,7 +93,7 @@ fixSymlink file link = do
liftIO $ do
#if ! defined(mingw32_HOST_OS)
-- preserve mtime of symlink
mtime <- catchMaybeIO $ TimeSpec . modificationTime
mtime <- catchMaybeIO $ modificationTimeHighRes
<$> getSymbolicLinkStatus file
#endif
createDirectoryIfMissing True (parentDir file)

View file

@ -39,6 +39,7 @@ module Utility.InodeCache (
import Common
import System.PosixCompat.Types
import Data.Time.Clock.POSIX
import Utility.QuickCheck
#ifdef mingw32_HOST_OS
@ -90,8 +91,8 @@ instance Eq InodeCacheKey where
inodeCacheToKey :: InodeComparisonType -> InodeCache -> InodeCacheKey
inodeCacheToKey ct (InodeCache prim) = InodeCacheKey ct prim
inodeCacheToMtime :: InodeCache -> EpochTime
inodeCacheToMtime (InodeCache (InodeCachePrim _ _ mtime)) = mtime
inodeCacheToMtime :: InodeCache -> POSIXTime
inodeCacheToMtime (InodeCache (InodeCachePrim _ _ mtime)) = realToFrac mtime
showInodeCache :: InodeCache -> String
showInodeCache (InodeCache (InodeCachePrim inode size mtime)) = unwords

View file

@ -1,6 +1,6 @@
{- More control over touching a file.
{- Portability shim for touching a file.
-
- Copyright 2011 Joey Hess <id@joeyh.name>
- Copyright 2011-2018 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
@ -8,42 +8,34 @@
{-# LANGUAGE CPP #-}
module Utility.Touch (
TimeSpec(..),
touchBoth,
touch
) where
#if ! defined(mingw32_HOST_OS)
#if MIN_VERSION_unix(2,7,0)
import System.Posix.Files
import System.Posix.Types
newtype TimeSpec = TimeSpec EpochTime
import Data.Time.Clock.POSIX
{- Changes the access and modification times of an existing file.
Can follow symlinks, or not. Throws IO error on failure. -}
touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO ()
touchBoth file (TimeSpec atime) (TimeSpec mtime) follow
| follow = setFileTimes file atime mtime
| otherwise = setSymbolicLinkTimesHiRes file (realToFrac atime) (realToFrac mtime)
Can follow symlinks, or not. -}
touchBoth :: FilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()
touchBoth file atime mtime follow
| follow = setFileTimesHiRes file atime mtime
| otherwise = setSymbolicLinkTimesHiRes file atime mtime
touch :: FilePath -> TimeSpec -> Bool -> IO ()
{- Changes the access and modification times of an existing file
- to the same value. Can follow symlinks, or not. -}
touch :: FilePath -> POSIXTime -> Bool -> IO ()
touch file mtime = touchBoth file mtime mtime
#else
import Utility.Touch.Old
#endif
#else
import System.PosixCompat
newtype TimeSpec = TimeSpec EpochTime
import Data.Time.Clock.POSIX
{- Noop for Windows -}
touchBoth :: FilePath -> TimeSpec -> TimeSpec -> Bool -> IO ()
touchBoth :: FilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()
touchBoth _ _ _ _ = return ()
touch :: FilePath -> TimeSpec -> Bool -> IO ()

View file

@ -391,7 +391,7 @@ Executable git-annex
setenv,
process (>= 1.6.2.0)
else
Build-Depends: unix
Build-Depends: unix (>= 2.7.2)
if flag(S3)
Build-Depends: aws (>= 0.9.2)