{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Distribution.Client.IndexUtils.Timestamp
( Timestamp
, nullTimestamp
, 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
newtype Timestamp = 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,Int -> Timestamp
Timestamp -> Int
Timestamp -> [Timestamp]
Timestamp -> Timestamp
Timestamp -> Timestamp -> [Timestamp]
Timestamp -> Timestamp -> Timestamp -> [Timestamp]
(Timestamp -> Timestamp)
-> (Timestamp -> Timestamp)
-> (Int -> Timestamp)
-> (Timestamp -> Int)
-> (Timestamp -> [Timestamp])
-> (Timestamp -> Timestamp -> [Timestamp])
-> (Timestamp -> Timestamp -> [Timestamp])
-> (Timestamp -> Timestamp -> Timestamp -> [Timestamp])
-> Enum Timestamp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Timestamp -> Timestamp
succ :: Timestamp -> Timestamp
$cpred :: Timestamp -> Timestamp
pred :: Timestamp -> Timestamp
$ctoEnum :: Int -> Timestamp
toEnum :: Int -> Timestamp
$cfromEnum :: Timestamp -> Int
fromEnum :: Timestamp -> Int
$cenumFrom :: Timestamp -> [Timestamp]
enumFrom :: Timestamp -> [Timestamp]
$cenumFromThen :: Timestamp -> Timestamp -> [Timestamp]
enumFromThen :: Timestamp -> Timestamp -> [Timestamp]
$cenumFromTo :: Timestamp -> Timestamp -> [Timestamp]
enumFromTo :: Timestamp -> Timestamp -> [Timestamp]
$cenumFromThenTo :: Timestamp -> Timestamp -> Timestamp -> [Timestamp]
enumFromThenTo :: Timestamp -> Timestamp -> Timestamp -> [Timestamp]
Enum,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 -> Maybe Timestamp
epochTimeToTimestamp :: Int64 -> Maybe Timestamp
epochTimeToTimestamp Int64
et
| Timestamp
ts Timestamp -> Timestamp -> Bool
forall a. Eq a => a -> a -> Bool
== Timestamp
nullTimestamp = Maybe Timestamp
forall a. Maybe a
Nothing
| Bool
otherwise = Timestamp -> Maybe Timestamp
forall a. a -> Maybe a
Just Timestamp
ts
where
ts :: Timestamp
ts = Int64 -> Timestamp
TS Int64
et
timestampToUTCTime :: Timestamp -> Maybe UTCTime
timestampToUTCTime :: Timestamp -> Maybe UTCTime
timestampToUTCTime (TS Int64
t)
| Int64
t Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
forall a. Bounded a => a
minBound = Maybe UTCTime
forall a. Maybe a
Nothing
| Bool
otherwise = 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 -> Maybe Timestamp
utcTimeToTimestamp :: UTCTime -> Maybe Timestamp
utcTimeToTimestamp UTCTime
utct
| Integer
minTime Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
t, Integer
t Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxTime = Timestamp -> Maybe Timestamp
forall a. a -> Maybe a
Just (Int64 -> Timestamp
TS (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
t))
| Bool
otherwise = Maybe Timestamp
forall a. Maybe a
Nothing
where
maxTime :: Integer
maxTime = Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64)
minTime :: Integer
minTime = 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)
t :: Integer
t :: Integer
t = 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 (UTCTime -> Integer) -> UTCTime -> Integer
forall a b. (a -> b) -> a -> b
$ UTCTime
utct
maximumTimestamp :: [Timestamp] -> Timestamp
maximumTimestamp :: [Timestamp] -> Timestamp
maximumTimestamp [] = Timestamp
nullTimestamp
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]
""
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
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'@'
Integer
t <- m Integer
forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
P.integral
m Timestamp
-> (Timestamp -> m Timestamp) -> Maybe Timestamp -> m Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m Timestamp
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is not representable as timestamp")) Timestamp -> m Timestamp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Timestamp -> m Timestamp) -> Maybe Timestamp -> m Timestamp
forall a b. (a -> b) -> a -> b
$
Integer -> Maybe Timestamp
posixSecondsToTimestamp Integer
t
parseUTC :: m Timestamp
parseUTC = do
Integer
ye <- m Integer
parseYear
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-'
Int
mo <- m Int
parseTwoDigits
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-'
Int
da <- m Int
parseTwoDigits
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'T'
Day
utctDay <- m Day -> (Day -> m Day) -> Maybe Day -> m Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m Day
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ((Integer, Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Integer
ye,Int
mo,Int
da) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is not valid gregorian date")) Day -> m Day
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Day -> m Day) -> Maybe Day -> m Day
forall a b. (a -> b) -> a -> b
$
Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
ye Int
mo Int
da
Int
ho <- m Int
parseTwoDigits
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':'
Int
mi <- m Int
parseTwoDigits
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':'
Int
se <- m Int
parseTwoDigits
Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'Z'
DiffTime
utctDayTime <- m DiffTime
-> (TimeOfDay -> m DiffTime) -> Maybe TimeOfDay -> m DiffTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m DiffTime
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ((Int, Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int
ho,Int
mi,Int
se) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is not valid time of day")) (DiffTime -> m DiffTime
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiffTime -> m DiffTime)
-> (TimeOfDay -> DiffTime) -> TimeOfDay -> m DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> DiffTime
timeOfDayToTime) (Maybe TimeOfDay -> m DiffTime) -> Maybe TimeOfDay -> m DiffTime
forall a b. (a -> b) -> a -> b
$
Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid Int
ho Int
mi (Int -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int
se::Int))
let utc :: UTCTime
utc = UTCTime {Day
DiffTime
utctDay :: Day
utctDayTime :: DiffTime
utctDay :: Day
utctDayTime :: DiffTime
..}
m Timestamp
-> (Timestamp -> m Timestamp) -> Maybe Timestamp -> m Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m Timestamp
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (UTCTime -> [Char]
forall a. Show a => a -> [Char]
show UTCTime
utc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is not representable as timestamp")) Timestamp -> m Timestamp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Timestamp -> m Timestamp) -> Maybe Timestamp -> m Timestamp
forall a b. (a -> b) -> a -> b
$ UTCTime -> Maybe Timestamp
utcTimeToTimestamp UTCTime
utc
parseTwoDigits :: m Int
parseTwoDigits = do
Char
d1 <- (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy Char -> Bool
isDigit
Char
d2 <- (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy Char -> Bool
isDigit
Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char
d1,Char
d2])
parseYear :: m Integer
parseYear = do
Char
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
'-')
[Char]
ds <- (Char -> Bool) -> m [Char]
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m [Char]
P.munch1 Char -> Bool
isDigit
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
ds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Year should have at least 4 digits"
Integer -> m Integer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Integer
forall a. Read a => [Char] -> a
read (Char
signChar -> ShowS
forall a. a -> [a] -> [a]
:[Char]
ds))
nullTimestamp :: Timestamp
nullTimestamp :: Timestamp
nullTimestamp = Int64 -> Timestamp
TS Int64
forall a. Bounded a => a
minBound