    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    module Distribution.Compat.Time
           ( ModTime(..) -- Needed for testing
           , getModTime, getFileAge, getCurTime
           , posixSecondsToModTime
           , calibrateMtimeChangeDelay )
           where

    import Prelude ()
    import Distribution.Compat.Prelude

    import System.Directory ( getModificationTime )

    import Distribution.Simple.Utils ( withTempDirectory )
    import Distribution.Verbosity ( silent )

    import System.FilePath

    import Data.Time.Clock.POSIX ( POSIXTime, getPOSIXTime )
    import Data.Time             ( diffUTCTime, getCurrentTime )
    import Data.Time.Clock.POSIX ( posixDayLength )

    #if defined mingw32_HOST_OS

    import qualified Prelude
    import Data.Bits          ((.|.), unsafeShiftL)
    #if MIN_VERSION_base(4,7,0)
    import Data.Bits          (finiteBitSize)
    #else
    import Data.Bits          (bitSize)
    #endif

    import Foreign            ( allocaBytes, peekByteOff )
    import System.IO.Error    ( mkIOError, doesNotExistErrorType )
    import System.Win32.Types ( BOOL, DWORD, LPCTSTR, LPVOID, withTString )

    #else

    import System.Posix.Files ( FileStatus, getFileStatus )

    #if MIN_VERSION_unix(2,6,0)
    import System.Posix.Files ( modificationTimeHiRes )
    #else
    import System.Posix.Files ( modificationTime )
    #endif

    #endif

    -- | An opaque type representing a file's modification time, represented
    -- internally as a 64-bit unsigned integer in the Windows UTC format.
    newtype ModTime = ModTime Word64
                    deriving (Get ModTime
    [ModTime] -> Put
    ModTime -> Put
    (ModTime -> Put)
    -> Get ModTime -> ([ModTime] -> Put) -> Binary ModTime
    forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
    $cput :: ModTime -> Put
    put :: ModTime -> Put
    $cget :: Get ModTime
    get :: Get ModTime
    $cputList :: [ModTime] -> Put
    putList :: [ModTime] -> Put
    Binary, (forall x. ModTime -> Rep ModTime x)
    -> (forall x. Rep ModTime x -> ModTime) -> Generic ModTime
    forall x. Rep ModTime x -> ModTime
    forall x. ModTime -> Rep ModTime x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. ModTime -> Rep ModTime x
    from :: forall x. ModTime -> Rep ModTime x
    $cto :: forall x. Rep ModTime x -> ModTime
    to :: forall x. Rep ModTime x -> ModTime
    Generic, ModTime
    ModTime -> ModTime -> Bounded ModTime
    forall a. a -> a -> Bounded a
    $cminBound :: ModTime
    minBound :: ModTime
    $cmaxBound :: ModTime
    maxBound :: ModTime
    Bounded, ModTime -> ModTime -> Bool
    (ModTime -> ModTime -> Bool)
    -> (ModTime -> ModTime -> Bool) -> Eq ModTime
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ModTime -> ModTime -> Bool
    == :: ModTime -> ModTime -> Bool
    $c/= :: ModTime -> ModTime -> Bool
    /= :: ModTime -> ModTime -> Bool
    Eq, Eq ModTime
    Eq ModTime
    -> (ModTime -> ModTime -> Ordering)
    -> (ModTime -> ModTime -> Bool)
    -> (ModTime -> ModTime -> Bool)
    -> (ModTime -> ModTime -> Bool)
    -> (ModTime -> ModTime -> Bool)
    -> (ModTime -> ModTime -> ModTime)
    -> (ModTime -> ModTime -> ModTime)
    -> Ord ModTime
    ModTime -> ModTime -> Bool
    ModTime -> ModTime -> Ordering
    ModTime -> ModTime -> ModTime
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ModTime -> ModTime -> Ordering
    compare :: ModTime -> ModTime -> Ordering
    $c< :: ModTime -> ModTime -> Bool
    < :: ModTime -> ModTime -> Bool
    $c<= :: ModTime -> ModTime -> Bool
    <= :: ModTime -> ModTime -> Bool
    $c> :: ModTime -> ModTime -> Bool
    > :: ModTime -> ModTime -> Bool
    $c>= :: ModTime -> ModTime -> Bool
    >= :: ModTime -> ModTime -> Bool
    $cmax :: ModTime -> ModTime -> ModTime
    max :: ModTime -> ModTime -> ModTime
    $cmin :: ModTime -> ModTime -> ModTime
    min :: ModTime -> ModTime -> ModTime
    Ord, Typeable)

    instance Structured ModTime

    instance Show ModTime where
      show :: ModTime -> String
    show (ModTime Word64
    x) = Word64 -> String
    forall a. Show a => a -> String
    show Word64
    x

    instance Read ModTime where
      readsPrec :: Int -> ReadS ModTime
    readsPrec Int
    p String
    str = ((Word64, String) -> (ModTime, String))
    -> [(Word64, String)] -> [(ModTime, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Word64 -> ModTime) -> (Word64, String) -> (ModTime, String)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first Word64 -> ModTime
    ModTime) (Int -> ReadS Word64
    forall a. Read a => Int -> ReadS a
    readsPrec Int
    p String
    str)

    -- | Return modification time of the given file. Works around the low clock
    -- resolution problem that 'getModificationTime' has on GHC < 7.8.
    --
    -- This is a modified version of the code originally written for Shake by Neil
    -- Mitchell. See module Development.Shake.FileInfo.
    getModTime :: FilePath -> IO ModTime

    #if defined mingw32_HOST_OS

    -- Directly against the Win32 API.
    getModTime path = allocaBytes size_WIN32_FILE_ATTRIBUTE_DATA $ \info -> do
      res <- getFileAttributesEx path info
      if not res
        then do
          let err = mkIOError doesNotExistErrorType
                    "Distribution.Compat.Time.getModTime"
                    Nothing (Just path)
          ioError err
        else do
          dwLow  <- peekByteOff info
                    index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime
          dwHigh <- peekByteOff info
                    index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwHighDateTime
    #if MIN_VERSION_base(4,7,0)
          let qwTime =
                (fromIntegral (dwHigh :: DWORD) `unsafeShiftL` finiteBitSize dwHigh)
                .|. (fromIntegral (dwLow :: DWORD))
    #else
          let qwTime =
                (fromIntegral (dwHigh :: DWORD) `unsafeShiftL` bitSize dwHigh)
                .|. (fromIntegral (dwLow :: DWORD))
    #endif
          return $! ModTime (qwTime :: Word64)

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

    foreign import CALLCONV "windows.h GetFileAttributesExW"
      c_getFileAttributesEx :: LPCTSTR -> Int32 -> LPVOID -> Prelude.IO BOOL

    getFileAttributesEx :: String -> LPVOID -> IO BOOL
    getFileAttributesEx path lpFileInformation =
      withTString path $ \c_path ->
          c_getFileAttributesEx c_path getFileExInfoStandard lpFileInformation

    getFileExInfoStandard :: Int32
    getFileExInfoStandard = 0

    size_WIN32_FILE_ATTRIBUTE_DATA :: Int
    size_WIN32_FILE_ATTRIBUTE_DATA = 36

    index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime :: Int
    index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime = 20

    index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwHighDateTime :: Int
    index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwHighDateTime = 24

    #else

    -- Directly against the unix library.
    getModTime :: String -> IO ModTime
    getModTime String
    path = do
        FileStatus
    st <- String -> IO FileStatus
    getFileStatus String
    path
        ModTime -> IO ModTime
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModTime -> IO ModTime) -> ModTime -> IO ModTime
    forall a b. (a -> b) -> a -> b
    $! (FileStatus -> ModTime
    extractFileTime FileStatus
    st)

    extractFileTime :: FileStatus -> ModTime
    extractFileTime :: FileStatus -> ModTime
    extractFileTime FileStatus
    x = NominalDiffTime -> ModTime
    posixTimeToModTime (FileStatus -> NominalDiffTime
    modificationTimeHiRes FileStatus
    x)

    #endif

    windowsTick, secToUnixEpoch :: Word64
    windowsTick :: Word64
    windowsTick    = Word64
    10000000
    secToUnixEpoch :: Word64
    secToUnixEpoch = Word64
    11644473600

    -- | Convert POSIX seconds to ModTime.
    posixSecondsToModTime :: Int64 -> ModTime
    posixSecondsToModTime :: Int64 -> ModTime
    posixSecondsToModTime Int64
    s =
      Word64 -> ModTime
    ModTime (Word64 -> ModTime) -> Word64 -> ModTime
    forall a b. (a -> b) -> a -> b
    $ ((Int64 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    s :: Word64) Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    + Word64
    secToUnixEpoch) Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    * Word64
    windowsTick

    -- | Convert 'POSIXTime' to 'ModTime'.
    posixTimeToModTime :: POSIXTime -> ModTime
    posixTimeToModTime :: NominalDiffTime -> ModTime
    posixTimeToModTime NominalDiffTime
    p = Word64 -> ModTime
    ModTime (Word64 -> ModTime) -> Word64 -> ModTime
    forall a b. (a -> b) -> a -> b
    $ (NominalDiffTime -> Word64
    forall b. Integral b => NominalDiffTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling (NominalDiffTime -> Word64) -> NominalDiffTime -> Word64
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime
    p NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    1e7) -- 100 ns precision
                           Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    + (Word64
    secToUnixEpoch Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    * Word64
    windowsTick)

    -- | Return age of given file in days.
    getFileAge :: FilePath -> IO Double
    getFileAge :: String -> IO Double
    getFileAge String
    file = do
      UTCTime
    t0 <- String -> IO UTCTime
    getModificationTime String
    file
      UTCTime
    t1 <- IO UTCTime
    getCurrentTime
      Double -> IO Double
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Double -> IO Double) -> Double -> IO Double
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> Double
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac (UTCTime
    t1 UTCTime -> UTCTime -> NominalDiffTime
    `diffUTCTime` UTCTime
    t0) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / NominalDiffTime -> Double
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac NominalDiffTime
    posixDayLength

    -- | Return the current time as 'ModTime'.
    getCurTime :: IO ModTime
    getCurTime :: IO ModTime
    getCurTime = NominalDiffTime -> ModTime
    posixTimeToModTime (NominalDiffTime -> ModTime) -> IO NominalDiffTime -> IO ModTime
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` IO NominalDiffTime
    getPOSIXTime -- Uses 'gettimeofday'.

    -- | Based on code written by Neil Mitchell for Shake. See
    -- 'sleepFileTimeCalibrate' in 'Test.Type'.  Returns a pair
    -- of microsecond values: first, the maximum delay seen, and the
    -- recommended delay to use before testing for file modification change.
    -- The returned delay is never smaller
    -- than 10 ms, but never larger than 1 second.
    calibrateMtimeChangeDelay :: IO (Int, Int)
    calibrateMtimeChangeDelay :: IO (Int, Int)
    calibrateMtimeChangeDelay =
      Verbosity
    -> String -> String -> (String -> IO (Int, Int)) -> IO (Int, Int)
    forall a. Verbosity -> String -> String -> (String -> IO a) -> IO a
    withTempDirectory Verbosity
    silent String
    "." String
    "calibration-" ((String -> IO (Int, Int)) -> IO (Int, Int))
    -> (String -> IO (Int, Int)) -> IO (Int, Int)
    forall a b. (a -> b) -> a -> b
    $ \String
    dir -> do
        let fileName :: String
    fileName = String
    dir String -> ShowS
    </> String
    "probe"
        [Int]
    mtimes <- [Int] -> (Int -> IO Int) -> IO [Int]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for [Int
    1..Int
    25] ((Int -> IO Int) -> IO [Int]) -> (Int -> IO Int) -> IO [Int]
    forall a b. (a -> b) -> a -> b
    $ \(Int
    i::Int) -> IO () -> IO Int
    time (IO () -> IO Int) -> IO () -> IO Int
    forall a b. (a -> b) -> a -> b
    $ do
          String -> String -> IO ()
    writeFile String
    fileName (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    i
          ModTime
    t0 <- String -> IO ModTime
    getModTime String
    fileName
          let spin :: a -> IO ()
    spin a
    j = do
                String -> String -> IO ()
    writeFile String
    fileName (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (Int, a) -> String
    forall a. Show a => a -> String
    show (Int
    i,a
    j)
                ModTime
    t1 <- String -> IO ModTime
    getModTime String
    fileName
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ModTime
    t0 ModTime -> ModTime -> Bool
    forall a. Ord a => a -> a -> Bool
    < ModTime
    t1) (a -> IO ()
    spin (a -> IO ()) -> a -> IO ()
    forall a b. (a -> b) -> a -> b
    $ a
    j a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1)
          Int -> IO ()
    forall {a}. (Show a, Num a) => a -> IO ()
    spin (Int
    0::Int)
        let mtimeChange :: Int
    mtimeChange  = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [Int]
    mtimes
            mtimeChange' :: Int
    mtimeChange' = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    1000000 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    10000 Int
    mtimeChange) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2
        (Int, Int) -> IO (Int, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    mtimeChange, Int
    mtimeChange')
      where
        time :: IO () -> IO Int
        time :: IO () -> IO Int
    time IO ()
    act = do
          UTCTime
    t0 <- IO UTCTime
    getCurrentTime
          IO ()
    act
          UTCTime
    t1 <- IO UTCTime
    getCurrentTime
          Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> IO Int)
    -> (NominalDiffTime -> Int) -> NominalDiffTime -> IO Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NominalDiffTime -> Int
    forall b. Integral b => NominalDiffTime -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling (NominalDiffTime -> IO Int) -> NominalDiffTime -> IO Int
    forall a b. (a -> b) -> a -> b
    $! (UTCTime
    t1 UTCTime -> UTCTime -> NominalDiffTime
    `diffUTCTime` UTCTime
    t0) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    1e6 -- microseconds