module PostgreSQLBinary.Encoder.Builder where import PostgreSQLBinary.Prelude hiding (bool) import Data.ByteString.Builder import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import qualified Data.Scientific as Scientific import qualified Data.UUID as UUID import qualified PostgreSQLBinary.Array as Array import qualified PostgreSQLBinary.Time as Time import qualified PostgreSQLBinary.Numeric as Numeric {-# INLINE run #-} run :: Builder -> B.ByteString run = BL.toStrict . toLazyByteString {-# INLINE bool #-} bool :: Bool -> Builder bool = \case True -> word8 1; False -> word8 0 {-# INLINE array #-} array :: Array.Data -> Builder array (dimensionsV, valuesV, nullsV, oidV) = dimensionsLength <> nulls <> oid <> dimensions <> values where dimensionsLength = word32BE $ fromIntegral $ length dimensionsV nulls = word32BE $ if nullsV then 1 else 0 oid = word32BE oidV dimensions = foldMap dimension dimensionsV values = foldMap value valuesV dimension (w, l) = word32BE w <> word32BE l value = \case Nothing -> word32BE (-1) Just b -> word32BE (fromIntegral (B.length b)) <> byteString b {-# INLINE date #-} date :: Day -> Builder date = int32BE . fromIntegral . Time.dayToPostgresJulian {-# INLINE timestamp #-} timestamp :: UTCTime -> Builder timestamp (UTCTime dayX timeX) = let days = Time.dayToPostgresJulian dayX * 10^6 * 60 * 60 * 24 time = (`div` (10^6)) . unsafeCoerce $ timeX in int64BE $ fromIntegral $ days + time {-# INLINE timestamptz #-} timestamptz :: LocalTime -> Builder timestamptz (LocalTime dayX timeX) = let days = Time.dayToPostgresJulian dayX * 10^6 * 60 * 60 * 24 time = (`div` (10^6)) . unsafeCoerce timeOfDayToTime $ timeX in int64BE $ fromIntegral $ days + time {-# INLINE interval #-} interval :: DiffTime -> Builder interval x = flip evalState (unsafeCoerce x :: Integer) $ do u <- state (`divMod` (10 ^ 6)) d <- state (`divMod` (10 ^ 6 * 60 * 60 * 24)) m <- get return $ int64BE (fromIntegral u) <> int32BE (fromIntegral d) <> int32BE (fromIntegral m) {-# INLINE numeric #-} numeric :: Scientific -> Builder numeric x = word16BE (fromIntegral componentsAmount) <> int16BE (fromIntegral pointIndex) <> word16BE signCode <> word16BE (fromIntegral trimmedExponent) <> foldMap word16BE components where componentsAmount = length components coefficient = Scientific.coefficient x exponent = Scientific.base10Exponent x components = Numeric.extractComponents tunedCoefficient pointIndex = componentsAmount + (tunedExponent `div` 4) - 1 (tunedCoefficient, tunedExponent) = case mod exponent 4 of 0 -> (coefficient, exponent) x -> (coefficient * 10 ^ x, exponent - x) trimmedExponent = if tunedExponent >= 0 then 0 else negate tunedExponent signCode = if coefficient < 0 then Numeric.negSignCode else Numeric.posSignCode {-# INLINE uuid #-} uuid :: UUID -> Builder uuid = UUID.toWords >>> \(a, b, c, d) -> word32BE a <> word32BE b <> word32BE c <> word32BE d