content: module Database.PostgreSQL.Protocol.Codecs.Decoders 
      ( dataRowHeader
      , getNonNullable
      , getNullable
      , FieldDecoder
      , bool
      , bytea
      , char
      , date
      , float4
      , float8
      , int2
      , int4
      , int8
      , interval
      , bsJsonText
      , bsJsonBytes
      , numeric
      , bsText
      , time
      , timetz
      , timestamp
      , timestamptz
      , uuid
      ) where
  
  import Prelude hiding   (bool)
  import Control.Monad    (replicateM, (<$!>))
  import Data.ByteString  (ByteString)
  import Data.Char        (chr)
  import Data.Int         (Int16, Int32, Int64)
  import Data.Scientific  (Scientific)
  import Data.Time        (Day, UTCTime, LocalTime, DiffTime, TimeOfDay)
  import Data.UUID        (UUID, fromWords)
  import qualified Data.Vector as V
  
  import Database.PostgreSQL.Protocol.Store.Decode
  import Database.PostgreSQL.Protocol.Types
  import Database.PostgreSQL.Protocol.Codecs.Time
  import Database.PostgreSQL.Protocol.Codecs.Numeric
  
  -- | Decodes DataRow header.
  -- 1 byte - Message Header
  -- 4 bytes - Message length
  -- 2 bytes - count of columns in the DataRow
  {-# INLINE dataRowHeader #-}
  dataRowHeader :: Decode ()
  dataRowHeader = skipBytes 7
  
  {-# INLINE fieldLength #-}
  fieldLength :: Decode Int
  fieldLength = fromIntegral <$> getWord32BE
  
  {-# INLINE getNonNullable #-}
  getNonNullable :: FieldDecoder a -> Decode a
  getNonNullable fdec = fieldLength >>= fdec
  
  {-# INLINE getNullable #-}
  getNullable :: FieldDecoder a -> Decode (Maybe a)
  getNullable fdec = do
      len <- fieldLength
      if len == -1
      then pure Nothing
      else Just <$!> fdec len
  
  -- | Field in composites contain Oid before value
  {-# INLINE compositeValuePrefix #-}
  compositeValuePrefix :: Decode ()
  compositeValuePrefix = skipBytes 4 
  
  -- | Skips length of elements in composite
  {-# INLINE compositeHeader #-}
  compositeHeader :: Decode ()
  compositeHeader = skipBytes 4
  
  -- | Skips array header.
  -- 4 bytes - count of dimensions
  -- 4 bytes - if array contains any NULL
  -- 4 bytes - element Oid
  {-# INLINE arrayHeader #-}
  arrayHeader :: Decode ()
  arrayHeader = skipBytes 12
  
  -- | Decodes size of each dimension.
  {-# INLINE arrayDimensions #-}
  arrayDimensions :: Int -> Decode (V.Vector Int)
  arrayDimensions dims = V.reverse <$> V.replicateM dims arrayDimSize 
    where
      -- 4 bytes - count of elements in the dimension
      -- 4 bytes - lower bound
      arrayDimSize = (fromIntegral <$> getWord32BE) <* getWord32BE
  
  {-# INLINE arrayFieldDecoder #-}
  arrayFieldDecoder :: Int -> (V.Vector Int -> Decode a) -> FieldDecoder a
  arrayFieldDecoder dims f _ = arrayHeader *> arrayDimensions dims >>= f
  
  --
  -- Primitives
  --
  
  -- | Decodes only a content of the field.
  type FieldDecoder a = Int -> Decode a 
  
  {-# INLINE bool #-}
  bool :: FieldDecoder Bool
  bool _ = (== 1) <$> getWord8
  
  {-# INLINE bytea #-}
  bytea :: FieldDecoder ByteString
  bytea = getByteString
  
  {-# INLINE char #-}
  char :: FieldDecoder Char
  char _ = chr . fromIntegral <$> getWord8
  
  {-# INLINE date #-}
  date :: FieldDecoder Day
  date _ = pgjToDay <$> getInt32BE
  
  {-# INLINE float4 #-}
  float4 :: FieldDecoder Float
  float4 _ = getFloat32BE
  
  {-# INLINE float8 #-}
  float8 :: FieldDecoder Double
  float8 _ = getFloat64BE
  
  {-# INLINE int2 #-}
  int2 :: FieldDecoder Int16
  int2 _ = getInt16BE
  
  {-# INLINE int4 #-}
  int4 :: FieldDecoder Int32
  int4 _ = getInt32BE 
  
  {-# INLINE int8 #-}
  int8 :: FieldDecoder Int64
  int8 _ = getInt64BE 
  
  {-# INLINE interval #-}
  interval :: FieldDecoder DiffTime
  interval _ = intervalToDiffTime <$> getInt64BE <*> getInt32BE <*> getInt32BE
  
  -- | Decodes representation of JSON as @ByteString@.
  {-# INLINE bsJsonText #-}
  bsJsonText :: FieldDecoder ByteString
  bsJsonText = getByteString
  
  -- | Decodes representation of JSONB as @ByteString@.
  {-# INLINE bsJsonBytes #-}
  bsJsonBytes :: FieldDecoder ByteString
  bsJsonBytes len = getWord8 *> getByteString (len - 1)
  
  {-# INLINE numeric #-}
  numeric :: FieldDecoder Scientific
  numeric _ = do 
      ndigits <- getWord16BE
      weight  <- getInt16BE
      sign    <- fromNumericSign =<< getWord16BE 
      _       <- getWord16BE
      numericToScientific sign weight <$> 
          replicateM (fromIntegral ndigits) getWord16BE
  
  -- | Decodes text without applying encoding.
  {-# INLINE bsText #-}
  bsText :: FieldDecoder ByteString
  bsText = getByteString
  
  {-# INLINE time #-}
  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
  
  {-# INLINE timestamptz #-}
  timestamptz :: FieldDecoder UTCTime
  timestamptz _ = microsToUTC <$> getInt64BE
  
  {-# INLINE uuid #-}
  uuid :: FieldDecoder UUID
  uuid _ = fromWords 
      <$> getWord32BE
      <*> getWord32BE
      <*> getWord32BE
      <*> getWord32BE
  