Base encoders

postgres-wire.cabal

@@ -33,6 +33,7 @@ library
                      , Database.PostgreSQL.Protocol.Store.Encode
                      , Database.PostgreSQL.Protocol.Store.Decode
                      , Database.PostgreSQL.Protocol.Codecs.Decoders
+                     , Database.PostgreSQL.Protocol.Codecs.Encoders
                      , Database.PostgreSQL.Protocol.Codecs.PgTypes
                      , Database.PostgreSQL.Protocol.Codecs.Time
                      , Database.PostgreSQL.Protocol.Codecs.Numeric

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

@@ -0,0 +1,100 @@
+module Database.PostgreSQL.Protocol.Codecs.Encoders where
+
+import Data.Word
+import Data.Monoid ((<>))
+import Data.Int
+import Data.Char
+import Data.Fixed
+import Data.UUID (UUID, toByteString)
+import Data.Time (Day, UTCTime, LocalTime, DiffTime)
+import qualified Data.ByteString as B
+import qualified Data.Vector as V
+
+import Control.Monad
+
+import Database.PostgreSQL.Protocol.Store.Encode
+import Database.PostgreSQL.Protocol.Types
+import Database.PostgreSQL.Protocol.Codecs.Time
+import Database.PostgreSQL.Protocol.Codecs.Numeric
+--
+-- Primitives
+--
+
+{-# INLINE bool #-}
+bool :: Bool -> Encode
+bool False = putWord8 0
+bool True  = putWord8 1
+
+{-# INLINE bytea #-}
+bytea :: B.ByteString -> Encode
+bytea = putByteString
+
+{-# INLINE char #-}
+char :: Char -> Encode
+char = putWord8 . fromIntegral . ord 
+
+{-# INLINE date #-}
+date :: Day -> Encode
+date = putWord32BE . dayToPgj
+
+{-# INLINE float4 #-}
+float4 :: Float -> Encode
+float4 = putFloat32BE
+
+{-# INLINE float8 #-}
+float8 :: Double -> Encode
+float8 = putFloat64BE
+
+{-# INLINE int2 #-}
+int2 :: Int16 -> Encode
+int2 = putInt16BE
+
+{-# INLINE int4 #-}
+int4 :: Int32 -> Encode
+int4 = putInt32BE 
+
+{-# INLINE int8 #-}
+int8 :: Int64 -> Encode
+int8 = putInt64BE 
+
+{-# INLINE interval #-}
+interval :: DiffTime -> Encode
+interval v = let (mcs, days, months)  = diffTimeToInterval v 
+             in putInt64BE mcs <> putInt32BE days <> putInt32BE months
+
+-- | Encodes representation of JSON as @ByteString@.
+{-# INLINE bsJsonText #-}
+bsJsonText :: B.ByteString -> Encode
+bsJsonText = putByteString
+
+-- | Encodes representation of JSONB as @ByteString@.
+{-# INLINE bsJsonBytes #-}
+bsJsonBytes :: B.ByteString -> Encode
+bsJsonBytes bs = putWord8 1 <> putByteString bs
+
+numeric :: HasResolution a => (Fixed a) -> Encode
+numeric _ = do undefined
+   -- ndigits <- putWord16BE
+   -- weight <- putInt16BE
+   -- msign <- numericSign <$> putWord16BE
+   -- sign <- maybe (fail "unknown numeric") pure msign
+   -- dscale <- putWord16BE
+   -- digits <- replicateM (fromIntegral ndigits) putWord16BE
+   -- pure $ undefined
+
+-- | Encodes text.
+{-# INLINE bsText #-}
+bsText :: B.ByteString -> Encode
+bsText = putByteString
+
+{-# INLINE timestamp #-}
+timestamp :: LocalTime -> Encode
+timestamp = putWord64BE . localTimeToMicros 
+
+{-# INLINE timestamptz #-}
+timestamptz :: UTCTime -> Encode
+timestamptz = putWord64BE . utcToMicros 
+
+{-# INLINE uuid #-}
+uuid :: UUID -> Encode
+uuid = undefined

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

@@ -16,18 +16,17 @@ import Data.Time (Day(..), UTCTime(..), LocalTime(..), DiffTime, TimeOfDay,
                   diffTimeToPicoseconds, timeOfDayToTime)
 
 {-# INLINE dayToPgj #-}
-dayToPgj :: Day -> Integer
-dayToPgj = (+ (modifiedJulianEpoch - postgresEpoch)) . toModifiedJulianDay
+dayToPgj :: Integral a => Day -> a
+dayToPgj = fromIntegral 
+    .(+ (modifiedJulianEpoch - postgresEpoch)) . toModifiedJulianDay
 
 {-# INLINE utcToMicros #-}
-utcToMicros :: UTCTime -> Word32
-utcToMicros (UTCTime day diffTime) = fromIntegral $ 
-    dayToMcs day + diffTimeToMcs diffTime
+utcToMicros :: UTCTime -> Word64
+utcToMicros (UTCTime day diffTime) = dayToMcs day + diffTimeToMcs diffTime
 
 {-# INLINE localTimeToMicros #-}
 localTimeToMicros :: LocalTime -> Word64
-localTimeToMicros (LocalTime day time) = fromIntegral $
-    dayToMcs day + timeOfDayToMcs time
+localTimeToMicros (LocalTime day time) = dayToMcs day + timeOfDayToMcs time
 
 {-# INLINE pgjToDay #-}
 pgjToDay :: Integral a => a -> Day
@@ -61,15 +60,15 @@ diffTimeToInterval dt = (fromIntegral $ diffTimeToMcs dt, 0, 0)
 -- Utils
 --
 {-# INLINE dayToMcs #-}
-dayToMcs :: Day -> Integer
+dayToMcs :: Integral a => Day -> a
 dayToMcs = (microsInDay *) . dayToPgj 
 
 {-# INLINE diffTimeToMcs #-}
-diffTimeToMcs :: DiffTime -> Integer
-diffTimeToMcs = pcsToMcs . diffTimeToPicoseconds 
+diffTimeToMcs :: Integral a => DiffTime -> a
+diffTimeToMcs = fromIntegral . pcsToMcs . diffTimeToPicoseconds 
 
 {-# INLINE timeOfDayToMcs #-}
-timeOfDayToMcs :: TimeOfDay -> Integer
+timeOfDayToMcs :: Integral a => TimeOfDay -> a
 timeOfDayToMcs = diffTimeToMcs . timeOfDayToTime 
 
 {-# INLINE mcsToDiffTime #-}