{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, CPP, ForeignFunctionInterface #-}moduleDevelopment.Shake.Internal.FileInfo(noFileHash ,isNoFileHash ,FileSize ,ModTime ,FileHash ,getFileHash ,getFileInfo )whereimportData.HashableimportControl.Exception.ExtraimportDevelopment.Shake.Classes importDevelopment.Shake.Internal.FileName importqualifiedData.ByteString.Lazy.InternalasLBS(defaultChunkSize)importData.CharimportData.WordimportNumericimportSystem.IOimportForeign#if defined(PORTABLE)
importSystem.IO.ErrorimportSystem.DirectoryimportData.Time#elif defined(mingw32_HOST_OS)
importDevelopment.Shake.Internal.ErrorsimportControl.MonadimportqualifiedData.ByteString.Char8asBSimportForeign.C.String#else
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,Hashable,Binary,Storable,NFData)noFileHash::FileHash noFileHash =FileInfo 1-- Equal to nothingisNoFileHash::FileHash ->BoolisNoFileHash (FileInfo i )=i ==1fileInfo::Word32->FileInfo a fileInfo a =FileInfo $ifa >maxBound-2thena elsea +2instanceShow(FileInfo a )whereshow (FileInfo x )|x ==0="EQ"|x ==1="NEQ"|otherwise="0x"++maptoUpper(showHex(x -2)"")instanceEq(FileInfo a )whereFileInfo a == FileInfo b |a ==0||b ==0=True|a ==1||b ==1=False|otherwise=a ==b dataFileInfoHash ;typeFileHash =FileInfo FileInfoHash dataFileInfoMod ;typeModTime =FileInfo FileInfoMod dataFileInfoSize ;typeFileSize =FileInfo FileInfoSize getFileHash::FileName ->IOFileHash getFileHash x =withFile(fileNameToString x )ReadMode$\h ->allocaBytesLBS.defaultChunkSize$\ptr ->go h ptr (hash())wherego h ptr salt =don <-hGetBufSomeh ptr LBS.defaultChunkSizeifn ==0thenreturn$!fileInfo $fromIntegralsalt elsego h ptr =<<hashPtrWithSaltptr n 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 x y =dox <-evaluate$fileInfo x y <-evaluate$fileInfo y return$Just(x ,y )getFileInfo::FileName ->IO(Maybe(ModTime ,FileSize ))#if defined(PORTABLE)
-- Portable fallbackgetFileInfox=handleBoolisDoesNotExistError(const$returnNothing)$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 versiongetFileInfox=BS.useAsCString(fileNameToByteStringx)$\file->alloca_WIN32_FILE_ATTRIBUTE_DATA$\fad->dores<-c_GetFileAttributesExAfile0fadletpeek=docode<-peekFileAttributesfadiftestBitcode4thenthrowIO$errorDirectoryNotFile$fileNameToStringxelsejoin$liftM2result(peekLastWriteTimeLowfad)(peekFileSizeLowfad)ifresthenpeekelseifBS.any(>=chr0x80)(fileNameToByteStringx)thenwithCWString(fileNameToStringx)$\file->dores<-c_GetFileAttributesExWfile0fadifresthenpeekelsereturnNothingelsereturnNothing#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 x =handleBoolisDoesNotExistError' (const$returnNothing)$dos <-getFileStatus$fileNameToByteString x ifisDirectorys thenthrowM $errorDirectoryNotFile $fileNameToString x elseresult (extractFileTime s )(fromIntegral$fileSizes )whereisDoesNotExistError' e =isDoesNotExistErrore ||ioeGetErrorTypee ==InappropriateTypeextractFileTime::FileStatus->Word32#ifndef MIN_VERSION_unix
#define MIN_VERSION_unix(a,b,c) 0
#endif
#if MIN_VERSION_unix(2,6,0)
extractFileTime x =ceiling$modificationTimeHiResx *1e4-- precision of 0.1ms#else
extractFileTimex=fromIntegral$fromEnum$modificationTimex#endif
#endif