Decoders for date/time fields

postgres-wire.cabal

@@ -34,6 +34,7 @@ library
                      , Database.PostgreSQL.Protocol.Store.Decode
                      , Database.PostgreSQL.Protocol.Codecs.Decoders
                      , Database.PostgreSQL.Protocol.Codecs.PgTypes
+                     , Database.PostgreSQL.Protocol.Codecs.Time
   other-modules:       Database.PostgreSQL.Protocol.Utils
   build-depends:       base >= 4.7 && < 5
                      , bytestring

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

@@ -3,6 +3,7 @@ module Database.PostgreSQL.Protocol.Codecs.Decoders where
 import Data.Word
 import Data.Int
 import Data.Char
+import Data.Time (Day, UTCTime, LocalTime)
 import qualified Data.ByteString as B
 import qualified Data.Vector as V
 
@@ -11,6 +12,7 @@ import Prelude hiding (bool)
 
 import Database.PostgreSQL.Protocol.Store.Decode
 import Database.PostgreSQL.Protocol.Types
+import Database.PostgreSQL.Protocol.Codecs.Time
 
 -- | Decodes DataRow header.
 -- 1 byte - Message Header
@@ -86,8 +88,9 @@ bytea = getByteString
 char :: FieldDecoder Char
 char _ = chr . fromIntegral <$> getWord8
 
--- date :: FieldDecoder ?
--- date = undefined
+{-# INLINE date #-}
+date :: FieldDecoder Day
+date _ = pgjToDay <$> getInt32BE
 
 {-# INLINE float4 #-}
 float4 :: FieldDecoder Float
@@ -118,7 +121,7 @@ bsJsonText :: FieldDecoder B.ByteString
 bsJsonText = getByteString
 
 -- | Decodes representation of JSONB as @ByteString@.
-{-# INLINE bytestringJsonBytes #-}
+{-# INLINE bsJsonBytes #-}
 bsJsonBytes :: FieldDecoder B.ByteString
 bsJsonBytes len = getWord8 *> getByteString (len - 1)
 
@@ -130,9 +133,10 @@ bsJsonBytes len = getWord8 *> getByteString (len - 1)
 bsText :: FieldDecoder B.ByteString
 bsText = getByteString
 
--- timestamp :: FieldDecoder ?
--- timestamp = undefined
+{-# INLINE timestamp #-}
+timestamp :: FieldDecoder LocalTime
+timestamp _ = microsToLocalTime <$> getInt64BE
 
--- timestamptz :: FieldDecoder ?
--- timestamptz = undefined
+timestamptz :: FieldDecoder UTCTime
+timestamptz _ = microsToUTC <$> getInt64BE
 

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

@@ -1,6 +1,78 @@
-module Database.PostgreSQL.Protocol.Codecs.Time where
+module Database.PostgreSQL.Protocol.Codecs.Time 
+    ( dayToPgj
+    , utcToMicros
+    , localTimeToMicros
+    , pgjToDay
+    , microsToUTC
+    , microsToLocalTime
+    ) where
 
-import Data.Time
+import Data.Int  (Int64)
+import Data.Time (Day(..), UTCTime(..), LocalTime(..), DiffTime, TimeOfDay,
+                  picosecondsToDiffTime, timeToTimeOfDay,
+                  diffTimeToPicoseconds, timeOfDayToTime)
+
+{-# INLINE dayToPgj #-}
+dayToPgj :: Day -> Integer
+dayToPgj = (+ (modifiedJulianEpoch - postgresEpoch)) . toModifiedJulianDay
+
+{-# INLINE utcToMicros #-}
+utcToMicros :: UTCTime -> Int64
+utcToMicros (UTCTime day diffTime) = fromIntegral $ 
+    dayToMcs day + diffTimeToMcs diffTime
+
+{-# INLINE localTimeToMicros #-}
+localTimeToMicros :: LocalTime -> Int64
+localTimeToMicros (LocalTime day time) = fromIntegral $
+    dayToMcs day + timeOfDayToMcs time
+
+{-# INLINE pgjToDay #-}
+pgjToDay :: Integral a => a -> Day
+pgjToDay = ModifiedJulianDay . fromIntegral 
+                        . subtract (modifiedJulianEpoch - postgresEpoch)
+
+{-# INLINE microsToUTC #-}
+microsToUTC :: Int64 -> UTCTime
+microsToUTC mcs =
+    let (d, r) = mcs `divMod` microsInDay
+    in UTCTime (pgjToDay d) (mcsToDiffTime r)
+
+{-# INLINE microsToLocalTime #-}
+microsToLocalTime :: Int64 -> LocalTime
+microsToLocalTime mcs =
+    let (d, r) = mcs `divMod` microsInDay
+    in LocalTime (pgjToDay d) (mcsToTimeOfDay r)
+
+--
+-- Utils
+--
+{-# INLINE dayToMcs #-}
+dayToMcs :: Day -> Integer
+dayToMcs = (microsInDay *) . dayToPgj 
+
+{-# INLINE diffTimeToMcs #-}
+diffTimeToMcs :: DiffTime -> Integer
+diffTimeToMcs = pcsToMcs . diffTimeToPicoseconds 
+
+{-# INLINE timeOfDayToMcs #-}
+timeOfDayToMcs :: TimeOfDay -> Integer
+timeOfDayToMcs = diffTimeToMcs . timeOfDayToTime 
+
+{-# INLINE mcsToDiffTime #-}
+mcsToDiffTime :: Integral a => a -> DiffTime
+mcsToDiffTime = picosecondsToDiffTime . fromIntegral . mcsToPcs 
+
+{-# INLINE mcsToTimeOfDay #-}
+mcsToTimeOfDay :: Integral a => a -> TimeOfDay
+mcsToTimeOfDay = timeToTimeOfDay . mcsToDiffTime
+
+{-# INLINE pcsToMcs #-}
+pcsToMcs :: Integral a => a -> a
+pcsToMcs = (`div` 10 ^ 6)
+
+{-# INLINE mcsToPcs #-}
+mcsToPcs :: Integral a => a -> a
+mcsToPcs = (* 10 ^ 6)
 
 modifiedJulianEpoch :: Num a => a 
 modifiedJulianEpoch = 2400001
@@ -10,26 +82,3 @@ postgresEpoch = 2451545
 
 microsInDay :: Num a => a
 microsInDay = 24 * 60 * 60 * 10 ^ 6
-
-picosecondsToMicros :: Integral a => a -> a
-picosecondsToMicros = (`div` 10 ^ 6)
-
-dayToPostgresJulian :: Day -> Integer
-dayToPostgresJulian = (+ (modifiedJulianEpoch - postgresEpoch)) 
-                        . toModifiedJulianDay
-
-postgresJulianToDay :: Integral a => a -> Day
-postgresJulianToDay = ModifiedJulianDay . fromIntegral 
-                        . subtract (modifiedJulianEpoch - postgresEpoch)
-
-utcToMicros :: UTCTime -> Int64
-utcToMicros (UTCTime day diffTime) =
-    let d = microsInDay $ dayToPostgresJulian day
-        p = picosecondsToMicros $ diffTimeToPicoseconds diffTime
-    in fromIntegral $ d + p
-
-localTimeToMicros :: LocalTime -> Int64
-localTimeToMicros (LocalTime day time) =
-  let d = microsInDay $ dayToPostgresJulian day
-      p = picosecondsToMicros . diffTimeToPicoseconds $ timeOfDayToTime timeX
-      in fromIntegral $ d + p