Base decoders for Time

postgres-wire.cabal

@@ -33,12 +33,12 @@ library
                      , Database.PostgreSQL.Protocol.Store.Encode
                      , Database.PostgreSQL.Protocol.Store.Decode
                      , Database.PostgreSQL.Protocol.Codecs.Decoders
+                     , Database.PostgreSQL.Protocol.Codecs.PgTypes
   other-modules:       Database.PostgreSQL.Protocol.Utils
   build-depends:       base >= 4.7 && < 5
                      , bytestring
                      , socket
                      , socket-unix
-                     , free
                      , vector
                      , safe
                      , time
@@ -47,10 +47,11 @@ library
                      , unordered-containers
                      , unix
                      , stm
-                     , postgresql-binary
                      , tls
                      , cryptonite
                      , store-core
+                     , scientific
+                     , uuid
   default-language:    Haskell2010
   default-extensions:  
     BangPatterns

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

@@ -70,6 +70,33 @@ arrayFieldDecoder dims f _ = arrayHeader *> arrayDimensions dims >>= f
 -- | Decodes only content of a field.
 type FieldDecoder a = Int -> Decode a 
 
+--
+-- Primitives
+--
+
+{-# INLINE bool #-}
+bool :: FieldDecoder Bool
+bool _ = (== 1) <$> getWord8
+
+{-# INLINE bytea #-}
+bytea :: FieldDecoder B.ByteString
+bytea = getByteString
+
+{-# INLINE char #-}
+char :: FieldDecoder Char
+char _ = chr . fromIntegral <$> getWord8
+
+-- date :: FieldDecoder ?
+-- date = undefined
+
+{-# INLINE float4 #-}
+float4 :: FieldDecoder Float
+float4 _ = getFloat32BE
+
+{-# INLINE float8 #-}
+float8 :: FieldDecoder Double
+float8 _ = getFloat64BE
+
 {-# INLINE int2 #-}
 int2 :: FieldDecoder Int16
 int2 _ =  getInt16BE
@@ -82,7 +109,30 @@ int4 _ =  getInt32BE
 int8 :: FieldDecoder Int64
 int8 _ =  getInt64BE 
 
-{-# INLINE bool #-}
-bool :: FieldDecoder Bool
-bool _ = (== 1) <$> getWord8
+-- interval :: FieldDecoder ?
+-- interval = undefined
+
+-- | Decodes representation of JSON as @ByteString@.
+{-# INLINE bsJsonText #-}
+bsJsonText :: FieldDecoder B.ByteString
+bsJsonText = getByteString
+
+-- | Decodes representation of JSONB as @ByteString@.
+{-# INLINE bytestringJsonBytes #-}
+bsJsonBytes :: FieldDecoder B.ByteString
+bsJsonBytes len = getWord8 *> getByteString (len - 1)
+
+-- numeric :: FieldDecoder Scientific
+-- numeric = undefined
+
+-- | Decodes text without applying encoding.
+{-# INLINE bsText #-}
+bsText :: FieldDecoder B.ByteString
+bsText = getByteString
+
+-- timestamp :: FieldDecoder ?
+-- timestamp = undefined
+
+-- timestamptz :: FieldDecoder ?
+-- timestamptz = undefined
 

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

@@ -52,6 +52,9 @@ interval = mkOids 1186 1187
 json :: Oids               
 json = mkOids 114 199     
 
+jsonb :: Oids
+jsonb = mkOids 3802 3807
+
 numeric :: Oids          
 numeric = mkOids 1700 1231 
 

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

@@ -0,0 +1,35 @@
+module Database.PostgreSQL.Protocol.Codecs.Time where
+
+import Data.Time
+
+modifiedJulianEpoch :: Num a => a 
+modifiedJulianEpoch = 2400001
+
+postgresEpoch :: Num a => a
+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