{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, CPP, ForeignFunctionInterface #-}moduleDevelopment.Shake.Internal.FileInfo(noFileHash ,isNoFileHash ,FileSize ,ModTime ,FileHash ,getFileHash ,getFileInfo )where
#ifndef MIN_VERSION_unix
#define MIN_VERSION_unix(a,b,c) 0
#endif

#ifndef MIN_VERSION_time
#define MIN_VERSION_time(a,b,c) 0
#endif
importData.HashableimportControl.Exception.ExtraimportDevelopment.Shake.Classes importDevelopment.Shake.Internal.FileName importqualifiedData.ByteString.Lazy.InternalasLBS(defaultChunkSize)importData.List.ExtraimportData.WordimportNumericimportSystem.IOimportForeign
#if defined(PORTABLE)
importSystem.IO.ErrorimportSystem.DirectoryimportData.Time
#elif defined(mingw32_HOST_OS)
importDevelopment.Shake.Internal.ErrorsimportControl.MonadimportqualifiedData.ByteString.Char8asBSimportForeign.C.StringimportData.Char
#else

#if MIN_VERSION_time(1,9,1)
importData.Time.ClockimportData.Fixed
#endif
importDevelopment.Shake.Internal.Errors importGHC.IO.ExceptionimportSystem.IO.ErrorimportSystem.Posix.Files.ByteString
#endif
-- A piece of file information, where 0 and 1 are special (see fileInfo* functions)newtypeFileInfo a =FileInfo Word32deriving(Typeable,Eq (FileInfo a)
Eq (FileInfo a) =>
(Int -> FileInfo a -> Int)
-> (FileInfo a -> Int) -> Hashable (FileInfo a)
Int -> FileInfo a -> Int
FileInfo a -> Int
forall a. Eq (FileInfo a)
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Int -> FileInfo a -> Int
forall a. FileInfo a -> Int
$chashWithSalt :: forall a. Int -> FileInfo a -> Int
hashWithSalt :: Int -> FileInfo a -> Int
$chash :: forall a. FileInfo a -> Int
hash :: FileInfo a -> Int
Hashable,Get (FileInfo a)
[FileInfo a] -> Put
FileInfo a -> Put
(FileInfo a -> Put)
-> Get (FileInfo a) -> ([FileInfo a] -> Put) -> Binary (FileInfo a)
forall a. Get (FileInfo a)
forall a. [FileInfo a] -> Put
forall a. FileInfo a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: forall a. FileInfo a -> Put
put :: FileInfo a -> Put
$cget :: forall a. Get (FileInfo a)
get :: Get (FileInfo a)
$cputList :: forall a. [FileInfo a] -> Put
putList :: [FileInfo a] -> Put
Binary,Ptr (FileInfo a) -> IO (FileInfo a)
Ptr (FileInfo a) -> Int -> IO (FileInfo a)
Ptr (FileInfo a) -> Int -> FileInfo a -> IO ()
Ptr (FileInfo a) -> FileInfo a -> IO ()
FileInfo a -> Int
(FileInfo a -> Int)
-> (FileInfo a -> Int)
-> (Ptr (FileInfo a) -> Int -> IO (FileInfo a))
-> (Ptr (FileInfo a) -> Int -> FileInfo a -> IO ())
-> (forall b. Ptr b -> Int -> IO (FileInfo a))
-> (forall b. Ptr b -> Int -> FileInfo a -> IO ())
-> (Ptr (FileInfo a) -> IO (FileInfo a))
-> (Ptr (FileInfo a) -> FileInfo a -> IO ())
-> Storable (FileInfo a)
forall b. Ptr b -> Int -> IO (FileInfo a)
forall b. Ptr b -> Int -> FileInfo a -> IO ()
forall a. Ptr (FileInfo a) -> IO (FileInfo a)
forall a. Ptr (FileInfo a) -> Int -> IO (FileInfo a)
forall a. Ptr (FileInfo a) -> Int -> FileInfo a -> IO ()
forall a. Ptr (FileInfo a) -> FileInfo a -> IO ()
forall a. FileInfo a -> Int
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall a b. Ptr b -> Int -> IO (FileInfo a)
forall a b. Ptr b -> Int -> FileInfo a -> IO ()
$csizeOf :: forall a. FileInfo a -> Int
sizeOf :: FileInfo a -> Int
$calignment :: forall a. FileInfo a -> Int
alignment :: FileInfo a -> Int
$cpeekElemOff :: forall a. Ptr (FileInfo a) -> Int -> IO (FileInfo a)
peekElemOff :: Ptr (FileInfo a) -> Int -> IO (FileInfo a)
$cpokeElemOff :: forall a. Ptr (FileInfo a) -> Int -> FileInfo a -> IO ()
pokeElemOff :: Ptr (FileInfo a) -> Int -> FileInfo a -> IO ()
$cpeekByteOff :: forall a b. Ptr b -> Int -> IO (FileInfo a)
peekByteOff :: forall b. Ptr b -> Int -> IO (FileInfo a)
$cpokeByteOff :: forall a b. Ptr b -> Int -> FileInfo a -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> FileInfo a -> IO ()
$cpeek :: forall a. Ptr (FileInfo a) -> IO (FileInfo a)
peek :: Ptr (FileInfo a) -> IO (FileInfo a)
$cpoke :: forall a. Ptr (FileInfo a) -> FileInfo a -> IO ()
poke :: Ptr (FileInfo a) -> FileInfo a -> IO ()
Storable,FileInfo a -> ()
(FileInfo a -> ()) -> NFData (FileInfo a)
forall a. FileInfo a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. FileInfo a -> ()
rnf :: FileInfo a -> ()
NFData)noFileHash ::FileHash noFileHash :: FileHash
noFileHash =Word32 -> FileHash
forall a. Word32 -> FileInfo a
FileInfo Word32
1-- Equal to nothingisNoFileHash ::FileHash ->BoolisNoFileHash :: FileHash -> Bool
isNoFileHash (FileInfo Word32
i )=Word32
i Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
1fileInfo ::Word32->FileInfo a fileInfo :: forall a. Word32 -> FileInfo a
fileInfo Word32
a =Word32 -> FileInfo a
forall a. Word32 -> FileInfo a
FileInfo (Word32 -> FileInfo a) -> Word32 -> FileInfo a
forall a b. (a -> b) -> a -> b
$ifWord32
a Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>Word32
forall a. Bounded a => a
maxBoundWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
-Word32
2thenWord32
a elseWord32
a Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
2instanceShow(FileInfo a )whereshow :: FileInfo a -> String
show (FileInfo Word32
x )|Word32
x Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
0=String
"EQ"|Word32
x Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
1=String
"NEQ"|Bool
otherwise=String
"0x"String -> ShowS
forall a. [a] -> [a] -> [a]
++ShowS
upper(Word32 -> ShowS
forall a. Integral a => a -> ShowS
showHex(Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
-Word32
2)String
"")instanceEq(FileInfo a )whereFileInfo Word32
a == :: FileInfo a -> FileInfo a -> Bool
==FileInfo Word32
b |Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
0Bool -> Bool -> Bool
||Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
0=Bool
True|Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
1Bool -> Bool -> Bool
||Word32
b Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
1=Bool
False|Bool
otherwise=Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
==Word32
b dataFileInfoHash ;typeFileHash =FileInfo FileInfoHash dataFileInfoMod ;typeModTime =FileInfo FileInfoMod dataFileInfoSize ;typeFileSize =FileInfo FileInfoSize getFileHash ::FileName ->IOFileHash getFileHash :: FileName -> IO FileHash
getFileHash FileName
x =String -> IOMode -> (Handle -> IO FileHash) -> IO FileHash
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile(FileName -> String
fileNameToString FileName
x )IOMode
ReadMode((Handle -> IO FileHash) -> IO FileHash)
-> (Handle -> IO FileHash) -> IO FileHash
forall a b. (a -> b) -> a -> b
$\Handle
h ->Int -> (Ptr Any -> IO FileHash) -> IO FileHash
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytesInt
LBS.defaultChunkSize((Ptr Any -> IO FileHash) -> IO FileHash)
-> (Ptr Any -> IO FileHash) -> IO FileHash
forall a b. (a -> b) -> a -> b
$\Ptr Any
ptr ->Handle -> Ptr Any -> Int -> IO FileHash
forall {a} {a}. Handle -> Ptr a -> Int -> IO (FileInfo a)
go Handle
h Ptr Any
ptr (() -> Int
forall a. Hashable a => a -> Int
hash())wherego :: Handle -> Ptr a -> Int -> IO (FileInfo a)
go Handle
h Ptr a
ptr Int
salt =doInt
n <-Handle -> Ptr a -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufSomeHandle
h Ptr a
ptr Int
LBS.defaultChunkSizeifInt
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0thenFileInfo a -> IO (FileInfo a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure(FileInfo a -> IO (FileInfo a)) -> FileInfo a -> IO (FileInfo a)
forall a b. (a -> b) -> a -> b
$!Word32 -> FileInfo a
forall a. Word32 -> FileInfo a
fileInfo (Word32 -> FileInfo a) -> Word32 -> FileInfo a
forall a b. (a -> b) -> a -> b
$Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
salt elseHandle -> Ptr a -> Int -> IO (FileInfo a)
go Handle
h Ptr a
ptr (Int -> IO (FileInfo a)) -> IO Int -> IO (FileInfo a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<Ptr a -> Int -> Int -> IO Int
forall a. Ptr a -> Int -> Int -> IO Int
hashPtrWithSaltPtr a
ptr Int
n Int
salt -- If the result isn't strict then we are referencing a much bigger structure,-- and it causes a space leak I don't really understand on Linux when running-- the 'tar' test, followed by the 'benchmark' test.-- See this blog post: https://neilmitchell.blogspot.co.uk/2015/09/three-space-leaks.htmlresult ::Word32->Word32->IO(Maybe(ModTime ,FileSize ))result :: Word32 -> Word32 -> IO (Maybe (ModTime, FileSize))
result Word32
x Word32
y =doModTime
x <-ModTime -> IO ModTime
forall a. a -> IO a
evaluate(ModTime -> IO ModTime) -> ModTime -> IO ModTime
forall a b. (a -> b) -> a -> b
$Word32 -> ModTime
forall a. Word32 -> FileInfo a
fileInfo Word32
x FileSize
y <-FileSize -> IO FileSize
forall a. a -> IO a
evaluate(FileSize -> IO FileSize) -> FileSize -> IO FileSize
forall a b. (a -> b) -> a -> b
$Word32 -> FileSize
forall a. Word32 -> FileInfo a
fileInfo Word32
y Maybe (ModTime, FileSize) -> IO (Maybe (ModTime, FileSize))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Maybe (ModTime, FileSize) -> IO (Maybe (ModTime, FileSize)))
-> Maybe (ModTime, FileSize) -> IO (Maybe (ModTime, FileSize))
forall a b. (a -> b) -> a -> b
$(ModTime, FileSize) -> Maybe (ModTime, FileSize)
forall a. a -> Maybe a
Just(ModTime
x ,FileSize
y )-- | True = allow directory, False = disallowgetFileInfo ::Bool->FileName ->IO(Maybe(ModTime ,FileSize ))
#if defined(PORTABLE)
-- Portable fallbackgetFileInfoallowDirx=handleBoolisDoesNotExistError(const$pureNothing)$doletfile=fileNameToStringxtime<-getModificationTimefilesize<-withFilefileReadModehFileSizeresult(extractFileTimetime)(fromIntegralsize)extractFileTime::UTCTime->Word32extractFileTime=floor.fromRational.toRational.utctDayTime
#elif defined(mingw32_HOST_OS)
-- Directly against the Win32 API, twice as fast as the portable versiongetFileInfoallowDirx=BS.useAsCString(fileNameToByteStringx)$\file->alloca_WIN32_FILE_ATTRIBUTE_DATA$\fad->dores<-c_GetFileAttributesExAfile0fadletpeek=docode<-peekFileAttributesfadifnotallowDir&&testBitcode4thenthrowIO$errorDirectoryNotFile$fileNameToStringxelsejoin$liftM2result(peekLastWriteTimeLowfad)(peekFileSizeLowfad)ifresthenpeekelseifBS.any(>=chr0x80)(fileNameToByteStringx)thenwithCWString(fileNameToStringx)$\file->dores<-c_GetFileAttributesExWfile0fadifresthenpeekelsepureNothingelsepureNothing
#ifdef x86_64_HOST_ARCH
#define CALLCONV ccall
#else
#define CALLCONV stdcall
#endif
foreignimportCALLCONVunsafe"Windows.h GetFileAttributesExA"c_GetFileAttributesExA::CString->Int32->PtrWIN32_FILE_ATTRIBUTE_DATA->IOBoolforeignimportCALLCONVunsafe"Windows.h GetFileAttributesExW"c_GetFileAttributesExW::CWString->Int32->PtrWIN32_FILE_ATTRIBUTE_DATA->IOBooldataWIN32_FILE_ATTRIBUTE_DATAalloca_WIN32_FILE_ATTRIBUTE_DATA::(PtrWIN32_FILE_ATTRIBUTE_DATA->IOa)->IOaalloca_WIN32_FILE_ATTRIBUTE_DATAact=allocaBytessize_WIN32_FILE_ATTRIBUTE_DATAactwheresize_WIN32_FILE_ATTRIBUTE_DATA=36peekFileAttributes::PtrWIN32_FILE_ATTRIBUTE_DATA->IOWord32peekFileAttributesp=peekByteOffpindex_WIN32_FILE_ATTRIBUTE_DATA_dwFileAttributeswhereindex_WIN32_FILE_ATTRIBUTE_DATA_dwFileAttributes=0peekLastWriteTimeLow::PtrWIN32_FILE_ATTRIBUTE_DATA->IOWord32peekLastWriteTimeLowp=peekByteOffpindex_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTimewhereindex_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime=20peekFileSizeLow::PtrWIN32_FILE_ATTRIBUTE_DATA->IOWord32peekFileSizeLowp=peekByteOffpindex_WIN32_FILE_ATTRIBUTE_DATA_nFileSizeLowwhereindex_WIN32_FILE_ATTRIBUTE_DATA_nFileSizeLow=32
#else
-- Unix versiongetFileInfo :: Bool -> FileName -> IO (Maybe (ModTime, FileSize))
getFileInfo Bool
allowDir FileName
x =(IOError -> Bool)
-> (IOError -> IO (Maybe (ModTime, FileSize)))
-> IO (Maybe (ModTime, FileSize))
-> IO (Maybe (ModTime, FileSize))
forall e a.
Exception e =>
(e -> Bool) -> (e -> IO a) -> IO a -> IO a
handleBoolIOError -> Bool
isDoesNotExistError' (IO (Maybe (ModTime, FileSize))
-> IOError -> IO (Maybe (ModTime, FileSize))
forall a b. a -> b -> a
const(IO (Maybe (ModTime, FileSize))
 -> IOError -> IO (Maybe (ModTime, FileSize)))
-> IO (Maybe (ModTime, FileSize))
-> IOError
-> IO (Maybe (ModTime, FileSize))
forall a b. (a -> b) -> a -> b
$Maybe (ModTime, FileSize) -> IO (Maybe (ModTime, FileSize))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureMaybe (ModTime, FileSize)
forall a. Maybe a
Nothing)(IO (Maybe (ModTime, FileSize)) -> IO (Maybe (ModTime, FileSize)))
-> IO (Maybe (ModTime, FileSize)) -> IO (Maybe (ModTime, FileSize))
forall a b. (a -> b) -> a -> b
$doFileStatus
s <-RawFilePath -> IO FileStatus
getFileStatus(RawFilePath -> IO FileStatus) -> RawFilePath -> IO FileStatus
forall a b. (a -> b) -> a -> b
$FileName -> RawFilePath
fileNameToByteString FileName
x ifBool -> Bool
notBool
allowDir Bool -> Bool -> Bool
&&FileStatus -> Bool
isDirectoryFileStatus
s thenSomeException -> IO (Maybe (ModTime, FileSize))
forall (m :: * -> *) a. MonadIO m => SomeException -> m a
throwM (SomeException -> IO (Maybe (ModTime, FileSize)))
-> SomeException -> IO (Maybe (ModTime, FileSize))
forall a b. (a -> b) -> a -> b
$String -> SomeException
errorDirectoryNotFile (String -> SomeException) -> String -> SomeException
forall a b. (a -> b) -> a -> b
$FileName -> String
fileNameToString FileName
x elseWord32 -> Word32 -> IO (Maybe (ModTime, FileSize))
result (FileStatus -> Word32
extractFileTime FileStatus
s )(FileOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral(FileOffset -> Word32) -> FileOffset -> Word32
forall a b. (a -> b) -> a -> b
$FileStatus -> FileOffset
fileSizeFileStatus
s )whereisDoesNotExistError' :: IOError -> Bool
isDoesNotExistError' IOError
e =IOError -> Bool
isDoesNotExistErrorIOError
e Bool -> Bool -> Bool
||IOError -> IOErrorType
ioeGetErrorTypeIOError
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
==IOErrorType
InappropriateTypeextractFileTime ::FileStatus->Word32
#if MIN_VERSION_unix(2,6,0)
#if MIN_VERSION_time(1,9,1)
extractFileTime :: FileStatus -> Word32
extractFileTime =Integer -> Word32
forall a. Num a => Integer -> a
fromInteger(Integer -> Word32)
-> (FileStatus -> Integer) -> FileStatus -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\(MkFixedInteger
x )->Integer
x )(Fixed E12 -> Integer)
-> (FileStatus -> Fixed E12) -> FileStatus -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NominalDiffTime -> Fixed E12
nominalDiffTimeToSeconds(NominalDiffTime -> Fixed E12)
-> (FileStatus -> NominalDiffTime) -> FileStatus -> Fixed E12
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FileStatus -> NominalDiffTime
modificationTimeHiRes
#else
extractFileTimex=ceiling$modificationTimeHiResx*1e4
#endif
#else
extractFileTimex=fromIntegral$fromEnum$modificationTimex
#endif

#endif