{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timestamp -> Timestamp -> Bool
$c/= :: Timestamp -> Timestamp -> Bool
== :: Timestamp -> Timestamp -> Bool
$c== :: Timestamp -> Timestamp -> Bool
Eq,Eq 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
min :: Timestamp -> Timestamp -> Timestamp
$cmin :: Timestamp -> Timestamp -> Timestamp
max :: Timestamp -> Timestamp -> Timestamp
$cmax :: Timestamp -> Timestamp -> Timestamp
>= :: Timestamp -> Timestamp -> Bool
$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
compare :: Timestamp -> Timestamp -> Ordering
$ccompare :: Timestamp -> Timestamp -> Ordering
Ord,Int -> Timestamp
Timestamp -> Int
Timestamp -> [Timestamp]
Timestamp -> Timestamp
Timestamp -> Timestamp -> [Timestamp]
Timestamp -> Timestamp -> Timestamp -> [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
enumFromThenTo :: Timestamp -> Timestamp -> Timestamp -> [Timestamp]
$cenumFromThenTo :: Timestamp -> Timestamp -> Timestamp -> [Timestamp]
enumFromTo :: Timestamp -> Timestamp -> [Timestamp]
$cenumFromTo :: Timestamp -> Timestamp -> [Timestamp]
enumFromThen :: Timestamp -> Timestamp -> [Timestamp]
$cenumFromThen :: Timestamp -> Timestamp -> [Timestamp]
enumFrom :: Timestamp -> [Timestamp]
$cenumFrom :: Timestamp -> [Timestamp]
fromEnum :: Timestamp -> Int
$cfromEnum :: Timestamp -> Int
toEnum :: Int -> Timestamp
$ctoEnum :: Int -> Timestamp
pred :: Timestamp -> Timestamp
$cpred :: Timestamp -> Timestamp
succ :: Timestamp -> Timestamp
$csucc :: Timestamp -> Timestamp
Enum,Timestamp -> ()
forall a. (a -> ()) -> NFData a
rnf :: Timestamp -> ()
$crnf :: Timestamp -> ()
NFData,Int -> Timestamp -> ShowS
[Timestamp] -> ShowS
Timestamp -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Timestamp] -> ShowS
$cshowList :: [Timestamp] -> ShowS
show :: Timestamp -> [Char]
$cshow :: Timestamp -> [Char]
showsPrec :: Int -> Timestamp -> ShowS
$cshowsPrec :: Int -> Timestamp -> ShowS
Show,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
$cto :: forall x. Rep Timestamp x -> Timestamp
$cfrom :: forall x. Timestamp -> Rep Timestamp x
Generic)
epochTimeToTimestamp :: Tar.EpochTime -> Maybe Timestamp
epochTimeToTimestamp :: Int64 -> Maybe Timestamp
epochTimeToTimestamp Int64
et
| Timestamp
ts forall a. Eq a => a -> a -> Bool
== Timestamp
nullTimestamp = forall a. Maybe a
Nothing
| Bool
otherwise = 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 forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (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 forall a. Ord a => a -> a -> Bool
<= Integer
t, Integer
t forall a. Ord a => a -> a -> Bool
<= Integer
maxTime = forall a. a -> Maybe a
Just (Int64 -> Timestamp
TS (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
t))
| Bool
otherwise = forall a. Maybe a
Nothing
where
maxTime :: Integer
maxTime = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int64)
minTime :: Integer
minTime = forall a. Integral a => a -> Integer
toInteger (forall a. Enum a => a -> a
succ forall a. Bounded a => a
minBound :: Int64)
t :: Integer
t :: Integer
t = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall a b. (a -> b) -> a -> b
$ UTCTime
utct
maximumTimestamp :: [Timestamp] -> Timestamp
maximumTimestamp :: [Timestamp] -> Timestamp
maximumTimestamp [] = Timestamp
nullTimestamp
maximumTimestamp xs :: [Timestamp]
xs@(Timestamp
_:[Timestamp]
_) = 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 forall a. Ord a => a -> a -> Bool
<= Integer
pt, Integer
pt forall a. Ord a => a -> a -> Bool
<= Integer
maxTs = forall a. a -> Maybe a
Just (Int64 -> Timestamp
TS (forall a. Num a => Integer -> a
fromInteger Integer
pt))
| Bool
otherwise = forall a. Maybe a
Nothing
where
maxTs :: Integer
maxTs = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int64)
minTs :: Integer
minTs = forall a. Integral a => a -> Integer
toInteger (forall a. Enum a => a -> a
succ 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{DiffTime
Day
utctDay :: UTCTime -> Day
utctDayTime :: UTCTime -> DiffTime
utctDayTime :: DiffTime
utctDay :: Day
..} -> Day -> [Char]
showGregorian Day
utctDay forall a. [a] -> [a] -> [a]
++ (Char
'T'forall a. a -> [a] -> [a]
:DiffTime -> [Char]
showTOD DiffTime
utctDayTime) forall a. [a] -> [a] -> [a]
++ [Char]
"Z"
where
showTOD :: DiffTime -> [Char]
showTOD = forall a. Show a => a -> [Char]
show 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 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Timestamp
parseUTC
where
parsePosix :: m Timestamp
parsePosix = do
Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'@'
Integer
t <- forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
P.integral
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall a. Show a => a -> [Char]
show Integer
t forall a. [a] -> [a] -> [a]
++ [Char]
" is not representable as timestamp")) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
Integer -> Maybe Timestamp
posixSecondsToTimestamp Integer
t
parseUTC :: m Timestamp
parseUTC = do
Integer
ye <- m Integer
parseYear
Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-'
Int
mo <- m Int
parseTwoDigits
Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-'
Int
da <- m Int
parseTwoDigits
Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'T'
Day
utctDay <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall a. Show a => a -> [Char]
show (Integer
ye,Int
mo,Int
da) forall a. [a] -> [a] -> [a]
++ [Char]
" is not valid gregorian date")) forall (m :: * -> *) a. Monad m => a -> m a
return 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
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':'
Int
mi <- m Int
parseTwoDigits
Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':'
Int
se <- m Int
parseTwoDigits
Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'Z'
DiffTime
utctDayTime <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall a. Show a => a -> [Char]
show (Int
ho,Int
mi,Int
se) forall a. [a] -> [a] -> [a]
++ [Char]
" is not valid time of day")) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> DiffTime
timeOfDayToTime) forall a b. (a -> b) -> a -> b
$
Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid Int
ho Int
mi (forall a b. (Real a, Fractional b) => a -> b
realToFrac (Int
se::Int))
let utc :: UTCTime
utc = UTCTime {DiffTime
Day
utctDayTime :: DiffTime
utctDay :: Day
utctDay :: Day
utctDayTime :: DiffTime
..}
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall a. Show a => a -> [Char]
show UTCTime
utc forall a. [a] -> [a] -> [a]
++ [Char]
" is not representable as timestamp")) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UTCTime -> Maybe Timestamp
utcTimeToTimestamp UTCTime
utc
parseTwoDigits :: m Int
parseTwoDigits = do
Char
d1 <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy Char -> Bool
isDigit
Char
d2 <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
P.satisfy Char -> Bool
isDigit
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Read a => [Char] -> a
read [Char
d1,Char
d2])
parseYear :: m Integer
parseYear = do
Char
sign <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
P.option Char
' ' (forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-')
[Char]
ds <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m [Char]
P.munch1 Char -> Bool
isDigit
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
ds forall a. Ord a => a -> a -> Bool
< Int
4) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Year should have at least 4 digits"
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Read a => [Char] -> a
read (Char
signforall a. a -> [a] -> [a]
:[Char]
ds))
nullTimestamp :: Timestamp
nullTimestamp :: Timestamp
nullTimestamp = Int64 -> Timestamp
TS forall a. Bounded a => a
minBound