From 2c1beb4275ef1064d8a98add5840d8a6154428c1 Mon Sep 17 00:00:00 2001
From: qz <qz@pandaren.local>
Date: Tue, 29 Jan 2019 10:58:37 +0300
Subject: [PATCH] pgtype timetz support (assume UTC)

---
 src/Database/PostgreSQL/Protocol/Codecs/Decoders.hs | 8 ++++++++
 src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs | 7 ++++++-
 src/Database/PostgreSQL/Protocol/Codecs/PgTypes.hs  | 4 ++++
 src/Database/PostgreSQL/Protocol/Codecs/Time.hs     | 2 ++
 tests/Codecs/QuickCheck.hs                          | 1 +
 5 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/src/Database/PostgreSQL/Protocol/Codecs/Decoders.hs b/src/Database/PostgreSQL/Protocol/Codecs/Decoders.hs
index 7510e76..09088e7 100644
--- a/src/Database/PostgreSQL/Protocol/Codecs/Decoders.hs
+++ b/src/Database/PostgreSQL/Protocol/Codecs/Decoders.hs
@@ -18,6 +18,7 @@ module Database.PostgreSQL.Protocol.Codecs.Decoders
     , numeric
     , bsText
     , time
+    , timetz
     , timestamp
     , timestamptz
     , uuid
@@ -169,6 +170,13 @@ bsText = getByteString
 time :: FieldDecoder TimeOfDay
 time _ = mcsToTimeOfDay <$> getInt64BE
 
+{-# INLINE timetz #-}
+timetz :: FieldDecoder TimeOfDay
+timetz _ = do
+  t <- getInt64BE
+  skipBytes 4
+  return $ mcsToTimeOfDay t
+
 {-# INLINE timestamp #-}
 timestamp :: FieldDecoder LocalTime
 timestamp _ = microsToLocalTime <$> getInt64BE
diff --git a/src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs b/src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs
index 768f285..709891c 100644
--- a/src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs
+++ b/src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs
@@ -14,6 +14,7 @@ module Database.PostgreSQL.Protocol.Codecs.Encoders
     , numeric
     , bsText
     , time
+    , timetz
     , timestamp
     , timestamptz
     , uuid
@@ -48,7 +49,7 @@ bytea = putByteString
 {-# INLINE char #-}
 char :: Char -> Encode
 char c
-  | ord(c) >= 128 = error "Character code must be below 128"
+  | ord c >= 128 = error "Character code must be below 128"
   | otherwise = (putWord8 . fromIntegral . ord) c
 
 {-# INLINE date #-}
@@ -109,6 +110,10 @@ bsText = putByteString
 time :: TimeOfDay -> Encode
 time = putInt64BE . timeOfDayToMcs
 
+{-# INLINE timetz #-}
+timetz :: TimeOfDay -> Encode
+timetz t = putInt64BE (timeOfDayToMcs t) <> putInt32BE 0
+
 {-# INLINE timestamp #-}
 timestamp :: LocalTime -> Encode
 timestamp = putInt64BE . localTimeToMicros 
diff --git a/src/Database/PostgreSQL/Protocol/Codecs/PgTypes.hs b/src/Database/PostgreSQL/Protocol/Codecs/PgTypes.hs
index 4077c65..591815f 100644
--- a/src/Database/PostgreSQL/Protocol/Codecs/PgTypes.hs
+++ b/src/Database/PostgreSQL/Protocol/Codecs/PgTypes.hs
@@ -19,6 +19,7 @@ module Database.PostgreSQL.Protocol.Codecs.PgTypes
     , numeric
     , text
     , time
+    , timetz
     , timestamp
     , timestamptz
     , uuid 
@@ -92,6 +93,9 @@ text = mkOids 25 1009
 time :: Oids
 time = mkOids 1083 1183
 
+timetz :: Oids
+timetz = mkOids 1266 1270
+
 timestamp :: Oids       
 timestamp = mkOids 1114 1115 
 
diff --git a/src/Database/PostgreSQL/Protocol/Codecs/Time.hs b/src/Database/PostgreSQL/Protocol/Codecs/Time.hs
index 67072b6..b136e06 100644
--- a/src/Database/PostgreSQL/Protocol/Codecs/Time.hs
+++ b/src/Database/PostgreSQL/Protocol/Codecs/Time.hs
@@ -7,8 +7,10 @@ module Database.PostgreSQL.Protocol.Codecs.Time
     , microsToUTC
     , microsToLocalTime
     , mcsToTimeOfDay
+    , mcsToDiffTime
     , intervalToDiffTime
     , diffTimeToInterval
+    , diffTimeToMcs
     ) where
 
 import Data.Int  (Int64, Int32, Int64)
diff --git a/tests/Codecs/QuickCheck.hs b/tests/Codecs/QuickCheck.hs
index 3bedb4b..cb017ce 100644
--- a/tests/Codecs/QuickCheck.hs
+++ b/tests/Codecs/QuickCheck.hs
@@ -111,6 +111,7 @@ testCodecsEncodeDecode = testGroup "Codecs property 'encode . decode = id'"
     , 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 "timetz" PGT.timetz PE.timetz PD.timetz
     , mkCodecTest "timestamp" PGT.timestamp PE.timestamp PD.timestamp
     , mkCodecTest "timestamptz" PGT.timestamptz PE.timestamptz PD.timestamptz
     , mkCodecTest "uuid" PGT.uuid PE.uuid PD.uuid