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

module Development.Shake.FileTime(
    FileTime, fileTimeNone,
    getModTimeError, getModTimeMaybe
    ) where

import Development.Shake.Classes
import Development.Shake.Util
import Data.Int
import qualified Data.ByteString.Char8 as BS
import System.IO.Error
import Control.Exception

-- Required for Portable
import System.Directory
#if __GLASGOW_HASKELL__ >= 706
import Data.Time
#else
import System.Time
#endif

-- Required for non-portable Windows
#if defined(mingw32_HOST_OS)
import Foreign
import Foreign.C.Types
type WIN32_FILE_ATTRIBUTE_DATA = Ptr ()
type LPCSTR = Ptr CChar
foreign import stdcall unsafe "Windows.h GetFileAttributesExA" c_getFileAttributesEx :: LPCSTR -> Int32 -> WIN32_FILE_ATTRIBUTE_DATA -> IO Bool
size_WIN32_FILE_ATTRIBUTE_DATA = 36
index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime = 20
#endif

-- Required for non-portable Unix (since it requires a non-standard library, only require if not portable)
#if !defined(PORTABLE) && !defined(mingw32_HOST_OS)
import System.Posix.Files.ByteString
#endif


-- FileTime is an optimised type, which stores some portion of the file time,
-- or maxBound to indicate there is no valid time. The moral type is @Maybe Datetime@
-- but it needs to be more efficient.
newtype FileTime = FileTime Int32
    deriving (Typeable,Eq,Hashable,Binary,Show,NFData)


fileTime :: Int32 -> FileTime
fileTime x = FileTime $ if x == maxBound then maxBound - 1 else x

fileTimeNone :: FileTime
fileTimeNone = FileTime maxBound


getModTimeError :: String -> BSU -> IO FileTime
getModTimeError msg x = do
    res <- getModTimeMaybe x
    case res of
        -- Make sure you raise an error in IO, not return a value which will error later
        Nothing -> error $ msg ++ "\n  " ++ unpackU x
        Just x -> return x


getModTimeMaybe :: BSU -> IO (Maybe FileTime)
#if defined(PORTABLE)
getModTimeMaybe x = getModTimeMaybePortable x
#elif defined(mingw32_HOST_OS)
getModTimeMaybe x = getModTimeMaybeWindows x
#else
getModTimeMaybe x = getModTimeMaybeUnix x
#endif



-- Portable fallback
getModTimeMaybePortable :: BSU -> IO (Maybe FileTime)
getModTimeMaybePortable x = handleJust (\e -> if isDoesNotExistError e then Just () else Nothing) (const $ return Nothing) $ do
    time <- getModificationTime $ unpackU x
#if __GLASGOW_HASKELL__ >= 706
    return $ Just $ fileTime $ floor $ utctDayTime time
#else
    let TOD t _ = time
    return $ Just $ fileTime $ fromIntegral t
#endif


-- Directly against the Win32 API, twice as fast as the portable version
#if defined(mingw32_HOST_OS)
getModTimeMaybeWindows :: BSU -> IO (Maybe FileTime)
getModTimeMaybeWindows x = BS.useAsCString (unpackU_ x) $ \file ->
    allocaBytes size_WIN32_FILE_ATTRIBUTE_DATA $ \info -> do
        res <- c_getFileAttributesEx file 0 info
        if res then do
            -- Technically a Word32, but we can treak it as an Int32 for peek
            dword <- peekByteOff info index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime :: IO Int32
            return $ Just $ fileTime dword
         else if requireU x then
            getModTimeMaybePortable x
         else
            return Nothing
#endif


-- Unix version
#if !defined(PORTABLE) && !defined(mingw32_HOST_OS)
getModTimeMaybeUnix :: BSU -> IO (Maybe FileTime)
getModTimeMaybeUnix x = handleJust (\e -> if isDoesNotExistError e then Just () else Nothing) (const $ return Nothing) $ do
    t <- fmap modificationTime $ getFileStatus $ unpackU_ x
    return $ Just $ fileTime $ fromIntegral $ fromEnum t
#endif
