b4624db · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

Handle timezone offsets with seconds when converting to UTCTime

Closes #122 Closes #123 Closes #124

commitb4624db41048e42e993d3bea820e907a010fde00 authorLeon P Smith <leon@melding-monads.com> dateMon 27 Oct 2014, 18:10 (12 years ago) parentde11024

3 files changed+80−7

compare with master

unifiedsplit

src/Database/PostgreSQL/Simple/Time/Implementation.hs+32−2 src/Database/PostgreSQL/Simple/Time/Internal.hs+3 test/Time.hs+45−5

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

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

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

144144 return $! minutesToTimeZone offset

145145

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+

146176getZonedTime :: A.Parser ZonedTime

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

148178

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

154184 day <- getDay

155185 _ <- A.char ' '

156186 time <- getTimeOfDay

157− zone <- getTimeZone

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

187+ zone <- getTimeZoneHMS

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

159189 let !day' = addDays dayDelta day

160190 let !time'' = timeOfDayToTime time'

161191 return (UTCTime day' time'')

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

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

1919 , getZonedTimestamp

2020 , getUTCTime

2121 , getUTCTimestamp

22+ , TimeZoneHMS

23+ , getTimeZoneHMS

24+ , localToUTCTimeOfDayHMS

2225 ) where

2326

2427import Database.PostgreSQL.Simple.Time.Implementation

test/Time.hs+45−5

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

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

1818would still pass these tests.

1919

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+

2033-}

2134

2235module Time (testTime) where

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

3548 initializeTable env

3649 execute_ conn "SET timezone TO 'UTC'"

3750 checkRoundTrips env

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

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

3952 checkRoundTrips env

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

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

4154 checkRoundTrips env

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

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

4356 checkRoundTrips env

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

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

4558 checkRoundTrips env

4659

4760initializeTable :: TestEnv -> IO ()

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

4962 execute_ conn

5063 [sql| CREATE TEMPORARY TABLE testtime

5164 ( 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+

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

5393 replicateM_ numTests $ execute conn

5494 [sql| INSERT INTO testtime (y) VALUES

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

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

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

5797 pop "1 microsecond" 6.3113904e15

5898 pop "10 microseconds" 6.3113904e14