{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Distribution.Client.IndexUtils.Timestamp
( Timestamp (NoTimestamp)
, epochTimeToTimestamp
, timestampToUTCTime
, utcTimeToTimestamp
, maximumTimestamp
) where
import Distribution.Client.Compat.Prelude
import Prelude (read)
import Data.Time (UTCTime (..), fromGregorianValid, makeTimeOfDayValid, showGregorian, timeOfDayToTime, timeToTimeOfDay)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import qualified Codec.Archive.Tar.Entry as Tar
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
data Timestamp = NoTimestamp | TS Int64
deriving (Timestamp -> Timestamp -> Bool
(Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool) -> Eq Timestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timestamp -> Timestamp -> Bool
== :: Timestamp -> Timestamp -> Bool
$c/= :: Timestamp -> Timestamp -> Bool
/= :: Timestamp -> Timestamp -> Bool
Eq, Eq Timestamp
Eq Timestamp =>
(Timestamp -> Timestamp -> Ordering)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Timestamp)
-> (Timestamp -> Timestamp -> Timestamp)
-> Ord Timestamp
Timestamp -> Timestamp -> Bool
Timestamp -> Timestamp -> Ordering
Timestamp -> Timestamp -> Timestamp
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 :: Timestamp -> Timestamp -> Ordering
compare :: Timestamp -> Timestamp -> Ordering
$c< :: Timestamp -> Timestamp -> Bool
< :: Timestamp -> Timestamp -> Bool
$c<= :: Timestamp -> Timestamp -> Bool
<= :: Timestamp -> Timestamp -> Bool
$c> :: Timestamp -> Timestamp -> Bool
> :: Timestamp -> Timestamp -> Bool
$c>= :: Timestamp -> Timestamp -> Bool
>= :: Timestamp -> Timestamp -> Bool
$cmax :: Timestamp -> Timestamp -> Timestamp
max :: Timestamp -> Timestamp -> Timestamp
$cmin :: Timestamp -> Timestamp -> Timestamp
min :: Timestamp -> Timestamp -> Timestamp
Ord, Timestamp -> ()
(Timestamp -> ()) -> NFData Timestamp
forall a. (a -> ()) -> NFData a
$crnf :: Timestamp -> ()
rnf :: Timestamp -> ()
NFData, Int -> Timestamp -> ShowS
[Timestamp] -> ShowS
Timestamp -> [Char]
(Int -> Timestamp -> ShowS)
-> (Timestamp -> [Char])
-> ([Timestamp] -> ShowS)
-> Show Timestamp
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timestamp -> ShowS
showsPrec :: Int -> Timestamp -> ShowS
$cshow :: Timestamp -> [Char]
show :: Timestamp -> [Char]
$cshowList :: [Timestamp] -> ShowS
showList :: [Timestamp] -> ShowS
Show, (forall x. Timestamp -> Rep Timestamp x)
-> (forall x. Rep Timestamp x -> Timestamp) -> Generic Timestamp
forall x. Rep Timestamp x -> Timestamp
forall x. Timestamp -> Rep Timestamp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Timestamp -> Rep Timestamp x
from :: forall x. Timestamp -> Rep Timestamp x
$cto :: forall x. Rep Timestamp x -> Timestamp
to :: forall x. Rep Timestamp x -> Timestamp
Generic)
epochTimeToTimestamp :: Tar.EpochTime -> Timestamp
epochTimeToTimestamp :: Int64 -> Timestamp
epochTimeToTimestamp = Int64 -> Timestamp
TS
timestampToUTCTime :: Timestamp -> Maybe UTCTime
timestampToUTCTime :: Timestamp -> Maybe UTCTime
timestampToUTCTime Timestamp
NoTimestamp = Maybe UTCTime
forall a. Maybe a
Nothing
timestampToUTCTime (TS Int64
t) = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (Int64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
t)
utcTimeToTimestamp :: UTCTime -> Timestamp
utcTimeToTimestamp :: UTCTime -> Timestamp
utcTimeToTimestamp =
Int64 -> Timestamp
TS
(Int64 -> Timestamp) -> (UTCTime -> Int64) -> UTCTime -> Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Integer -> Int64)
(Integer -> Int64) -> (UTCTime -> Integer) -> UTCTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round
(POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds
maximumTimestamp :: [Timestamp] -> Timestamp
maximumTimestamp :: [Timestamp] -> Timestamp
maximumTimestamp [] = Timestamp
NoTimestamp
maximumTimestamp xs :: [Timestamp]
xs@(Timestamp
_ : [Timestamp]
_) = [Timestamp] -> Timestamp
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Timestamp]
xs
posixSecondsToTimestamp :: Integer -> Maybe Timestamp
posixSecondsToTimestamp :: Integer -> Maybe Timestamp
posixSecondsToTimestamp Integer
pt
| Integer
minTs Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
pt, Integer
pt Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxTs = Timestamp -> Maybe Timestamp
forall a. a -> Maybe a
Just (Int64 -> Timestamp
TS (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
pt))
| Bool
otherwise = Maybe Timestamp
forall a. Maybe a
Nothing
where
maxTs :: Integer
maxTs = Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64)
minTs :: Integer
minTs = Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Int64
forall a. Enum a => a -> a
succ Int64
forall a. Bounded a => a
minBound :: Int64)
showTimestamp :: Timestamp -> String
showTimestamp :: Timestamp -> [Char]
showTimestamp Timestamp
ts = case Timestamp -> Maybe UTCTime
timestampToUTCTime Timestamp
ts of
Maybe UTCTime
Nothing -> [Char]
"Unknown or invalid timestamp"
Just UTCTime{Day
DiffTime
utctDay :: Day
utctDayTime :: DiffTime
utctDay :: UTCTime -> Day
utctDayTime :: UTCTime -> DiffTime
..} -> Day -> [Char]
showGregorian Day
utctDay [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
'T' Char -> ShowS
forall a. a -> [a] -> [a]
: DiffTime -> [Char]
showTOD DiffTime
utctDayTime) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"Z"
where
showTOD :: DiffTime -> [Char]
showTOD = TimeOfDay -> [Char]
forall a. Show a => a -> [Char]
show (TimeOfDay -> [Char])
-> (DiffTime -> TimeOfDay) -> DiffTime -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> TimeOfDay
timeToTimeOfDay
instance Binary Timestamp
instance Structured Timestamp
instance Pretty Timestamp where
pretty :: Timestamp -> Doc
pretty = [Char] -> Doc
Disp.text ([Char] -> Doc) -> (Timestamp -> [Char]) -> Timestamp -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timestamp -> [Char]
showTimestamp
instance Parsec Timestamp where
parsec :: forall (m :: * -> *). CabalParsing m => m Timestamp
parsec = m Timestamp
parsePosix m Timestamp -> m Timestamp -> m Timestamp
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Timestamp
parseUTC
where
parsePosix :: m Timestamp
parsePosix = do
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'@'
t <- P.integral
maybe (fail (show t ++ " is not representable as timestamp")) return $
posixSecondsToTimestamp t
parseUTC :: m Timestamp
parseUTC = do
ye <- m Integer
parseYear
_ <- P.char '-'
mo <- parseTwoDigits
_ <- P.char '-'
da <- parseTwoDigits
_ <- P.char 'T'
utctDay <-
maybe (fail (show (ye, mo, da) ++ " is not valid gregorian date")) return $
fromGregorianValid ye mo da
ho <- parseTwoDigits
_ <- P.char ':'
mi <- parseTwoDigits
_ <- P.char ':'
se <- parseTwoDigits
_ <- P.char 'Z'
utctDayTime <-
maybe (fail (show (ho, mi, se) ++ " is not valid time of day")) (return . timeOfDayToTime) $
makeTimeOfDayValid ho mi (realToFrac (se :: Int))
let utc = UTCTime{Day
DiffTime
utctDay :: Day
utctDayTime :: DiffTime
utctDay :: Day
utctDayTime :: DiffTime
..}
return $ utcTimeToTimestamp utc
parseTwoDigits :: m Int
parseTwoDigits = do
d1 <- (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy Char -> Bool
isDigit
d2 <- P.satisfy isDigit
return (read [d1, d2])
parseYear :: m Integer
parseYear = do
sign <- Char -> m Char -> m Char
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Char
' ' (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-')
ds <- P.munch1 isDigit
when (length ds < 4) $ fail "Year should have at least 4 digits"
return (read (sign : ds))