Add FromField DiffTime and FromField TimeOfDay
This commit is contained in:
parent
9628a4b57f
commit
7eccd0d778
@ -16,7 +16,13 @@ import Data.ByteString (ByteString)
|
||||
import Data.Functor (($>))
|
||||
import Data.Int (Int32)
|
||||
import Data.Proxy (Proxy (..))
|
||||
import Data.Time (Day (..))
|
||||
import Data.Time
|
||||
( Day (..)
|
||||
, DiffTime
|
||||
, TimeOfDay
|
||||
, picosecondsToDiffTime
|
||||
, timeToTimeOfDay
|
||||
)
|
||||
import Data.Text (Text)
|
||||
import Data.Word (Word32, Word64)
|
||||
import Database.PostgreSQL.LibPQ (Oid)
|
||||
@ -125,6 +131,23 @@ instance FromField Day where
|
||||
where
|
||||
fromJulianDay x = ModifiedJulianDay $ x + 51544
|
||||
|
||||
-- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
|
||||
-- Binary format: https://git.postgresql.org/gitweb/?p=postgresql.git;a=blob;f=src/backend/utils/adt/date.c;h=ae0f24de2c3c54eb6d0405cdb212597c2407238e;hb=HEAD#l1542.
|
||||
-- Accepts @time@.
|
||||
instance FromField DiffTime where
|
||||
validOid Proxy = Oid.time
|
||||
parseField = microsecondsToDiffTime <$> intParser
|
||||
where
|
||||
microsecondsToDiffTime :: Integer -> DiffTime
|
||||
microsecondsToDiffTime ms = picosecondsToDiffTime $ ms * 1000000
|
||||
|
||||
-- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
|
||||
-- Binary format: https://git.postgresql.org/gitweb/?p=postgresql.git;a=blob;f=src/backend/utils/adt/date.c;h=ae0f24de2c3c54eb6d0405cdb212597c2407238e;hb=HEAD#l1542.
|
||||
-- Accepts @time@.
|
||||
instance FromField TimeOfDay where
|
||||
validOid Proxy = Oid.time
|
||||
parseField = timeToTimeOfDay <$> parseField @DiffTime
|
||||
|
||||
newtype RawField = RawField ByteString
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
@ -52,3 +52,7 @@ boolean = eq $ Oid 16
|
||||
-- | Single days/dates.
|
||||
date :: Oid -> Bool
|
||||
date = eq $ Oid 1082
|
||||
|
||||
-- | Time of day.
|
||||
time :: Oid -> Bool
|
||||
time = eq $ Oid 1083
|
||||
|
@ -4,7 +4,7 @@
|
||||
module Database.PostgreSQL.Opium.FromFieldSpec (spec) where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Time (Day (..), fromGregorian)
|
||||
import Data.Time (Day (..), DiffTime, TimeOfDay (..), fromGregorian, secondsToDiffTime)
|
||||
import Data.Text (Text)
|
||||
import Database.PostgreSQL.LibPQ (Connection)
|
||||
import Database.PostgreSQL.Opium (FromRow)
|
||||
@ -81,6 +81,18 @@ newtype ADay = ADay
|
||||
|
||||
instance FromRow ADay where
|
||||
|
||||
newtype ADiffTime = ADiffTime
|
||||
{ difftime :: DiffTime
|
||||
} deriving (Eq, Generic, Show)
|
||||
|
||||
instance FromRow ADiffTime where
|
||||
|
||||
newtype ATimeOfDay = ATimeOfDay
|
||||
{ timeofday :: TimeOfDay
|
||||
} deriving (Eq, Generic, Show)
|
||||
|
||||
instance FromRow ATimeOfDay where
|
||||
|
||||
newtype ARawField = ARawField
|
||||
{ raw :: Opium.RawField
|
||||
} deriving (Eq, Generic, Show)
|
||||
@ -223,6 +235,18 @@ spec = do
|
||||
-- Example from postgres doc page
|
||||
shouldFetch conn "SELECT date 'J2451187' AS day" [ADay $ fromGregorian 1999 1 8]
|
||||
|
||||
describe "FromField DiffTime" $ do
|
||||
it "Decodes the time" $ \conn -> do
|
||||
shouldFetch conn "SELECT time '00:00:00' AS difftime" [ADiffTime 0]
|
||||
shouldFetch conn "SELECT time '00:01:00' AS difftime" [ADiffTime $ secondsToDiffTime 60]
|
||||
shouldFetch conn "SELECT time '13:07:43' AS difftime" [ADiffTime $ secondsToDiffTime $ 13 * 3600 + 7 * 60 + 43]
|
||||
|
||||
describe "FromField TimeOfDay" $ do
|
||||
it "Decodes the time" $ \conn -> do
|
||||
shouldFetch conn "SELECT time '00:00:00' AS timeofday" [ATimeOfDay $ TimeOfDay 0 0 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]
|
||||
|
||||
describe "FromField RawField" $ do
|
||||
it "Simply returns the bytestring without decoding it" $ \conn -> do
|
||||
shouldFetch conn "SELECT 'Hello, World!'::bytea AS raw" [ARawField $ Opium.RawField "Hello, World!"]
|
||||
|
Loading…
x
Reference in New Issue
Block a user