{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Distribution.Compat.Time
  ( ModTime
  , getModTime
  , getFileAge
  , getCurTime
  )
where

import Distribution.Compat.Prelude
import Prelude ()

import System.Directory (getModificationTime)

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

-- | 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)

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.
getModTime :: FilePath -> IO ModTime
getModTime :: String -> IO ModTime
getModTime = (UTCTime -> ModTime) -> IO UTCTime -> IO ModTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NominalDiffTime -> ModTime
posixTimeToModTime (NominalDiffTime -> ModTime)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> ModTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds) (IO UTCTime -> IO ModTime)
-> (String -> IO UTCTime) -> String -> IO ModTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO UTCTime
getModificationTime

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

-- | 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
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
  t0 <- String -> IO UTCTime
getModificationTime String
file
  t1 <- getCurrentTime
  return $ realToFrac (t1 `diffUTCTime` t0) / realToFrac 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