    {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, CPP, ForeignFunctionInterface #-}

    module Development.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

    import Data.Hashable
    import Control.Exception.Extra
    import Development.Shake.Classes
    import Development.Shake.Internal.FileName
    import qualified Data.ByteString.Lazy.Internal as LBS (defaultChunkSize)
    import Data.List.Extra
    import Data.Word
    import Numeric
    import System.IO
    import Foreign

    #if defined(PORTABLE)
    import System.IO.Error
    import System.Directory
    import Data.Time

    #elif defined(mingw32_HOST_OS)
    import Development.Shake.Internal.Errors
    import Control.Monad
    import qualified Data.ByteString.Char8 as BS
    import Foreign.C.String
    import Data.Char

    #else

    #if MIN_VERSION_time(1,9,1)
    import Data.Time.Clock
    import Data.Fixed
    #endif

    import Development.Shake.Internal.Errors
    import GHC.IO.Exception
    import System.IO.Error
    import System.Posix.Files.ByteString
    #endif

    -- A piece of file information, where 0 and 1 are special (see fileInfo* functions)
    newtype FileInfo a = FileInfo Word32
        deriving (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 nothing

    isNoFileHash :: FileHash -> Bool
    isNoFileHash :: FileHash -> Bool
    isNoFileHash (FileInfo Word32
    i) = Word32
    i Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    1

    fileInfo :: 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
    $ if Word32
    a Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word32
    forall a. Bounded a => a
    maxBound Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Word32
    2 then Word32
    a else Word32
    a Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    2

    instance Show (FileInfo a) where
        show :: 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
    xWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    -Word32
    2) String
    "")

    instance Eq (FileInfo a) where
        FileInfo Word32
    a == :: FileInfo a -> FileInfo a -> Bool
    == FileInfo Word32
    b
            | Word32
    a Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    0 Bool -> 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
    1 Bool -> 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

    data FileInfoHash; type FileHash = FileInfo FileInfoHash
    data FileInfoMod ; type ModTime  = FileInfo FileInfoMod
    data FileInfoSize; type FileSize = FileInfo FileInfoSize

    getFileHash :: FileName -> IO FileHash
    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 (ZonkAny 0) -> IO FileHash) -> IO FileHash
    forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes Int
    LBS.defaultChunkSize ((Ptr (ZonkAny 0) -> IO FileHash) -> IO FileHash)
    -> (Ptr (ZonkAny 0) -> IO FileHash) -> IO FileHash
    forall a b. (a -> b) -> a -> b
    $ \Ptr (ZonkAny 0)
    ptr ->
            Handle -> Ptr (ZonkAny 0) -> Int -> IO FileHash
    forall {a} {a}. Handle -> Ptr a -> Int -> IO (FileInfo a)
    go Handle
    h Ptr (ZonkAny 0)
    ptr (() -> Int
    forall a. Hashable a => a -> Int
    hash ())
        where
            go :: Handle -> Ptr a -> Int -> IO (FileInfo a)
    go Handle
    h Ptr a
    ptr Int
    salt = do
                n <- Handle -> Ptr a -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    hGetBufSome Handle
    h Ptr a
    ptr Int
    LBS.defaultChunkSize
                if n == 0 then
                    pure $! fileInfo $ fromIntegral salt
                else
                    go h ptr =<< hashPtrWithSalt ptr 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.html
    result :: Word32 -> Word32 -> IO (Maybe (ModTime, FileSize))
    result :: Word32 -> Word32 -> IO (Maybe (ModTime, FileSize))
    result Word32
    x Word32
    y = do
        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
        y <- evaluate $ fileInfo y
        pure $ Just (x, y)

    -- | True = allow directory, False = disallow
    getFileInfo :: Bool -> FileName -> IO (Maybe (ModTime, FileSize))

    #if defined(PORTABLE)
    -- Portable fallback
    getFileInfo allowDir x = handleBool isDoesNotExistError (const $ pure Nothing) $ do
        let file = fileNameToString x
        time <- getModificationTime file
        size <- withFile file ReadMode hFileSize
        result (extractFileTime time) (fromIntegral size)

    extractFileTime :: UTCTime -> Word32
    extractFileTime = floor . fromRational . toRational . utctDayTime

    #elif defined(mingw32_HOST_OS)
    -- Directly against the Win32 API, twice as fast as the portable version
    getFileInfo allowDir x = BS.useAsCString (fileNameToByteString x) $ \file ->
        alloca_WIN32_FILE_ATTRIBUTE_DATA $ \fad -> do
            res <- c_GetFileAttributesExA file 0 fad
            let peek = do
                    code <- peekFileAttributes fad
                    if not allowDir && testBit code 4 then
                        throwIO $ errorDirectoryNotFile $ fileNameToString x
                     else
                        join $ liftM2 result (peekLastWriteTimeLow fad) (peekFileSizeLow fad)
            if res then
                peek
             else if BS.any (>= chr 0x80) (fileNameToByteString x) then withCWString (fileNameToString x) $ \file -> do
                res <- c_GetFileAttributesExW file 0 fad
                if res then peek else pure Nothing
             else
                pure Nothing

    #ifdef x86_64_HOST_ARCH
    #define CALLCONV ccall
    #else
    #define CALLCONV stdcall
    #endif

    foreign import CALLCONV unsafe "Windows.h GetFileAttributesExA" c_GetFileAttributesExA :: CString  -> Int32 -> Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO Bool
    foreign import CALLCONV unsafe "Windows.h GetFileAttributesExW" c_GetFileAttributesExW :: CWString -> Int32 -> Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO Bool

    data WIN32_FILE_ATTRIBUTE_DATA

    alloca_WIN32_FILE_ATTRIBUTE_DATA :: (Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO a) -> IO a
    alloca_WIN32_FILE_ATTRIBUTE_DATA act = allocaBytes size_WIN32_FILE_ATTRIBUTE_DATA act
        where size_WIN32_FILE_ATTRIBUTE_DATA = 36

    peekFileAttributes :: Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO Word32
    peekFileAttributes p = peekByteOff p index_WIN32_FILE_ATTRIBUTE_DATA_dwFileAttributes
        where index_WIN32_FILE_ATTRIBUTE_DATA_dwFileAttributes = 0

    peekLastWriteTimeLow :: Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO Word32
    peekLastWriteTimeLow p = peekByteOff p index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime
        where index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime = 20

    peekFileSizeLow :: Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO Word32
    peekFileSizeLow p = peekByteOff p index_WIN32_FILE_ATTRIBUTE_DATA_nFileSizeLow
        where index_WIN32_FILE_ATTRIBUTE_DATA_nFileSizeLow = 32

    #else
    -- Unix version
    getFileInfo :: 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
    handleBool IOError -> 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
    pure Maybe (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
    $ do
        s <- RawFilePath -> IO FileStatus
    getFileStatus (RawFilePath -> IO FileStatus) -> RawFilePath -> IO FileStatus
    forall a b. (a -> b) -> a -> b
    $ FileName -> RawFilePath
    fileNameToByteString FileName
    x
        if not allowDir && isDirectory s then
            throwM $ errorDirectoryNotFile $ fileNameToString x
         else
            result (extractFileTime s) (fromIntegral $ fileSize s)
        where
            isDoesNotExistError' :: IOError -> Bool
    isDoesNotExistError' IOError
    e =
                IOError -> Bool
    isDoesNotExistError IOError
    e Bool -> Bool -> Bool
    || IOError -> IOErrorType
    ioeGetErrorType IOError
    e IOErrorType -> IOErrorType -> Bool
    forall a. Eq a => a -> a -> Bool
    == IOErrorType
    InappropriateType

    extractFileTime :: 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
    . (\(MkFixed Integer
    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
    extractFileTime x = ceiling $ modificationTimeHiRes x * 1e4
    #endif
    #else
    extractFileTime x = fromIntegral $ fromEnum $ modificationTime x
    #endif

    #endif