never executed always true always false
1 {-# LANGUAGE DeriveGeneric #-}
2 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE RecordWildCards #-}
5
6 -----------------------------------------------------------------------------
7 -- |
8 -- Module : Distribution.Client.IndexUtils.Timestamp
9 -- Copyright : (c) 2016 Herbert Valerio Riedel
10 -- License : BSD3
11 --
12 -- Timestamp type used in package indexes
13
14 module Distribution.Client.IndexUtils.Timestamp
15 ( Timestamp
16 , nullTimestamp
17 , epochTimeToTimestamp
18 , timestampToUTCTime
19 , utcTimeToTimestamp
20 , maximumTimestamp
21 ) where
22
23 import Distribution.Client.Compat.Prelude
24
25 -- read is needed for Text instance
26 import Prelude (read)
27
28 import Data.Time (UTCTime (..), fromGregorianValid, makeTimeOfDayValid, showGregorian, timeOfDayToTime, timeToTimeOfDay)
29 import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
30
31 import qualified Codec.Archive.Tar.Entry as Tar
32 import qualified Distribution.Compat.CharParsing as P
33 import qualified Text.PrettyPrint as Disp
34
35 -- | UNIX timestamp (expressed in seconds since unix epoch, i.e. 1970).
36 newtype Timestamp = TS Int64 -- Tar.EpochTime
37 deriving (Eq,Ord,Enum,NFData,Show,Generic)
38
39 epochTimeToTimestamp :: Tar.EpochTime -> Maybe Timestamp
40 epochTimeToTimestamp et
41 | ts == nullTimestamp = Nothing
42 | otherwise = Just ts
43 where
44 ts = TS et
45
46 timestampToUTCTime :: Timestamp -> Maybe UTCTime
47 timestampToUTCTime (TS t)
48 | t == minBound = Nothing
49 | otherwise = Just $ posixSecondsToUTCTime (fromIntegral t)
50
51 utcTimeToTimestamp :: UTCTime -> Maybe Timestamp
52 utcTimeToTimestamp utct
53 | minTime <= t, t <= maxTime = Just (TS (fromIntegral t))
54 | otherwise = Nothing
55 where
56 maxTime = toInteger (maxBound :: Int64)
57 minTime = toInteger (succ minBound :: Int64)
58 t :: Integer
59 t = round . utcTimeToPOSIXSeconds $ utct
60
61 -- | Compute the maximum 'Timestamp' value
62 --
63 -- Returns 'nullTimestamp' for the empty list. Also note that
64 -- 'nullTimestamp' compares as smaller to all non-'nullTimestamp'
65 -- values.
66 maximumTimestamp :: [Timestamp] -> Timestamp
67 maximumTimestamp [] = nullTimestamp
68 maximumTimestamp xs@(_:_) = maximum xs
69
70 -- returns 'Nothing' if not representable as 'Timestamp'
71 posixSecondsToTimestamp :: Integer -> Maybe Timestamp
72 posixSecondsToTimestamp pt
73 | minTs <= pt, pt <= maxTs = Just (TS (fromInteger pt))
74 | otherwise = Nothing
75 where
76 maxTs = toInteger (maxBound :: Int64)
77 minTs = toInteger (succ minBound :: Int64)
78
79 -- | Pretty-prints 'Timestamp' in ISO8601/RFC3339 format
80 -- (e.g. @"2017-12-31T23:59:59Z"@)
81 --
82 -- Returns empty string for 'nullTimestamp' in order for
83 --
84 -- > null (display nullTimestamp) == True
85 --
86 -- to hold.
87 showTimestamp :: Timestamp -> String
88 showTimestamp ts = case timestampToUTCTime ts of
89 Nothing -> ""
90 -- Note: we don't use 'formatTime' here to avoid incurring a
91 -- dependency on 'old-locale' for older `time` libs
92 Just UTCTime{..} -> showGregorian utctDay ++ ('T':showTOD utctDayTime) ++ "Z"
93 where
94 showTOD = show . timeToTimeOfDay
95
96 instance Binary Timestamp
97 instance Structured Timestamp
98
99 instance Pretty Timestamp where
100 pretty = Disp.text . showTimestamp
101
102 instance Parsec Timestamp where
103 parsec = parsePosix <|> parseUTC
104 where
105 -- | Parses unix timestamps, e.g. @"\@1474626019"@
106 parsePosix = do
107 _ <- P.char '@'
108 t <- P.integral -- note, no negative timestamps
109 maybe (fail (show t ++ " is not representable as timestamp")) return $
110 posixSecondsToTimestamp t
111
112 -- | Parses ISO8601/RFC3339-style UTC timestamps,
113 -- e.g. @"2017-12-31T23:59:59Z"@
114 --
115 -- TODO: support numeric tz offsets; allow to leave off seconds
116 parseUTC = do
117 -- Note: we don't use 'Data.Time.Format.parseTime' here since
118 -- we want more control over the accepted formats.
119
120 ye <- parseYear
121 _ <- P.char '-'
122 mo <- parseTwoDigits
123 _ <- P.char '-'
124 da <- parseTwoDigits
125 _ <- P.char 'T'
126
127 utctDay <- maybe (fail (show (ye,mo,da) ++ " is not valid gregorian date")) return $
128 fromGregorianValid ye mo da
129
130 ho <- parseTwoDigits
131 _ <- P.char ':'
132 mi <- parseTwoDigits
133 _ <- P.char ':'
134 se <- parseTwoDigits
135 _ <- P.char 'Z'
136
137 utctDayTime <- maybe (fail (show (ho,mi,se) ++ " is not valid time of day")) (return . timeOfDayToTime) $
138 makeTimeOfDayValid ho mi (realToFrac (se::Int))
139
140 let utc = UTCTime {..}
141
142 maybe (fail (show utc ++ " is not representable as timestamp")) return $ utcTimeToTimestamp utc
143
144 parseTwoDigits = do
145 d1 <- P.satisfy isDigit
146 d2 <- P.satisfy isDigit
147 return (read [d1,d2])
148
149 -- A year must have at least 4 digits; e.g. "0097" is fine,
150 -- while "97" is not c.f. RFC3339 which
151 -- deprecates 2-digit years
152 parseYear = do
153 sign <- P.option ' ' (P.char '-')
154 ds <- P.munch1 isDigit
155 when (length ds < 4) $ fail "Year should have at least 4 digits"
156 return (read (sign:ds))
157
158 -- | Special timestamp value to be used when 'timestamp' is
159 -- missing/unknown/invalid
160 nullTimestamp :: Timestamp
161 nullTimestamp = TS minBound