postgresql-simple 0.4.6.0 → 0.4.7.0
raw patch · 4 files changed
+88/−15 lines, 4 files
Files
- postgresql-simple.cabal +2/−2
- src/Database/PostgreSQL/Simple/Time/Implementation.hs +38/−8
- src/Database/PostgreSQL/Simple/Time/Internal.hs +3/−0
- test/Time.hs +45/−5
postgresql-simple.cabal view
@@ -1,5 +1,5 @@ Name: postgresql-simple-Version: 0.4.6.0+Version: 0.4.7.0 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -81,7 +81,7 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple- tag: v0.4.6.0+ tag: v0.4.7.0 test-suite test type: exitcode-stdio-1.0
src/Database/PostgreSQL/Simple/Time/Implementation.hs view
@@ -98,7 +98,7 @@ let !year = toNum yearStr _ <- A.char '-'- month <- digits "month"+ !month <- digits "month" _ <- A.char '-' day <- digits "day" @@ -115,7 +115,7 @@ getTimeOfDay :: A.Parser TimeOfDay getTimeOfDay = do- hour <- digits "hours"+ !hour <- digits "hours" _ <- A.char ':' minute <- digits "minutes" _ <- A.char ':'@@ -136,13 +136,43 @@ getTimeZone :: A.Parser TimeZone getTimeZone = do- sign <- A.satisfy (\c -> c == '+' || c == '-')- hours <- digits "timezone"- mins <- (A.char ':' *> digits "timezone minutes") <|> pure 0+ !sign <- A.satisfy (\c -> c == '+' || c == '-')+ !hours <- digits "timezone"+ !mins <- (A.char ':' *> digits "timezone minutes") <|> pure 0 let !absset = 60 * hours + mins !offset = if sign == '+' then absset else -absset return $! minutesToTimeZone offset +type TimeZoneHMS = (Int,Int,Int)++getTimeZoneHMS :: A.Parser TimeZoneHMS+getTimeZoneHMS = do+ !sign <- A.satisfy (\c -> c == '+' || c == '-')+ !hours <- digits "timezone"+ !mins <- (A.char ':' *> digits "timezone minutes") <|> pure 0+ !secs <- (A.char ':' *> digits "timezone seconds") <|> pure 0+ if sign == '+'+ then return $! (hours, mins, secs)+ else return $! (\ !h !m !s -> (h,m,s)) (-hours) (-mins) (-secs)++localToUTCTimeOfDayHMS :: TimeZoneHMS -> TimeOfDay -> (Integer, TimeOfDay)+localToUTCTimeOfDayHMS (dh, dm, ds) (TimeOfDay h m s) =+ (\ !a !b -> (a,b)) dday (TimeOfDay h'' m'' s'')+ where+ s' = s - fromIntegral ds+ (!s'', m')+ | s' < 0 = (s' + 60, m - dm - 1)+ | s' >= 60 = (s' - 60, m - dm + 1)+ | otherwise = (s' , m - dm )+ (!m'', h')+ | m' < 0 = (m' + 60, h - dh - 1)+ | m' >= 60 = (m' - 60, h - dh + 1)+ | otherwise = (m' , h - dh )+ (!h'', dday)+ | h' < 0 = (h' + 24, -1)+ | h' >= 24 = (h' - 24, 1)+ | otherwise = (h' , 0)+ getZonedTime :: A.Parser ZonedTime getZonedTime = ZonedTime <$> getLocalTime <*> getTimeZone @@ -154,11 +184,11 @@ day <- getDay _ <- A.char ' ' time <- getTimeOfDay- zone <- getTimeZone- let (!dayDelta,!time') = localToUTCTimeOfDay zone time+ zone <- getTimeZoneHMS+ let !(dayDelta,time') = localToUTCTimeOfDayHMS zone time let !day' = addDays dayDelta day let !time'' = timeOfDayToTime time'- return (UTCTime day' time'')+ return $! UTCTime day' time'' getUTCTimestamp :: A.Parser UTCTimestamp getUTCTimestamp = getUnbounded getUTCTime
src/Database/PostgreSQL/Simple/Time/Internal.hs view
@@ -19,6 +19,9 @@ , getZonedTimestamp , getUTCTime , getUTCTimestamp+ , TimeZoneHMS+ , getTimeZoneHMS+ , localToUTCTimeOfDayHMS ) where import Database.PostgreSQL.Simple.Time.Implementation
test/Time.hs view
@@ -17,6 +17,19 @@ when printed to a string and subtracted an hour when parsed from string would still pass these tests. ++Right now, we are checking that 1400+ timestamps in the range of 1860 to+2060 round trip from postgresql to haskell and back in 5 different timezones.+In addition to UTC, the four timezones were selected so that 2 have a positive+offset, and 2 have a negative offset, and that 2 have an offset of a+whole number of hours, while the other two do not.++It may be worth adding a few more timezones to ensure better test coverage.++We are checking a handful of selected timestamps to ensure we hit+various corner-cases in the code, in addition to 1400 timestamps randomly+generated with granularity of seconds down to microseconds in powers of ten.+ -} module Time (testTime) where@@ -35,13 +48,13 @@ initializeTable env execute_ conn "SET timezone TO 'UTC'" checkRoundTrips env- execute_ conn "SET timezone TO 'America/Chicago'"+ execute_ conn "SET timezone TO 'America/Chicago'" -- -5:00 checkRoundTrips env- execute_ conn "SET timezone TO 'Asia/Tokyo'"+ execute_ conn "SET timezone TO 'Asia/Tokyo'" -- +9:00 checkRoundTrips env- execute_ conn "SET timezone TO 'Asia/Kathmandu'"+ execute_ conn "SET timezone TO 'Asia/Kathmandu'" -- +5:45 checkRoundTrips env- execute_ conn "SET timezone TO 'America/St_Johns'"+ execute_ conn "SET timezone TO 'America/St_Johns'" -- -3:30 checkRoundTrips env initializeTable :: TestEnv -> IO ()@@ -49,10 +62,37 @@ execute_ conn [sql| CREATE TEMPORARY TABLE testtime ( x serial, y timestamptz, PRIMARY KEY(x) ) |]++ let test :: ByteString -> IO () = \x -> do+ execute conn [sql|+ INSERT INTO testtime (y) VALUES (?)+ |] (Only x)+ return ()+ -- America/Chicago+ test "1883-11-18 11:59:59-05:50:36"+ test "1883-11-18 12:09:23-05:50:36"+ test "1883-11-18 12:00:00-06"+ -- Asia/Tokyo+ test "1887-12-31 23:59:59+09:18:59"+ test "1888-01-01 00:18:58+09:18:59"+ test "1888-01-01 00:00:00+09"+ -- Asia/Kathmandu+ test "1919-12-31 23:59:59+05:41:16"+ test "1919-12-31 23:48:44+05:30"+ test "1985-12-31 23:59:59+05:30"+ test "1986-01-01 00:15:00+05:45"+ -- America/St_Johns+ test "1935-03-29 23:59:59-03:30:52"+ test "1935-03-30 00:00:52-03:30"++ -- While the above special cases are probably a decent start, there+ -- are probably more that are well worth adding to ensure better+ -- coverage.+ let pop :: ByteString -> Double -> IO () = \x y -> replicateM_ numTests $ execute conn [sql| INSERT INTO testtime (y) VALUES- ('1936-01-01 00:00:00+00'::timestamptz+ ('1860-01-01 00:00:00+00'::timestamptz + ?::interval * ROUND(RANDOM() * ?)) |] (x,y) pop "1 microsecond" 6.3113904e15 pop "10 microseconds" 6.3113904e14