{-# LANGUAGE MagicHash #-}
-- | How a value is delimited on the wire, apart from packets and from what is
-- done with the value.  A value is read in two steps: 'cellHead' reads its
-- delimiter, and the caller then says what it wants of the payload, which is
-- all of it ('wholeValueBytes'), its pieces as they arrive ('valueStream') or
-- nothing ('skipValue').
module Hmssql.Tds.Value
  ( Row, rowColumnCount, rowCell, rowCellLength
  , rowValues, rowFromValues
  , ColumnShape (..), Cell (..), cellLength, rowShape, valueShape, cellHead
  , valueStream, boundedValue, WholeValue (..), wholeValueBytes, ownedValue, skipValue, foldValue, rowBitmap, columnNull, cellAt, skipCells
  ) where

import Streaming (Stream, Of (..))
import qualified Streaming as S
import qualified Streaming.Prelude as S
import Data.Primitive.SmallArray
import Data.Bits (testBit)
import qualified Data.ByteString as B
import Data.Int (Int64)
import Data.Word (Word64)
import Hmssql.Internal.Derived
import Hmssql.Tds.Parser (Parser)
import qualified Hmssql.Tds.Parser as P
import Hmssql.Tds.TypeInfo (RawBytes, TypeInfo, LengthKind (..), lengthKind)

-- | How a column's values are delimited, chosen once from its metadata.  A
-- value with no delimiter of its own (a fixed width, or no value at all) keeps
-- its 'Cell' here, so that every row shares it.
data ColumnShape = ConstantCell !Cell | ByteLength | ShortLength | LongLength | TextPointer | Variant | PlpValue
  deriving stock (ColumnShape -> ColumnShape -> Bool
(ColumnShape -> ColumnShape -> Bool)
-> (ColumnShape -> ColumnShape -> Bool) -> Eq ColumnShape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnShape -> ColumnShape -> Bool
== :: ColumnShape -> ColumnShape -> Bool
$c/= :: ColumnShape -> ColumnShape -> Bool
/= :: ColumnShape -> ColumnShape -> Bool
Eq)

instance Show ColumnShape where
  showsPrec :: Int -> ColumnShape -> ShowS
showsPrec Int
p = \case
    ConstantCell Cell
a -> Int -> Addr# -> Cell -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"ConstantCell"# Cell
a
    ColumnShape
ByteLength -> [Char] -> ShowS
showString [Char]
"ByteLength"
    ColumnShape
ShortLength -> [Char] -> ShowS
showString [Char]
"ShortLength"
    ColumnShape
LongLength -> [Char] -> ShowS
showString [Char]
"LongLength"
    ColumnShape
TextPointer -> [Char] -> ShowS
showString [Char]
"TextPointer"
    ColumnShape
Variant -> [Char] -> ShowS
showString [Char]
"Variant"
    ColumnShape
PlpValue -> [Char] -> ShowS
showString [Char]
"PlpValue"
  {-# OPAQUE showsPrec #-}

-- | What a value's delimiter said: NULL, a known length, or a PLP value whose
-- total length may or may not be known.  The payload still follows.
data Cell = NullCell | Sized !Int | Unsized !(Maybe Word64)
  deriving stock (Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
/= :: Cell -> Cell -> Bool
Eq)

instance Show Cell where
  showsPrec :: Int -> Cell -> ShowS
showsPrec Int
p = \case
    Cell
NullCell -> [Char] -> ShowS
showString [Char]
"NullCell"
    Sized Int
a -> Int -> Addr# -> Int -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"Sized"# Int
a
    Unsized Maybe Word64
a -> Int -> Addr# -> Maybe Word64 -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"Unsized"# Maybe Word64
a
  {-# OPAQUE showsPrec #-}

-- | How a RETURNVALUE's value is delimited: as a column's, except that a legacy
-- @text@, @ntext@ or @image@ value has no text pointer in front of it.
valueShape :: TypeInfo -> ColumnShape
valueShape :: TypeInfo -> ColumnShape
valueShape TypeInfo
ti = case TypeInfo -> LengthKind
lengthKind TypeInfo
ti of
  Fixed Int
n -> Cell -> ColumnShape
ConstantCell (Int -> Cell
Sized Int
n)
  LengthKind
ByteLen -> ColumnShape
ByteLength
  LengthKind
UShortCharBin -> ColumnShape
ShortLength
  LengthKind
LongLen -> ColumnShape
LongLength
  LengthKind
VariantLen -> ColumnShape
Variant
  LengthKind
Plp -> ColumnShape
PlpValue
  LengthKind
NoValue -> Cell -> ColumnShape
ConstantCell Cell
NullCell

-- | How a column's value is delimited in a ROW: as 'valueShape' says, with a
-- text pointer and timestamp in front of a legacy @text@, @ntext@ or @image@
-- value.
rowShape :: TypeInfo -> ColumnShape
rowShape :: TypeInfo -> ColumnShape
rowShape TypeInfo
ti = case TypeInfo -> ColumnShape
valueShape TypeInfo
ti of
  ColumnShape
LongLength -> ColumnShape
TextPointer
  ColumnShape
s -> ColumnShape
s

-- | Read a value's delimiter.  Each form has its own way to say NULL.
cellHead :: ColumnShape -> Parser Cell
-- The argument is on the left so that the INLINE pragma fires only where
-- 'cellHead' is applied, and @noinline cellHead@ calls the compiled copy.
cellHead :: ColumnShape -> Parser Cell
cellHead ColumnShape
shape = case ColumnShape
shape of
  ConstantCell Cell
cell -> Cell -> Parser Cell
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cell
cell
  ColumnShape
ByteLength -> Word8 -> Word8 -> Cell
forall {a}. Integral a => a -> a -> Cell
size Word8
0 (Word8 -> Cell) -> Recipe () Word8 -> Parser Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Recipe () Word8
P.word8
  ColumnShape
ShortLength -> Word16 -> Word16 -> Cell
forall {a}. Integral a => a -> a -> Cell
size Word16
0xFFFF (Word16 -> Cell) -> Recipe () Word16 -> Parser Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Recipe () Word16
P.word16le
  ColumnShape
LongLength -> Word32 -> Word32 -> Cell
forall {a}. Integral a => a -> a -> Cell
size Word32
0xFFFFFFFF (Word32 -> Cell) -> Recipe () Word32 -> Parser Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Recipe () Word32
P.word32le
  ColumnShape
Variant -> (\Word32
n -> if Word32
n Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 then Cell
NullCell else Word32 -> Word32 -> Cell
forall {a}. Integral a => a -> a -> Cell
size Word32
0xFFFFFFFF Word32
n) (Word32 -> Cell) -> Recipe () Word32 -> Parser Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Recipe () Word32
P.word32le
  ColumnShape
TextPointer -> Recipe () Word8
P.word8 Recipe () Word8 -> (Word8 -> Parser Cell) -> Parser Cell
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0 -> Cell -> Parser Cell
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cell
NullCell
    Word8
n -> Int -> Parser ()
P.skip (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Parser () -> Parser Cell -> Parser Cell
forall a b. Recipe () a -> Recipe () b -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Word32 -> Word32 -> Cell
forall {a}. Integral a => a -> a -> Cell
size Word32
0xFFFFFFFF (Word32 -> Cell) -> Recipe () Word32 -> Parser Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Recipe () Word32
P.word32le)
  ColumnShape
PlpValue -> Parser Word64
P.word64le Parser Word64 -> (Word64 -> Parser Cell) -> Parser Cell
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word64
0xFFFFFFFFFFFFFFFF -> Cell -> Parser Cell
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cell
NullCell
    Word64
0xFFFFFFFFFFFFFFFE -> Cell -> Parser Cell
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Word64 -> Cell
Unsized Maybe Word64
forall a. Maybe a
Nothing)
    Word64
n -> Cell -> Parser Cell
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Word64 -> Cell
Unsized (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
n))
  where size :: a -> a -> Cell
size a
null a
n = if a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
null then Cell
NullCell else Int -> Cell
Sized (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
{-# INLINE cellHead #-}

-- | The value's declared length, if it has one that fits an 'Int64'.
cellLength :: Cell -> Maybe Int64
cellLength :: Cell -> Maybe Int64
cellLength (Sized Int
n) = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
cellLength (Unsized (Just Word64
n)) | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
forall a. Bounded a => a
maxBound :: Int64) = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
cellLength Cell
_ = Maybe Int64
forall a. Maybe a
Nothing

-- | Fold over the pieces of a value's payload: one piece for a sized value,
-- or a PLP value's chunks, with the chunk headers read here.  The step must
-- consume exactly the length it is given, whether it reads, collects or skips.
foldValue :: (a -> Int -> Parser a) -> a -> Cell -> Parser a
foldValue :: forall a. (a -> Int -> Parser a) -> a -> Cell -> Parser a
foldValue a -> Int -> Parser a
use a
initial = \case
  Cell
NullCell -> a -> Parser a
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
initial
  Sized Int
n -> a -> Int -> Parser a
use a
initial Int
n
  Unsized Maybe Word64
_ -> a -> Parser a
go a
initial
  where
    go :: a -> Parser a
go a
a = Parser Int
plpChunkLength Parser Int -> (Int -> Parser a) -> Parser a
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then a -> Parser a
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a else a -> Int -> Parser a
use a
a Int
n Parser a -> (a -> Parser a) -> Parser a
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Parser a
go
{-# INLINE foldValue #-}

-- | A PLP chunk's length header.
plpChunkLength :: Parser Int
plpChunkLength :: Parser Int
plpChunkLength = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Recipe () Word32 -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Recipe () Word32
P.word32le

-- The stream form of 'foldValue', for a consumer that pulls.  The two stay
-- separate: skipping through a Stream would allocate one per skipped cell, and
-- a drain that skips asks for nothing, where assembling a 16 MiB value only to
-- drop it cost 44 MB.
segments :: Cell -> Stream (Of Int) Parser ()
segments :: Cell -> Stream (Of Int) (Recipe ()) ()
segments = \case
  Cell
NullCell -> () -> Stream (Of Int) (Recipe ()) ()
forall a. a -> Stream (Of Int) (Recipe ()) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Sized Int
n -> Int -> Stream (Of Int) (Recipe ()) ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
S.yield Int
n
  Unsized Maybe Word64
_ -> Stream (Of Int) (Recipe ()) ()
plpChunks

-- A PLP value's chunk lengths from here to its terminator.
plpChunks :: Stream (Of Int) Parser ()
plpChunks :: Stream (Of Int) (Recipe ()) ()
plpChunks = Parser (Stream (Of Int) (Recipe ()) ())
-> Stream (Of Int) (Recipe ()) ()
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
m (Stream f m r) -> Stream f m r
S.effect (Parser (Stream (Of Int) (Recipe ()) ())
 -> Stream (Of Int) (Recipe ()) ())
-> Parser (Stream (Of Int) (Recipe ()) ())
-> Stream (Of Int) (Recipe ()) ()
forall a b. (a -> b) -> a -> b
$ do
  n <- Parser Int
plpChunkLength
  pure (if n == 0 then pure () else S.yield n >> plpChunks)

-- | The value's payload as it arrives, in pieces.  A PLP value's chunk headers
-- are read here and never appear in the stream.
valueStream :: Cell -> Stream (Of B.ByteString) Parser ()
valueStream :: Cell -> Stream (Of ByteString) (Recipe ()) ()
valueStream Cell
cell = Stream (Of Int) (Recipe ()) ()
-> (Int -> Stream (Of ByteString) (Recipe ()) ())
-> Stream (Of ByteString) (Recipe ()) ()
forall (m :: * -> *) (f :: * -> *) a r x.
(Monad m, Functor f) =>
Stream (Of a) m r -> (a -> Stream f m x) -> Stream f m r
S.for (Cell -> Stream (Of Int) (Recipe ()) ()
segments Cell
cell) Int -> Stream (Of ByteString) (Recipe ()) ()
pieces

-- The next this many bytes of a value, in pieces as they arrive.
pieces :: Int -> Stream (Of B.ByteString) Parser ()
pieces :: Int -> Stream (Of ByteString) (Recipe ()) ()
pieces Int
0 = () -> Stream (Of ByteString) (Recipe ()) ()
forall a. a -> Stream (Of ByteString) (Recipe ()) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
pieces Int
n = Parser (Stream (Of ByteString) (Recipe ()) ())
-> Stream (Of ByteString) (Recipe ()) ()
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
m (Stream f m r) -> Stream f m r
S.effect (Parser (Stream (Of ByteString) (Recipe ()) ())
 -> Stream (Of ByteString) (Recipe ()) ())
-> Parser (Stream (Of ByteString) (Recipe ()) ())
-> Stream (Of ByteString) (Recipe ()) ()
forall a b. (a -> b) -> a -> b
$ do
  bs <- Int -> Parser ByteString
P.chunk Int
n
  pure (S.yield bs >> pieces (n - B.length bs))

-- | A value for a consumer: read whole ('Right') if it is at most this many bytes,
-- given the allocation bound of 'wholeValueBytes' and the limit, or else its payload
-- as it arrives ('Left', as 'valueStream').  A PLP value whose total isn't known
-- (@xml@, and @json@) is read a chunk at a time until it ends within the limit;
-- once a chunk would take it past, the stream starts with the chunks already read,
-- so at most the limit is ever held.  A whole value is 'Owned' unless it lay in one
-- payload, and a drain that takes over while it is read gives 'DiscardedValue'.
boundedValue :: Int -> Int -> Cell -> Parser (Either (Stream (Of B.ByteString) Parser ()) WholeValue)
boundedValue :: Int
-> Int
-> Cell
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
boundedValue Int
ahead Int
limit Cell
cell = case Cell
cell of
  Unsized Maybe Word64
Nothing -> Int
-> Int
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
gatheredPlpValue Int
ahead Int
limit
  Cell
_ | Bool
within -> WholeValue
-> Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue
forall a b. b -> Either a b
Right (WholeValue
 -> Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
-> Recipe () WholeValue
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Cell -> Recipe () WholeValue
wholeValueBytes Int
ahead Cell
cell
    | Bool
otherwise -> Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stream (Of ByteString) (Recipe ()) ()
-> Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue
forall a b. a -> Either a b
Left (Cell -> Stream (Of ByteString) (Recipe ()) ()
valueStream Cell
cell))
  where
    within :: Bool
within = case Cell
cell of
      Sized Int
n -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
limit
      Unsized (Just Word64
total) -> Word64
total Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
limit
      Cell
_ -> Bool
True
{-# NOINLINE boundedValue #-}

-- 'boundedValue' of a PLP value whose total isn't known.
gatheredPlpValue :: Int -> Int -> Parser (Either (Stream (Of B.ByteString) Parser ()) WholeValue)
gatheredPlpValue :: Int
-> Int
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
gatheredPlpValue Int
ahead Int
limit = [ByteString]
-> Int
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
gather [] Int
0
  where
    -- The chunks are read into bytes of their own, with no drain's discarding, which
    -- the limit makes cheap: a value read whole during a drain is never converted.
    gather :: [ByteString]
-> Int
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
gather [ByteString]
held Int
size = Parser Int
plpChunkLength Parser Int
-> (Int
    -> Parser
         (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue))
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n ->
      if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WholeValue
-> Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue
forall a b. b -> Either a b
Right (ValueBytes -> WholeValue
PresentValue (ByteString -> ValueBytes
P.Owned ([ByteString] -> ByteString
B.concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
held)))))
      else if Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit then Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stream (Of ByteString) (Recipe ()) ()
-> Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue
forall a b. a -> Either a b
Left ([ByteString] -> Stream (Of ByteString) (Recipe ()) ()
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Foldable f) =>
f a -> Stream (Of a) m ()
S.each ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
held) Stream (Of ByteString) (Recipe ()) ()
-> Stream (Of ByteString) (Recipe ()) ()
-> Stream (Of ByteString) (Recipe ()) ()
forall a b.
Stream (Of ByteString) (Recipe ()) a
-> Stream (Of ByteString) (Recipe ()) b
-> Stream (Of ByteString) (Recipe ()) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Stream (Of ByteString) (Recipe ()) ()
pieces Int
n Stream (Of ByteString) (Recipe ()) ()
-> Stream (Of ByteString) (Recipe ()) ()
-> Stream (Of ByteString) (Recipe ()) ()
forall a b.
Stream (Of ByteString) (Recipe ()) a
-> Stream (Of ByteString) (Recipe ()) b
-> Stream (Of ByteString) (Recipe ()) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream (Of Int) (Recipe ()) ()
-> (Int -> Stream (Of ByteString) (Recipe ()) ())
-> Stream (Of ByteString) (Recipe ()) ()
forall (m :: * -> *) (f :: * -> *) a r x.
(Monad m, Functor f) =>
Stream (Of a) m r -> (a -> Stream f m x) -> Stream f m r
S.for Stream (Of Int) (Recipe ()) ()
plpChunks Int -> Stream (Of ByteString) (Recipe ()) ()
pieces))
      else Int -> Int -> Parser ByteString
P.ownedBytes Int
ahead Int
n Parser ByteString
-> (ByteString
    -> Parser
         (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue))
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
bytes -> [ByteString]
-> Int
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
gather (ByteString
bytes ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
held) (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
{-# NOINLINE gatheredPlpValue #-}

-- | Pass over a value's payload.
skipValue :: Cell -> Parser ()
skipValue :: Cell -> Parser ()
skipValue Cell
cell = (() -> Int -> Parser ()) -> () -> Cell -> Parser ()
forall a. (a -> Int -> Parser a) -> a -> Cell -> Parser a
foldValue (\() -> Int -> Parser ()
P.skip) () Cell
cell
{-# INLINE skipValue #-}

-- | A value read whole: NULL, present, or discarded because a drain took over
-- the response while the value was being assembled.
data WholeValue = NullValue | PresentValue !P.ValueBytes | DiscardedValue

-- | Read all of a value into bytes of its own, as an output parameter's value
-- is kept.  A value discarded by a drain comes back as empty bytes, which only
-- the drain sees.
ownedValue :: Int -> Cell -> Parser RawBytes
ownedValue :: Int -> Cell -> Parser RawBytes
ownedValue Int
ahead Cell
cell = Int -> Cell -> Recipe () WholeValue
wholeValueBytes Int
ahead Cell
cell Recipe () WholeValue
-> (WholeValue -> Parser RawBytes) -> Parser RawBytes
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  WholeValue
NullValue -> RawBytes -> Parser RawBytes
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RawBytes
forall a. Maybe a
Nothing
  PresentValue ValueBytes
value -> RawBytes -> Parser RawBytes
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> RawBytes
forall a. a -> Maybe a
Just (ValueBytes -> ByteString
P.keepBytes ValueBytes
value))
  WholeValue
DiscardedValue -> RawBytes -> Parser RawBytes
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> RawBytes
forall a. a -> Maybe a
Just ByteString
B.empty)

-- | Read all of a value: a slice if it lies in the buffer, otherwise one buffer of
-- its own.
wholeValueBytes :: Int -> Cell -> Parser WholeValue
wholeValueBytes :: Int -> Cell -> Recipe () WholeValue
wholeValueBytes Int
ahead = \case
  Cell
NullCell -> WholeValue -> Recipe () WholeValue
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WholeValue
NullValue
  Sized Int
n -> WholeValue
-> (ValueBytes -> WholeValue) -> Maybe ValueBytes -> WholeValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WholeValue
DiscardedValue ValueBytes -> WholeValue
PresentValue (Maybe ValueBytes -> WholeValue)
-> Recipe () (Maybe ValueBytes) -> Recipe () WholeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Recipe () (Maybe ValueBytes)
P.bytesValue Int
ahead Int
n
  Unsized Maybe Word64
total -> Int -> Maybe Word64 -> Recipe () WholeValue
wholePlpValue Int
ahead Maybe Word64
total
{-# INLINE wholeValueBytes #-}

-- Ownership while collecting a PLP value. A drain releases any saved bytes.
data Gathered = NothingYet | OneSlice !B.ByteString | Growing !P.Accumulator | Dropped

-- One payload fragment stays borrowed, even if its closing delimiter arrives
-- later. From the second fragment onward, use the bounded accumulator.
wholePlpValue :: Int -> Maybe Word64 -> Parser WholeValue
wholePlpValue :: Int -> Maybe Word64 -> Recipe () WholeValue
wholePlpValue Int
ahead Maybe Word64
total = do
  accumulated <- (Gathered -> Int -> Parser Gathered)
-> Gathered -> Cell -> Parser Gathered
forall a. (a -> Int -> Parser a) -> a -> Cell -> Parser a
foldValue Gathered -> Int -> Parser Gathered
pieces Gathered
NothingYet (Maybe Word64 -> Cell
Unsized Maybe Word64
total)
  case accumulated of
    Gathered
NothingYet -> WholeValue -> Recipe () WholeValue
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueBytes -> WholeValue
PresentValue (ByteString -> ValueBytes
P.Borrowed ByteString
B.empty))
    OneSlice ByteString
bytes -> WholeValue -> Recipe () WholeValue
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueBytes -> WholeValue
PresentValue (ByteString -> ValueBytes
P.Borrowed ByteString
bytes))
    Growing Accumulator
acc -> ValueBytes -> WholeValue
PresentValue (ValueBytes -> WholeValue)
-> (ByteString -> ValueBytes) -> ByteString -> WholeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ValueBytes
P.Owned (ByteString -> WholeValue)
-> Parser ByteString -> Recipe () WholeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> Parser ByteString
forall a. IO a -> Parser a
P.effect (Accumulator -> IO ByteString
P.finish Accumulator
acc)
    Gathered
Dropped -> WholeValue -> Recipe () WholeValue
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WholeValue
DiscardedValue
  where
    pieces :: Gathered -> Int -> Parser Gathered
pieces Gathered
gathered Int
0 = Gathered -> Parser Gathered
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Gathered
gathered
    pieces Gathered
Dropped Int
n = Int -> Parser ()
P.skip Int
n Parser () -> Parser Gathered -> Parser Gathered
forall a b. Recipe () a -> Recipe () b -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Gathered -> Parser Gathered
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Gathered
Dropped
    pieces Gathered
NothingYet Int
n = Int -> (ByteString -> Parser Gathered) -> Parser Gathered
fragment Int
n (Gathered -> Parser Gathered
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Gathered -> Parser Gathered)
-> (ByteString -> Gathered) -> ByteString -> Parser Gathered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Gathered
OneSlice)
    pieces (OneSlice ByteString
first) Int
n = Int -> (ByteString -> Parser Gathered) -> Parser Gathered
fragment Int
n ((ByteString -> Parser Gathered) -> Parser Gathered)
-> (ByteString -> Parser Gathered) -> Parser Gathered
forall a b. (a -> b) -> a -> b
$ \ByteString
bytes -> Accumulator -> Gathered
Growing (Accumulator -> Gathered)
-> Recipe () Accumulator -> Parser Gathered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Accumulator -> Recipe () Accumulator
forall a. IO a -> Parser a
P.effect (do
      acc <- Int -> Accumulator -> ByteString -> IO Accumulator
P.append Int
ahead (Maybe Word64 -> Accumulator
P.accumulator Maybe Word64
total) ByteString
first
      P.append ahead acc bytes)
    pieces (Growing Accumulator
acc) Int
n = Int -> (ByteString -> Parser Gathered) -> Parser Gathered
fragment Int
n ((ByteString -> Parser Gathered) -> Parser Gathered)
-> (ByteString -> Parser Gathered) -> Parser Gathered
forall a b. (a -> b) -> a -> b
$ \ByteString
bytes -> Accumulator -> Gathered
Growing (Accumulator -> Gathered)
-> Recipe () Accumulator -> Parser Gathered
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Accumulator -> Recipe () Accumulator
forall a. IO a -> Parser a
P.effect (Int -> Accumulator -> ByteString -> IO Accumulator
P.append Int
ahead Accumulator
acc ByteString
bytes)
    fragment :: Int -> (ByteString -> Parser Gathered) -> Parser Gathered
fragment Int
n ByteString -> Parser Gathered
add = Int -> Parser RawBytes
P.chunkOrDiscard Int
n Parser RawBytes -> (RawBytes -> Parser Gathered) -> Parser Gathered
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      RawBytes
Nothing -> Int -> Parser ()
P.skip Int
n Parser () -> Parser Gathered -> Parser Gathered
forall a b. Recipe () a -> Recipe () b -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Gathered -> Parser Gathered
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Gathered
Dropped
      Just ByteString
bytes -> ByteString -> Parser Gathered
add ByteString
bytes Parser Gathered -> (Gathered -> Parser Gathered) -> Parser Gathered
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Gathered
next -> Gathered -> Int -> Parser Gathered
pieces Gathered
next (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
bytes)
{-# NOINLINE wholePlpValue #-}

-- | A row's token byte, and an NBCROW's null bitmap. Empty means a ROW, where each
-- delimiter says for itself whether its value is NULL.
rowBitmap :: Int -> Parser B.ByteString
rowBitmap :: Int -> Parser ByteString
rowBitmap Int
n = Recipe () Word8
P.word8 Recipe () Word8
-> (Word8 -> Parser ByteString) -> Parser ByteString
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Word8
0xD1 -> ByteString -> Parser ByteString
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
B.empty
  Word8
0xD2 -> Int -> Parser ByteString
P.boundedBytes ((Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)
  Word8
_ -> [Char] -> Parser ByteString
forall a. [Char] -> Recipe () a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expected ROW or NBCROW"
{-# INLINE rowBitmap #-}

-- | Whether the bitmap marks this column NULL, in which case it has no bytes at all.
columnNull :: B.ByteString -> Int -> Bool
columnNull :: ByteString -> Int -> Bool
columnNull ByteString
bitmap Int
i = Bool -> Bool
not (ByteString -> Bool
B.null ByteString
bitmap) Bool -> Bool -> Bool
&& Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
B.index ByteString
bitmap (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)) (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8)
{-# INLINE columnNull #-}

-- | Read one column's delimiter, including its NBCROW null bit.
cellAt :: B.ByteString -> Int -> ColumnShape -> Parser Cell
cellAt :: ByteString -> Int -> ColumnShape -> Parser Cell
cellAt ByteString
bitmap Int
i ColumnShape
shape = if ByteString -> Int -> Bool
columnNull ByteString
bitmap Int
i then Cell -> Parser Cell
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cell
NullCell else ColumnShape -> Parser Cell
cellHead ColumnShape
shape
{-# INLINE cellAt #-}

-- | Read past these columns of a row, given as their indexes and shapes.
skipCells :: B.ByteString -> [(Int, ColumnShape)] -> Parser ()
-- A recursion under 'P.oneShotRecipe' rather than 'mapM_': each tail's recipe is
-- built after the cell before it is skipped and run once, so GHC passes the input
-- through the recursive call instead of allocating a closure per cell.  Draining
-- 100 responses of 10,000 @int@ and @bigint@ rows allocated 559 MB this way and
-- 815 MB with 'mapM_' (GHC 9.12.4, 2026-11-04).  A probe that skipped fixed-width
-- cells alone went the other way, from 27.8 to 32.0 MB, and the drain is the path
-- that matters.
skipCells :: ByteString -> [(Int, ColumnShape)] -> Parser ()
skipCells ByteString
bitmap = [(Int, ColumnShape)] -> Parser ()
go
  where
    go :: [(Int, ColumnShape)] -> Parser ()
go [] = () -> Parser ()
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    go ((Int
i, ColumnShape
shape) : [(Int, ColumnShape)]
later) = Parser () -> Parser ()
forall env a. Recipe env a -> Recipe env a
P.oneShotRecipe (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
      cell <- ByteString -> Int -> ColumnShape -> Parser Cell
cellAt ByteString
bitmap Int
i ColumnShape
shape
      skipValue cell
      go later

-- | A row's values, each read whole into bytes of its own, for the token-level
-- interface ('Hmssql.Tds.Token.TRow').  A typed row decoder never builds one.
newtype Row = Row (SmallArray RawBytes)
  deriving stock (Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
/= :: Row -> Row -> Bool
Eq)

instance Show Row where
  showsPrec :: Int -> Row -> ShowS
showsPrec Int
d Row
r = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
showString [Char]
"rowFromValues " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [RawBytes] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Row -> [RawBytes]
rowValues Row
r)

-- | How many columns the row has.
rowColumnCount :: Row -> Int
rowColumnCount :: Row -> Int
rowColumnCount (Row SmallArray RawBytes
cells) = SmallArray RawBytes -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray RawBytes
cells

-- | A row from its values.
rowFromValues :: [RawBytes] -> Row
rowFromValues :: [RawBytes] -> Row
rowFromValues = SmallArray RawBytes -> Row
Row (SmallArray RawBytes -> Row)
-> ([RawBytes] -> SmallArray RawBytes) -> [RawBytes] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RawBytes] -> SmallArray RawBytes
forall a. [a] -> SmallArray a
smallArrayFromList

-- | The value at a column, counted from 0; 'error' past the last.
rowCell :: Row -> Int -> RawBytes
rowCell :: Row -> Int -> RawBytes
rowCell (Row SmallArray RawBytes
cells) Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SmallArray RawBytes -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray RawBytes
cells = SmallArray RawBytes -> Int -> RawBytes
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray RawBytes
cells Int
i
  | Bool
otherwise = [Char] -> RawBytes
forall a. HasCallStack => [Char] -> a
error ([Char]
"column " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" of a row of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (SmallArray RawBytes -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray RawBytes
cells) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" columns")

-- | The length of the value at a column, or -1 for NULL.
rowCellLength :: Row -> Int -> Int
rowCellLength :: Row -> Int -> Int
rowCellLength Row
row Int
i = Int -> (ByteString -> Int) -> RawBytes -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1) ByteString -> Int
B.length (Row -> Int -> RawBytes
rowCell Row
row Int
i)

-- | The row's values, in column order.
rowValues :: Row -> [RawBytes]
rowValues :: Row -> [RawBytes]
rowValues Row
row = [Row -> Int -> RawBytes
rowCell Row
row Int
i | Int
i <- [Int
0 .. Row -> Int
rowColumnCount Row
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]