pgtype time support

Author: qz

src/Database/PostgreSQL/Protocol/Codecs/Decoders.hs

@@ -17,6 +17,7 @@ module Database.PostgreSQL.Protocol.Codecs.Decoders
     , bsJsonBytes
     , numeric
     , bsText
+    , time
     , timestamp
     , timestamptz
     , uuid
@@ -28,7 +29,7 @@ import Data.ByteString  (ByteString)
 import Data.Char        (chr)
 import Data.Int         (Int16, Int32, Int64)
 import Data.Scientific  (Scientific)
-import Data.Time        (Day, UTCTime, LocalTime, DiffTime)
+import Data.Time        (Day, UTCTime, LocalTime, DiffTime, TimeOfDay)
 import Data.UUID        (UUID, fromWords)
 import qualified Data.Vector as V
 
@@ -164,6 +165,10 @@ numeric _ = do
 bsText :: FieldDecoder ByteString
 bsText = getByteString
 
+{-# INLINE time #-}
+time :: FieldDecoder TimeOfDay
+time _ = mcsToTimeOfDay <$> getInt64BE
+
 {-# INLINE timestamp #-}
 timestamp :: FieldDecoder LocalTime
 timestamp _ = microsToLocalTime <$> getInt64BE

src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs

@@ -13,6 +13,7 @@ module Database.PostgreSQL.Protocol.Codecs.Encoders
     , bsJsonBytes
     , numeric
     , bsText
+    , time
     , timestamp
     , timestamptz
     , uuid
@@ -23,7 +24,7 @@ import Data.Char        (ord)
 import Data.Int         (Int16, Int32, Int64)
 import Data.Monoid      ((<>))
 import Data.Scientific  (Scientific)
-import Data.Time        (Day, UTCTime, LocalTime, DiffTime)
+import Data.Time        (Day, UTCTime, LocalTime, DiffTime, TimeOfDay)
 import Data.UUID        (UUID, toWords)
 
 import Database.PostgreSQL.Protocol.Store.Encode
@@ -104,6 +105,10 @@ numeric n =
 bsText :: ByteString -> Encode
 bsText = putByteString
 
+{-# INLINE time #-}
+time :: TimeOfDay -> Encode
+time = putInt64BE . timeOfDayToMcs
+
 {-# INLINE timestamp #-}
 timestamp :: LocalTime -> Encode
 timestamp = putInt64BE . localTimeToMicros 

src/Database/PostgreSQL/Protocol/Codecs/PgTypes.hs

@@ -18,6 +18,7 @@ module Database.PostgreSQL.Protocol.Codecs.PgTypes
     , jsonb
     , numeric
     , text
+    , time
     , timestamp
     , timestamptz
     , uuid 
@@ -88,6 +89,9 @@ numeric = mkOids 1700 1231
 text :: Oids              
 text = mkOids 25 1009    
 
+time :: Oids
+time = mkOids 1083 1183
+
 timestamp :: Oids       
 timestamp = mkOids 1114 1115 
 

src/Database/PostgreSQL/Protocol/Codecs/Time.hs

@@ -2,9 +2,11 @@ module Database.PostgreSQL.Protocol.Codecs.Time
     ( dayToPgj
     , utcToMicros
     , localTimeToMicros
+    , timeOfDayToMcs
     , pgjToDay
     , microsToUTC
     , microsToLocalTime
+    , mcsToTimeOfDay
     , intervalToDiffTime
     , diffTimeToInterval
     ) where

tests/Codecs/QuickCheck.hs

@@ -110,6 +110,7 @@ testCodecsEncodeDecode = testGroup "Codecs property 'encode . decode = id'"
                                     (fmap JsonString <$> PD.bsJsonBytes)
     , mkCodecTest "numeric" PGT.numeric PE.numeric PD.numeric
     , mkCodecTest "text" PGT.text PE.bsText PD.bsText
+    , mkCodecTest "time" PGT.time PE.time PD.time
     , mkCodecTest "timestamp" PGT.timestamp PE.timestamp PD.timestamp
     , mkCodecTest "timestamptz" PGT.timestamptz PE.timestamptz PD.timestamptz
     , mkCodecTest "uuid" PGT.uuid PE.uuid PD.uuid
@@ -174,6 +175,9 @@ instance Arbitrary Day where
 instance Arbitrary DiffTime where
     arbitrary = secondsToDiffTime <$> choose (0, 86400 - 1)
 
+instance Arbitrary TimeOfDay where
+    arbitrary = timeToTimeOfDay <$> arbitrary
+
 instance Arbitrary LocalTime where
     arbitrary = LocalTime <$> arbitrary <*> fmap timeToTimeOfDay arbitrary