Implement UTCTime decoding

Remove LocalTime decoding because it requires IO to convert from Postgres time.
This commit is contained in:
Paul Brinkmeier 2024-01-08 15:28:14 +01:00
parent 68d747f605
commit 4bf489c554
4 changed files with 33 additions and 30 deletions

View File

@ -67,6 +67,7 @@ getScoreByAge conn = do
- [x] Implement `UTCTime` - [x] Implement `UTCTime`
- [x] Implement `ByteString` decoding (`bytea`) - [x] Implement `ByteString` decoding (`bytea`)
- [x] Test negative integer decoding, especially for `Integer` - [x] Test negative integer decoding, especially for `Integer`
- [ ] Implement time intervals
- [ ] and zoned time decoding - [ ] and zoned time decoding
- [ ] Implement `fetch` (`fetch_` but with parameter passing) - [ ] Implement `fetch` (`fetch_` but with parameter passing)
- [ ] Implement JSON decoding - [ ] Implement JSON decoding

View File

@ -19,8 +19,8 @@ import Data.Proxy (Proxy (..))
import Data.Time import Data.Time
( Day (..) ( Day (..)
, DiffTime , DiffTime
, LocalTime (..)
, TimeOfDay , TimeOfDay
, UTCTime (..)
, addDays , addDays
, fromGregorian , fromGregorian
, picosecondsToDiffTime , picosecondsToDiffTime
@ -171,23 +171,20 @@ instance FromField TimeOfDay where
validOid Proxy = Oid.time validOid Proxy = Oid.time
parseField = timeToTimeOfDay <$> parseField @DiffTime parseField = timeToTimeOfDay <$> parseField @DiffTime
-- | See https://www.postgresql.org/docs/current/datatype-datetime.html. fromPostgresTimestamp :: Int -> (Day, DiffTime)
-- | Accepts @timestamp@. fromPostgresTimestamp ts = (day, time)
-- Note that Postgres uses the proleptic Gregorian calendar, whereas @Show Day@ and @fromGregorian@ use an astronomical calendar.
-- In short, Postgres treats 1 BC as a leap year and doesn't have a year zero.
-- This means that working with negative dates will be different in Postgres and your application code.
instance FromField LocalTime where
validOid Proxy = Oid.timestamp
parseField = fromPostgresTimestamp <$> readBigEndian @Int <$> AP.takeByteString
where where
fromPostgresTimestamp :: Int -> LocalTime
fromPostgresTimestamp ts =
let
(days, microseconds) = ts `divMod` (86400 * 1000000) (days, microseconds) = ts `divMod` (86400 * 1000000)
day = fromPostgresJulian $ fromIntegral days day = fromPostgresJulian $ fromIntegral days
time = picosecondsToDiffTime $ fromIntegral microseconds * 1000000 time = picosecondsToDiffTime $ fromIntegral microseconds * 1000000
in
LocalTime day (timeToTimeOfDay time) -- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
-- Accepts @timestamp with timezone@.
instance FromField UTCTime where
validOid Proxy = Oid.timestampWithTimezone
parseField = toUTCTime . fromPostgresTimestamp <$> readBigEndian @Int <$> AP.takeByteString
where
toUTCTime (day, time) = UTCTime day time
newtype RawField a = RawField a newtype RawField a = RawField a
deriving (Eq, Show) deriving (Eq, Show)

View File

@ -60,3 +60,7 @@ time = eq $ Oid 1083
-- | A point in time. -- | A point in time.
timestamp :: Oid -> Bool timestamp :: Oid -> Bool
timestamp = eq $ Oid 1114 timestamp = eq $ Oid 1114
-- | A point in time.
timestampWithTimezone :: Oid -> Bool
timestampWithTimezone = eq $ Oid 1184

View File

@ -7,10 +7,11 @@ import Data.ByteString (ByteString)
import Data.Time import Data.Time
( Day (..) ( Day (..)
, DiffTime , DiffTime
, LocalTime (..)
, TimeOfDay (..) , TimeOfDay (..)
, UTCTime (..)
, fromGregorian , fromGregorian
, secondsToDiffTime , secondsToDiffTime
, timeOfDayToTime
) )
import Data.Text (Text) import Data.Text (Text)
import Database.PostgreSQL.LibPQ (Connection) import Database.PostgreSQL.LibPQ (Connection)
@ -100,11 +101,11 @@ newtype ATimeOfDay = ATimeOfDay
instance FromRow ATimeOfDay where instance FromRow ATimeOfDay where
newtype ALocalTime = ALocalTime newtype AUTCTime = AUTCTime
{ localtime :: LocalTime { utctime :: UTCTime
} deriving (Eq, Generic, Show) } deriving (Eq, Generic, Show)
instance FromRow ALocalTime where instance FromRow AUTCTime where
newtype ARawField = ARawField newtype ARawField = ARawField
{ raw :: Opium.RawField ByteString { raw :: Opium.RawField ByteString
@ -283,20 +284,20 @@ spec = do
shouldFetch conn "SELECT time '00:01:00' AS timeofday" [ATimeOfDay $ TimeOfDay 0 1 0] shouldFetch conn "SELECT time '00:01:00' AS timeofday" [ATimeOfDay $ TimeOfDay 0 1 0]
shouldFetch conn "SELECT time '13:07:43' AS timeofday" [ATimeOfDay $ TimeOfDay 13 7 43] shouldFetch conn "SELECT time '13:07:43' AS timeofday" [ATimeOfDay $ TimeOfDay 13 7 43]
describe "FromField LocalTime" $ do describe "FromField UTCTime" $ do
it "Decodes timestamp" $ \conn -> do it "Decodes timestamp with timezone" $ \conn -> do
let ts0 = LocalTime (fromGregorian 2023 10 2) (TimeOfDay 12 42 23) let ts0 = UTCTime (fromGregorian 2023 10 2) (timeOfDayToTime $ TimeOfDay 12 42 23)
shouldFetch conn "SELECT timestamp '2023-10-02 12:42:23' AS localtime" [ALocalTime ts0] shouldFetch conn "SELECT timestamp with time zone '2023-10-02 12:42:23' AS utctime" [AUTCTime ts0]
let ts1 = LocalTime (fromGregorian 294275 12 31) (TimeOfDay 23 59 59) let ts1 = UTCTime (fromGregorian 294275 12 31) (timeOfDayToTime $ TimeOfDay 23 59 59)
shouldFetch conn "SELECT timestamp '294275-12-31 23:59:59' AS localtime" [ALocalTime ts1] shouldFetch conn "SELECT timestamp with time zone '294275-12-31 23:59:59' AS utctime" [AUTCTime ts1]
let ts2 = LocalTime (fromGregorian 1 1 1) (TimeOfDay 0 0 0) let ts2 = UTCTime (fromGregorian 1 1 1) (timeOfDayToTime $ TimeOfDay 0 0 0)
shouldFetch conn "SELECT timestamp '0001-01-01 00:00:00' AS localtime" [ALocalTime ts2] shouldFetch conn "SELECT timestamp with time zone '0001-01-01 00:00:00' AS utctime" [AUTCTime ts2]
-- See note at the FromField Day instance. -- See note at the FromField Day instance.
let ts3 = LocalTime (fromGregorian 0 2 29) (TimeOfDay 0 0 0) let ts3 = UTCTime (fromGregorian 0 2 29) (timeOfDayToTime $ TimeOfDay 0 0 0)
shouldFetch conn "SELECT timestamp '0001-02-29 BC 00:00:00' AS localtime" [ALocalTime ts3] shouldFetch conn "SELECT timestamp with time zone '0001-02-29 BC 00:00:00' AS utctime" [AUTCTime ts3]
describe "FromField RawField" $ do describe "FromField RawField" $ do
it "Simply returns the bytestring without decoding it" $ \conn -> do it "Simply returns the bytestring without decoding it" $ \conn -> do