b4624db · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Handle timezone offsets with seconds when converting to UTCTime

b4624dbLeon P Smith12 years ago

src/Database/PostgreSQL/Simple/Time/Implementation.hs+32−2

compare with master

unifiedsplit

@@ -143,6 +143,36 @@ getTimeZone = do

143 !offset = if sign == '+' then absset else -absset

144 return $! minutesToTimeZone offset

145

146+type TimeZoneHMS = (Int,Int,Int)

147+

148+getTimeZoneHMS :: A.Parser TimeZoneHMS

149+getTimeZoneHMS = do

150+ sign <- A.satisfy (\c -> c == '+' || c == '-')

151+ hours <- digits "timezone"

152+ mins <- (A.char ':' *> digits "timezone minutes") <|> pure 0

153+ secs <- (A.char ':' *> digits "timezone seconds") <|> pure 0

154+ if sign == '+'

155+ then return (hours, mins, secs)

156+ else return $! (\ !h !m !s -> (h,m,s)) (-hours) (-mins) (-secs)

157+

158+localToUTCTimeOfDayHMS :: TimeZoneHMS -> TimeOfDay -> (Integer, TimeOfDay)

159+localToUTCTimeOfDayHMS (dh, dm, ds) (TimeOfDay h m s) =

160+ (\ !a !b -> (a,b)) dday (TimeOfDay h'' m'' s'')

161+ where

162+ s' = s - fromIntegral ds

163+ (!s'', m')

164+ | s' < 0 = (s' + 60, m - dm - 1)

165+ | s' >= 60 = (s' - 60, m - dm + 1)

166+ | otherwise = (s' , m - dm )

167+ (!m'', h')

168+ | m' < 0 = (m' + 60, h - dh - 1)

169+ | m' >= 60 = (m' - 60, h - dh + 1)

170+ | otherwise = (m' , h - dh )

171+ (!h'', dday)

172+ | h' < 0 = (h' + 24, -1)

173+ | h' >= 24 = (h' - 24, 1)

174+ | otherwise = (h' , 0)

175+

146getZonedTime :: A.Parser ZonedTime

176getZonedTime :: A.Parser ZonedTime

147getZonedTime = ZonedTime <$> getLocalTime <*> getTimeZone

177getZonedTime = ZonedTime <$> getLocalTime <*> getTimeZone

148

178

@@ -154,8 +184,8 @@ getUTCTime = do

154 day <- getDay

184 day <- getDay

155 _ <- A.char ' '

185 _ <- A.char ' '

156 time <- getTimeOfDay

186 time <- getTimeOfDay

157− zone <- getTimeZone

187+ zone <- getTimeZoneHMS

158− let (!dayDelta,!time') = localToUTCTimeOfDay zone time

188+ let (!dayDelta,!time') = localToUTCTimeOfDayHMS zone time

159 let !day' = addDays dayDelta day

189 let !day' = addDays dayDelta day

160 let !time'' = timeOfDayToTime time'

190 let !time'' = timeOfDayToTime time'

161 return (UTCTime day' time'')

191 return (UTCTime day' time'')

src/Database/PostgreSQL/Simple/Time/Internal.hs+3

@@ -19,6 +19,9 @@ module Database.PostgreSQL.Simple.Time.Internal

19 , getZonedTimestamp

20 , getUTCTime

21 , getUTCTimestamp

22+ , TimeZoneHMS

23+ , getTimeZoneHMS

24+ , localToUTCTimeOfDayHMS

22 ) where

25 ) where

24import Database.PostgreSQL.Simple.Time.Implementation

27import Database.PostgreSQL.Simple.Time.Implementation

test/Time.hs+45−5

@@ -17,6 +17,19 @@ correspond; for example, a conversion that consistently added hour

17when printed to a string and subtracted an hour when parsed from string

18would still pass these tests.

20+

21+Right now, we are checking that 1400+ timestamps in the range of 1860 to

22+2060 round trip from postgresql to haskell and back in 5 different timezones.

23+In addition to UTC, the four timezones were selected so that 2 have a positive

24+offset, and 2 have a negative offset, and that 2 have an offset of a

25+whole number of hours, while the other two do not.

26+

27+It may be worth adding a few more timezones to ensure better test coverage.

28+

29+We are checking a handful of selected timestamps to ensure we hit

30+various corner-cases in the code, in addition to 1400 timestamps randomly

31+generated with granularity of seconds down to microseconds in powers of ten.

32+

20-}

33-}

22module Time (testTime) where

35module Time (testTime) where

@@ -35,13 +48,13 @@ testTime env@TestEnv{..} = TestCase $ do

35 initializeTable env

48 initializeTable env

36 execute_ conn "SET timezone TO 'UTC'"

49 execute_ conn "SET timezone TO 'UTC'"

37 checkRoundTrips env

50 checkRoundTrips env

38− execute_ conn "SET timezone TO 'America/Chicago'"

51+ execute_ conn "SET timezone TO 'America/Chicago'" -- -5:00

39 checkRoundTrips env

52 checkRoundTrips env

40− execute_ conn "SET timezone TO 'Asia/Tokyo'"

53+ execute_ conn "SET timezone TO 'Asia/Tokyo'" -- +9:00

41 checkRoundTrips env

54 checkRoundTrips env

42− execute_ conn "SET timezone TO 'Asia/Kathmandu'"

55+ execute_ conn "SET timezone TO 'Asia/Kathmandu'" -- +5:45

43 checkRoundTrips env

56 checkRoundTrips env

44− execute_ conn "SET timezone TO 'America/St_Johns'"

57+ execute_ conn "SET timezone TO 'America/St_Johns'" -- -3:30

45 checkRoundTrips env

58 checkRoundTrips env

47initializeTable :: TestEnv -> IO ()

60initializeTable :: TestEnv -> IO ()

@@ -49,10 +62,37 @@ initializeTable TestEnv{..} = withTransaction conn $ do

49 execute_ conn

62 execute_ conn

50 [sql| CREATE TEMPORARY TABLE testtime

63 [sql| CREATE TEMPORARY TABLE testtime

51 ( x serial, y timestamptz, PRIMARY KEY(x) ) |]

64 ( x serial, y timestamptz, PRIMARY KEY(x) ) |]

65+

66+ let test :: ByteString -> IO () = \x -> do

67+ execute conn [sql|

68+ INSERT INTO testtime (y) VALUES (?)

69+ |] (Only x)

70+ return ()

71+ -- America/Chicago

72+ test "1883-11-18 11:59:59-05:50:36"

73+ test "1883-11-18 12:09:23-05:50:36"

74+ test "1883-11-18 12:00:00-06"

75+ -- Asia/Tokyo

76+ test "1887-12-31 23:59:59+09:18:59"

77+ test "1888-01-01 00:18:58+09:18:59"

78+ test "1888-01-01 00:00:00+09"

79+ -- Asia/Kathmandu

80+ test "1919-12-31 23:59:59+05:41:16"

81+ test "1919-12-31 23:48:44+05:30"

82+ test "1985-12-31 23:59:59+05:30"

83+ test "1986-01-01 00:15:00+05:45"

84+ -- America/St_Johns

85+ test "1935-03-29 23:59:59-03:30:52"

86+ test "1935-03-30 00:00:52-03:30"

87+

88+ -- While the above special cases are probably a decent start, there

89+ -- are probably more that are well worth adding to ensure better

90+ -- coverage.

91+

52 let pop :: ByteString -> Double -> IO () = \x y ->

92 let pop :: ByteString -> Double -> IO () = \x y ->

53 replicateM_ numTests $ execute conn

93 replicateM_ numTests $ execute conn

54 [sql| INSERT INTO testtime (y) VALUES

94 [sql| INSERT INTO testtime (y) VALUES

55− ('1936-01-01 00:00:00+00'::timestamptz

95+ ('1860-01-01 00:00:00+00'::timestamptz

56 + ?::interval * ROUND(RANDOM() * ?)) |] (x,y)

96 + ?::interval * ROUND(RANDOM() * ?)) |] (x,y)

57 pop "1 microsecond" 6.3113904e15

97 pop "1 microsecond" 6.3113904e15

58 pop "10 microseconds" 6.3113904e14

98 pop "10 microseconds" 6.3113904e14