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:
parent
94b7968f1f
commit
5d97898a7c
5 changed files with 19 additions and 26 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue