{-# LANGUAGE ExistentialQuantification, GADTs, InstanceSigs, MagicHash #-}
-- | Turning the columns of a result set into Haskell values.
--
-- 'FromSqlField' decodes one column, with instances for the usual types
-- ("Hmssql.Types" has the table of which SQL types each accepts);
-- 'FromSqlRow' decodes a row, derived for a record or given for a tuple.
-- A new field decoder is usually 'refineField' over an existing one (an
-- enumeration from a @varchar@, a JSON column), or 'fieldDecoderFor' from
-- the value's bytes.
--
-- A 'FieldDecoder' checks its column's 'ColumnInfo' once per result set,
-- rejecting an incompatible SQL type before any row is read.  It then reads
-- each value whole, or gives it to a consumer as it arrives ('streamField').
-- 'RowDecoder' composes field decoders applicatively and knows how many
-- columns it consumes, so a whole result set is type-checked before the
-- first row is decoded.  'RowDecoderMonadic' is a monadic variant for shapes
-- only known at runtime.
module Hmssql.Decoding
  ( -- * Field decoders
    FromSqlField (fieldDecoder, fieldRowDecoder)
  , FieldDecoder (..)
  , fieldDecoderFor
  , fieldDecoderForTypes
  , refineField
  , nullableField
  , RawValue (..)

    -- * Field decoders from a value's parts #parts#
    -- | The date and time types decode to the @time@ package's types, and @decimal@
    -- to 'Decimal', which are built from 'Integer's.  For code that writes a value
    -- straight out, as JSON or text, or keeps it in a type of its own, these decoders
    -- give your function the value's parts instead: a date's 'Day', its picoseconds
    -- since midnight and its offset in minutes, or a decimal's sign, magnitude and
    -- scale.  A value is checked as the built-in decoders check it, and a NULL
    -- is a 'DecodeError' unless the decoder is wrapped in 'nullableField'.
    --
    -- > -- the minutes since midnight of a datetime2 or datetime column
    -- > minuteOfDay :: FieldDecoder Int
    -- > minuteOfDay = dayTimeFieldDecoder "minute of day" $ \_ ps ->
    -- >   fromIntegral (ps `quot` 60_000_000_000_000)
  , dayTimeFieldDecoder
  , dateTimeOffsetFieldDecoder
  , timeFieldDecoder
  , decimalFieldDecoder

    -- * Streaming a large value #streaming#
    -- | A decoder normally reads a whole value into memory.  'streamField' instead
    -- gives each value to your function as it arrives, so a column of any size can go
    -- to a file or a socket without being held in memory:
    --
    -- > import qualified Data.ByteString as B
    -- > import qualified Streaming.Prelude as S
    -- > import System.IO (IOMode (..), withBinaryFile)
    -- >
    -- > saveDocument :: Connection -> Int -> FilePath -> IO ()
    -- > saveDocument conn docId path =
    -- >   query1With (singleField (streamField toFile)) conn
    -- >     ("SELECT payload FROM dbo.documents WHERE id = " <> param docId)
    -- >   where
    -- >     toFile value = withBinaryFile path WriteMode $ \h ->
    -- >       S.mapM_ (B.hPut h) (valueChunks value)
    --
    -- 'streamTextField' does the same for character data, with the chunks decoded to
    -- 'Text'.  Either one composes with other columns like any field decoder:
    --
    -- > (,) <$> singleField (fieldDecoder @Int) <*> singleField (streamField toFile)
    --
    -- Your function runs once per row, on the thread reading the rows, and these rules
    -- come with it:
    --
    -- * A value of at most 'streamWholeLimit' (64 KiB) is read whole first, and your
    --   function gets it as one chunk; only a larger one arrives in pieces.  Given a
    --   value whole, your function may run before rows read ahead of it reach you.
    -- * Bytes it doesn't read are skipped, so it can stop early.
    -- * An exception it throws ends the query: the statement is canceled, and the
    --   exception reaches the caller as it was thrown, with the connection still
    --   usable.  To report a bad value as a 'DecodeError' instead, return an
    --   @Either String@ and wrap the decoder in @'refineField' id@.
    -- * The stream is valid only until the function returns.
    -- * A NULL is a 'DecodeError' unless the decoder is wrapped in 'nullableField'.
    -- * It must not make a request on its own connection.  On a MARS connection it may
    --   make requests beside the stream.
    -- * The connection is locked while it runs, and the statement may be holding locks
    --   on the server, so slow work there holds up other work.
    --
    -- When one column's value decides what to do with a later one, such as a name for
    -- the file, use cells instead ("Hmssql.Query#g:cells").  Whole rows can be streamed
    -- with "Hmssql.Query#g:streaming", and large parameters can be sent as they are read
    -- with "Hmssql.Encoding#g:streaming".
  , ValueStream (..), streamField, streamTextField

    -- * Row decoders
  , FromSqlRow (..)
  , RowDecoder (..)
  , singleField
  , inlinedField
  , inlinedNullableField
  , byColumn
  , genericFromSqlRow

    -- * Monadic row decoders
  , RowDecoderMonadic (..)
  , singleFieldM
  , remainingColumns
  , toMonadicRowDecoder
  , sqlRowDecoder

    -- * Values known only at runtime
  , sqlValueDecoder
  , sqlRowDecoderFor

    -- * Running decoders
    -- | What a field decoder compiles to, and how a row decoder is run: for code
    -- that reads a response itself (the low-level part of "Hmssql.Query") or
    -- decodes values it already holds.  Nothing here is needed to use the query
    -- functions.
  , compileField
  , CellDecoder (..)
  , StreamedValue (..)
  , streamWholeLimit
  , ReadFailure (..)
  , decodeCell
  , fieldDecoderCompiled
  , readCellRecipe
  , compileRowDecoder
  , compileRowDecoderFor
  , compileMonadicRowDecoder
  , skipRowDecoder
  , CompiledRow (..)
  , Prepared (..)
  , rowRecipe
  , decodeColumnChunks
  , decodeColumnText
  ) where

import Control.Monad (when)
import Streaming (Stream, Of)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.Coerce (Coercible, coerce)
import Data.Decimal (Decimal, DecimalRaw (..))
import Data.Int (Int16, Int32, Int64, Int8)
import GHC.Exts (Int64#)
import GHC.Int (Int64 (I64#))
import Data.Primitive.SmallArray (indexSmallArray)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Time
import Data.Tuple.Only (Only (..))
import Data.UUID.Types (UUID)
import Data.Word (Word64, Word8)
import GHC.Generics

import Hmssql.Errors (DecodeError (..))
import Hmssql.SqlValue
import Hmssql.Internal.SqlDataType (SqlDataType (..))
import Hmssql.Tds.Scalar
import Hmssql.Tds.CodePage (decodeCodecChunks)
import Hmssql.Tds.Context
import Hmssql.Tds.Primitives
import Hmssql.Tds.Value
import Hmssql.Tds.Token (ColumnInfo (..), ResultSetInfo, compileResultSet, rsColumnArray, rsColumnCount, rsColumns, rsCells)
import Hmssql.Tds.TypeInfo
import qualified Hmssql.Tds.Utf16 as Utf16

import Hmssql.Tds.Parser (Parser)
import qualified Hmssql.Tds.Parser as P
import Hmssql.Tds.Reader (CompiledRow (..), Prepared (..), ReadFailure (..), rowRecipe)

-- | How to decode one column.  Given the connection's context and the column, it
-- returns a 'CellDecoder' for the column's values, or why it can't decode them.
--
-- The check runs when a result set's columns arrive, before its first row, so
-- a type mismatch is reported even for an empty result.
newtype FieldDecoder a = FieldDecoder
  (TdsContext -> ColumnInfo -> Either String (CellDecoder a))

-- | How to decode a column's values, once the column has been checked.  There
-- are two ways, because nearly every value is small and a few are too large to
-- hold in memory; the ordinary way is much the cheaper, since it runs no 'IO'
-- and needs no stream or exception handler per value.
data CellDecoder a
  -- Why two conversions: most values lie within one packet and are read as a
  -- slice of it, so a conversion that keeps those bytes must copy them, or the
  -- value would keep the whole packet alive.  A value that crossed packets was
  -- assembled into a buffer of its own, and copying that again would double the
  -- work on the largest values.  Conversions that keep nothing (integers, text
  -- decoded to a new array) use one function for both.
  --
  -- Why a closure per column, rather than a selection and a reader that inline
  -- into one function per row: that was tried (value-streaming-research.md,
  -- "Full-suite comparison").  Once a row inlined, each bind's continuation was
  -- used in the completed branch and captured in the suspended one, so Core made
  -- it a heap closure per bind, 1.2 to 1.8 times this allocation.  One unknown
  -- call per cell is the cheaper price for a parser that can suspend.
  = CellDecoder (Either String a) (ValueReader a) (ValueReader a)
    -- ^ The ordinary way: the whole value is read, and then converted by a pure
    -- function.  The fields are the result for a NULL, which stays lazy until a NULL
    -- is decoded, and two conversions.  The first takes bytes borrowed from a receive
    -- buffer, and the second takes bytes in a buffer of their own.
    --
    -- Nothing ever overwrites borrowed bytes, so a conversion that keeps them still
    -- gets correct data.  The danger is memory: they hold the whole receive buffer of
    -- up to 32 KiB, so keeping small values from many rows could keep far more memory
    -- than those values need.  So the first conversion should copy any bytes it keeps.
    -- The second can keep them as they are, and a conversion that keeps none, such as
    -- an integer's, can use the same function for both.
  | FoldingCell (Either String a) (ValueReader a) (ValueReader a)
      (Stream (Of B.ByteString) Parser () -> Parser (Either ReadFailure a))
    -- ^ A value of any length, converted with no consumer: one of at most
    -- 'streamWholeLimit' bytes read whole and converted by the first three fields,
    -- as 'CellDecoder''s are, and a longer one given as it arrives to the fourth, a
    -- recipe that follows 'StreamingCell''s two rules below.  Its pieces may be slices
    -- of a receive buffer, so it copies what it keeps.  This is for a conversion
    -- that can work a piece at a time, such as writing text out as JSON, so that a
    -- long value is never held whole as it came, while a short one costs what a
    -- 'CellDecoder' costs.
  | StreamingCell (StreamedValue -> Parser (Either ReadFailure a))
    -- ^ The way to read a value as it arrives.  'streamField' and 'streamTextField'
    -- build this; see "Hmssql.Decoding#g:streaming".  Writing one by hand has two rules:
    --
    -- * The recipe must read its value to the end, even when it fails, because the
    --   next column's bytes come straight after it.
    -- * A value that can't be decoded must be a 'DecodeFailed'.  The rest of the row
    --   is then read past, the response is drained, and the 'DecodeError' is thrown
    --   from the query, with the connection still usable.  When 'P.consume' gives
    --   'Nothing', the response is being thrown away, and the result is 'ReadDiscarded'.
    --
    -- A failure is returned because a thrown one would end the recipe, and with it the
    -- reading of the row.  So a recipe throws, as 'fail' does, only when the bytes
    -- can't be read at all, and the connection is then broken.  A consumer's exception
    -- is neither: it ends the query at once, as described at "Hmssql.Decoding#g:streaming".

-- | A value as a 'StreamingCell' receives it: NULL, the whole value, or its total
-- length if known and a stream of its bytes.  A value of at most 'streamWholeLimit'
-- bytes is read whole first, since giving it to the consumer as it arrives costs
-- several times what reading it does; a larger one is streamed.
data StreamedValue
  = StreamedNull
  | StreamedWhole !P.ValueBytes
    -- ^ The value, read whole.  As for 'CellDecoder''s conversions, 'P.Borrowed'
    -- bytes are a slice of a receive buffer, so a recipe that keeps them copies
    -- them ('P.keepBytes').
  | StreamedBytes !(Maybe Int64) (Stream (Of B.ByteString) Parser ())

-- | The largest value a 'StreamingCell' is given whole, 64 KiB.  Up to this size a
-- value read whole and handed over costs about what 'fieldDecoder' does, where
-- streaming it cost seven times as much for a value of 100 bytes; past it, the
-- stream's cost per value is small beside the value's own bytes, and what is held
-- at once stays bounded.
streamWholeLimit :: Int
streamWholeLimit :: Int
streamWholeLimit = Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

instance Functor CellDecoder where
  fmap :: forall a b. (a -> b) -> CellDecoder a -> CellDecoder b
fmap a -> b
f (CellDecoder Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned) =
    Either [Char] b -> ValueReader b -> ValueReader b -> CellDecoder b
forall a.
Either [Char] a -> ValueReader a -> ValueReader a -> CellDecoder a
CellDecoder ((a -> b) -> Either [Char] a -> Either [Char] b
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either [Char] a
onNull) ((a -> b) -> Either [Char] a -> Either [Char] b
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either [Char] a -> Either [Char] b)
-> ValueReader a -> ValueReader b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueReader a
borrowed) ((a -> b) -> Either [Char] a -> Either [Char] b
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either [Char] a -> Either [Char] b)
-> ValueReader a -> ValueReader b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueReader a
owned)
  fmap a -> b
f (FoldingCell Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
fold) =
    Either [Char] b
-> ValueReader b
-> ValueReader b
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure b))
-> CellDecoder b
forall a.
Either [Char] a
-> ValueReader a
-> ValueReader a
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure a))
-> CellDecoder a
FoldingCell ((a -> b) -> Either [Char] a -> Either [Char] b
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either [Char] a
onNull) ((a -> b) -> Either [Char] a -> Either [Char] b
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either [Char] a -> Either [Char] b)
-> ValueReader a -> ValueReader b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueReader a
borrowed) ((a -> b) -> Either [Char] a -> Either [Char] b
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either [Char] a -> Either [Char] b)
-> ValueReader a -> ValueReader b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueReader a
owned) ((Either ReadFailure a -> Either ReadFailure b)
-> Parser (Either ReadFailure a) -> Parser (Either ReadFailure b)
forall a b. (a -> b) -> Recipe () a -> Recipe () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Either ReadFailure a -> Either ReadFailure b
forall a b.
(a -> b) -> Either ReadFailure a -> Either ReadFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Parser (Either ReadFailure a) -> Parser (Either ReadFailure b))
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure a))
-> Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
fold)
  fmap a -> b
f (StreamingCell StreamedValue -> Parser (Either ReadFailure a)
d) = (StreamedValue -> Parser (Either ReadFailure b)) -> CellDecoder b
forall a.
(StreamedValue -> Parser (Either ReadFailure a)) -> CellDecoder a
StreamingCell ((Either ReadFailure a -> Either ReadFailure b)
-> Parser (Either ReadFailure a) -> Parser (Either ReadFailure b)
forall a b. (a -> b) -> Recipe () a -> Recipe () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Either ReadFailure a -> Either ReadFailure b
forall a b.
(a -> b) -> Either ReadFailure a -> Either ReadFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Parser (Either ReadFailure a) -> Parser (Either ReadFailure b))
-> (StreamedValue -> Parser (Either ReadFailure a))
-> StreamedValue
-> Parser (Either ReadFailure b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamedValue -> Parser (Either ReadFailure a)
d)

instance Functor FieldDecoder where
  fmap :: forall a b. (a -> b) -> FieldDecoder a -> FieldDecoder b
fmap = (a -> b) -> FieldDecoder a -> FieldDecoder b
forall a b. (a -> b) -> FieldDecoder a -> FieldDecoder b
mapField
  {-# INLINE fmap #-}

-- Out of line: the comment at 'nullableField'.
mapField :: (a -> b) -> FieldDecoder a -> FieldDecoder b
mapField :: forall a b. (a -> b) -> FieldDecoder a -> FieldDecoder b
mapField a -> b
f (FieldDecoder TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compile) = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder b))
-> FieldDecoder b
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext -> ColumnInfo -> Either [Char] (CellDecoder b))
 -> FieldDecoder b)
-> (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder b))
-> FieldDecoder b
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ColumnInfo
col -> (CellDecoder a -> CellDecoder b)
-> Either [Char] (CellDecoder a) -> Either [Char] (CellDecoder b)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> CellDecoder a -> CellDecoder b
forall a b. (a -> b) -> CellDecoder a -> CellDecoder b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compile TdsContext
ctx ColumnInfo
col)
{-# OPAQUE mapField #-}

-- | Run a 'FieldDecoder' against a column: the 'CellDecoder' for its values, or
-- why it can't decode them.
compileField :: FieldDecoder a -> TdsContext -> ColumnInfo -> Either String (CellDecoder a)
compileField :: forall a.
FieldDecoder a
-> TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compileField (FieldDecoder TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compile) = TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compile
{-# INLINE compileField #-}

-- | A decoder from a function that checks the column and chooses how to decode
-- its values.  For a decoder 'fieldDecoderFor' can't express.
fieldDecoderCompiled :: (TdsContext -> ColumnInfo -> Either String (CellDecoder a)) -> FieldDecoder a
fieldDecoderCompiled :: forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
fieldDecoderCompiled = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder
{-# INLINE fieldDecoderCompiled #-}

-- | Decode a value already in memory ('Nothing' is NULL).  A 'StreamingCell' gives
-- a 'Left', because it reads its value as the value arrives.
decodeCell :: CellDecoder a -> RawBytes -> Either String a
decodeCell :: forall a. CellDecoder a -> RawBytes -> Either [Char] a
decodeCell (CellDecoder Either [Char] a
onNull ValueReader a
_ ValueReader a
owned) = Either [Char] a -> ValueReader a -> RawBytes -> Either [Char] a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either [Char] a
onNull ValueReader a
owned
decodeCell (FoldingCell Either [Char] a
onNull ValueReader a
_ ValueReader a
owned Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
_) = Either [Char] a -> ValueReader a -> RawBytes -> Either [Char] a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either [Char] a
onNull ValueReader a
owned
decodeCell (StreamingCell StreamedValue -> Parser (Either ReadFailure a)
_) = Either [Char] a -> RawBytes -> Either [Char] a
forall a b. a -> b -> a
const ([Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
"a streaming field requires a live value stream")

-- The value is forced before it is returned: as a thunk it would hold the bytes
-- it reads, and through a borrowed slice, the packet they arrived in.
cellDecoder :: Either String a -> ValueReader a -> CellDecoder a
cellDecoder :: forall a. Either [Char] a -> ValueReader a -> CellDecoder a
cellDecoder Either [Char] a
onNull ValueReader a
decode = Either [Char] a -> ValueReader a -> ValueReader a -> CellDecoder a
forall a.
Either [Char] a -> ValueReader a -> ValueReader a -> CellDecoder a
CellDecoder Either [Char] a
onNull ValueReader a
converted ValueReader a
converted
  where converted :: ValueReader a
converted ByteString
bytes = ValueReader a
decode ByteString
bytes Either [Char] a -> (a -> Either [Char] a) -> Either [Char] a
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either [Char] a
forall a. a -> Either [Char] a
evaluated
{-# INLINE cellDecoder #-}

instance Semigroup (FieldDecoder a) where
  FieldDecoder TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
f <> :: FieldDecoder a -> FieldDecoder a -> FieldDecoder a
<> FieldDecoder TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
g = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
 -> FieldDecoder a)
-> (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ColumnInfo
col -> case TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
f TdsContext
ctx ColumnInfo
col of
    Right CellDecoder a
d -> CellDecoder a -> Either [Char] (CellDecoder a)
forall a b. b -> Either a b
Right CellDecoder a
d
    Left [Char]
e1 -> case TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
g TdsContext
ctx ColumnInfo
col of
      Right CellDecoder a
d -> CellDecoder a -> Either [Char] (CellDecoder a)
forall a b. b -> Either a b
Right CellDecoder a
d
      Left [Char]
e2 -> [Char] -> Either [Char] (CellDecoder a)
forall a b. a -> Either a b
Left ([Char]
e1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"; " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e2)
  {-# INLINE (<>) #-}

-- | Types that decode from one column.  The usual Haskell types have
-- instances, and "Hmssql.Types" has the table of which SQL types each
-- accepts.  'Maybe' accepts NULL; without it, a NULL is a 'DecodeError'.
-- An instance of your own defines 'fieldDecoder', usually with
-- 'refineField' over a built-in type's decoder.
class FromSqlField a where
  -- | The decoder of one column of this type.
  fieldDecoder :: FieldDecoder a

  -- | A row decoder of one column of this type, the same as @'singleField'
  -- 'fieldDecoder'@.  Tuples, 'Only' and derived 'FromSqlRow' instances read their
  -- columns with it, and the built-in types' are faster than 'singleField'.  An
  -- instance doesn't define it.
  fieldRowDecoder :: RowDecoder a
  fieldRowDecoder = (TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
forall a.
(TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
RowDecoder (\TdsContext
ctx ResultSetInfo
rs Int
i -> RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart a)
forall a.
RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart a)
compileRowAt (Nulls a a -> RowDecoder a
forall a b. FromSqlField a => Nulls a b -> RowDecoder b
forall b. Nulls a b -> RowDecoder b
rowDecoderWith Nulls a a
forall a. Nulls a a
NoNulls) TdsContext
ctx ResultSetInfo
rs Int
i) Int
1

  -- The rest are not exported.  'fieldRowDecoder' of 'Maybe' this type, which the
  -- 'Maybe' instance's 'fieldRowDecoder' is.
  nullableRowDecoder :: RowDecoder (Maybe a)
  nullableRowDecoder = (TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart (Maybe a)))
-> Int -> RowDecoder (Maybe a)
forall a.
(TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
RowDecoder (\TdsContext
ctx ResultSetInfo
rs Int
i -> RowDecoder (Maybe a)
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart (Maybe a))
forall a.
RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart a)
compileRowAt (Nulls a (Maybe a) -> RowDecoder (Maybe a)
forall a b. FromSqlField a => Nulls a b -> RowDecoder b
forall b. Nulls a b -> RowDecoder b
rowDecoderWith Nulls a (Maybe a)
forall a. Nulls a (Maybe a)
Nulls) TdsContext
ctx ResultSetInfo
rs Int
i) Int
1

  -- Both row decoders, which a built-in instance compiles as one
  -- ('cellRowDecoder').
  rowDecoderWith :: Nulls a b -> RowDecoder b
  rowDecoderWith Nulls a b
nulls = FieldDecoder b -> RowDecoder b
forall a. FieldDecoder a -> RowDecoder a
singleField (Nulls a b -> FieldDecoder a -> FieldDecoder b
forall a b. Nulls a b -> FieldDecoder a -> FieldDecoder b
nullsField Nulls a b
nulls FieldDecoder a
forall a. FromSqlField a => FieldDecoder a
fieldDecoder)

-- A built-in type's row decoders are compiled once, here, as one function for the
-- type and 'Maybe' the type ('rowDecoderWith', which takes a 'Nulls'), with the
-- conversion inlined at one place ('cellRowDecoder', 'P.prefixedRowValue'): a value that
-- lies in the payload behind a fixed width or a one- or two-byte length.  The
-- conversion is then a known call given the slice's fields, or inlined, rather than an
-- unknown call given a 'B.ByteString' built for it that returns an 'Either'.  A field
-- of a tuple or a derived record refers to its type's row decoder and holds no code of
-- its own for the cell.
--
-- Measured against 'singleField' out of line (64799fb), on 2026-11-04 with GHC 9.12.4,
-- in bytes allocated per query: a typed @(Int32, Int64)@ row in Mock.query 2,864,247
-- rather than 3,661,904 (0.78), the nullable five-column row 7,943,905 rather than
-- 9,566,082 (0.83), and their derived-record forms 0.80 and 0.84.  In Decode, per
-- 10,000 rows: @nvarchar(50)@ 0.93, @decimal(18,4)@ 0.96, @datetime2@ with
-- @datetimeoffset@ 0.97, @uniqueidentifier@ 0.89.  A @max@ value goes through the
-- shared path and allocates as before.  The full program of scripts/code-size.sh has
-- 79,088 bytes of FromRows object code (67 per field) rather than 111,304, and
-- Decoding.o is 511 KB rather than 325 KB.  Timed roughly, three alternating pairs
-- on an idle machine, the typed cases took 0.92 of the time in Decode and 0.87 in
-- Mock.query (geometric means), from 0.78 for @(Int32, Int64)@ to 1.02 for a short
-- @nvarchar(max)@.
--
-- Why one place.  With the whole cell's read inlined into each type's two row
-- decoders, Decoding.o was 1.23 MB, and the allocation 0.83 and 0.91 of the above.
-- Each step that made the copies small, in Decoding.o's .text:
--
-- * Only the common delimiters inlined, each with the conversion, and the rest
--   through an out-of-line read: 771 KB.
-- * One copy for both row decoders, through 'Nulls': 670 KB.  Each instance's
--   'rowDecoderWith' is NOINLINE, or GHC inlines it into the two methods that apply it
--   to a constructor, and there are two copies again.
-- * The delimiter's fast path in one out-of-line function ('P.prefixedRowValue''s
--   @valueSpan@), which returns where the value lies, so the conversion has one call
--   site; and every slower case through 'sharedCell': 520 KB.  The slow path through
--   the inlined decoder instead kept a second copy of each conversion in its closures.
-- * The out-of-range and invalid-length messages out of line: 503 KB.  The integer
--   types' copies are still the largest, about 5.4 KB each with 'integerAt'.
-- * 'fieldRowDecoder' as a constructor, below: 511 KB with the methods' wrappers.
--
-- The large conversions, of the date and time types, 'Decimal' and 'Money', are out of
-- line and called from the copy ('localTimeReader' and the others): a second copy of
-- one each would be a large share of the copy, for a few per cent of what the
-- conversion allocates anyway.
--
-- Why 'fieldRowDecoder' is a constructor around a call rather than @rowDecoderWith
-- NoNulls@.  That was a thunk, which a field of a derived record evaluated in its own
-- code, 92 bytes per field rather than 67.  A constructor of a known function is an
-- unfolding GHC sees through, so a field refers to the function.
--
-- Why each built-in type's decoder is a top-level INLINE definition beside its
-- instance.  'fieldDecoder' isn't INLINE, because a hand-written @singleField
-- fieldDecoder@ would copy the decoder into every use (2.8 KB per field of a
-- ten-field applicative decoder), and in the library GHC didn't inline it into
-- the row decoders by itself, nor through 'GHC.Exts.inline': the allocation stayed
-- at the out-of-line figure.  So the instance's 'fieldDecoder' is the INLINE
-- definition, compiled once as the method, and its 'rowDecoderWith' gives the
-- same definition to 'cellRowDecoder', where it inlines.  A rewrite of
-- @singleField fieldDecoder@ to 'fieldRowDecoder' never fires, because the
-- class-op rule rewrites 'fieldDecoder' first.
--
-- Why a type of the user's gets the shared 'singleField'.  GHC inlines a default
-- method into each instance (it shows as a Compulsory unfolding in the interface, on
-- 9.10.3 and 9.12.4), so a default of 'cellRowDecoder' would give each such type a
-- copy of the cell's read, for a decoder usually built with 'refineField' over a
-- built-in one, whose conversion is an unknown call anyway.  With 'singleField' a field
-- of the type costs what a built-in type's does.
--
-- INLINE or INLINABLE on a row decoder method undoes all this.  GHC copies either
-- from a default method to the instance's method, and the instance's method is then
-- a constructor application whose unfolding is the whole cell read; GHC looks through
-- a constructor application's unfolding at any size, so every field got the copy
-- again (the quick program was 3.5 MB rather than 0.53 MB, measured on 9fcfe0d).

-- | A decoder from a value's bytes, given a name for error messages, the wire
-- types it accepts and the conversion.  A NULL is a 'DecodeError' unless the
-- decoder is wrapped in 'nullableField'.  The bytes may be part of a receive
-- buffer, so a conversion should copy any it keeps, as 'CellDecoder' explains.
fieldDecoderFor :: String -> (TypeInfo -> Bool)
  -> (TdsContext -> TypeInfo -> B.ByteString -> Either String a) -> FieldDecoder a
fieldDecoderFor :: forall a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> ByteString -> Either [Char] a)
-> FieldDecoder a
fieldDecoderFor [Char]
name TypeInfo -> Bool
accepts TdsContext -> TypeInfo -> ByteString -> Either [Char] a
decode = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] (TdsContext, TypeInfo))
-> ((TdsContext, TypeInfo) -> ByteString -> Either [Char] a)
-> FieldDecoder a
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
name TypeInfo -> Bool
accepts
  (\TdsContext
ctx TypeInfo
ti -> (TdsContext, TypeInfo) -> Either [Char] (TdsContext, TypeInfo)
forall a b. b -> Either a b
Right (TdsContext
ctx, TypeInfo
ti)) (\(TdsContext
ctx, TypeInfo
ti) ByteString
bs -> TdsContext -> TypeInfo -> ByteString -> Either [Char] a
decode TdsContext
ctx TypeInfo
ti ByteString
bs)
{-# INLINE fieldDecoderFor #-}

-- | 'fieldDecoderFor', accepting by SQL data type rather than by wire type.  The
-- conversion still receives the column's 'TypeInfo'.
fieldDecoderForTypes :: String -> (SqlDataType -> Bool)
  -> (TdsContext -> TypeInfo -> B.ByteString -> Either String a) -> FieldDecoder a
fieldDecoderForTypes :: forall a.
[Char]
-> (SqlDataType -> Bool)
-> (TdsContext -> TypeInfo -> ByteString -> Either [Char] a)
-> FieldDecoder a
fieldDecoderForTypes [Char]
name SqlDataType -> Bool
accepts = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> ByteString -> Either [Char] a)
-> FieldDecoder a
forall a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> ByteString -> Either [Char] a)
-> FieldDecoder a
fieldDecoderFor [Char]
name ((SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType SqlDataType -> Bool
accepts)

compiledFieldDecoder :: String -> (TypeInfo -> Bool)
  -> (TdsContext -> TypeInfo -> Either String s) -> (s -> ValueReader a) -> FieldDecoder a
compiledFieldDecoder :: forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
name TypeInfo -> Bool
accepts TdsContext -> TypeInfo -> Either [Char] s
select s -> ValueReader a
reader = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
 -> FieldDecoder a)
-> (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ColumnInfo
col ->
  let ti :: TypeInfo
ti = ColumnInfo -> TypeInfo
columnType ColumnInfo
col
   in if TypeInfo -> Bool
accepts TypeInfo
ti
        then do
          selected <- TdsContext -> TypeInfo -> Either [Char] s
select TdsContext
ctx TypeInfo
ti
          pure (cellDecoder (nullAs name) (reader selected))
        else [Char] -> Either [Char] (CellDecoder a)
forall a b. a -> Either a b
Left ([Char] -> TypeInfo -> [Char]
rejectAs [Char]
name TypeInfo
ti)
{-# INLINE compiledFieldDecoder #-}

nullAs :: String -> Either String a
nullAs :: forall a. [Char] -> Either [Char] a
nullAs [Char]
name = [Char] -> Either [Char] a
forall a b. a -> Either a b
Left ([Char] -> Either [Char] a) -> [Char] -> Either [Char] a
forall a b. (a -> b) -> a -> b
$ [Char]
"SQL NULL cannot be decoded as " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"; use Maybe " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name

evaluated :: a -> Either String a
evaluated :: forall a. a -> Either [Char] a
evaluated a
a = a
a a -> Either [Char] a -> Either [Char] a
forall a b. a -> b -> b
`seq` a -> Either [Char] a
forall a b. b -> Either a b
Right a
a

bytesDecoder :: String -> (TypeInfo -> Bool) -> (B.ByteString -> a) -> FieldDecoder a
bytesDecoder :: forall a.
[Char] -> (TypeInfo -> Bool) -> (ByteString -> a) -> FieldDecoder a
bytesDecoder [Char]
name TypeInfo -> Bool
accepts ByteString -> a
mk = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
 -> FieldDecoder a)
-> (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a b. (a -> b) -> a -> b
$ \TdsContext
_ ColumnInfo
col ->
  let ti :: TypeInfo
ti = ColumnInfo -> TypeInfo
columnType ColumnInfo
col
   in if TypeInfo -> Bool
accepts TypeInfo
ti
        then CellDecoder a -> Either [Char] (CellDecoder a)
forall a b. b -> Either a b
Right (CellDecoder a -> Either [Char] (CellDecoder a))
-> CellDecoder a -> Either [Char] (CellDecoder a)
forall a b. (a -> b) -> a -> b
$ Either [Char] a -> ValueReader a -> ValueReader a -> CellDecoder a
forall a.
Either [Char] a -> ValueReader a -> ValueReader a -> CellDecoder a
CellDecoder ([Char] -> Either [Char] a
forall a. [Char] -> Either [Char] a
nullAs [Char]
name)
          (\ByteString
bytes -> a -> Either [Char] a
forall a b. b -> Either a b
Right (a -> Either [Char] a) -> a -> Either [Char] a
forall a b. (a -> b) -> a -> b
$! ByteString -> a
mk (ByteString -> ByteString
B.copy ByteString
bytes)) (\ByteString
bytes -> a -> Either [Char] a
forall a b. b -> Either a b
Right (a -> Either [Char] a) -> a -> Either [Char] a
forall a b. (a -> b) -> a -> b
$! ByteString -> a
mk ByteString
bytes)
        else [Char] -> Either [Char] (CellDecoder a)
forall a b. a -> Either a b
Left ([Char] -> TypeInfo -> [Char]
rejectAs [Char]
name TypeInfo
ti)
{-# INLINE bytesDecoder #-}

-- | Decode NULL as 'Nothing', keeping the inner decoder's type check.  A streaming
-- consumer isn't called for a NULL.
nullableField :: FieldDecoder a -> FieldDecoder (Maybe a)
nullableField :: forall a. FieldDecoder a -> FieldDecoder (Maybe a)
nullableField (FieldDecoder TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compile) = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder (Maybe a)))
-> FieldDecoder (Maybe a)
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext
  -> ColumnInfo -> Either [Char] (CellDecoder (Maybe a)))
 -> FieldDecoder (Maybe a))
-> (TdsContext
    -> ColumnInfo -> Either [Char] (CellDecoder (Maybe a)))
-> FieldDecoder (Maybe a)
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ColumnInfo
col -> (CellDecoder a -> CellDecoder (Maybe a))
-> Either [Char] (CellDecoder a)
-> Either [Char] (CellDecoder (Maybe a))
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CellDecoder a -> CellDecoder (Maybe a)
forall a. CellDecoder a -> CellDecoder (Maybe a)
nullableCell (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compile TdsContext
ctx ColumnInfo
col)
-- Out of line, as 'refineField' and 'FieldDecoder''s 'fmap' are, so that a use is a
-- call, not a copy of the adapter: a use of @Maybe Int32@ in each module that names
-- the type, and a decoder an application composes where it is written.  The cell's
-- reading is the same closures either way.  In a module of 40 functions each calling
-- 'Hmssql.Query.queryWith' with one column so adapted, the code per function was 944
-- bytes with 'nullableField' INLINE, 3,240 with 'refineField' and 800 with 'fmap'.
{-# OPAQUE nullableField #-}

nullableCell :: CellDecoder a -> CellDecoder (Maybe a)
nullableCell :: forall a. CellDecoder a -> CellDecoder (Maybe a)
nullableCell (CellDecoder Either [Char] a
_ ValueReader a
borrowed ValueReader a
owned) =
  Either [Char] (Maybe a)
-> ValueReader (Maybe a)
-> ValueReader (Maybe a)
-> CellDecoder (Maybe a)
forall a.
Either [Char] a -> ValueReader a -> ValueReader a -> CellDecoder a
CellDecoder (Maybe a -> Either [Char] (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> Either [Char] a -> Either [Char] (Maybe a)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either [Char] a -> Either [Char] (Maybe a))
-> ValueReader a -> ValueReader (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueReader a
borrowed) ((a -> Maybe a) -> Either [Char] a -> Either [Char] (Maybe a)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either [Char] a -> Either [Char] (Maybe a))
-> ValueReader a -> ValueReader (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueReader a
owned)
nullableCell (FoldingCell Either [Char] a
_ ValueReader a
borrowed ValueReader a
owned Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
fold) =
  Either [Char] (Maybe a)
-> ValueReader (Maybe a)
-> ValueReader (Maybe a)
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure (Maybe a)))
-> CellDecoder (Maybe a)
forall a.
Either [Char] a
-> ValueReader a
-> ValueReader a
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure a))
-> CellDecoder a
FoldingCell (Maybe a -> Either [Char] (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> Either [Char] a -> Either [Char] (Maybe a)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either [Char] a -> Either [Char] (Maybe a))
-> ValueReader a -> ValueReader (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueReader a
borrowed) ((a -> Maybe a) -> Either [Char] a -> Either [Char] (Maybe a)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either [Char] a -> Either [Char] (Maybe a))
-> ValueReader a -> ValueReader (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueReader a
owned) ((Either ReadFailure a -> Either ReadFailure (Maybe a))
-> Parser (Either ReadFailure a)
-> Parser (Either ReadFailure (Maybe a))
forall a b. (a -> b) -> Recipe () a -> Recipe () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe a)
-> Either ReadFailure a -> Either ReadFailure (Maybe a)
forall a b.
(a -> b) -> Either ReadFailure a -> Either ReadFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just) (Parser (Either ReadFailure a)
 -> Parser (Either ReadFailure (Maybe a)))
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure a))
-> Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
fold)
nullableCell (StreamingCell StreamedValue -> Parser (Either ReadFailure a)
d) = (StreamedValue -> Parser (Either ReadFailure (Maybe a)))
-> CellDecoder (Maybe a)
forall a.
(StreamedValue -> Parser (Either ReadFailure a)) -> CellDecoder a
StreamingCell ((StreamedValue -> Parser (Either ReadFailure (Maybe a)))
 -> CellDecoder (Maybe a))
-> (StreamedValue -> Parser (Either ReadFailure (Maybe a)))
-> CellDecoder (Maybe a)
forall a b. (a -> b) -> a -> b
$ \case
  StreamedValue
StreamedNull -> Either ReadFailure (Maybe a)
-> Parser (Either ReadFailure (Maybe a))
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Either ReadFailure (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing)
  StreamedValue
cell -> (Either ReadFailure a -> Either ReadFailure (Maybe a))
-> Parser (Either ReadFailure a)
-> Parser (Either ReadFailure (Maybe a))
forall a b. (a -> b) -> Recipe () a -> Recipe () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe a)
-> Either ReadFailure a -> Either ReadFailure (Maybe a)
forall a b.
(a -> b) -> Either ReadFailure a -> Either ReadFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just) (StreamedValue -> Parser (Either ReadFailure a)
d StreamedValue
cell)
{-# INLINE nullableCell #-}

-- Which of a type's two row decoders: of the type, or of 'Maybe' the type.  A
-- built-in type compiles both as one function, which takes this.
data Nulls a b where
  NoNulls :: Nulls a a
  Nulls :: Nulls a (Maybe a)

nullsField :: Nulls a b -> FieldDecoder a -> FieldDecoder b
nullsField :: forall a b. Nulls a b -> FieldDecoder a -> FieldDecoder b
nullsField Nulls a b
NoNulls = FieldDecoder a -> FieldDecoder a
FieldDecoder a -> FieldDecoder b
forall a. a -> a
id
nullsField Nulls a b
Nulls = FieldDecoder a -> FieldDecoder b
FieldDecoder a -> FieldDecoder (Maybe a)
forall a. FieldDecoder a -> FieldDecoder (Maybe a)
nullableField
{-# INLINE nullsField #-}

nullsCell :: Nulls a b -> CellDecoder a -> CellDecoder b
nullsCell :: forall a b. Nulls a b -> CellDecoder a -> CellDecoder b
nullsCell Nulls a b
NoNulls = CellDecoder a -> CellDecoder a
CellDecoder a -> CellDecoder b
forall a. a -> a
id
nullsCell Nulls a b
Nulls = CellDecoder a -> CellDecoder b
CellDecoder a -> CellDecoder (Maybe a)
forall a. CellDecoder a -> CellDecoder (Maybe a)
nullableCell
-- Out of line: it runs once per result set, and inlined, every built-in type's row
-- decoder held a copy of 'nullableCell'.
{-# NOINLINE nullsCell #-}

instance FromSqlField a => FromSqlField (Maybe a) where
  fieldDecoder :: FieldDecoder (Maybe a)
fieldDecoder = FieldDecoder a -> FieldDecoder (Maybe a)
forall a. FieldDecoder a -> FieldDecoder (Maybe a)
nullableField FieldDecoder a
forall a. FromSqlField a => FieldDecoder a
fieldDecoder
  fieldRowDecoder :: RowDecoder (Maybe a)
fieldRowDecoder = RowDecoder (Maybe a)
forall a. FromSqlField a => RowDecoder (Maybe a)
nullableRowDecoder
  {-# INLINE fieldRowDecoder #-}

-- | Convert a decoded value further.  A 'Left' becomes a 'DecodeError' naming the
-- column.  The inner decoder's type check and NULL handling still apply.
--
-- > instance FromSqlField Status where
-- >   fieldDecoder = refineField parseStatus fieldDecoder
refineField :: (a -> Either String b) -> FieldDecoder a -> FieldDecoder b
refineField :: forall a b.
(a -> Either [Char] b) -> FieldDecoder a -> FieldDecoder b
refineField a -> Either [Char] b
f (FieldDecoder TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compile) = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder b))
-> FieldDecoder b
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext -> ColumnInfo -> Either [Char] (CellDecoder b))
 -> FieldDecoder b)
-> (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder b))
-> FieldDecoder b
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ColumnInfo
col -> do
  d <- TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compile TdsContext
ctx ColumnInfo
col
  let refined = ([Char] -> Either ReadFailure b)
-> (b -> Either ReadFailure b)
-> Either [Char] b
-> Either ReadFailure b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ReadFailure -> Either ReadFailure b
forall a b. a -> Either a b
Left (ReadFailure -> Either ReadFailure b)
-> ([Char] -> ReadFailure) -> [Char] -> Either ReadFailure b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeError -> ReadFailure
DecodeFailed (DecodeError -> ReadFailure)
-> ([Char] -> DecodeError) -> [Char] -> ReadFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> [Char] -> DecodeError
DecodeError (Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnInfo -> Text
columnName ColumnInfo
col))) b -> Either ReadFailure b
forall a b. b -> Either a b
Right (Either [Char] b -> Either ReadFailure b)
-> (a -> Either [Char] b) -> a -> Either ReadFailure b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either [Char] b
f
  pure $ case d of
    CellDecoder Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned -> Either [Char] b -> ValueReader b -> ValueReader b -> CellDecoder b
forall a.
Either [Char] a -> ValueReader a -> ValueReader a -> CellDecoder a
CellDecoder (Either [Char] a
onNull Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either [Char] b
f)
      (\ByteString
bytes -> ValueReader a
borrowed ByteString
bytes Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either [Char] b
f) (\ByteString
bytes -> ValueReader a
owned ByteString
bytes Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either [Char] b
f)
    FoldingCell Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
fold -> Either [Char] b
-> ValueReader b
-> ValueReader b
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure b))
-> CellDecoder b
forall a.
Either [Char] a
-> ValueReader a
-> ValueReader a
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure a))
-> CellDecoder a
FoldingCell (Either [Char] a
onNull Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either [Char] b
f)
      (\ByteString
bytes -> ValueReader a
borrowed ByteString
bytes Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either [Char] b
f) (\ByteString
bytes -> ValueReader a
owned ByteString
bytes Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either [Char] b
f)
      (\Stream (Of ByteString) (Recipe ()) ()
chunks -> (Either ReadFailure a
-> (a -> Either ReadFailure b) -> Either ReadFailure b
forall a b.
Either ReadFailure a
-> (a -> Either ReadFailure b) -> Either ReadFailure b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either ReadFailure b
refined) (Either ReadFailure a -> Either ReadFailure b)
-> Parser (Either ReadFailure a) -> Parser (Either ReadFailure b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
fold Stream (Of ByteString) (Recipe ()) ()
chunks)
    StreamingCell StreamedValue -> Parser (Either ReadFailure a)
read -> (StreamedValue -> Parser (Either ReadFailure b)) -> CellDecoder b
forall a.
(StreamedValue -> Parser (Either ReadFailure a)) -> CellDecoder a
StreamingCell ((StreamedValue -> Parser (Either ReadFailure b)) -> CellDecoder b)
-> (StreamedValue -> Parser (Either ReadFailure b))
-> CellDecoder b
forall a b. (a -> b) -> a -> b
$ \StreamedValue
cell -> do
      result <- StreamedValue -> Parser (Either ReadFailure a)
read StreamedValue
cell
      pure $ result >>= refined
-- Out of line: the comment at 'nullableField'.
{-# OPAQUE refineField #-}

-- | The bytes of any column's value as the server sends them, including the CLR
-- types hmssql doesn't otherwise decode.
newtype RawValue = RawValue B.ByteString deriving stock (RawValue -> RawValue -> Bool
(RawValue -> RawValue -> Bool)
-> (RawValue -> RawValue -> Bool) -> Eq RawValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawValue -> RawValue -> Bool
== :: RawValue -> RawValue -> Bool
$c/= :: RawValue -> RawValue -> Bool
/= :: RawValue -> RawValue -> Bool
Eq, Int -> RawValue -> [Char] -> [Char]
[RawValue] -> [Char] -> [Char]
RawValue -> [Char]
(Int -> RawValue -> [Char] -> [Char])
-> (RawValue -> [Char])
-> ([RawValue] -> [Char] -> [Char])
-> Show RawValue
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> RawValue -> [Char] -> [Char]
showsPrec :: Int -> RawValue -> [Char] -> [Char]
$cshow :: RawValue -> [Char]
show :: RawValue -> [Char]
$cshowList :: [RawValue] -> [Char] -> [Char]
showList :: [RawValue] -> [Char] -> [Char]
Show)

-- The built-in types' decoders, each INLINE: the type's 'fieldDecoder',
-- compiled once as the method, and the decoder 'cellRowDecoder' inlines (the
-- comment at 'FromSqlField').
rawValueDecoder :: FieldDecoder RawValue
rawValueDecoder :: FieldDecoder RawValue
rawValueDecoder = [Char]
-> (TypeInfo -> Bool)
-> (ByteString -> RawValue)
-> FieldDecoder RawValue
forall a.
[Char] -> (TypeInfo -> Bool) -> (ByteString -> a) -> FieldDecoder a
bytesDecoder [Char]
"RawValue" (Bool -> TypeInfo -> Bool
forall a b. a -> b -> a
const Bool
True) ByteString -> RawValue
RawValue
{-# INLINE rawValueDecoder #-}

instance FromSqlField RawValue where
  fieldDecoder :: FieldDecoder RawValue
fieldDecoder = FieldDecoder RawValue
rawValueDecoder
  rowDecoderWith :: forall b. Nulls RawValue b -> RowDecoder b
rowDecoderWith = FieldDecoder RawValue
-> FieldDecoder RawValue -> Nulls RawValue b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder RawValue
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder RawValue
rawValueDecoder
  {-# NOINLINE rowDecoderWith #-}

-- | An integer type whose range is within the range of 'Int64'.
boundedInteger :: forall a. (Integral a, Bounded a) => String -> FieldDecoder a
boundedInteger :: forall a. (Integral a, Bounded a) => [Char] -> FieldDecoder a
boundedInteger [Char]
name = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] Bool)
-> (Bool -> ValueReader a)
-> FieldDecoder a
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
name TypeInfo -> Bool
isIntegerType (\TdsContext
_ TypeInfo
ti -> Bool -> Either [Char] Bool
forall a b. b -> Either a b
Right (TypeInfo -> Bool
unsignedByteType TypeInfo
ti)) ((Bool -> ValueReader a) -> FieldDecoder a)
-> (Bool -> ValueReader a) -> FieldDecoder a
forall a b. (a -> b) -> a -> b
$ \Bool
unsigned ByteString
bs ->
  case Bool -> ValueReader Int64
integerAt Bool
unsigned ByteString
bs of
    Left [Char]
e -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
e
    Right (I64# Int64#
i) -> [Char] -> Int64# -> Either [Char] a
forall a.
(Integral a, Bounded a) =>
[Char] -> Int64# -> Either [Char] a
inBounds [Char]
name Int64#
i
{-# INLINE boundedInteger #-}

-- The range check, given the integer unboxed.  GHC's last float-out pass makes the
-- check, a closed lambda once 'outOfRange' is out of line, a function of its own,
-- after the pass that gives a function a worker taking its arguments unboxed; given
-- an 'Int64', each @Int32@ cell read through 'fieldDecoder' allocated its box, 16
-- bytes, which for a hand-written @(Int32, Int64)@ decoder was 2,844,575 bytes per
-- query in Mock.query rather than 3,004,528.  Given an 'Int64#', the function takes
-- it unboxed.
inBounds :: forall a. (Integral a, Bounded a) => String -> Int64# -> Either String a
inBounds :: forall a.
(Integral a, Bounded a) =>
[Char] -> Int64# -> Either [Char] a
inBounds [Char]
name Int64#
i
  | Int64# -> Int64
I64# Int64#
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @a) Bool -> Bool -> Bool
|| Int64# -> Int64
I64# Int64#
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @a) = [Char] -> Either [Char] a
forall a b. a -> Either a b
Left ([Char] -> Int64 -> [Char]
outOfRange [Char]
name (Int64# -> Int64
I64# Int64#
i))
  | Bool
otherwise = a -> Either [Char] a
forall a b. b -> Either a b
Right (Int64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64# -> Int64
I64# Int64#
i))
{-# INLINE inBounds #-}

-- Out of line, so that a copy of a bounded integer's conversion doesn't hold the
-- message's 'show'.
outOfRange :: String -> Int64 -> String
outOfRange :: [Char] -> Int64 -> [Char]
outOfRange [Char]
name Int64
i = [Char]
"value " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is out of range for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name
{-# NOINLINE outOfRange #-}

-- The conversions of the date and time types and of 'Decimal' and 'Money', compiled
-- once, out of line, for their field decoders and their row decoders.  Inlined into
-- the row decoders, each would be a second copy of a large conversion per type, which
-- allocates far more than the call costs.  A known call still takes the slice's
-- fields unboxed, though it returns an 'Either': GHC doesn't return a sum type
-- unboxed from a function that isn't a join point.  The bang keeps GHC from
-- eta-reducing a definition to the function it calls; it did, and then the INLINE
-- 'localTimeValue', unsaturated, wasn't inlined, and the call took a boxed slice.
decimalReader :: DecimalColumn -> ValueReader Decimal
decimalReader :: DecimalColumn -> ValueReader Decimal
decimalReader DecimalColumn
column !ByteString
bs = case DecimalColumn
column of
  DecimalColumn Word8
precision Word8
scale -> Word8 -> Word8 -> ValueReader Decimal
readDecimal Word8
precision Word8
scale ByteString
bs
  OtherDecimal TypeInfo
ti -> TypeInfo -> ValueReader Decimal
decimalValue TypeInfo
ti ByteString
bs
{-# NOINLINE decimalReader #-}

-- What 'decimalReader' needs of a column's type, taken from it once per column, with
-- the precision and scale boxed there.  Given the 'TypeInfo', whose fields are
-- unpacked, the reader boxed both for each value, 32 bytes, as 'readDecimal' takes
-- them boxed: a hand-written decoder of the nullable NBCROW rows, half of whose
-- decimals are NULL, allocated 7,884,063 bytes per query in Mock.query rather than
-- 7,724,622.
data DecimalColumn = DecimalColumn Precision Scale | OtherDecimal TypeInfo

decimalColumn :: TypeInfo -> DecimalColumn
decimalColumn :: TypeInfo -> DecimalColumn
decimalColumn = \case
  TIDecimalN Word8
precision Word8
scale -> Word8 -> Word8 -> DecimalColumn
DecimalColumn Word8
precision Word8
scale
  TINumericN Word8
precision Word8
scale -> Word8 -> Word8 -> DecimalColumn
DecimalColumn Word8
precision Word8
scale
  TypeInfo
ti -> TypeInfo -> DecimalColumn
OtherDecimal TypeInfo
ti
moneyValue :: ValueReader Money
moneyValue :: ValueReader Money
moneyValue !ByteString
bs = ValueReader Money
readMoney ByteString
bs
{-# NOINLINE moneyValue #-}
localTimeReader :: TypeInfo -> ValueReader LocalTime
localTimeReader :: TypeInfo -> ValueReader LocalTime
localTimeReader TypeInfo
ti !ByteString
bs = TypeInfo -> ValueReader LocalTime
localTimeValue TypeInfo
ti ByteString
bs
{-# NOINLINE localTimeReader #-}
utcTimeReader :: TypeInfo -> ValueReader UTCTime
utcTimeReader :: TypeInfo -> ValueReader UTCTime
utcTimeReader TypeInfo
ti !ByteString
bs = case TypeInfo
ti of
  TIDateTimeOffsetN Word8
s -> DateTimeOffset -> UTCTime
dtoUtcTime (DateTimeOffset -> UTCTime)
-> Either [Char] DateTimeOffset -> Either [Char] UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> ValueReader DateTimeOffset
readDateTimeOffset Word8
s ByteString
bs
  TypeInfo
_ -> (Day -> Int64 -> UTCTime) -> TypeInfo -> ValueReader UTCTime
forall a. (Day -> Int64 -> a) -> TypeInfo -> ValueReader a
dayTimeValue Day -> Int64 -> UTCTime
utcTimeOf TypeInfo
ti ByteString
bs
{-# NOINLINE utcTimeReader #-}
dayValue :: ValueReader Day
dayValue :: ValueReader Day
dayValue !ByteString
bs = ValueReader Day
readDate ByteString
bs
{-# NOINLINE dayValue #-}

intDecoder :: FieldDecoder Int
intDecoder :: FieldDecoder Int
intDecoder = [Char] -> FieldDecoder Int
forall a. (Integral a, Bounded a) => [Char] -> FieldDecoder a
boundedInteger [Char]
"Int"
{-# INLINE intDecoder #-}

-- | @bit@ and the integer types.  A value out of range is a 'DecodeError', as it
-- is for the other fixed-size integers below.
instance FromSqlField Int where
  fieldDecoder :: FieldDecoder Int
fieldDecoder = FieldDecoder Int
intDecoder
  rowDecoderWith :: forall b. Nulls Int b -> RowDecoder b
rowDecoderWith = FieldDecoder Int -> FieldDecoder Int -> Nulls Int b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Int
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Int
intDecoder
  {-# NOINLINE rowDecoderWith #-}

int8Decoder :: FieldDecoder Int8
int8Decoder :: FieldDecoder Int8
int8Decoder = [Char] -> FieldDecoder Int8
forall a. (Integral a, Bounded a) => [Char] -> FieldDecoder a
boundedInteger [Char]
"Int8"
{-# INLINE int8Decoder #-}

-- | @bit@ and the integer types.
instance FromSqlField Int8 where
  fieldDecoder :: FieldDecoder Int8
fieldDecoder = FieldDecoder Int8
int8Decoder
  rowDecoderWith :: forall b. Nulls Int8 b -> RowDecoder b
rowDecoderWith = FieldDecoder Int8
-> FieldDecoder Int8 -> Nulls Int8 b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Int8
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Int8
int8Decoder
  {-# NOINLINE rowDecoderWith #-}

int16Decoder :: FieldDecoder Int16
int16Decoder :: FieldDecoder Int16
int16Decoder = [Char] -> FieldDecoder Int16
forall a. (Integral a, Bounded a) => [Char] -> FieldDecoder a
boundedInteger [Char]
"Int16"
{-# INLINE int16Decoder #-}

-- | @bit@ and the integer types.
instance FromSqlField Int16 where
  fieldDecoder :: FieldDecoder Int16
fieldDecoder = FieldDecoder Int16
int16Decoder
  rowDecoderWith :: forall b. Nulls Int16 b -> RowDecoder b
rowDecoderWith = FieldDecoder Int16
-> FieldDecoder Int16 -> Nulls Int16 b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Int16
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Int16
int16Decoder
  {-# NOINLINE rowDecoderWith #-}

int32Decoder :: FieldDecoder Int32
int32Decoder :: FieldDecoder Int32
int32Decoder = [Char] -> FieldDecoder Int32
forall a. (Integral a, Bounded a) => [Char] -> FieldDecoder a
boundedInteger [Char]
"Int32"
{-# INLINE int32Decoder #-}

-- | @bit@ and the integer types.
instance FromSqlField Int32 where
  fieldDecoder :: FieldDecoder Int32
fieldDecoder = FieldDecoder Int32
int32Decoder
  rowDecoderWith :: forall b. Nulls Int32 b -> RowDecoder b
rowDecoderWith = FieldDecoder Int32
-> FieldDecoder Int32 -> Nulls Int32 b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Int32
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Int32
int32Decoder
  {-# NOINLINE rowDecoderWith #-}

int64Decoder :: FieldDecoder Int64
int64Decoder :: FieldDecoder Int64
int64Decoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] Bool)
-> (Bool -> ValueReader Int64)
-> FieldDecoder Int64
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"Int64" TypeInfo -> Bool
isIntegerType (\TdsContext
_ TypeInfo
ti -> Bool -> Either [Char] Bool
forall a b. b -> Either a b
Right (TypeInfo -> Bool
unsignedByteType TypeInfo
ti)) Bool -> ValueReader Int64
integerAt
{-# INLINE int64Decoder #-}

-- | @bit@ and the integer types.
instance FromSqlField Int64 where
  fieldDecoder :: FieldDecoder Int64
fieldDecoder = FieldDecoder Int64
int64Decoder
  rowDecoderWith :: forall b. Nulls Int64 b -> RowDecoder b
rowDecoderWith = FieldDecoder Int64
-> FieldDecoder Int64 -> Nulls Int64 b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Int64
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Int64
int64Decoder
  {-# NOINLINE rowDecoderWith #-}

word8Decoder :: FieldDecoder Word8
word8Decoder :: FieldDecoder Word8
word8Decoder = [Char] -> FieldDecoder Word8
forall a. (Integral a, Bounded a) => [Char] -> FieldDecoder a
boundedInteger [Char]
"Word8"
{-# INLINE word8Decoder #-}

-- | @bit@ and the integer types.
instance FromSqlField Word8 where
  fieldDecoder :: FieldDecoder Word8
fieldDecoder = FieldDecoder Word8
word8Decoder
  rowDecoderWith :: forall b. Nulls Word8 b -> RowDecoder b
rowDecoderWith = FieldDecoder Word8
-> FieldDecoder Word8 -> Nulls Word8 b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Word8
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Word8
word8Decoder
  {-# NOINLINE rowDecoderWith #-}

-- | Integer types, and @decimal@ / @numeric@ with scale 0 (such as
-- @decimal(38,0)@, which 'Integer' parameters beyond @bigint@ are sent as).
instance FromSqlField Integer where
  fieldDecoder :: FieldDecoder Integer
fieldDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] TypeInfo)
-> (TypeInfo -> ValueReader Integer)
-> FieldDecoder Integer
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"Integer" (\TypeInfo
ti -> TypeInfo -> Bool
isIntegerType TypeInfo
ti Bool -> Bool -> Bool
|| TypeInfo -> Bool
isScale0 TypeInfo
ti) (\TdsContext
_ TypeInfo
ti -> TypeInfo -> Either [Char] TypeInfo
forall a b. b -> Either a b
Right TypeInfo
ti) ((TypeInfo -> ValueReader Integer) -> FieldDecoder Integer)
-> (TypeInfo -> ValueReader Integer) -> FieldDecoder Integer
forall a b. (a -> b) -> a -> b
$ \TypeInfo
ti ByteString
bs ->
    if TypeInfo -> Bool
isScale0 TypeInfo
ti
      then Decimal -> Integer
forall i. DecimalRaw i -> i
decimalMantissa (Decimal -> Integer)
-> Either [Char] Decimal -> Either [Char] Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeInfo -> ValueReader Decimal
decimalValue TypeInfo
ti ByteString
bs
      else Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Integer) -> Either [Char] Int64 -> Either [Char] Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeInfo -> ValueReader Int64
integerValue TypeInfo
ti ByteString
bs
    where
      isScale0 :: TypeInfo -> Bool
isScale0 = \case
        TIDecimalN Word8
_ Word8
0 -> Bool
True
        TINumericN Word8
_ Word8
0 -> Bool
True
        TypeInfo
_ -> Bool
False

boolDecoder :: FieldDecoder Bool
boolDecoder :: FieldDecoder Bool
boolDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] ())
-> (() -> ValueReader Bool)
-> FieldDecoder Bool
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"Bool" ((SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType (SqlDataType -> SqlDataType -> Bool
forall a. Eq a => a -> a -> Bool
== SqlDataType
TyBit)) (\TdsContext
_ TypeInfo
_ -> () -> Either [Char] ()
forall a b. b -> Either a b
Right ()) (\()
_ -> ValueReader Bool
bitValue)
{-# INLINE boolDecoder #-}

-- | @bit@.
instance FromSqlField Bool where
  fieldDecoder :: FieldDecoder Bool
fieldDecoder = FieldDecoder Bool
boolDecoder
  rowDecoderWith :: forall b. Nulls Bool b -> RowDecoder b
rowDecoderWith = FieldDecoder Bool
-> FieldDecoder Bool -> Nulls Bool b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Bool
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Bool
boolDecoder
  {-# NOINLINE rowDecoderWith #-}

doubleDecoder :: FieldDecoder Double
doubleDecoder :: FieldDecoder Double
doubleDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] ())
-> (() -> ValueReader Double)
-> FieldDecoder Double
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"Double" TypeInfo -> Bool
isFloatType (\TdsContext
_ TypeInfo
_ -> () -> Either [Char] ()
forall a b. b -> Either a b
Right ()) (\()
_ -> ValueReader Double
readFloating)
{-# INLINE doubleDecoder #-}

-- | @real@ and @float@.
instance FromSqlField Double where
  fieldDecoder :: FieldDecoder Double
fieldDecoder = FieldDecoder Double
doubleDecoder
  rowDecoderWith :: forall b. Nulls Double b -> RowDecoder b
rowDecoderWith = FieldDecoder Double
-> FieldDecoder Double -> Nulls Double b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Double
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Double
doubleDecoder
  {-# NOINLINE rowDecoderWith #-}

floatDecoder :: FieldDecoder Float
floatDecoder :: FieldDecoder Float
floatDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] ())
-> (() -> ValueReader Float)
-> FieldDecoder Float
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"Float" TypeInfo -> Bool
isFloatType (\TdsContext
_ TypeInfo
_ -> () -> Either [Char] ()
forall a b. b -> Either a b
Right ()) (\()
_ -> ValueReader Float
float32Value)
{-# INLINE floatDecoder #-}

-- | @real@.  A @float@ value that takes eight bytes is a 'DecodeError', rather
-- than being narrowed.
instance FromSqlField Float where
  fieldDecoder :: FieldDecoder Float
fieldDecoder = FieldDecoder Float
floatDecoder
  rowDecoderWith :: forall b. Nulls Float b -> RowDecoder b
rowDecoderWith = FieldDecoder Float
-> FieldDecoder Float -> Nulls Float b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Float
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Float
floatDecoder
  {-# NOINLINE rowDecoderWith #-}

decimalDecoder :: FieldDecoder Decimal
decimalDecoder :: FieldDecoder Decimal
decimalDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] DecimalColumn)
-> (DecimalColumn -> ValueReader Decimal)
-> FieldDecoder Decimal
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"Decimal"
  (\TypeInfo
ti -> TypeInfo -> Bool
isDecimalType TypeInfo
ti Bool -> Bool -> Bool
|| TypeInfo -> Bool
isMoneyType TypeInfo
ti Bool -> Bool -> Bool
|| TypeInfo -> Bool
isIntegerType TypeInfo
ti)
  (\TdsContext
_ TypeInfo
ti -> DecimalColumn -> Either [Char] DecimalColumn
forall a b. b -> Either a b
Right (TypeInfo -> DecimalColumn
decimalColumn TypeInfo
ti))
  DecimalColumn -> ValueReader Decimal
decimalReader
{-# INLINE decimalDecoder #-}

-- | Accepts @decimal@, @numeric@, @money@, @smallmoney@ and integer types.
instance FromSqlField Decimal where
  fieldDecoder :: FieldDecoder Decimal
fieldDecoder = FieldDecoder Decimal
decimalDecoder
  rowDecoderWith :: forall b. Nulls Decimal b -> RowDecoder b
rowDecoderWith = FieldDecoder Decimal
-> FieldDecoder Decimal -> Nulls Decimal b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Decimal
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Decimal
decimalDecoder
  {-# NOINLINE rowDecoderWith #-}

moneyDecoder :: FieldDecoder Money
moneyDecoder :: FieldDecoder Money
moneyDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] ())
-> (() -> ValueReader Money)
-> FieldDecoder Money
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"Money" TypeInfo -> Bool
isMoneyType (\TdsContext
_ TypeInfo
_ -> () -> Either [Char] ()
forall a b. b -> Either a b
Right ()) (\()
_ -> ValueReader Money
moneyValue)
{-# INLINE moneyDecoder #-}

-- | @money@ and @smallmoney@, with all four decimal places.
instance FromSqlField Money where
  fieldDecoder :: FieldDecoder Money
fieldDecoder = FieldDecoder Money
moneyDecoder
  rowDecoderWith :: forall b. Nulls Money b -> RowDecoder b
rowDecoderWith = FieldDecoder Money
-> FieldDecoder Money -> Nulls Money b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Money
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Money
moneyDecoder
  {-# NOINLINE rowDecoderWith #-}

uuidDecoder :: FieldDecoder UUID
uuidDecoder :: FieldDecoder UUID
uuidDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] ())
-> (() -> ValueReader UUID)
-> FieldDecoder UUID
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"UUID" ((SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType (SqlDataType -> SqlDataType -> Bool
forall a. Eq a => a -> a -> Bool
== SqlDataType
TyUniqueIdentifier)) (\TdsContext
_ TypeInfo
_ -> () -> Either [Char] ()
forall a b. b -> Either a b
Right ()) (\()
_ -> ValueReader UUID
readGuid)
{-# INLINE uuidDecoder #-}

-- | @uniqueidentifier@.
instance FromSqlField UUID where
  fieldDecoder :: FieldDecoder UUID
fieldDecoder = FieldDecoder UUID
uuidDecoder
  rowDecoderWith :: forall b. Nulls UUID b -> RowDecoder b
rowDecoderWith = FieldDecoder UUID
-> FieldDecoder UUID -> Nulls UUID b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder UUID
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder UUID
uuidDecoder
  {-# NOINLINE rowDecoderWith #-}

-- Strings ------------------------------------------------------------------

textDecoder :: FieldDecoder Text
textDecoder :: FieldDecoder Text
textDecoder = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder Text))
-> FieldDecoder Text
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext -> ColumnInfo -> Either [Char] (CellDecoder Text))
 -> FieldDecoder Text)
-> (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder Text))
-> FieldDecoder Text
forall a b. (a -> b) -> a -> b
$ \TdsContext
_ ColumnInfo
col -> do
  enc <- TypeInfo -> Either [Char] TextEncoding
textEncodingOf (ColumnInfo -> TypeInfo
columnType ColumnInfo
col)
  let read = TextEncoding -> ValueReader Text
textValue TextEncoding
enc
  pure (CellDecoder (nullAs "Text") read read)
{-# INLINE textDecoder #-}

-- | Accepts Unicode types, and single-byte types in UTF-8 or a supported
-- single-byte code page.  The collation is checked when the result set's
-- columns arrive, before any rows are decoded.
instance FromSqlField Text where
  fieldDecoder :: FieldDecoder Text
fieldDecoder = FieldDecoder Text
textDecoder
  rowDecoderWith :: forall b. Nulls Text b -> RowDecoder b
rowDecoderWith = FieldDecoder Text
-> FieldDecoder Text -> Nulls Text b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Text
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Text
textDecoder
  {-# NOINLINE rowDecoderWith #-}

lazyTextDecoder :: FieldDecoder LT.Text
lazyTextDecoder :: FieldDecoder Text
lazyTextDecoder = Text -> Text
LT.fromStrict (Text -> Text) -> FieldDecoder Text -> FieldDecoder Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldDecoder Text
textDecoder
{-# INLINE lazyTextDecoder #-}

-- | As 'Text', with the whole value read into memory first.  To read a large value
-- as it arrives, use 'streamTextField'.
instance FromSqlField LT.Text where
  fieldDecoder :: FieldDecoder Text
fieldDecoder = FieldDecoder Text
lazyTextDecoder
  rowDecoderWith :: forall b. Nulls Text b -> RowDecoder b
rowDecoderWith = FieldDecoder Text
-> FieldDecoder Text -> Nulls Text b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Text
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Text
lazyTextDecoder
  {-# NOINLINE rowDecoderWith #-}

stringDecoder :: FieldDecoder String
stringDecoder :: FieldDecoder [Char]
stringDecoder = Text -> [Char]
T.unpack (Text -> [Char]) -> FieldDecoder Text -> FieldDecoder [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldDecoder Text
textDecoder
{-# INLINE stringDecoder #-}

instance {-# OVERLAPPING #-} FromSqlField String where
  fieldDecoder :: FieldDecoder [Char]
fieldDecoder = FieldDecoder [Char]
stringDecoder
  rowDecoderWith :: forall b. Nulls [Char] b -> RowDecoder b
rowDecoderWith = FieldDecoder [Char]
-> FieldDecoder [Char] -> Nulls [Char] b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder [Char]
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder [Char]
stringDecoder
  {-# NOINLINE rowDecoderWith #-}

byteStringDecoder :: FieldDecoder B.ByteString
byteStringDecoder :: FieldDecoder ByteString
byteStringDecoder = [Char]
-> (TypeInfo -> Bool)
-> (ByteString -> ByteString)
-> FieldDecoder ByteString
forall a.
[Char] -> (TypeInfo -> Bool) -> (ByteString -> a) -> FieldDecoder a
bytesDecoder [Char]
"ByteString" (\TypeInfo
ti -> TypeInfo -> Bool
isBinaryType TypeInfo
ti Bool -> Bool -> Bool
|| TypeInfo -> Bool
isAnsiType TypeInfo
ti) ByteString -> ByteString
forall a. a -> a
id
{-# INLINE byteStringDecoder #-}

-- | Accepts binary types and also the raw bytes of single-byte character types.
instance FromSqlField B.ByteString where
  fieldDecoder :: FieldDecoder ByteString
fieldDecoder = FieldDecoder ByteString
byteStringDecoder
  rowDecoderWith :: forall b. Nulls ByteString b -> RowDecoder b
rowDecoderWith = FieldDecoder ByteString
-> FieldDecoder ByteString -> Nulls ByteString b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder ByteString
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder ByteString
byteStringDecoder
  {-# NOINLINE rowDecoderWith #-}

lazyByteStringDecoder :: FieldDecoder LB.ByteString
lazyByteStringDecoder :: FieldDecoder ByteString
lazyByteStringDecoder = ByteString -> ByteString
LB.fromStrict (ByteString -> ByteString)
-> FieldDecoder ByteString -> FieldDecoder ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldDecoder ByteString
byteStringDecoder
{-# INLINE lazyByteStringDecoder #-}

-- | As a strict 'B.ByteString', with the whole value read into memory first.  To
-- read a large value as it arrives, use 'streamField'.
instance FromSqlField LB.ByteString where
  fieldDecoder :: FieldDecoder ByteString
fieldDecoder = FieldDecoder ByteString
lazyByteStringDecoder
  rowDecoderWith :: forall b. Nulls ByteString b -> RowDecoder b
rowDecoderWith = FieldDecoder ByteString
-> FieldDecoder ByteString -> Nulls ByteString b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder ByteString
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder ByteString
lazyByteStringDecoder
  {-# NOINLINE rowDecoderWith #-}

-- Dates and times ---------------------------------------------------------

localTimeDecoder :: FieldDecoder LocalTime
localTimeDecoder :: FieldDecoder LocalTime
localTimeDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] TypeInfo)
-> (TypeInfo -> ValueReader LocalTime)
-> FieldDecoder LocalTime
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"LocalTime" TypeInfo -> Bool
isLocalTimeType (\TdsContext
_ TypeInfo
ti -> TypeInfo -> Either [Char] TypeInfo
forall a b. b -> Either a b
Right TypeInfo
ti) TypeInfo -> ValueReader LocalTime
localTimeReader
{-# INLINE localTimeDecoder #-}

-- | @datetime@, @smalldatetime@, @datetime2@ and @date@ (at midnight).
instance FromSqlField LocalTime where
  fieldDecoder :: FieldDecoder LocalTime
fieldDecoder = FieldDecoder LocalTime
localTimeDecoder
  rowDecoderWith :: forall b. Nulls LocalTime b -> RowDecoder b
rowDecoderWith = FieldDecoder LocalTime
-> FieldDecoder LocalTime -> Nulls LocalTime b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder LocalTime
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder LocalTime
localTimeDecoder
  {-# NOINLINE rowDecoderWith #-}

utcTimeDecoder :: FieldDecoder UTCTime
utcTimeDecoder :: FieldDecoder UTCTime
utcTimeDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] TypeInfo)
-> (TypeInfo -> ValueReader UTCTime)
-> FieldDecoder UTCTime
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"UTCTime"
  (\TypeInfo
ti -> TypeInfo -> Bool
isLocalTimeType TypeInfo
ti Bool -> Bool -> Bool
|| TypeInfo -> Bool
isDateTimeOffsetType TypeInfo
ti)
  (\TdsContext
_ TypeInfo
ti -> TypeInfo -> Either [Char] TypeInfo
forall a b. b -> Either a b
Right TypeInfo
ti)
  TypeInfo -> ValueReader UTCTime
utcTimeReader
{-# INLINE utcTimeDecoder #-}

-- | Zoneless types are taken to be UTC; @datetimeoffset@ is converted to UTC.
instance FromSqlField UTCTime where
  fieldDecoder :: FieldDecoder UTCTime
fieldDecoder = FieldDecoder UTCTime
utcTimeDecoder
  rowDecoderWith :: forall b. Nulls UTCTime b -> RowDecoder b
rowDecoderWith = FieldDecoder UTCTime
-> FieldDecoder UTCTime -> Nulls UTCTime b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder UTCTime
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder UTCTime
utcTimeDecoder
  {-# NOINLINE rowDecoderWith #-}

dateTimeOffsetDecoder :: FieldDecoder DateTimeOffset
dateTimeOffsetDecoder :: FieldDecoder DateTimeOffset
dateTimeOffsetDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] Word8)
-> (Word8 -> ValueReader DateTimeOffset)
-> FieldDecoder DateTimeOffset
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"DateTimeOffset" TypeInfo -> Bool
isDateTimeOffsetType
  (\TdsContext
_ TypeInfo
ti -> case TypeInfo
ti of
    TIDateTimeOffsetN Word8
s -> Word8 -> Either [Char] Word8
forall a b. b -> Either a b
Right Word8
s
    TypeInfo
_ -> [Char] -> Either [Char] Word8
forall a b. a -> Either a b
Left [Char]
"not datetimeoffset")
  Word8 -> ValueReader DateTimeOffset
readDateTimeOffset
{-# INLINE dateTimeOffsetDecoder #-}

instance FromSqlField DateTimeOffset where
  fieldDecoder :: FieldDecoder DateTimeOffset
fieldDecoder = FieldDecoder DateTimeOffset
dateTimeOffsetDecoder
  rowDecoderWith :: forall b. Nulls DateTimeOffset b -> RowDecoder b
rowDecoderWith = FieldDecoder DateTimeOffset
-> FieldDecoder DateTimeOffset
-> Nulls DateTimeOffset b
-> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder DateTimeOffset
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder DateTimeOffset
dateTimeOffsetDecoder
  {-# NOINLINE rowDecoderWith #-}

zonedTimeDecoder :: FieldDecoder ZonedTime
zonedTimeDecoder :: FieldDecoder ZonedTime
zonedTimeDecoder = DateTimeOffset -> ZonedTime
dateTimeOffsetToZonedTime (DateTimeOffset -> ZonedTime)
-> FieldDecoder DateTimeOffset -> FieldDecoder ZonedTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldDecoder DateTimeOffset
dateTimeOffsetDecoder
{-# INLINE zonedTimeDecoder #-}

instance FromSqlField ZonedTime where
  fieldDecoder :: FieldDecoder ZonedTime
fieldDecoder = FieldDecoder ZonedTime
zonedTimeDecoder
  rowDecoderWith :: forall b. Nulls ZonedTime b -> RowDecoder b
rowDecoderWith = FieldDecoder ZonedTime
-> FieldDecoder ZonedTime -> Nulls ZonedTime b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder ZonedTime
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder ZonedTime
zonedTimeDecoder
  {-# NOINLINE rowDecoderWith #-}

dayDecoder :: FieldDecoder Day
dayDecoder :: FieldDecoder Day
dayDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] ())
-> (() -> ValueReader Day)
-> FieldDecoder Day
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"Day" ((SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType (SqlDataType -> SqlDataType -> Bool
forall a. Eq a => a -> a -> Bool
== SqlDataType
TyDate)) (\TdsContext
_ TypeInfo
_ -> () -> Either [Char] ()
forall a b. b -> Either a b
Right ()) (\()
_ -> ValueReader Day
dayValue)
{-# INLINE dayDecoder #-}

-- | @date@.
instance FromSqlField Day where
  fieldDecoder :: FieldDecoder Day
fieldDecoder = FieldDecoder Day
dayDecoder
  rowDecoderWith :: forall b. Nulls Day b -> RowDecoder b
rowDecoderWith = FieldDecoder Day -> FieldDecoder Day -> Nulls Day b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder Day
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder Day
dayDecoder
  {-# NOINLINE rowDecoderWith #-}

timeOfDayDecoder :: FieldDecoder TimeOfDay
timeOfDayDecoder :: FieldDecoder TimeOfDay
timeOfDayDecoder = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] Word8)
-> (Word8 -> ValueReader TimeOfDay)
-> FieldDecoder TimeOfDay
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
"TimeOfDay" ((SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType (SqlDataType -> SqlDataType -> Bool
forall a. Eq a => a -> a -> Bool
== SqlDataType
TyTime))
  (\TdsContext
_ TypeInfo
ti -> case TypeInfo
ti of
    TITimeN Word8
s -> Word8 -> Either [Char] Word8
forall a b. b -> Either a b
Right Word8
s
    TypeInfo
_ -> [Char] -> Either [Char] Word8
forall a b. a -> Either a b
Left [Char]
"not time")
  Word8 -> ValueReader TimeOfDay
readTime
{-# INLINE timeOfDayDecoder #-}

-- | @time@ at any scale.
instance FromSqlField TimeOfDay where
  fieldDecoder :: FieldDecoder TimeOfDay
fieldDecoder = FieldDecoder TimeOfDay
timeOfDayDecoder
  rowDecoderWith :: forall b. Nulls TimeOfDay b -> RowDecoder b
rowDecoderWith = FieldDecoder TimeOfDay
-> FieldDecoder TimeOfDay -> Nulls TimeOfDay b -> RowDecoder b
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder TimeOfDay
forall a. FromSqlField a => FieldDecoder a
fieldDecoder FieldDecoder TimeOfDay
timeOfDayDecoder
  {-# NOINLINE rowDecoderWith #-}

-- Decoders from a value's parts --------------------------------------------

-- | A decoder of the types 'LocalTime' accepts (@date@, @datetime@,
-- @smalldatetime@ and @datetime2@), given a name for error messages and a
-- function of each value's day and picoseconds since midnight, which are 0 for
-- a @date@.  A @datetime@'s picoseconds are rounded down, as 'LocalTime''s are,
-- and a day count or a time count out of range is a 'DecodeError', as it is for
-- 'LocalTime'.
dayTimeFieldDecoder :: String -> (Day -> Int64 -> a) -> FieldDecoder a
dayTimeFieldDecoder :: forall a. [Char] -> (Day -> Int64 -> a) -> FieldDecoder a
dayTimeFieldDecoder [Char]
name Day -> Int64 -> a
k = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] TypeInfo)
-> (TypeInfo -> ValueReader a)
-> FieldDecoder a
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
name TypeInfo -> Bool
isLocalTimeType (\TdsContext
_ TypeInfo
ti -> TypeInfo -> Either [Char] TypeInfo
forall a b. b -> Either a b
Right TypeInfo
ti) ((Day -> Int64 -> a) -> TypeInfo -> ValueReader a
forall a. (Day -> Int64 -> a) -> TypeInfo -> ValueReader a
dayTimeValue Day -> Int64 -> a
k)
{-# INLINE dayTimeFieldDecoder #-}

-- | A decoder of @datetimeoffset@, given a name for error messages and a
-- function of each value's day and picoseconds since midnight, both in UTC, and
-- its offset in minutes, as 'DateTimeOffset' holds them.  The value is checked as
-- 'DateTimeOffset' is: the offset must lie within ±14:00, and the local date
-- must be in range.
dateTimeOffsetFieldDecoder :: String -> (Day -> Int64 -> Int16 -> a) -> FieldDecoder a
dateTimeOffsetFieldDecoder :: forall a. [Char] -> (Day -> Int64 -> Int16 -> a) -> FieldDecoder a
dateTimeOffsetFieldDecoder [Char]
name Day -> Int64 -> Int16 -> a
k = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] Word8)
-> (Word8 -> ValueReader a)
-> FieldDecoder a
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
name TypeInfo -> Bool
isDateTimeOffsetType
  (\TdsContext
_ TypeInfo
ti -> case TypeInfo
ti of
    TIDateTimeOffsetN Word8
s -> Word8 -> Either [Char] Word8
forall a b. b -> Either a b
Right Word8
s
    TypeInfo
_ -> [Char] -> Either [Char] Word8
forall a b. a -> Either a b
Left [Char]
"not datetimeoffset")
  ((Day -> Int64 -> Int16 -> a) -> Word8 -> ValueReader a
forall a. (Day -> Int64 -> Int16 -> a) -> Word8 -> ValueReader a
readDateTimeOffsetWith Day -> Int64 -> Int16 -> a
k)
{-# INLINE dateTimeOffsetFieldDecoder #-}

-- | A decoder of @time@ at any scale, given a name for error messages and a
-- function of each value's picoseconds since midnight.
timeFieldDecoder :: String -> (Int64 -> a) -> FieldDecoder a
timeFieldDecoder :: forall a. [Char] -> (Int64 -> a) -> FieldDecoder a
timeFieldDecoder [Char]
name Int64 -> a
k = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] Word8)
-> (Word8 -> ValueReader a)
-> FieldDecoder a
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
name ((SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType (SqlDataType -> SqlDataType -> Bool
forall a. Eq a => a -> a -> Bool
== SqlDataType
TyTime))
  (\TdsContext
_ TypeInfo
ti -> case TypeInfo
ti of
    TITimeN Word8
s -> Word8 -> Either [Char] Word8
forall a b. b -> Either a b
Right Word8
s
    TypeInfo
_ -> [Char] -> Either [Char] Word8
forall a b. a -> Either a b
Left [Char]
"not time")
  ((Int64 -> a) -> Word8 -> ValueReader a
forall a. (Int64 -> a) -> Word8 -> ValueReader a
readTimeWith Int64 -> a
k)
{-# INLINE timeFieldDecoder #-}

-- | A decoder of the types 'Decimal' accepts (@decimal@, @numeric@, @money@,
-- @smallmoney@ and the integer types), given a name for error messages and a
-- function of each value's parts: whether it is negative, the high and low 64 bits
-- of its magnitude, and its scale.  A @decimal@ is checked as 'Decimal' checks it,
-- a @money@ value has scale 4 and an integer scale 0, and a zero is never negative.
-- The high bits are 0 unless the value needs more than 64, which only a @decimal@
-- of precision 20 or more can.
--
-- > -- a value's whole part, when its magnitude fits 64 bits
-- > wholePart :: FieldDecoder (Maybe Integer)
-- > wholePart = decimalFieldDecoder "whole part" $ \negative hi lo scale ->
-- >   if hi /= 0 then Nothing
-- >   else Just ((if negative then negate else id) (toInteger (lo `quot` 10 ^ scale)))
decimalFieldDecoder :: String -> (Bool -> Word64 -> Word64 -> Word8 -> a) -> FieldDecoder a
decimalFieldDecoder :: forall a.
[Char]
-> (Bool -> Word64 -> Word64 -> Word8 -> a) -> FieldDecoder a
decimalFieldDecoder [Char]
name Bool -> Word64 -> Word64 -> Word8 -> a
k = [Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] DecimalColumn)
-> (DecimalColumn -> ValueReader a)
-> FieldDecoder a
forall s a.
[Char]
-> (TypeInfo -> Bool)
-> (TdsContext -> TypeInfo -> Either [Char] s)
-> (s -> ValueReader a)
-> FieldDecoder a
compiledFieldDecoder [Char]
name
  (\TypeInfo
ti -> TypeInfo -> Bool
isDecimalType TypeInfo
ti Bool -> Bool -> Bool
|| TypeInfo -> Bool
isMoneyType TypeInfo
ti Bool -> Bool -> Bool
|| TypeInfo -> Bool
isIntegerType TypeInfo
ti)
  (\TdsContext
_ TypeInfo
ti -> DecimalColumn -> Either [Char] DecimalColumn
forall a b. b -> Either a b
Right (TypeInfo -> DecimalColumn
decimalColumn TypeInfo
ti))
  ((Bool -> Word64 -> Word64 -> Word8 -> a)
-> DecimalColumn -> ValueReader a
forall a.
(Bool -> Word64 -> Word64 -> Word8 -> a)
-> DecimalColumn -> ValueReader a
decimalPartsReader Bool -> Word64 -> Word64 -> Word8 -> a
k)
{-# INLINE decimalFieldDecoder #-}

-- 'decimalReader' for 'decimalFieldDecoder''s function.  The bang is
-- 'decimalReader''s.
decimalPartsReader :: (Bool -> Word64 -> Word64 -> Word8 -> a) -> DecimalColumn -> ValueReader a
decimalPartsReader :: forall a.
(Bool -> Word64 -> Word64 -> Word8 -> a)
-> DecimalColumn -> ValueReader a
decimalPartsReader Bool -> Word64 -> Word64 -> Word8 -> a
k DecimalColumn
column !ByteString
bs = case DecimalColumn
column of
  DecimalColumn Word8
precision Word8
scale -> (Bool -> Word64 -> Word64 -> Word8 -> a)
-> Word8 -> Word8 -> ValueReader a
forall a.
(Bool -> Word64 -> Word64 -> Word8 -> a)
-> Word8 -> Word8 -> ValueReader a
readDecimalWith Bool -> Word64 -> Word64 -> Word8 -> a
k Word8
precision Word8
scale ByteString
bs
  OtherDecimal TypeInfo
ti
    | TypeInfo -> Bool
isMoneyType TypeInfo
ti -> (Int64 -> Word8 -> Either [Char] a
`signed` Word8
4) (Int64 -> Either [Char] a)
-> Either [Char] Int64 -> Either [Char] a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ValueReader Int64
moneyUnits ByteString
bs
    | Bool
otherwise -> (Int64 -> Word8 -> Either [Char] a
`signed` Word8
0) (Int64 -> Either [Char] a)
-> Either [Char] Int64 -> Either [Char] a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TypeInfo -> ValueReader Int64
integerValue TypeInfo
ti ByteString
bs
  where
    signed :: Int64 -> Word8 -> Either [Char] a
signed Int64
i Word8
scale = a -> Either [Char] a
forall a b. b -> Either a b
Right (a -> Either [Char] a) -> a -> Either [Char] a
forall a b. (a -> b) -> a -> b
$! Bool -> Word64 -> Word64 -> Word8 -> a
k (Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0) Word64
0 (if Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 then Word64 -> Word64
forall a. Num a => a -> a
negate (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i) else Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i) Word8
scale
{-# INLINE decimalPartsReader #-}

------------------------------------------------------------------------------
-- Dynamic values

-- | Any column as a 'SqlValue' (the 'FromSqlField' instance), with the
-- reader chosen by the column's type.
sqlValueDecoder :: FieldDecoder SqlValue
sqlValueDecoder :: FieldDecoder SqlValue
sqlValueDecoder = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder SqlValue))
-> FieldDecoder SqlValue
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext -> ColumnInfo -> Either [Char] (CellDecoder SqlValue))
 -> FieldDecoder SqlValue)
-> (TdsContext
    -> ColumnInfo -> Either [Char] (CellDecoder SqlValue))
-> FieldDecoder SqlValue
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ColumnInfo
col -> do
  let ti :: TypeInfo
ti = ColumnInfo -> TypeInfo
columnType ColumnInfo
col
  -- Reject a single-byte column whose collation can't be decoded up front,
  -- as the Text decoder does.  (A sql_variant's collation is per value.)
  Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TypeInfo -> Bool
isAnsiType TypeInfo
ti) (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ () () -> Either [Char] (ValueReader Text) -> Either [Char] ()
forall a b. a -> Either [Char] b -> Either [Char] a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TypeInfo -> Either [Char] (ValueReader Text)
columnTextDecoder TypeInfo
ti
  case TypeInfo
ti of
    TIUdt UdtInfo
_ -> [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left (TypeInfo -> [Char] -> [Char]
unsupportedUdt TypeInfo
ti [Char]
"as SqlValue")
    TypeInfo
_ -> () -> Either [Char] ()
forall a. a -> Either [Char] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  -- Select the scalar reader once per column and evaluate its SqlValue
  -- result before returning it. Binary values keep their ownership paths.
  CellDecoder SqlValue -> Either [Char] (CellDecoder SqlValue)
forall a b. b -> Either a b
Right (CellDecoder SqlValue -> Either [Char] (CellDecoder SqlValue))
-> CellDecoder SqlValue -> Either [Char] (CellDecoder SqlValue)
forall a b. (a -> b) -> a -> b
$ if TypeInfo -> Bool
isBinaryType TypeInfo
ti
    then Either [Char] SqlValue
-> ValueReader SqlValue
-> ValueReader SqlValue
-> CellDecoder SqlValue
forall a.
Either [Char] a -> ValueReader a -> ValueReader a -> CellDecoder a
CellDecoder (SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right SqlValue
SqlNull)
      (\ByteString
bytes -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (SqlValue -> Either [Char] SqlValue)
-> SqlValue -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$! ByteString -> SqlValue
SqlBinary (ByteString -> ByteString
B.copy ByteString
bytes)) (\ByteString
bytes -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (SqlValue -> Either [Char] SqlValue)
-> SqlValue -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$! ByteString -> SqlValue
SqlBinary ByteString
bytes)
    else case TdsContext -> TypeInfo -> SelectedReader
selectSqlValueReader TdsContext
ctx TypeInfo
ti of
      SelectedReader ValueReader SqlValue
reader -> Either [Char] SqlValue
-> ValueReader SqlValue -> CellDecoder SqlValue
forall a. Either [Char] a -> ValueReader a -> CellDecoder a
cellDecoder (SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right SqlValue
SqlNull) ValueReader SqlValue
reader

instance FromSqlField SqlValue where
  fieldDecoder :: FieldDecoder SqlValue
fieldDecoder = FieldDecoder SqlValue
sqlValueDecoder

-- | A compiled part prepares a recipe once per allocation bound. Column
-- positions are captured at compilation, and the NBCROW bitmap is the recipe's
-- read-only environment.  A cell that fails reads past the rest of the row and
-- then fails the recipe ('P.failValue'), which stops composition before any later
-- consumer runs; the row compiler catches it ('P.attempt').  The skip comes from the
-- result set's compiled shapes, captured per column, so no decoder carries a skip
-- recipe of its own.  The recipe is 'Prepared' for the reason 'CompiledRow' gives: a
-- part not inlined into its row, such as each column of a 'SqlRow', was otherwise
-- prepared again for every row.
data RowPart a = RowPart (Int -> Prepared (P.Recipe B.ByteString a))

-- | A decoder of a whole row, with a fixed column count, checked against a result
-- set's columns before its first row.  Compose it with its 'Applicative' instance.
-- It has no 'Monad' instance; use 'RowDecoderMonadic' when later columns depend on
-- earlier values.
data RowDecoder a = RowDecoder
  { forall a.
RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart a)
compileRowAt :: TdsContext -> ResultSetInfo -> Int -> Either DecodeError (RowPart a)
  , forall a. RowDecoder a -> Int
numExpectedColumns :: !Int
  }

-- The instances call their combinators out of line, so that a decoder an application
-- composes, such as @(,) \<$\> singleField a \<*\> singleField b@, is a few calls where
-- it is written rather than its own copy of the composition: a function calling
-- 'Hmssql.Query.queryWith' with that decoder was 1,563 bytes of object code, and is
-- 283.  The rules below turn a chain of '<*>' into one call of a lift function of its
-- length, so that a row applies the combining function once, to all its values;
-- through 'apRowCalled' alone, each step of a row held a partial application of it,
-- 176 bytes per row of five columns.  The combining function is then an unknown call
-- once per row, beside the columns' recipes, which were unknown calls already
-- ('singleField' is out of line).  The library's own compositions use the inlined
-- 'mapRow' and 'liftRow', whose recipe knows the combining function.
instance Functor RowDecoder where
  fmap :: forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
fmap = (a -> b) -> RowDecoder a -> RowDecoder b
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRowCalled
  {-# INLINE fmap #-}

instance Applicative RowDecoder where
  pure :: forall a. a -> RowDecoder a
pure a
a = (TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
forall a.
(TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
RowDecoder (\TdsContext
_ ResultSetInfo
_ Int
_ -> RowPart a -> Either DecodeError (RowPart a)
forall a b. b -> Either a b
Right ((Int -> Prepared (Recipe ByteString a)) -> RowPart a
forall a. (Int -> Prepared (Recipe ByteString a)) -> RowPart a
RowPart (\Int
_ -> Recipe ByteString a -> Prepared (Recipe ByteString a)
forall a. a -> Prepared a
Prepared (a -> Recipe ByteString a
forall a. a -> Recipe ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)))) Int
0
  <*> :: forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
(<*>) = RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
apRowCalled
  {-# INLINE (<*>) #-}
  liftA2 :: forall a b c.
(a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftA2 = (a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
forall a b c.
(a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftRowCalled
  {-# INLINE liftA2 #-}

mapRow :: (a -> b) -> RowDecoder a -> RowDecoder b
mapRow :: forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRow a -> b
f (RowDecoder TdsContext
-> ResultSetInfo -> Int -> Either DecodeError (RowPart a)
c Int
n) = (TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart b))
-> Int -> RowDecoder b
forall a.
(TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
RowDecoder
  (\TdsContext
ctx ResultSetInfo
rs Int
i -> do
    RowPart prepare <- TdsContext
-> ResultSetInfo -> Int -> Either DecodeError (RowPart a)
c TdsContext
ctx ResultSetInfo
rs Int
i
    pure $ RowPart $ \Int
ahead -> case Int -> Prepared (Recipe ByteString a)
prepare Int
ahead of
      Prepared Recipe ByteString a
read -> Recipe ByteString b -> Prepared (Recipe ByteString b)
forall a. a -> Prepared a
Prepared ((a -> b) -> Recipe ByteString a -> Recipe ByteString b
forall a b. (a -> b) -> Recipe ByteString a -> Recipe ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Recipe ByteString a
read)) Int
n
{-# INLINE mapRow #-}

liftRow :: (a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftRow :: forall a b c.
(a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftRow a -> b -> c
f (RowDecoder TdsContext
-> ResultSetInfo -> Int -> Either DecodeError (RowPart a)
ca Int
na) (RowDecoder TdsContext
-> ResultSetInfo -> Int -> Either DecodeError (RowPart b)
cb Int
nb) = (TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart c))
-> Int -> RowDecoder c
forall a.
(TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
RowDecoder
  (\TdsContext
ctx ResultSetInfo
rs Int
i -> do
    RowPart prepareA <- TdsContext
-> ResultSetInfo -> Int -> Either DecodeError (RowPart a)
ca TdsContext
ctx ResultSetInfo
rs Int
i
    -- Strict, because out of line 'cb' is an unknown call and took a thunk.
    RowPart prepareB <- cb ctx rs $! i + na
    -- The parts are closures built by 'singleField' or a type's 'fieldRowDecoder',
    -- so GHC calls them without seeing into them; 'P.dynamic' spares the second its
    -- position's box, and the first gets the position as it came.
    pure $ RowPart $ \Int
ahead -> case (Int -> Prepared (Recipe ByteString a)
prepareA Int
ahead, Int -> Prepared (Recipe ByteString b)
prepareB Int
ahead) of
      (Prepared Recipe ByteString a
readA, Prepared Recipe ByteString b
readB) -> Recipe ByteString c -> Prepared (Recipe ByteString c)
forall a. a -> Prepared a
Prepared ((a -> b -> c)
-> Recipe ByteString a
-> Recipe ByteString b
-> Recipe ByteString c
forall a b c.
(a -> b -> c)
-> Recipe ByteString a
-> Recipe ByteString b
-> Recipe ByteString c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Recipe ByteString a
readA (Recipe ByteString b -> Recipe ByteString b
forall env a. Recipe env a -> Recipe env a
P.dynamic Recipe ByteString b
readB))) (Int
na Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nb)
{-# INLINE liftRow #-}

apRow :: RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
apRow :: forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
apRow = ((a -> b) -> a -> b)
-> RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
forall a b c.
(a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftRow (a -> b) -> a -> b
forall a. a -> a
id
{-# INLINE apRow #-}

mapRowCalled :: (a -> b) -> RowDecoder a -> RowDecoder b
mapRowCalled :: forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRowCalled = (a -> b) -> RowDecoder a -> RowDecoder b
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRow
{-# OPAQUE mapRowCalled #-}

liftRowCalled :: (a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftRowCalled :: forall a b c.
(a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftRowCalled = (a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
forall a b c.
(a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftRow
{-# OPAQUE liftRowCalled #-}

apRowCalled :: RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
apRowCalled :: forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
apRowCalled = RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
apRow
{-# OPAQUE apRowCalled #-}

-- 'liftA2' with '(:)', as 'traverse' and 'sequenceA' of a list compose, so that the
-- cons is built where the values are rather than through an unknown call.
consRowCalled :: RowDecoder a -> RowDecoder [a] -> RowDecoder [a]
consRowCalled :: forall a. RowDecoder a -> RowDecoder [a] -> RowDecoder [a]
consRowCalled = (a -> [a] -> [a])
-> RowDecoder a -> RowDecoder [a] -> RowDecoder [a]
forall a b c.
(a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftRow (:)
{-# OPAQUE consRowCalled #-}

-- The lift functions of three to twelve columns, which the rules make of a chain of
-- '<*>' and which the tuples of those lengths are.  Each is the chain itself, inlined
-- here once: the lambda gives its function a known arity, so that GHC eliminates the
-- partial applications between the steps and the row calls @f@ once with all its
-- values.  A chain longer than twelve goes on through 'apRowCalled'.
lift3RowCalled :: (a -> b -> c -> r) -> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder r
lift3RowCalled :: forall a b c r.
(a -> b -> c -> r)
-> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder r
lift3RowCalled a -> b -> c -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 = (a -> b -> c -> r) -> RowDecoder a -> RowDecoder (b -> c -> r)
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRow (\a
x1 b
x2 c
x3 -> a -> b -> c -> r
f a
x1 b
x2 c
x3) RowDecoder a
d1 RowDecoder (b -> c -> r) -> RowDecoder b -> RowDecoder (c -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder b
d2 RowDecoder (c -> r) -> RowDecoder c -> RowDecoder r
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder c
d3
{-# OPAQUE lift3RowCalled #-}

lift4RowCalled :: (a -> b -> c -> d -> r) -> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder r
lift4RowCalled :: forall a b c d r.
(a -> b -> c -> d -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder r
lift4RowCalled a -> b -> c -> d -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 = (a -> b -> c -> d -> r)
-> RowDecoder a -> RowDecoder (b -> c -> d -> r)
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRow (\a
x1 b
x2 c
x3 d
x4 -> a -> b -> c -> d -> r
f a
x1 b
x2 c
x3 d
x4) RowDecoder a
d1 RowDecoder (b -> c -> d -> r)
-> RowDecoder b -> RowDecoder (c -> d -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder b
d2 RowDecoder (c -> d -> r) -> RowDecoder c -> RowDecoder (d -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder c
d3 RowDecoder (d -> r) -> RowDecoder d -> RowDecoder r
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder d
d4
{-# OPAQUE lift4RowCalled #-}

lift5RowCalled :: (a -> b -> c -> d -> e -> r) -> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder r
lift5RowCalled :: forall a b c d e r.
(a -> b -> c -> d -> e -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder r
lift5RowCalled a -> b -> c -> d -> e -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 RowDecoder e
d5 = (a -> b -> c -> d -> e -> r)
-> RowDecoder a -> RowDecoder (b -> c -> d -> e -> r)
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRow (\a
x1 b
x2 c
x3 d
x4 e
x5 -> a -> b -> c -> d -> e -> r
f a
x1 b
x2 c
x3 d
x4 e
x5) RowDecoder a
d1 RowDecoder (b -> c -> d -> e -> r)
-> RowDecoder b -> RowDecoder (c -> d -> e -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder b
d2 RowDecoder (c -> d -> e -> r)
-> RowDecoder c -> RowDecoder (d -> e -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder c
d3 RowDecoder (d -> e -> r) -> RowDecoder d -> RowDecoder (e -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder d
d4 RowDecoder (e -> r) -> RowDecoder e -> RowDecoder r
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder e
d5
{-# OPAQUE lift5RowCalled #-}

lift6RowCalled :: (a -> b -> c -> d -> e -> g -> r) -> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder g -> RowDecoder r
lift6RowCalled :: forall a b c d e g r.
(a -> b -> c -> d -> e -> g -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder r
lift6RowCalled a -> b -> c -> d -> e -> g -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 RowDecoder e
d5 RowDecoder g
d6 = (a -> b -> c -> d -> e -> g -> r)
-> RowDecoder a -> RowDecoder (b -> c -> d -> e -> g -> r)
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRow (\a
x1 b
x2 c
x3 d
x4 e
x5 g
x6 -> a -> b -> c -> d -> e -> g -> r
f a
x1 b
x2 c
x3 d
x4 e
x5 g
x6) RowDecoder a
d1 RowDecoder (b -> c -> d -> e -> g -> r)
-> RowDecoder b -> RowDecoder (c -> d -> e -> g -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder b
d2 RowDecoder (c -> d -> e -> g -> r)
-> RowDecoder c -> RowDecoder (d -> e -> g -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder c
d3 RowDecoder (d -> e -> g -> r)
-> RowDecoder d -> RowDecoder (e -> g -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder d
d4 RowDecoder (e -> g -> r) -> RowDecoder e -> RowDecoder (g -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder e
d5 RowDecoder (g -> r) -> RowDecoder g -> RowDecoder r
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder g
d6
{-# OPAQUE lift6RowCalled #-}

-- Seven to eleven columns are two of the smaller recipes, one applied to the
-- other through 'id', rather than a recipe of their own: the first takes the
-- leading columns and the second the last five (three, for seven), which keeps
-- each unknown application small enough for the RTS's generic apply without a
-- further frame.  That is 96,568 bytes less of library code, and 2.2% to 5.4%
-- less allocation per row of seven to eleven columns (GHC 9.12.4, 2026-11-04,
-- docs/dev/performance-research.md, "The ideas run").  Split the same way, twelve columns
-- allocated more, so 'lift12RowCalled' below stays one recipe.
lift7RowCalled :: (a -> b -> c -> d -> e -> g -> h -> r) -> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder g -> RowDecoder h -> RowDecoder r
lift7RowCalled :: forall a b c d e g h r.
(a -> b -> c -> d -> e -> g -> h -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder r
lift7RowCalled a -> b -> c -> d -> e -> g -> h -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 RowDecoder e
d5 RowDecoder g
d6 RowDecoder h
d7 = ((e -> g -> h -> r) -> e -> g -> h -> r)
-> RowDecoder (e -> g -> h -> r)
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder r
forall a b c d r.
(a -> b -> c -> d -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder r
lift4RowCalled (e -> g -> h -> r) -> e -> g -> h -> r
forall a. a -> a
id ((a -> b -> c -> d -> e -> g -> h -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder (e -> g -> h -> r)
forall a b c d r.
(a -> b -> c -> d -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder r
lift4RowCalled a -> b -> c -> d -> e -> g -> h -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4) RowDecoder e
d5 RowDecoder g
d6 RowDecoder h
d7
{-# OPAQUE lift7RowCalled #-}

lift8RowCalled :: (a -> b -> c -> d -> e -> g -> h -> i -> r) -> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder g -> RowDecoder h -> RowDecoder i -> RowDecoder r
lift8RowCalled :: forall a b c d e g h i r.
(a -> b -> c -> d -> e -> g -> h -> i -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder r
lift8RowCalled a -> b -> c -> d -> e -> g -> h -> i -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 RowDecoder e
d5 RowDecoder g
d6 RowDecoder h
d7 RowDecoder i
d8 = ((d -> e -> g -> h -> i -> r) -> d -> e -> g -> h -> i -> r)
-> RowDecoder (d -> e -> g -> h -> i -> r)
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder r
forall a b c d e g r.
(a -> b -> c -> d -> e -> g -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder r
lift6RowCalled (d -> e -> g -> h -> i -> r) -> d -> e -> g -> h -> i -> r
forall a. a -> a
id ((a -> b -> c -> d -> e -> g -> h -> i -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder (d -> e -> g -> h -> i -> r)
forall a b c r.
(a -> b -> c -> r)
-> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder r
lift3RowCalled a -> b -> c -> d -> e -> g -> h -> i -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3) RowDecoder d
d4 RowDecoder e
d5 RowDecoder g
d6 RowDecoder h
d7 RowDecoder i
d8
{-# OPAQUE lift8RowCalled #-}

lift9RowCalled :: (a -> b -> c -> d -> e -> g -> h -> i -> j -> r) -> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder g -> RowDecoder h -> RowDecoder i -> RowDecoder j -> RowDecoder r
lift9RowCalled :: forall a b c d e g h i j r.
(a -> b -> c -> d -> e -> g -> h -> i -> j -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder r
lift9RowCalled a -> b -> c -> d -> e -> g -> h -> i -> j -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 RowDecoder e
d5 RowDecoder g
d6 RowDecoder h
d7 RowDecoder i
d8 RowDecoder j
d9 = ((e -> g -> h -> i -> j -> r) -> e -> g -> h -> i -> j -> r)
-> RowDecoder (e -> g -> h -> i -> j -> r)
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder r
forall a b c d e g r.
(a -> b -> c -> d -> e -> g -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder r
lift6RowCalled (e -> g -> h -> i -> j -> r) -> e -> g -> h -> i -> j -> r
forall a. a -> a
id ((a -> b -> c -> d -> e -> g -> h -> i -> j -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder (e -> g -> h -> i -> j -> r)
forall a b c d r.
(a -> b -> c -> d -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder r
lift4RowCalled a -> b -> c -> d -> e -> g -> h -> i -> j -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4) RowDecoder e
d5 RowDecoder g
d6 RowDecoder h
d7 RowDecoder i
d8 RowDecoder j
d9
{-# OPAQUE lift9RowCalled #-}

lift10RowCalled :: (a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> r) -> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder g -> RowDecoder h -> RowDecoder i -> RowDecoder j -> RowDecoder k -> RowDecoder r
lift10RowCalled :: forall a b c d e g h i j k r.
(a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder r
lift10RowCalled a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 RowDecoder e
d5 RowDecoder g
d6 RowDecoder h
d7 RowDecoder i
d8 RowDecoder j
d9 RowDecoder k
d10 = ((g -> h -> i -> j -> k -> r) -> g -> h -> i -> j -> k -> r)
-> RowDecoder (g -> h -> i -> j -> k -> r)
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder r
forall a b c d e g r.
(a -> b -> c -> d -> e -> g -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder r
lift6RowCalled (g -> h -> i -> j -> k -> r) -> g -> h -> i -> j -> k -> r
forall a. a -> a
id ((a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder (g -> h -> i -> j -> k -> r)
forall a b c d e r.
(a -> b -> c -> d -> e -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder r
lift5RowCalled a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 RowDecoder e
d5) RowDecoder g
d6 RowDecoder h
d7 RowDecoder i
d8 RowDecoder j
d9 RowDecoder k
d10
{-# OPAQUE lift10RowCalled #-}

lift11RowCalled :: (a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> r) -> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder g -> RowDecoder h -> RowDecoder i -> RowDecoder j -> RowDecoder k -> RowDecoder l -> RowDecoder r
lift11RowCalled :: forall a b c d e g h i j k l r.
(a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder l
-> RowDecoder r
lift11RowCalled a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 RowDecoder e
d5 RowDecoder g
d6 RowDecoder h
d7 RowDecoder i
d8 RowDecoder j
d9 RowDecoder k
d10 RowDecoder l
d11 = ((h -> i -> j -> k -> l -> r) -> h -> i -> j -> k -> l -> r)
-> RowDecoder (h -> i -> j -> k -> l -> r)
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder l
-> RowDecoder r
forall a b c d e g r.
(a -> b -> c -> d -> e -> g -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder r
lift6RowCalled (h -> i -> j -> k -> l -> r) -> h -> i -> j -> k -> l -> r
forall a. a -> a
id ((a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder (h -> i -> j -> k -> l -> r)
forall a b c d e g r.
(a -> b -> c -> d -> e -> g -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder r
lift6RowCalled a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 RowDecoder e
d5 RowDecoder g
d6) RowDecoder h
d7 RowDecoder i
d8 RowDecoder j
d9 RowDecoder k
d10 RowDecoder l
d11
{-# OPAQUE lift11RowCalled #-}

lift12RowCalled :: (a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> m -> r) -> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder g -> RowDecoder h -> RowDecoder i -> RowDecoder j -> RowDecoder k -> RowDecoder l -> RowDecoder m -> RowDecoder r
lift12RowCalled :: forall a b c d e g h i j k l m r.
(a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> m -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder l
-> RowDecoder m
-> RowDecoder r
lift12RowCalled a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> m -> r
f RowDecoder a
d1 RowDecoder b
d2 RowDecoder c
d3 RowDecoder d
d4 RowDecoder e
d5 RowDecoder g
d6 RowDecoder h
d7 RowDecoder i
d8 RowDecoder j
d9 RowDecoder k
d10 RowDecoder l
d11 RowDecoder m
d12 = (a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> m -> r)
-> RowDecoder a
-> RowDecoder
     (b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> m -> r)
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRow (\a
x1 b
x2 c
x3 d
x4 e
x5 g
x6 h
x7 i
x8 j
x9 k
x10 l
x11 m
x12 -> a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> m -> r
f a
x1 b
x2 c
x3 d
x4 e
x5 g
x6 h
x7 i
x8 j
x9 k
x10 l
x11 m
x12) RowDecoder a
d1 RowDecoder
  (b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> m -> r)
-> RowDecoder b
-> RowDecoder (c -> d -> e -> g -> h -> i -> j -> k -> l -> m -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder b
d2 RowDecoder (c -> d -> e -> g -> h -> i -> j -> k -> l -> m -> r)
-> RowDecoder c
-> RowDecoder (d -> e -> g -> h -> i -> j -> k -> l -> m -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder c
d3 RowDecoder (d -> e -> g -> h -> i -> j -> k -> l -> m -> r)
-> RowDecoder d
-> RowDecoder (e -> g -> h -> i -> j -> k -> l -> m -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder d
d4 RowDecoder (e -> g -> h -> i -> j -> k -> l -> m -> r)
-> RowDecoder e
-> RowDecoder (g -> h -> i -> j -> k -> l -> m -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder e
d5 RowDecoder (g -> h -> i -> j -> k -> l -> m -> r)
-> RowDecoder g -> RowDecoder (h -> i -> j -> k -> l -> m -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder g
d6 RowDecoder (h -> i -> j -> k -> l -> m -> r)
-> RowDecoder h -> RowDecoder (i -> j -> k -> l -> m -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder h
d7 RowDecoder (i -> j -> k -> l -> m -> r)
-> RowDecoder i -> RowDecoder (j -> k -> l -> m -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder i
d8 RowDecoder (j -> k -> l -> m -> r)
-> RowDecoder j -> RowDecoder (k -> l -> m -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder j
d9 RowDecoder (k -> l -> m -> r)
-> RowDecoder k -> RowDecoder (l -> m -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder k
d10 RowDecoder (l -> m -> r) -> RowDecoder l -> RowDecoder (m -> r)
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder l
d11 RowDecoder (m -> r) -> RowDecoder m -> RowDecoder r
forall a b. RowDecoder (a -> b) -> RowDecoder a -> RowDecoder b
`apRow` RowDecoder m
d12
{-# OPAQUE lift12RowCalled #-}

{-# RULES
"RowDecoder/fmap-ap" forall f d1 d2. apRowCalled (mapRowCalled f d1) d2 = liftRowCalled f d1 d2
"RowDecoder/lift2-ap" forall f d1 d2 d3. apRowCalled (liftRowCalled f d1 d2) d3 = lift3RowCalled f d1 d2 d3
"RowDecoder/lift3-ap" forall f d1 d2 d3 d4. apRowCalled (lift3RowCalled f d1 d2 d3) d4 = lift4RowCalled f d1 d2 d3 d4
"RowDecoder/lift4-ap" forall f d1 d2 d3 d4 d5. apRowCalled (lift4RowCalled f d1 d2 d3 d4) d5 = lift5RowCalled f d1 d2 d3 d4 d5
"RowDecoder/lift5-ap" forall f d1 d2 d3 d4 d5 d6. apRowCalled (lift5RowCalled f d1 d2 d3 d4 d5) d6 = lift6RowCalled f d1 d2 d3 d4 d5 d6
"RowDecoder/lift6-ap" forall f d1 d2 d3 d4 d5 d6 d7. apRowCalled (lift6RowCalled f d1 d2 d3 d4 d5 d6) d7 = lift7RowCalled f d1 d2 d3 d4 d5 d6 d7
"RowDecoder/lift7-ap" forall f d1 d2 d3 d4 d5 d6 d7 d8. apRowCalled (lift7RowCalled f d1 d2 d3 d4 d5 d6 d7) d8 = lift8RowCalled f d1 d2 d3 d4 d5 d6 d7 d8
"RowDecoder/lift8-ap" forall f d1 d2 d3 d4 d5 d6 d7 d8 d9. apRowCalled (lift8RowCalled f d1 d2 d3 d4 d5 d6 d7 d8) d9 = lift9RowCalled f d1 d2 d3 d4 d5 d6 d7 d8 d9
"RowDecoder/lift9-ap" forall f d1 d2 d3 d4 d5 d6 d7 d8 d9 d10. apRowCalled (lift9RowCalled f d1 d2 d3 d4 d5 d6 d7 d8 d9) d10 = lift10RowCalled f d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
"RowDecoder/lift10-ap" forall f d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11. apRowCalled (lift10RowCalled f d1 d2 d3 d4 d5 d6 d7 d8 d9 d10) d11 = lift11RowCalled f d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11
"RowDecoder/lift11-ap" forall f d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12. apRowCalled (lift11RowCalled f d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11) d12 = lift12RowCalled f d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12
"RowDecoder/cons" forall d ds. liftRowCalled (:) d ds = consRowCalled d ds
  #-}

-- | A row decoder of one column, with this field decoder.  For a type's own decoder,
-- 'fieldRowDecoder' is the same.
singleField :: FieldDecoder a -> RowDecoder a
singleField :: forall a. FieldDecoder a -> RowDecoder a
singleField FieldDecoder a
decoder = (TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
forall a.
(TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
RowDecoder
  (\TdsContext
ctx ResultSetInfo
rs Int
i -> case ResultSetInfo -> Int -> Either DecodeError ColumnInfo
columnAt ResultSetInfo
rs Int
i of
    Left DecodeError
err -> DecodeError -> Either DecodeError (RowPart a)
forall a b. a -> Either a b
Left DecodeError
err
    Right ColumnInfo
col -> case FieldDecoder a
-> TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
forall a.
FieldDecoder a
-> TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compileField FieldDecoder a
decoder TdsContext
ctx ColumnInfo
col of
      Left [Char]
err -> DecodeError -> Either DecodeError (RowPart a)
forall a b. a -> Either a b
Left (Maybe Text -> [Char] -> DecodeError
DecodeError (Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnInfo -> Text
columnName ColumnInfo
col)) [Char]
err)
      Right CellDecoder a
d -> RowPart a -> Either DecodeError (RowPart a)
forall a b. b -> Either a b
Right (ResultSetInfo -> Int -> ColumnInfo -> CellDecoder a -> RowPart a
forall a.
ResultSetInfo -> Int -> ColumnInfo -> CellDecoder a -> RowPart a
cellPart ResultSetInfo
rs Int
i ColumnInfo
col CellDecoder a
d)) Int
1
-- Out of line: inlined, every field of every row type got its own copy of the
-- cell's reading, 25 KB of object code per field in a program of fifty derived
-- records (29.9 MB in all, 617 s to compile); out of line it is one copy here.
-- OPAQUE rather than NOINLINE, so that it isn't split into a worker returning the
-- decoder's two fields unboxed: each use then rebuilt the 'RowDecoder' from them,
-- once per field type in a module.  The derived instances of code-size.sh --quick
-- are 35,544 bytes instead of 37,672, and of the full program 111,208 instead of
-- 111,304 (its larger instances grew slightly).  ('productDecoder' OPAQUE made the
-- quick ones 45,927: its operands are then lazy, a thunk each.)
{-# OPAQUE singleField #-}

-- | 'singleField', compiled as a built-in type's 'fieldRowDecoder' is.  The
-- reading of a value that lies in the packet behind a fixed width or a one- or
-- two-byte length is copied around the decoder's conversion, which the copy then
-- calls as a known function on the value's place in the buffer, rather than as an
-- unknown function on a 'B.ByteString' made for it.  The result decodes exactly
-- what 'singleField' decodes: the column's type is checked once per result set, a
-- NULL is a 'DecodeError' unless the decoder allows it, and a value cut by a
-- packet, like every value of a @max@, legacy LOB or @sql_variant@ column, is read
-- through 'singleField''s own path.
--
-- It pays for a decoder of your own whose conversion is small and runs for many
-- rows, such as one made by 'fieldDecoderFor'.  A large conversion, such as a
-- date's, is cheaper left a call through 'singleField', as the built-in date and
-- time decoders leave theirs, because inlined it allocates more than the call
-- saves.
--
-- Each use is a copy of the cell's reading, a few kilobytes of object code where
-- 'singleField' is one call, so bind the result once at the top level with
-- @NOINLINE@, which keeps GHC from copying the binding into its uses.  The
-- conversion inlines into the copy when its definition is visible there, which an
-- @INLINE@ definition or one in the same module is.
--
-- > idField :: RowDecoder Builder
-- > idField = inlinedField (fieldDecoderFor "id" isIdType (\_ _ bytes -> Right (idDigits bytes)))
-- > {-# NOINLINE idField #-}
inlinedField :: FieldDecoder a -> RowDecoder a
inlinedField :: forall a. FieldDecoder a -> RowDecoder a
inlinedField FieldDecoder a
d = FieldDecoder a -> FieldDecoder a -> Nulls a a -> RowDecoder a
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder a
d FieldDecoder a
d Nulls a a
forall a. Nulls a a
NoNulls
{-# INLINE inlinedField #-}

-- | 'inlinedField' of a nullable column, with the NULL and the 'Just' handled in
-- the copy as well.  Use it rather than @'inlinedField' . 'nullableField'@, which
-- gains nothing over 'singleField', because 'nullableField' is out of line and the
-- copy can't see the conversion through it.  'singleField' needs no such
-- counterpart, since its conversion is a call either way, so
-- @'singleField' . 'nullableField'@ is its nullable form.
inlinedNullableField :: FieldDecoder a -> RowDecoder (Maybe a)
inlinedNullableField :: forall a. FieldDecoder a -> RowDecoder (Maybe a)
inlinedNullableField FieldDecoder a
d = FieldDecoder a
-> FieldDecoder a -> Nulls a (Maybe a) -> RowDecoder (Maybe a)
forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder a
d FieldDecoder a
d Nulls a (Maybe a)
forall a. Nulls a (Maybe a)
Nulls
{-# INLINE inlinedNullableField #-}

-- | A row decoder of one column, chosen by the function from the column's
-- 'ColumnInfo' when a result set's columns arrive, before its first row; the
-- decoder chosen reads every value of the column, and must read one column.  This
-- is for a program that builds its queries and their decoders at runtime and
-- decodes a column by what the server says it is, such as a long column through a
-- 'FoldingCell' and a short one through its type's 'fieldRowDecoder'.  The choice
-- costs nothing per row, where 'RowDecoderMonadic' makes it for every row and
-- reads each column through 'singleField'.
--
-- > -- a long text a piece at a time, any other whole
-- > textOrFold :: RowDecoder Summary
-- > textOrFold = byColumn $ \col ->
-- >   if columnIsLong col then singleField folded else summarize <$> fieldRowDecoder @Text
byColumn :: (ColumnInfo -> RowDecoder a) -> RowDecoder a
byColumn :: forall a. (ColumnInfo -> RowDecoder a) -> RowDecoder a
byColumn ColumnInfo -> RowDecoder a
choose = (TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
forall a.
(TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
RowDecoder
  (\TdsContext
ctx ResultSetInfo
rs Int
i -> case ResultSetInfo -> Int -> Either DecodeError ColumnInfo
columnAt ResultSetInfo
rs Int
i of
    Left DecodeError
err -> DecodeError -> Either DecodeError (RowPart a)
forall a b. a -> Either a b
Left DecodeError
err
    Right ColumnInfo
col -> case ColumnInfo -> RowDecoder a
choose ColumnInfo
col of
      RowDecoder TdsContext
-> ResultSetInfo -> Int -> Either DecodeError (RowPart a)
compile Int
1 -> TdsContext
-> ResultSetInfo -> Int -> Either DecodeError (RowPart a)
compile TdsContext
ctx ResultSetInfo
rs Int
i
      RowDecoder TdsContext
-> ResultSetInfo -> Int -> Either DecodeError (RowPart a)
_ Int
n -> DecodeError -> Either DecodeError (RowPart a)
forall a b. a -> Either a b
Left (Maybe Text -> [Char] -> DecodeError
DecodeError (Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnInfo -> Text
columnName ColumnInfo
col))
        ([Char]
"byColumn chose a decoder of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" columns, not 1"))) Int
1
-- Out of line, as 'singleField' is: what it builds is per result set.
{-# OPAQUE byColumn #-}

-- The column a one-column decoder at this index reads, or why there is none.
columnAt :: ResultSetInfo -> Int -> Either DecodeError ColumnInfo
columnAt :: ResultSetInfo -> Int -> Either DecodeError ColumnInfo
columnAt ResultSetInfo
rs 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
>= ResultSetInfo -> Int
rsColumnCount ResultSetInfo
rs =
      DecodeError -> Either DecodeError ColumnInfo
forall a b. a -> Either a b
Left (Maybe Text -> [Char] -> DecodeError
DecodeError Maybe Text
forall a. Maybe a
Nothing ([Char]
"expected 1 column, got " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (ResultSetInfo -> Int
rsColumnCount ResultSetInfo
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i))))
  | Bool
otherwise = ColumnInfo -> Either DecodeError ColumnInfo
forall a b. b -> Either a b
Right (SmallArray ColumnInfo -> Int -> ColumnInfo
forall a. SmallArray a -> Int -> a
indexSmallArray (ResultSetInfo -> SmallArray ColumnInfo
rsColumnArray ResultSetInfo
rs) Int
i)
{-# NOINLINE columnAt #-}

-- The recipe of a column at an index, with its cell decoder: the general read, which
-- calls the conversion through the decoder.
cellPart :: ResultSetInfo -> Int -> ColumnInfo -> CellDecoder a -> RowPart a
cellPart :: forall a.
ResultSetInfo -> Int -> ColumnInfo -> CellDecoder a -> RowPart a
cellPart ResultSetInfo
rs Int
i ColumnInfo
col CellDecoder a
d = (Int -> Prepared (Recipe ByteString a)) -> RowPart a
forall a. (Int -> Prepared (Recipe ByteString a)) -> RowPart a
RowPart ((Int -> Prepared (Recipe ByteString a)) -> RowPart a)
-> (Int -> Prepared (Recipe ByteString a)) -> RowPart a
forall a b. (a -> b) -> a -> b
$ \Int
ahead ->
  let shape :: ColumnShape
shape = TypeInfo -> ColumnShape
rowShape (ColumnInfo -> TypeInfo
columnType ColumnInfo
col)
      present :: Recipe ByteString a
present = Parser a -> Recipe ByteString a
forall a env. Parser a -> Recipe env a
P.liftParser (ColumnShape -> Parser Cell
cellHead ColumnShape
shape Parser Cell -> (Cell -> 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
>>= ColumnInfo -> CellDecoder a -> Int -> Cell -> Parser a
forall a. ColumnInfo -> CellDecoder a -> Int -> Cell -> Parser a
readCellRecipe ColumnInfo
col CellDecoder a
d Int
ahead)
      absent :: Recipe ByteString a
absent = Parser a -> Recipe ByteString a
forall a env. Parser a -> Recipe env a
P.liftParser (ColumnInfo -> CellDecoder a -> Int -> Cell -> Parser a
forall a. ColumnInfo -> CellDecoder a -> Int -> Cell -> Parser a
readCellRecipe ColumnInfo
col CellDecoder a
d Int
ahead Cell
NullCell)
   in Recipe ByteString a -> Prepared (Recipe ByteString a)
forall a. a -> Prepared a
Prepared (Recipe ByteString a -> Prepared (Recipe ByteString a))
-> Recipe ByteString a -> Prepared (Recipe ByteString a)
forall a b. (a -> b) -> a -> b
$ Recipe ByteString a
-> (ReadFailure -> Recipe ByteString a) -> Recipe ByteString a
forall env a.
Recipe env a -> (ReadFailure -> Recipe env a) -> Recipe env a
P.recover (Recipe ByteString ByteString
forall env. Recipe env env
P.ask Recipe ByteString ByteString
-> (ByteString -> Recipe ByteString a) -> Recipe ByteString a
forall a b.
Recipe ByteString a
-> (a -> Recipe ByteString b) -> Recipe ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
bitmap -> if ByteString -> Int -> Bool
columnNull ByteString
bitmap Int
i then Recipe ByteString a
absent else Recipe ByteString a
present) (ResultSetInfo -> Int -> ReadFailure -> Recipe ByteString a
forall a.
ResultSetInfo -> Int -> ReadFailure -> Recipe ByteString a
skipLater ResultSetInfo
rs Int
i)
{-# NOINLINE cellPart #-}

-- A failed cell's handler: read past the rest of the row and fail it.  The handler
-- asks for the bitmap itself, so that it captures nothing of the row and is built
-- once per column.  Given the bitmap from outside, it was a closure and a thunk for
-- every cell.
skipLater :: ResultSetInfo -> Int -> ReadFailure -> P.Recipe B.ByteString a
skipLater :: forall a.
ResultSetInfo -> Int -> ReadFailure -> Recipe ByteString a
skipLater ResultSetInfo
rs Int
i = \ReadFailure
failure -> do
  bitmap <- Recipe ByteString ByteString
forall env. Recipe env env
P.ask
  P.liftParser (skipCells bitmap later)
  P.failValue failure
  where later :: [(Int, ColumnShape)]
later = Int -> [(Int, ColumnShape)] -> [(Int, ColumnShape)]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ResultSetInfo -> [(Int, ColumnShape)]
rsCells ResultSetInfo
rs)
{-# NOINLINE skipLater #-}

-- A present cell, read whole through its decoder: the cells 'cellRowDecoder' doesn't
-- read inline.  Behind 'Prepared', as a row's recipe is, so that what it builds for a
-- column it builds once: returning the recipe, it was a function of the cell's input
-- too, and as 'cellPart''s read a 'SqlRow' of an int and a bigint allocated 80 bytes
-- more per row.  'cellPart' has its own copy of this read even so: through this
-- function, an extra unknown call per cell, a typed row of 50 columns, each a
-- 'SqlValue' through 'singleField', took 1.10 times as long, for 17 KB of code saved.
otherCell :: ColumnInfo -> CellDecoder a -> Int -> ColumnShape -> Prepared (Parser a)
otherCell :: forall a.
ColumnInfo
-> CellDecoder a -> Int -> ColumnShape -> Prepared (Parser a)
otherCell ColumnInfo
col CellDecoder a
d Int
ahead ColumnShape
shape = Parser a -> Prepared (Parser a)
forall a. a -> Prepared a
Prepared (ColumnShape -> Parser Cell
cellHead ColumnShape
shape Parser Cell -> (Cell -> 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
>>= ColumnInfo -> CellDecoder a -> Int -> Cell -> Parser a
forall a. ColumnInfo -> CellDecoder a -> Int -> Cell -> Parser a
readCellRecipe ColumnInfo
col CellDecoder a
d Int
ahead)
{-# NOINLINE otherCell #-}

-- 'otherCell' with the cell decoder of the type's out-of-line 'fieldDecoder', so that
-- a type's row decoder holds no second copy of its conversion for the cells that
-- aren't read inline.  It compiles the decoder once, the first time a column's recipe
-- needs it.
sharedCell :: Nulls a b -> FieldDecoder a -> TdsContext -> ColumnInfo -> Int -> ColumnShape -> Prepared (Parser b)
sharedCell :: forall a b.
Nulls a b
-> FieldDecoder a
-> TdsContext
-> ColumnInfo
-> Int
-> ColumnShape
-> Prepared (Parser b)
sharedCell Nulls a b
nulls FieldDecoder a
shared TdsContext
ctx ColumnInfo
col Int
ahead ColumnShape
shape = case FieldDecoder a
-> TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
forall a.
FieldDecoder a
-> TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compileField FieldDecoder a
shared TdsContext
ctx ColumnInfo
col of
  Right CellDecoder a
d -> ColumnInfo
-> CellDecoder b -> Int -> ColumnShape -> Prepared (Parser b)
forall a.
ColumnInfo
-> CellDecoder a -> Int -> ColumnShape -> Prepared (Parser a)
otherCell ColumnInfo
col (Nulls a b -> CellDecoder a -> CellDecoder b
forall a b. Nulls a b -> CellDecoder a -> CellDecoder b
nullsCell Nulls a b
nulls CellDecoder a
d) Int
ahead ColumnShape
shape
  Left [Char]
err -> Parser b -> Prepared (Parser b)
forall a. a -> Prepared a
Prepared (ReadFailure -> Parser b
forall env a. ReadFailure -> Recipe env a
P.failValue (DecodeError -> ReadFailure
DecodeFailed (Maybe Text -> [Char] -> DecodeError
DecodeError (Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnInfo -> Text
columnName ColumnInfo
col)) [Char]
err)))
{-# NOINLINE sharedCell #-}

-- A built-in type's row decoders, the copies the comment at 'FromSqlField' describes,
-- and an application's through 'inlinedField': 'singleField' of the second decoder,
-- with its conversion inlined at one place, for a value that lies in the payload
-- behind a fixed width or a one- or two-byte length.  Those are every column but the
-- @max@, legacy LOB and @sql_variant@ ones.  Every other cell is read by 'sharedCell'
-- through the first decoder, which for a built-in type is its 'fieldDecoder', out of
-- line.  It takes two arguments, so that an instance's @cellRowDecoder fieldDecoder
-- int32Decoder@ inlines.  Both decoders' compile functions run, once per result set
-- each, which is harmless because a 'FieldDecoder''s is pure.
cellRowDecoder :: forall a b. FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder :: forall a b.
FieldDecoder a -> FieldDecoder a -> Nulls a b -> RowDecoder b
cellRowDecoder FieldDecoder a
shared FieldDecoder a
inlined = \Nulls a b
nulls -> (TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart b))
-> Int -> RowDecoder b
forall a.
(TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
RowDecoder
  (\TdsContext
ctx ResultSetInfo
rs Int
i -> case ResultSetInfo -> Int -> Either DecodeError ColumnInfo
columnAt ResultSetInfo
rs Int
i of
    Left DecodeError
err -> DecodeError -> Either DecodeError (RowPart b)
forall a b. a -> Either a b
Left DecodeError
err
    Right ColumnInfo
col -> case FieldDecoder a
-> TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
forall a.
FieldDecoder a
-> TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compileField FieldDecoder a
inlined TdsContext
ctx ColumnInfo
col of
      Left [Char]
err -> DecodeError -> Either DecodeError (RowPart b)
forall a b. a -> Either a b
Left (Maybe Text -> [Char] -> DecodeError
DecodeError (Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnInfo -> Text
columnName ColumnInfo
col)) [Char]
err)
      -- A folding cell reads a long column's values, none of which is read inline.
      Right d :: CellDecoder a
d@FoldingCell{} -> RowPart b -> Either DecodeError (RowPart b)
forall a b. b -> Either a b
Right (ResultSetInfo -> Int -> ColumnInfo -> CellDecoder b -> RowPart b
forall a.
ResultSetInfo -> Int -> ColumnInfo -> CellDecoder a -> RowPart a
cellPart ResultSetInfo
rs Int
i ColumnInfo
col (Nulls a b -> CellDecoder a -> CellDecoder b
forall a b. Nulls a b -> CellDecoder a -> CellDecoder b
nullsCell Nulls a b
nulls CellDecoder a
d))
      Right (CellDecoder Either [Char] a
onNull ValueReader a
borrowed ValueReader a
_) ->
        let shape :: ColumnShape
shape = TypeInfo -> ColumnShape
rowShape (ColumnInfo -> TypeInfo
columnType ColumnInfo
col)
            -- The delimiter as 'P.prefixedRowValue' takes it, evaluated here, once per
            -- column.  Inlined into the cell, the shape was two constructors per
            -- fixed-width cell.
            !width :: Int
width = case ColumnShape
shape of
              ConstantCell (Sized Int
_) -> Int
0
              ColumnShape
ByteLength -> Int
1
              ColumnShape
ShortLength -> Int
2
              ColumnShape
_ -> -Int
1 :: Int
            !marker :: Int
marker = case ColumnShape
shape of
              ConstantCell (Sized Int
n) -> Int
n
              ColumnShape
ShortLength -> Int
0xFFFF
              ColumnShape
_ -> Int
0
            named :: [Char] -> ReadFailure
named = DecodeError -> ReadFailure
DecodeFailed (DecodeError -> ReadFailure)
-> ([Char] -> DecodeError) -> [Char] -> ReadFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> [Char] -> DecodeError
DecodeError (Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnInfo -> Text
columnName ColumnInfo
col))
            -- The conversion is known here, so it takes the slice's fields rather than
            -- a 'B.ByteString' built for it, and its 'Either' goes: the gain over
            -- 'singleField''s unknown call.
            convert :: ByteString -> Either ReadFailure b
convert ByteString
bytes = case ValueReader a
borrowed ByteString
bytes of
              Left [Char]
e -> ReadFailure -> Either ReadFailure b
forall a b. a -> Either a b
Left ([Char] -> ReadFailure
named [Char]
e)
              Right a
v -> b -> Either ReadFailure b
forall a b. b -> Either a b
Right (case Nulls a b
nulls of
                Nulls a b
NoNulls -> a
b
v
                Nulls a b
Nulls -> a -> Maybe a
forall a. a -> Maybe a
Just a
v)
            nullValue :: P.Recipe env b
            nullValue :: forall env. Recipe env b
nullValue = case Nulls a b
nulls of
              Nulls a b
NoNulls -> ([Char] -> Recipe env b)
-> (b -> Recipe env b) -> Either [Char] b -> Recipe env b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ReadFailure -> Recipe env b
forall env a. ReadFailure -> Recipe env a
P.failValue (ReadFailure -> Recipe env b)
-> ([Char] -> ReadFailure) -> [Char] -> Recipe env b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ReadFailure
named) b -> Recipe env b
forall a. a -> Recipe env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either [Char] a
Either [Char] b
onNull
              Nulls a b
Nulls -> b -> Recipe env b
forall a. a -> Recipe env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
Maybe a
forall a. Maybe a
Nothing
         in RowPart b -> Either DecodeError (RowPart b)
forall a b. b -> Either a b
Right (RowPart b -> Either DecodeError (RowPart b))
-> RowPart b -> Either DecodeError (RowPart b)
forall a b. (a -> b) -> a -> b
$ (Int -> Prepared (Recipe ByteString b)) -> RowPart b
forall a. (Int -> Prepared (Recipe ByteString a)) -> RowPart a
RowPart ((Int -> Prepared (Recipe ByteString b)) -> RowPart b)
-> (Int -> Prepared (Recipe ByteString b)) -> RowPart b
forall a b. (a -> b) -> a -> b
$ \Int
ahead ->
              let other :: Parser b
other = case Nulls a b
-> FieldDecoder a
-> TdsContext
-> ColumnInfo
-> Int
-> ColumnShape
-> Prepared (Parser b)
forall a b.
Nulls a b
-> FieldDecoder a
-> TdsContext
-> ColumnInfo
-> Int
-> ColumnShape
-> Prepared (Parser b)
sharedCell Nulls a b
nulls FieldDecoder a
shared TdsContext
ctx ColumnInfo
col Int
ahead ColumnShape
shape of Prepared Parser b
recipe -> Parser b
recipe
                  present :: Recipe ByteString b
present = Int
-> Int
-> Int
-> (ByteString -> Either ReadFailure b)
-> Recipe ByteString b
-> Recipe ByteString b
-> Recipe ByteString b
forall a.
Int
-> Int
-> Int
-> (ByteString -> Either ReadFailure a)
-> Recipe ByteString a
-> Recipe ByteString a
-> Recipe ByteString a
P.prefixedRowValue Int
i Int
width Int
marker ByteString -> Either ReadFailure b
convert Recipe ByteString b
forall env. Recipe env b
nullValue (Parser b -> Recipe ByteString b
forall a env. Parser a -> Recipe env a
P.liftParser Parser b
other)
               in Recipe ByteString b -> Prepared (Recipe ByteString b)
forall a. a -> Prepared a
Prepared (Recipe ByteString b -> Prepared (Recipe ByteString b))
-> Recipe ByteString b -> Prepared (Recipe ByteString b)
forall a b. (a -> b) -> a -> b
$ Recipe ByteString b
-> (ReadFailure -> Recipe ByteString b) -> Recipe ByteString b
forall env a.
Recipe env a -> (ReadFailure -> Recipe env a) -> Recipe env a
P.recover
                    Recipe ByteString b
present
                    (ResultSetInfo -> Int -> ReadFailure -> Recipe ByteString b
forall a.
ResultSetInfo -> Int -> ReadFailure -> Recipe ByteString a
skipLater ResultSetInfo
rs Int
i)
      Right CellDecoder a
d -> RowPart b -> Either DecodeError (RowPart b)
forall a b. b -> Either a b
Right (ResultSetInfo -> Int -> ColumnInfo -> CellDecoder b -> RowPart b
forall a.
ResultSetInfo -> Int -> ColumnInfo -> CellDecoder a -> RowPart a
cellPart ResultSetInfo
rs Int
i ColumnInfo
col (Nulls a b -> CellDecoder a -> CellDecoder b
forall a b. Nulls a b -> CellDecoder a -> CellDecoder b
nullsCell Nulls a b
nulls CellDecoder a
d))) Int
1
{-# INLINE cellRowDecoder #-}

-- | Types that decode from a whole row, one column per field in order.
-- Tuples of up to twelve fields and 'Only' have instances.  Derive one for
-- a record whose fields are 'FromSqlField' types, one field per column of
-- the @SELECT@, in order:
--
-- > data Customer = Customer { customerId :: Int, name :: Text, birthDate :: Maybe Day }
-- >   deriving stock (Show, Generic)
-- >   deriving anyclass (FromSqlRow)
--
-- The column types are checked against the fields before the first row is
-- decoded, and a mismatch is a 'DecodeError' naming the column.  For a row
-- decoder written by hand, see 'singleField'.
class FromSqlRow a where
  rowDecoder :: RowDecoder a
  default rowDecoder :: (Generic a, GRowDecoder (Rep a)) => RowDecoder a
  rowDecoder = RowDecoder a
forall a. (Generic a, GRowDecoder (Rep a)) => RowDecoder a
genericFromSqlRow

-- | Check a row decoder against a result set's columns, before any row is read.  A
-- wrong column count or an incompatible type is a 'DecodeError'.
compileRowDecoder :: RowDecoder a -> TdsContext -> [ColumnInfo] -> Either DecodeError (CompiledRow a)
compileRowDecoder :: forall a.
RowDecoder a
-> TdsContext -> [ColumnInfo] -> Either DecodeError (CompiledRow a)
compileRowDecoder RowDecoder a
dec TdsContext
ctx [ColumnInfo]
cols = RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Either DecodeError (CompiledRow a)
forall a.
RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Either DecodeError (CompiledRow a)
compileRowDecoderFor RowDecoder a
dec TdsContext
ctx ([ColumnInfo] -> ResultSetInfo
compileResultSet [ColumnInfo]
cols)

-- | 'compileRowDecoder' for columns already prepared with 'compileResultSet'.
compileRowDecoderFor :: RowDecoder a -> TdsContext -> ResultSetInfo -> Either DecodeError (CompiledRow a)
compileRowDecoderFor :: forall a.
RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Either DecodeError (CompiledRow a)
compileRowDecoderFor RowDecoder a
dec TdsContext
ctx ResultSetInfo
rs
  | ResultSetInfo -> Int
rsColumnCount ResultSetInfo
rs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= RowDecoder a -> Int
forall a. RowDecoder a -> Int
numExpectedColumns RowDecoder a
dec = DecodeError -> Either DecodeError (CompiledRow a)
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError (CompiledRow a))
-> DecodeError -> Either DecodeError (CompiledRow a)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> [Char] -> DecodeError
DecodeError Maybe Text
forall a. Maybe a
Nothing ([Char] -> DecodeError) -> [Char] -> DecodeError
forall a b. (a -> b) -> a -> b
$
      [Char]
"result has " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (ResultSetInfo -> Int
rsColumnCount ResultSetInfo
rs) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" column(s) but the row type expects " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (RowDecoder a -> Int
forall a. RowDecoder a -> Int
numExpectedColumns RowDecoder a
dec)
  | Bool
otherwise = do
      RowPart prepare <- RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart a)
forall a.
RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart a)
compileRowAt RowDecoder a
dec TdsContext
ctx ResultSetInfo
rs Int
0
      -- A cell that fails reads past the rest of the row and fails the recipe, and
      -- the failure is left in it for the driver ('P.runParserAt'), so a row that
      -- decodes costs no 'Right'.
      pure $ CompiledRow $ \Int
ahead -> case Int -> Prepared (Recipe ByteString a)
prepare Int
ahead of
        Prepared Recipe ByteString a
read -> Parser a -> Prepared (Parser a)
forall a. a -> Prepared a
Prepared (Parser a -> Prepared (Parser a))
-> Parser a -> Prepared (Parser a)
forall a b. (a -> b) -> a -> b
$ do
          bitmap <- Int -> Parser ByteString
rowBitmap (ResultSetInfo -> Int
rsColumnCount ResultSetInfo
rs)
          P.withEnv bitmap (P.dynamic read)

-- | A decoder of every column as a 'SqlValue'.  A column with no such conversion
-- fails on the first row rather than at the check, so an empty result set still
-- gives its columns.
sqlRowDecoderFor :: [ColumnInfo] -> RowDecoder SqlRow
sqlRowDecoderFor :: [ColumnInfo] -> RowDecoder SqlRow
sqlRowDecoderFor [ColumnInfo]
cols = (TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart SqlRow))
-> Int -> RowDecoder SqlRow
forall a.
(TdsContext
 -> ResultSetInfo -> Int -> Either DecodeError (RowPart a))
-> Int -> RowDecoder a
RowDecoder TdsContext
-> ResultSetInfo -> Int -> Either DecodeError (RowPart SqlRow)
compile Int
n
  where
    n :: Int
n = [ColumnInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColumnInfo]
cols
    -- Each column is compiled once, and a row is one loop over the columns'
    -- recipes that builds the list.  'traverse' with 'singleField' went through the
    -- general 'liftA2' once per column, which built a partial application of (:)
    -- per cell and a recipe closure per level.
    compile :: TdsContext
-> ResultSetInfo -> Int -> Either DecodeError (RowPart SqlRow)
compile TdsContext
ctx ResultSetInfo
rs Int
i = do
      parts <- (Int -> Either DecodeError (RowPart SqlValue))
-> [Int] -> Either DecodeError [RowPart SqlValue]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (RowDecoder SqlValue
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart SqlValue)
forall a.
RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart a)
compileRowAt (FieldDecoder SqlValue -> RowDecoder SqlValue
forall a. FieldDecoder a -> RowDecoder a
singleField FieldDecoder SqlValue
deferred) TdsContext
ctx ResultSetInfo
rs) (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n [Int
i ..])
      pure $ RowPart $ \Int
ahead ->
        -- Built whole before the closure that reads a row.  Left as a thunk beside
        -- it, GHC 9.14.1 moved the building of the columns' array into that closure's
        -- loop, once for every cell (bugs-found.md, "Memory and performance").
        let !cells :: [Recipe ByteString SqlValue]
cells = Int -> [RowPart SqlValue] -> [Recipe ByteString SqlValue]
forall {a}. Int -> [RowPart a] -> [Recipe ByteString a]
prepareAll Int
ahead [RowPart SqlValue]
parts
         in Recipe ByteString SqlRow -> Prepared (Recipe ByteString SqlRow)
forall a. a -> Prepared a
Prepared ([ColumnInfo] -> [SqlValue] -> SqlRow
SqlRow [ColumnInfo]
cols ([SqlValue] -> SqlRow)
-> Recipe ByteString [SqlValue] -> Recipe ByteString SqlRow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Recipe ByteString SqlValue] -> Recipe ByteString [SqlValue]
forall {env} {a}. [Recipe env a] -> Recipe env [a]
values [Recipe ByteString SqlValue]
cells)
    prepareAll :: Int -> [RowPart a] -> [Recipe ByteString a]
prepareAll Int
_ [] = []
    prepareAll Int
ahead (RowPart Int -> Prepared (Recipe ByteString a)
prepare : [RowPart a]
parts) = case Int -> Prepared (Recipe ByteString a)
prepare Int
ahead of
      Prepared Recipe ByteString a
read -> let !rest :: [Recipe ByteString a]
rest = Int -> [RowPart a] -> [Recipe ByteString a]
prepareAll Int
ahead [RowPart a]
parts in Recipe ByteString a
read Recipe ByteString a
-> [Recipe ByteString a] -> [Recipe ByteString a]
forall a. a -> [a] -> [a]
: [Recipe ByteString a]
rest
    -- 'liftA2' rather than a bind: a bind's continuation is one closure shared by
    -- the completed and the suspended branches, 16 bytes per cell, where 'liftA2'
    -- calls the rest of the loop directly and builds a closure only to suspend.
    values :: [Recipe env a] -> Recipe env [a]
values [] = [a] -> Recipe env [a]
forall a. a -> Recipe env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    values (Recipe env a
cell : [Recipe env a]
cells) = (a -> [a] -> [a])
-> Recipe env a -> Recipe env [a] -> Recipe env [a]
forall a b c.
(a -> b -> c) -> Recipe env a -> Recipe env b -> Recipe env c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Recipe env a -> Recipe env a
forall env a. Recipe env a -> Recipe env a
P.dynamic Recipe env a
cell) ([Recipe env a] -> Recipe env [a]
values [Recipe env a]
cells)
    -- A compile error becomes a per-row one: a generic reader should still learn
    -- the columns of an empty result set it couldn't have decoded.
    deferred :: FieldDecoder SqlValue
deferred = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder SqlValue))
-> FieldDecoder SqlValue
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext -> ColumnInfo -> Either [Char] (CellDecoder SqlValue))
 -> FieldDecoder SqlValue)
-> (TdsContext
    -> ColumnInfo -> Either [Char] (CellDecoder SqlValue))
-> FieldDecoder SqlValue
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ColumnInfo
col -> case FieldDecoder SqlValue
-> TdsContext -> ColumnInfo -> Either [Char] (CellDecoder SqlValue)
forall a.
FieldDecoder a
-> TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a)
compileField FieldDecoder SqlValue
sqlValueDecoder TdsContext
ctx ColumnInfo
col of
      Left [Char]
err -> CellDecoder SqlValue -> Either [Char] (CellDecoder SqlValue)
forall a b. b -> Either a b
Right (Either [Char] SqlValue
-> ValueReader SqlValue
-> ValueReader SqlValue
-> CellDecoder SqlValue
forall a.
Either [Char] a -> ValueReader a -> ValueReader a -> CellDecoder a
CellDecoder ([Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left [Char]
err) (Either [Char] SqlValue -> ValueReader SqlValue
forall a b. a -> b -> a
const ([Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left [Char]
err)) (Either [Char] SqlValue -> ValueReader SqlValue
forall a b. a -> b -> a
const ([Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left [Char]
err)))
      Right CellDecoder SqlValue
result -> CellDecoder SqlValue -> Either [Char] (CellDecoder SqlValue)
forall a b. b -> Either a b
Right CellDecoder SqlValue
result

-- The instances of 'Only' and the tuples are compiled here, once for each arity: an
-- instance's decoder is a function of the fields' row decoders, out of line, so that
-- a use such as @query conn sql :: IO [(Int32, Text)]@ refers to a decoder built by a
-- call with the fields' instances, rather than to a copy of the row's composition.  With
-- the instances INLINE, every row type used in a module got its own copy: in a module
-- of 40 functions each calling 'Hmssql.Query.query', with 16 'Only' types the code
-- was 593 bytes per function and with eight tuple types of two to six fields 1,449;
-- now 206 and 193 (a 'query' of a record type is 167).  The row's reading is the same
-- code as before: each field is its type's 'fieldRowDecoder', compiled in the
-- library, so nothing per row depended on knowing the types, and within each arity
-- the composition is still inlined into one recipe.  OPAQUE, as 'singleField' is, so
-- that a use isn't a worker's unboxed result boxed again (about 50 bytes per row type).
instance FromSqlField a => FromSqlRow (Only a) where
  rowDecoder :: RowDecoder (Only a)
rowDecoder = RowDecoder a -> RowDecoder (Only a)
forall a. RowDecoder a -> RowDecoder (Only a)
onlyDecoder RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b) => FromSqlRow (a, b) where
  rowDecoder :: RowDecoder (a, b)
rowDecoder = RowDecoder a -> RowDecoder b -> RowDecoder (a, b)
forall a b. RowDecoder a -> RowDecoder b -> RowDecoder (a, b)
tuple2 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b, FromSqlField c) => FromSqlRow (a, b, c) where
  rowDecoder :: RowDecoder (a, b, c)
rowDecoder = RowDecoder a
-> RowDecoder b -> RowDecoder c -> RowDecoder (a, b, c)
forall a b c.
RowDecoder a
-> RowDecoder b -> RowDecoder c -> RowDecoder (a, b, c)
tuple3 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder c
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b, FromSqlField c, FromSqlField d) => FromSqlRow (a, b, c, d) where
  rowDecoder :: RowDecoder (a, b, c, d)
rowDecoder = RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder (a, b, c, d)
forall a b c d.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder (a, b, c, d)
tuple4 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder c
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder d
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b, FromSqlField c, FromSqlField d, FromSqlField e) => FromSqlRow (a, b, c, d, e) where
  rowDecoder :: RowDecoder (a, b, c, d, e)
rowDecoder = RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder (a, b, c, d, e)
forall a b c d e.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder (a, b, c, d, e)
tuple5 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder c
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder d
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder e
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b, FromSqlField c, FromSqlField d, FromSqlField e, FromSqlField f) => FromSqlRow (a, b, c, d, e, f) where
  rowDecoder :: RowDecoder (a, b, c, d, e, f)
rowDecoder = RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder (a, b, c, d, e, f)
forall a b c d e f.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder (a, b, c, d, e, f)
tuple6 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder c
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder d
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder e
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder f
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b, FromSqlField c, FromSqlField d, FromSqlField e, FromSqlField f, FromSqlField g) => FromSqlRow (a, b, c, d, e, f, g) where
  rowDecoder :: RowDecoder (a, b, c, d, e, f, g)
rowDecoder = RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder (a, b, c, d, e, f, g)
forall a b c d e f g.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder (a, b, c, d, e, f, g)
tuple7 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder c
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder d
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder e
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder f
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder g
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b, FromSqlField c, FromSqlField d, FromSqlField e, FromSqlField f, FromSqlField g, FromSqlField h) => FromSqlRow (a, b, c, d, e, f, g, h) where
  rowDecoder :: RowDecoder (a, b, c, d, e, f, g, h)
rowDecoder = RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder (a, b, c, d, e, f, g, h)
forall a b c d e f g h.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder (a, b, c, d, e, f, g, h)
tuple8 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder c
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder d
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder e
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder f
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder g
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder h
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b, FromSqlField c, FromSqlField d, FromSqlField e, FromSqlField f, FromSqlField g, FromSqlField h, FromSqlField i) => FromSqlRow (a, b, c, d, e, f, g, h, i) where
  rowDecoder :: RowDecoder (a, b, c, d, e, f, g, h, i)
rowDecoder = RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder (a, b, c, d, e, f, g, h, i)
forall a b c d e f g h i.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder (a, b, c, d, e, f, g, h, i)
tuple9 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder c
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder d
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder e
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder f
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder g
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder h
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder i
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b, FromSqlField c, FromSqlField d, FromSqlField e, FromSqlField f, FromSqlField g, FromSqlField h, FromSqlField i, FromSqlField j) => FromSqlRow (a, b, c, d, e, f, g, h, i, j) where
  rowDecoder :: RowDecoder (a, b, c, d, e, f, g, h, i, j)
rowDecoder = RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder (a, b, c, d, e, f, g, h, i, j)
forall a b c d e f g h i j.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder (a, b, c, d, e, f, g, h, i, j)
tuple10 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder c
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder d
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder e
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder f
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder g
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder h
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder i
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder j
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b, FromSqlField c, FromSqlField d, FromSqlField e, FromSqlField f, FromSqlField g, FromSqlField h, FromSqlField i, FromSqlField j, FromSqlField k) => FromSqlRow (a, b, c, d, e, f, g, h, i, j, k) where
  rowDecoder :: RowDecoder (a, b, c, d, e, f, g, h, i, j, k)
rowDecoder = RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder (a, b, c, d, e, f, g, h, i, j, k)
forall a b c d e f g h i j k.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder (a, b, c, d, e, f, g, h, i, j, k)
tuple11 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder c
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder d
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder e
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder f
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder g
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder h
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder i
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder j
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder k
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

instance (FromSqlField a, FromSqlField b, FromSqlField c, FromSqlField d, FromSqlField e, FromSqlField f, FromSqlField g, FromSqlField h, FromSqlField i, FromSqlField j, FromSqlField k, FromSqlField l) => FromSqlRow (a, b, c, d, e, f, g, h, i, j, k, l) where
  rowDecoder :: RowDecoder (a, b, c, d, e, f, g, h, i, j, k, l)
rowDecoder = RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder l
-> RowDecoder (a, b, c, d, e, f, g, h, i, j, k, l)
forall a b c d e f g h i j k l.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder l
-> RowDecoder (a, b, c, d, e, f, g, h, i, j, k, l)
tuple12 RowDecoder a
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder b
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder c
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder d
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder e
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder f
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder g
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder h
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder i
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder j
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder k
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder RowDecoder l
forall a. FromSqlField a => RowDecoder a
fieldRowDecoder

onlyDecoder :: RowDecoder a -> RowDecoder (Only a)
onlyDecoder :: forall a. RowDecoder a -> RowDecoder (Only a)
onlyDecoder RowDecoder a
a = (a -> Only a) -> RowDecoder a -> RowDecoder (Only a)
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRow a -> Only a
forall a. a -> Only a
Only RowDecoder a
a
{-# OPAQUE onlyDecoder #-}

-- A tuple of three or more fields is the lift function of its length with the
-- constructor, so that each row applies the constructor once, to all its values, and
-- the composition is the one an application's chain of '<*>' of that length is
-- rewritten to.  Composed before from a balanced tree of pairs and triples, each row
-- of five columns built a pair and a triple beside the tuple, 56 bytes: Mock.query
-- of the nullable NBCROW rows allocated 8,245,012 bytes and allocates 7,713,338,
-- and Hmssql.Decoding's object code is 3 KB smaller with the lift functions than it
-- was with the tuples' own compositions.
tuple2 :: RowDecoder a -> RowDecoder b -> RowDecoder (a, b)
tuple2 :: forall a b. RowDecoder a -> RowDecoder b -> RowDecoder (a, b)
tuple2 RowDecoder a
a RowDecoder b
b = (a -> b -> (a, b))
-> RowDecoder a -> RowDecoder b -> RowDecoder (a, b)
forall a b c.
(a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftRow (,) RowDecoder a
a RowDecoder b
b
{-# OPAQUE tuple2 #-}
tuple3 :: RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder (a, b, c)
tuple3 :: forall a b c.
RowDecoder a
-> RowDecoder b -> RowDecoder c -> RowDecoder (a, b, c)
tuple3 RowDecoder a
a RowDecoder b
b RowDecoder c
c = (a -> b -> c -> (a, b, c))
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder (a, b, c)
forall a b c r.
(a -> b -> c -> r)
-> RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder r
lift3RowCalled (,,) RowDecoder a
a RowDecoder b
b RowDecoder c
c
{-# OPAQUE tuple3 #-}
tuple4 :: RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder (a, b, c, d)
tuple4 :: forall a b c d.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder (a, b, c, d)
tuple4 RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d = (a -> b -> c -> d -> (a, b, c, d))
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder (a, b, c, d)
forall a b c d r.
(a -> b -> c -> d -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder r
lift4RowCalled (,,,) RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d
{-# OPAQUE tuple4 #-}
tuple5 :: RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder (a, b, c, d, e)
tuple5 :: forall a b c d e.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder (a, b, c, d, e)
tuple5 RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e = (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder (a, b, c, d, e)
forall a b c d e r.
(a -> b -> c -> d -> e -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder r
lift5RowCalled (,,,,) RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e
{-# OPAQUE tuple5 #-}
tuple6 :: RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder f -> RowDecoder (a, b, c, d, e, f)
tuple6 :: forall a b c d e f.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder (a, b, c, d, e, f)
tuple6 RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f = (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder (a, b, c, d, e, f)
forall a b c d e g r.
(a -> b -> c -> d -> e -> g -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder r
lift6RowCalled (,,,,,) RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f
{-# OPAQUE tuple6 #-}
tuple7 :: RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder f -> RowDecoder g -> RowDecoder (a, b, c, d, e, f, g)
tuple7 :: forall a b c d e f g.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder (a, b, c, d, e, f, g)
tuple7 RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g = (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder (a, b, c, d, e, f, g)
forall a b c d e g h r.
(a -> b -> c -> d -> e -> g -> h -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder r
lift7RowCalled (,,,,,,) RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g
{-# OPAQUE tuple7 #-}
tuple8 :: RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder f -> RowDecoder g -> RowDecoder h -> RowDecoder (a, b, c, d, e, f, g, h)
tuple8 :: forall a b c d e f g h.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder (a, b, c, d, e, f, g, h)
tuple8 RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g RowDecoder h
h = (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder (a, b, c, d, e, f, g, h)
forall a b c d e g h i r.
(a -> b -> c -> d -> e -> g -> h -> i -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder r
lift8RowCalled (,,,,,,,) RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g RowDecoder h
h
{-# OPAQUE tuple8 #-}
tuple9 :: RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder f -> RowDecoder g -> RowDecoder h -> RowDecoder i -> RowDecoder (a, b, c, d, e, f, g, h, i)
tuple9 :: forall a b c d e f g h i.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder (a, b, c, d, e, f, g, h, i)
tuple9 RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g RowDecoder h
h RowDecoder i
i = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> (a, b, c, d, e, f, g, h, i))
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder (a, b, c, d, e, f, g, h, i)
forall a b c d e g h i j r.
(a -> b -> c -> d -> e -> g -> h -> i -> j -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder r
lift9RowCalled (,,,,,,,,) RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g RowDecoder h
h RowDecoder i
i
{-# OPAQUE tuple9 #-}
tuple10 :: RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder f -> RowDecoder g -> RowDecoder h -> RowDecoder i -> RowDecoder j -> RowDecoder (a, b, c, d, e, f, g, h, i, j)
tuple10 :: forall a b c d e f g h i j.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder (a, b, c, d, e, f, g, h, i, j)
tuple10 RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g RowDecoder h
h RowDecoder i
i RowDecoder j
j = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> (a, b, c, d, e, f, g, h, i, j))
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder (a, b, c, d, e, f, g, h, i, j)
forall a b c d e g h i j k r.
(a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder r
lift10RowCalled (,,,,,,,,,) RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g RowDecoder h
h RowDecoder i
i RowDecoder j
j
{-# OPAQUE tuple10 #-}
tuple11 :: RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder f -> RowDecoder g -> RowDecoder h -> RowDecoder i -> RowDecoder j -> RowDecoder k -> RowDecoder (a, b, c, d, e, f, g, h, i, j, k)
tuple11 :: forall a b c d e f g h i j k.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder (a, b, c, d, e, f, g, h, i, j, k)
tuple11 RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g RowDecoder h
h RowDecoder i
i RowDecoder j
j RowDecoder k
k = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder (a, b, c, d, e, f, g, h, i, j, k)
forall a b c d e g h i j k l r.
(a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder l
-> RowDecoder r
lift11RowCalled (,,,,,,,,,,) RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g RowDecoder h
h RowDecoder i
i RowDecoder j
j RowDecoder k
k
{-# OPAQUE tuple11 #-}
tuple12 :: RowDecoder a -> RowDecoder b -> RowDecoder c -> RowDecoder d -> RowDecoder e -> RowDecoder f -> RowDecoder g -> RowDecoder h -> RowDecoder i -> RowDecoder j -> RowDecoder k -> RowDecoder l -> RowDecoder (a, b, c, d, e, f, g, h, i, j, k, l)
tuple12 :: forall a b c d e f g h i j k l.
RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder l
-> RowDecoder (a, b, c, d, e, f, g, h, i, j, k, l)
tuple12 RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g RowDecoder h
h RowDecoder i
i RowDecoder j
j RowDecoder k
k RowDecoder l
l = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder f
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder l
-> RowDecoder (a, b, c, d, e, f, g, h, i, j, k, l)
forall a b c d e g h i j k l m r.
(a -> b -> c -> d -> e -> g -> h -> i -> j -> k -> l -> m -> r)
-> RowDecoder a
-> RowDecoder b
-> RowDecoder c
-> RowDecoder d
-> RowDecoder e
-> RowDecoder g
-> RowDecoder h
-> RowDecoder i
-> RowDecoder j
-> RowDecoder k
-> RowDecoder l
-> RowDecoder m
-> RowDecoder r
lift12RowCalled (,,,,,,,,,,,) RowDecoder a
a RowDecoder b
b RowDecoder c
c RowDecoder d
d RowDecoder e
e RowDecoder f
f RowDecoder g
g RowDecoder h
h RowDecoder i
i RowDecoder j
j RowDecoder k
k RowDecoder l
l
{-# OPAQUE tuple12 #-}

-- | The decoder a derived 'FromSqlRow' instance uses: one column per field of a
-- record or product constructor, in order.
genericFromSqlRow :: forall a. (Generic a, GRowDecoder (Rep a)) => RowDecoder a
genericFromSqlRow :: forall a. (Generic a, GRowDecoder (Rep a)) => RowDecoder a
genericFromSqlRow = case forall (f :: * -> *) p. GRowDecoder f => GDecoder f p
gRowDecoder @(Rep a) @() of
  GDecoder RowDecoder a
d -> (a -> a) -> RowDecoder a -> RowDecoder a
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
recordDecoder ((Rep a () -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to :: Rep a () -> a) (Rep a () -> a) -> (a -> Rep a ()) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a ()
forall a b. Coercible a b => a -> b
coerce) RowDecoder a
d
{-# INLINE genericFromSqlRow #-}

-- The generic decoder shares its composition.  A derived instance is a chain of calls
-- to 'fieldRowDecoder', 'productDecoder' and 'recordDecoder', all out of line, so a
-- record's instance holds no copy of a row's reading.  With the composition inlined
-- into every instance, through 'RowDecoder''s 'fmap' and 'liftA2' and 'to', a
-- derived instance was 2,150 bytes of object code per field once 'singleField' was
-- out of line; with this it was 790 in a module of twelve records, of which about 700
-- were the field decoders inlined into the module, and under 100 with those out of
-- line too.  With each field taking its type's 'fieldRowDecoder', it is 67 in the
-- full program of scripts/code-size.sh.  A tuple's composition is compiled here once
-- (the comment above the tuple instances), and so is a hand-written one (the comment
-- above 'RowDecoder''s instances).
--
-- A 'GDecoder' is the decoder of a type coercible to the representation type, so
-- that the 'M1' and 'K1' wrappers cost nothing.  They are newtypes, but a 'RowDecoder'
-- can't be coerced across them, because its result type is nominal through 'Stream',
-- so the coercion is kept here and applied to the values, in the product's combining
-- function and at the record before 'to'.  Mapping each wrapper over its field's
-- decoder instead gave each field three layers of composition.
data GDecoder f p = forall a. Coercible a (f p) => GDecoder (RowDecoder a)

class GRowDecoder f where
  gRowDecoder :: GDecoder f p
instance (GRowDecoder f, GRowDecoder g) => GRowDecoder (f :*: g) where
  gRowDecoder :: forall p. GDecoder (f :*: g) p
  gRowDecoder :: forall p. GDecoder (f :*: g) p
gRowDecoder = case forall (f :: * -> *) p. GRowDecoder f => GDecoder f p
gRowDecoder @f @p of
    GDecoder RowDecoder a
da -> case forall (f :: * -> *) p. GRowDecoder f => GDecoder f p
gRowDecoder @g @p of
      GDecoder RowDecoder a
db -> RowDecoder ((:*:) f g p) -> GDecoder (f :*: g) p
forall (f :: * -> *) p a.
Coercible a (f p) =>
RowDecoder a -> GDecoder f p
GDecoder (RowDecoder a -> RowDecoder a -> RowDecoder ((:*:) f g p)
forall a b (f :: * -> *) (g :: * -> *) p.
(Coercible a (f p), Coercible b (g p)) =>
RowDecoder a -> RowDecoder b -> RowDecoder ((:*:) f g p)
productDecoder RowDecoder a
da RowDecoder a
db :: RowDecoder ((f :*: g) p))
  {-# INLINE gRowDecoder #-}
instance GRowDecoder f => GRowDecoder (M1 i c f) where
  gRowDecoder :: forall p. GDecoder (M1 i c f) p
  gRowDecoder :: forall p. GDecoder (M1 i c f) p
gRowDecoder = case forall (f :: * -> *) p. GRowDecoder f => GDecoder f p
gRowDecoder @f @p of GDecoder RowDecoder a
d -> RowDecoder a -> GDecoder (M1 i c f) p
forall (f :: * -> *) p a.
Coercible a (f p) =>
RowDecoder a -> GDecoder f p
GDecoder RowDecoder a
d
  {-# INLINE gRowDecoder #-}
instance FromSqlField a => GRowDecoder (K1 i a) where
  gRowDecoder :: forall p. GDecoder (K1 i a) p
gRowDecoder = RowDecoder a -> GDecoder (K1 i a) p
forall (f :: * -> *) p a.
Coercible a (f p) =>
RowDecoder a -> GDecoder f p
GDecoder (forall a. FromSqlField a => RowDecoder a
fieldRowDecoder @a)
  {-# INLINE gRowDecoder #-}

-- The combining function is inside, where it is one closure.  Given to 'liftA2' at
-- each product as '(:*:)' cast, GHC eta-expanded it into a closure per product, and
-- out of line on its own it was worker-wrappered into a wrapper per product.
productDecoder :: forall a b f g p. (Coercible a (f p), Coercible b (g p))
  => RowDecoder a -> RowDecoder b -> RowDecoder ((f :*: g) p)
productDecoder :: forall a b (f :: * -> *) (g :: * -> *) p.
(Coercible a (f p), Coercible b (g p)) =>
RowDecoder a -> RowDecoder b -> RowDecoder ((:*:) f g p)
productDecoder = (a -> b -> (:*:) f g p)
-> RowDecoder a -> RowDecoder b -> RowDecoder ((:*:) f g p)
forall a b c.
(a -> b -> c) -> RowDecoder a -> RowDecoder b -> RowDecoder c
liftRow (\a
a b
b -> a -> f p
forall a b. Coercible a b => a -> b
coerce a
a f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b -> g p
forall a b. Coercible a b => a -> b
coerce b
b)
{-# NOINLINE productDecoder #-}

-- Out of line so that 'to' is called, not copied into the row's recipe.
recordDecoder :: (a -> b) -> RowDecoder a -> RowDecoder b
recordDecoder :: forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
recordDecoder = (a -> b) -> RowDecoder a -> RowDecoder b
forall a b. (a -> b) -> RowDecoder a -> RowDecoder b
mapRow
{-# NOINLINE recordDecoder #-}

-- | A row decoder that runs per row, so later columns can depend on earlier values
-- or on the columns themselves ('remainingColumns').  Each row must read all the
-- columns.  Its checks run per row, so an empty result set isn't checked at all.
newtype RowDecoderMonadic a = RowDecoderMonadic
  { forall a.
RowDecoderMonadic a
-> TdsContext
-> ResultSetInfo
-> Int
-> ByteString
-> Int
-> Parser (Either ReadFailure a, Int)
runRowDecoderMonadic :: TdsContext -> ResultSetInfo -> Int -> B.ByteString -> Int
      -> Parser (Either ReadFailure a, Int)
  }

instance Functor RowDecoderMonadic where
  fmap :: forall a b. (a -> b) -> RowDecoderMonadic a -> RowDecoderMonadic b
fmap a -> b
f (RowDecoderMonadic TdsContext
-> ResultSetInfo
-> Int
-> ByteString
-> Int
-> Parser (Either ReadFailure a, Int)
d) = (TdsContext
 -> ResultSetInfo
 -> Int
 -> ByteString
 -> Int
 -> Parser (Either ReadFailure b, Int))
-> RowDecoderMonadic b
forall a.
(TdsContext
 -> ResultSetInfo
 -> Int
 -> ByteString
 -> Int
 -> Parser (Either ReadFailure a, Int))
-> RowDecoderMonadic a
RowDecoderMonadic ((TdsContext
  -> ResultSetInfo
  -> Int
  -> ByteString
  -> Int
  -> Parser (Either ReadFailure b, Int))
 -> RowDecoderMonadic b)
-> (TdsContext
    -> ResultSetInfo
    -> Int
    -> ByteString
    -> Int
    -> Parser (Either ReadFailure b, Int))
-> RowDecoderMonadic b
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ResultSetInfo
rs Int
ahead ByteString
bitmap Int
i -> do
    (r, j) <- TdsContext
-> ResultSetInfo
-> Int
-> ByteString
-> Int
-> Parser (Either ReadFailure a, Int)
d TdsContext
ctx ResultSetInfo
rs Int
ahead ByteString
bitmap Int
i
    pure (fmap f r, j)

instance Applicative RowDecoderMonadic where
  pure :: forall a. a -> RowDecoderMonadic a
pure a
a = (TdsContext
 -> ResultSetInfo
 -> Int
 -> ByteString
 -> Int
 -> Parser (Either ReadFailure a, Int))
-> RowDecoderMonadic a
forall a.
(TdsContext
 -> ResultSetInfo
 -> Int
 -> ByteString
 -> Int
 -> Parser (Either ReadFailure a, Int))
-> RowDecoderMonadic a
RowDecoderMonadic ((TdsContext
  -> ResultSetInfo
  -> Int
  -> ByteString
  -> Int
  -> Parser (Either ReadFailure a, Int))
 -> RowDecoderMonadic a)
-> (TdsContext
    -> ResultSetInfo
    -> Int
    -> ByteString
    -> Int
    -> Parser (Either ReadFailure a, Int))
-> RowDecoderMonadic a
forall a b. (a -> b) -> a -> b
$ \TdsContext
_ ResultSetInfo
_ Int
_ ByteString
_ Int
i -> (Either ReadFailure a, Int) -> Parser (Either ReadFailure a, Int)
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either ReadFailure a
forall a b. b -> Either a b
Right a
a, Int
i)
  RowDecoderMonadic (a -> b)
mf <*> :: forall a b.
RowDecoderMonadic (a -> b)
-> RowDecoderMonadic a -> RowDecoderMonadic b
<*> RowDecoderMonadic a
ma = RowDecoderMonadic (a -> b)
mf RowDecoderMonadic (a -> b)
-> ((a -> b) -> RowDecoderMonadic b) -> RowDecoderMonadic b
forall a b.
RowDecoderMonadic a
-> (a -> RowDecoderMonadic b) -> RowDecoderMonadic b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
f -> (a -> b) -> RowDecoderMonadic a -> RowDecoderMonadic b
forall a b. (a -> b) -> RowDecoderMonadic a -> RowDecoderMonadic b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f RowDecoderMonadic a
ma

instance Monad RowDecoderMonadic where
  RowDecoderMonadic TdsContext
-> ResultSetInfo
-> Int
-> ByteString
-> Int
-> Parser (Either ReadFailure a, Int)
d >>= :: forall a b.
RowDecoderMonadic a
-> (a -> RowDecoderMonadic b) -> RowDecoderMonadic b
>>= a -> RowDecoderMonadic b
k = (TdsContext
 -> ResultSetInfo
 -> Int
 -> ByteString
 -> Int
 -> Parser (Either ReadFailure b, Int))
-> RowDecoderMonadic b
forall a.
(TdsContext
 -> ResultSetInfo
 -> Int
 -> ByteString
 -> Int
 -> Parser (Either ReadFailure a, Int))
-> RowDecoderMonadic a
RowDecoderMonadic ((TdsContext
  -> ResultSetInfo
  -> Int
  -> ByteString
  -> Int
  -> Parser (Either ReadFailure b, Int))
 -> RowDecoderMonadic b)
-> (TdsContext
    -> ResultSetInfo
    -> Int
    -> ByteString
    -> Int
    -> Parser (Either ReadFailure b, Int))
-> RowDecoderMonadic b
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ResultSetInfo
rs Int
ahead ByteString
bitmap Int
i -> do
    (r, j) <- TdsContext
-> ResultSetInfo
-> Int
-> ByteString
-> Int
-> Parser (Either ReadFailure a, Int)
d TdsContext
ctx ResultSetInfo
rs Int
ahead ByteString
bitmap Int
i
    case r of
      Left ReadFailure
err -> (Either ReadFailure b, Int) -> Parser (Either ReadFailure b, Int)
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadFailure -> Either ReadFailure b
forall a b. a -> Either a b
Left ReadFailure
err, Int
j)
      Right a
a -> RowDecoderMonadic b
-> TdsContext
-> ResultSetInfo
-> Int
-> ByteString
-> Int
-> Parser (Either ReadFailure b, Int)
forall a.
RowDecoderMonadic a
-> TdsContext
-> ResultSetInfo
-> Int
-> ByteString
-> Int
-> Parser (Either ReadFailure a, Int)
runRowDecoderMonadic (a -> RowDecoderMonadic b
k a
a) TdsContext
ctx ResultSetInfo
rs Int
ahead ByteString
bitmap Int
j

-- | Decode the next column with this field decoder.
singleFieldM :: FieldDecoder a -> RowDecoderMonadic a
singleFieldM :: forall a. FieldDecoder a -> RowDecoderMonadic a
singleFieldM = RowDecoder a -> RowDecoderMonadic a
forall a. RowDecoder a -> RowDecoderMonadic a
toMonadicRowDecoder (RowDecoder a -> RowDecoderMonadic a)
-> (FieldDecoder a -> RowDecoder a)
-> FieldDecoder a
-> RowDecoderMonadic a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDecoder a -> RowDecoder a
forall a. FieldDecoder a -> RowDecoder a
singleField

-- | The columns not yet read.
remainingColumns :: RowDecoderMonadic [ColumnInfo]
remainingColumns :: RowDecoderMonadic [ColumnInfo]
remainingColumns = (TdsContext
 -> ResultSetInfo
 -> Int
 -> ByteString
 -> Int
 -> Parser (Either ReadFailure [ColumnInfo], Int))
-> RowDecoderMonadic [ColumnInfo]
forall a.
(TdsContext
 -> ResultSetInfo
 -> Int
 -> ByteString
 -> Int
 -> Parser (Either ReadFailure a, Int))
-> RowDecoderMonadic a
RowDecoderMonadic ((TdsContext
  -> ResultSetInfo
  -> Int
  -> ByteString
  -> Int
  -> Parser (Either ReadFailure [ColumnInfo], Int))
 -> RowDecoderMonadic [ColumnInfo])
-> (TdsContext
    -> ResultSetInfo
    -> Int
    -> ByteString
    -> Int
    -> Parser (Either ReadFailure [ColumnInfo], Int))
-> RowDecoderMonadic [ColumnInfo]
forall a b. (a -> b) -> a -> b
$ \TdsContext
_ ResultSetInfo
rs Int
_ ByteString
_ Int
i -> (Either ReadFailure [ColumnInfo], Int)
-> Parser (Either ReadFailure [ColumnInfo], Int)
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ColumnInfo] -> Either ReadFailure [ColumnInfo]
forall a b. b -> Either a b
Right (Int -> [ColumnInfo] -> [ColumnInfo]
forall a. Int -> [a] -> [a]
drop Int
i (ResultSetInfo -> [ColumnInfo]
rsColumns ResultSetInfo
rs)), Int
i)

-- | Read the next columns with a 'RowDecoder'.
toMonadicRowDecoder :: RowDecoder a -> RowDecoderMonadic a
toMonadicRowDecoder :: forall a. RowDecoder a -> RowDecoderMonadic a
toMonadicRowDecoder RowDecoder a
dec = (TdsContext
 -> ResultSetInfo
 -> Int
 -> ByteString
 -> Int
 -> Parser (Either ReadFailure a, Int))
-> RowDecoderMonadic a
forall a.
(TdsContext
 -> ResultSetInfo
 -> Int
 -> ByteString
 -> Int
 -> Parser (Either ReadFailure a, Int))
-> RowDecoderMonadic a
RowDecoderMonadic ((TdsContext
  -> ResultSetInfo
  -> Int
  -> ByteString
  -> Int
  -> Parser (Either ReadFailure a, Int))
 -> RowDecoderMonadic a)
-> (TdsContext
    -> ResultSetInfo
    -> Int
    -> ByteString
    -> Int
    -> Parser (Either ReadFailure a, Int))
-> RowDecoderMonadic a
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ResultSetInfo
rs Int
ahead ByteString
bitmap Int
i -> do
  let n :: Int
n = RowDecoder a -> Int
forall a. RowDecoder a -> Int
numExpectedColumns RowDecoder a
dec
      remaining :: Int
remaining = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (ResultSetInfo -> Int
rsColumnCount ResultSetInfo
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
  if Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then (Either ReadFailure a, Int) -> Parser (Either ReadFailure a, Int)
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadFailure -> Either ReadFailure a
forall a b. a -> Either a b
Left (DecodeError -> ReadFailure
DecodeFailed (Maybe Text -> [Char] -> DecodeError
DecodeError Maybe Text
forall a. Maybe a
Nothing
      (if Int
remaining Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then [Char]
"no more columns" else
       [Char]
"result has " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
remaining [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" column(s) but the row type expects " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n))), Int
i)
    else case RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart a)
forall a.
RowDecoder a
-> TdsContext
-> ResultSetInfo
-> Int
-> Either DecodeError (RowPart a)
compileRowAt RowDecoder a
dec TdsContext
ctx ResultSetInfo
rs Int
i of
      Left DecodeError
err -> (Either ReadFailure a, Int) -> Parser (Either ReadFailure a, Int)
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadFailure -> Either ReadFailure a
forall a b. a -> Either a b
Left (DecodeError -> ReadFailure
DecodeFailed DecodeError
err), Int
i)
      Right (RowPart Int -> Prepared (Recipe ByteString a)
prepare) | Prepared Recipe ByteString a
read <- Int -> Prepared (Recipe ByteString a)
prepare Int
ahead -> do
        result <- Recipe () a -> Recipe () (Either ReadFailure a)
forall env a. Recipe env a -> Recipe env (Either ReadFailure a)
P.attempt (ByteString -> Recipe ByteString a -> Recipe () a
forall env a. env -> Recipe env a -> Parser a
P.withEnv ByteString
bitmap Recipe ByteString a
read)
        pure $ case result of
          -- The cell that failed read past the rest of the row.
          Left ReadFailure
err -> (ReadFailure -> Either ReadFailure a
forall a b. a -> Either a b
Left ReadFailure
err, ResultSetInfo -> Int
rsColumnCount ResultSetInfo
rs)
          Right a
value -> (a -> Either ReadFailure a
forall a b. b -> Either a b
Right a
value, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

-- | Decode the remaining columns as 'SqlValue's, keeping their 'ColumnInfo's.
sqlRowDecoder :: RowDecoderMonadic SqlRow
sqlRowDecoder :: RowDecoderMonadic SqlRow
sqlRowDecoder = do
  cols <- RowDecoderMonadic [ColumnInfo]
remainingColumns
  SqlRow cols <$> mapM (const (singleFieldM sqlValueDecoder)) cols

-- | Prepare a 'RowDecoderMonadic' to read rows.  A failed conversion or a wrong
-- column count is reported once the rest of the row has been read past, so the
-- following rows can still be read.
compileMonadicRowDecoder :: RowDecoderMonadic a -> TdsContext -> [ColumnInfo] -> CompiledRow a
compileMonadicRowDecoder :: forall a.
RowDecoderMonadic a -> TdsContext -> [ColumnInfo] -> CompiledRow a
compileMonadicRowDecoder RowDecoderMonadic a
dec TdsContext
ctx [ColumnInfo]
cols = (Int -> Prepared (Parser a)) -> CompiledRow a
forall a. (Int -> Prepared (Parser a)) -> CompiledRow a
CompiledRow ((Int -> Prepared (Parser a)) -> CompiledRow a)
-> (Int -> Prepared (Parser a)) -> CompiledRow a
forall a b. (a -> b) -> a -> b
$ \Int
ahead -> Parser a -> Prepared (Parser a)
forall a. a -> Prepared a
Prepared (Parser a -> Prepared (Parser a))
-> Parser a -> Prepared (Parser a)
forall a b. (a -> b) -> a -> b
$ do
  bitmap <- Int -> Parser ByteString
rowBitmap Int
n
  (result, consumed) <- runRowDecoderMonadic dec ctx rs ahead bitmap 0
  skipCells bitmap (drop consumed (rsCells rs))
  case result of
    Left ReadFailure
err -> ReadFailure -> Parser a
forall env a. ReadFailure -> Recipe env a
P.failValue ReadFailure
err
    Right a
a | Int
consumed Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n -> a -> Parser a
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Right a
_ -> ReadFailure -> Parser a
forall env a. ReadFailure -> Recipe env a
P.failValue (ReadFailure -> Parser a) -> ReadFailure -> Parser a
forall a b. (a -> b) -> a -> b
$ DecodeError -> ReadFailure
DecodeFailed (DecodeError -> ReadFailure) -> DecodeError -> ReadFailure
forall a b. (a -> b) -> a -> b
$ Maybe Text -> [Char] -> DecodeError
DecodeError Maybe Text
forall a. Maybe a
Nothing ([Char] -> DecodeError) -> [Char] -> DecodeError
forall a b. (a -> b) -> a -> b
$
      [Char]
"result has " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" column(s) but the row decoder consumed " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
consumed
  where
    rs :: ResultSetInfo
rs = [ColumnInfo] -> ResultSetInfo
compileResultSet [ColumnInfo]
cols
    n :: Int
n = ResultSetInfo -> Int
rsColumnCount ResultSetInfo
rs

-- | A non-NULL value's bytes as they arrive, with its column and its total length
-- if the server sent it.  A chunk is safe to keep.  The stream is valid only
-- inside its consumer, and bytes the consumer doesn't read are skipped.
data ValueStream = ValueStream
  { ValueStream -> ColumnInfo
valueColumn :: !ColumnInfo
  , ValueStream -> Maybe Int64
valueLength :: !(Maybe Int64)
  , ValueStream -> Stream (Of ByteString) IO ()
valueChunks :: Stream (Of B.ByteString) IO ()
  }

-- | A decoder that gives any non-NULL value to a consumer as it arrives, so a large
-- value needn't be in memory.  A NULL is a 'DecodeError' unless the decoder is
-- wrapped in 'nullableField'.  The consumer runs on the thread reading the rows.
-- Reading this stream twice or after the consumer returns throws
-- 'Hmssql.Errors.ResultAbandoned'. On a plain connection, the consumer
-- must not use the connection; on MARS it may use other responses.
streamField :: (ValueStream -> IO a) -> FieldDecoder a
streamField :: forall a. (ValueStream -> IO a) -> FieldDecoder a
streamField ValueStream -> IO a
use = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
 -> FieldDecoder a)
-> (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a b. (a -> b) -> a -> b
$ \TdsContext
_ ColumnInfo
col -> CellDecoder a -> Either [Char] (CellDecoder a)
forall a b. b -> Either a b
Right (CellDecoder a -> Either [Char] (CellDecoder a))
-> CellDecoder a -> Either [Char] (CellDecoder a)
forall a b. (a -> b) -> a -> b
$ (StreamedValue -> Parser (Either ReadFailure a)) -> CellDecoder a
forall a.
(StreamedValue -> Parser (Either ReadFailure a)) -> CellDecoder a
StreamingCell ((StreamedValue -> Parser (Either ReadFailure a)) -> CellDecoder a)
-> (StreamedValue -> Parser (Either ReadFailure a))
-> CellDecoder a
forall a b. (a -> b) -> a -> b
$ \case
  StreamedValue
StreamedNull -> Either ReadFailure a -> Parser (Either ReadFailure a)
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadFailure -> Either ReadFailure a
forall a b. a -> Either a b
Left (DecodeError -> ReadFailure
DecodeFailed (Maybe Text -> [Char] -> DecodeError
DecodeError (Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnInfo -> Text
columnName ColumnInfo
col)) [Char]
"SQL NULL cannot be streamed; use nullableField")))
  StreamedWhole ValueBytes
bytes -> Either ReadFailure a
-> (a -> Either ReadFailure a) -> Maybe a -> Either ReadFailure a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ReadFailure -> Either ReadFailure a
forall a b. a -> Either a b
Left ReadFailure
ReadDiscarded) a -> Either ReadFailure a
forall a b. b -> Either a b
Right
    (Maybe a -> Either ReadFailure a)
-> Recipe () (Maybe a) -> Parser (Either ReadFailure a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString
-> (Stream (Of ByteString) IO () -> IO a) -> Recipe () (Maybe a)
forall a.
ByteString
-> (Stream (Of ByteString) IO () -> IO a) -> Parser (Maybe a)
P.consumeWhole (ValueBytes -> ByteString
P.keepBytes ValueBytes
bytes) (ValueStream -> IO a
use (ValueStream -> IO a)
-> (Stream (Of ByteString) IO () -> ValueStream)
-> Stream (Of ByteString) IO ()
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo
-> Maybe Int64 -> Stream (Of ByteString) IO () -> ValueStream
ValueStream ColumnInfo
col (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length (ValueBytes -> ByteString
P.valueBytes ValueBytes
bytes)))))
  StreamedBytes Maybe Int64
total Stream (Of ByteString) (Recipe ()) ()
chunks -> Either ReadFailure a
-> (a -> Either ReadFailure a) -> Maybe a -> Either ReadFailure a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ReadFailure -> Either ReadFailure a
forall a b. a -> Either a b
Left ReadFailure
ReadDiscarded) a -> Either ReadFailure a
forall a b. b -> Either a b
Right (Maybe a -> Either ReadFailure a)
-> Recipe () (Maybe a) -> Parser (Either ReadFailure a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream (Of ByteString) (Recipe ()) ()
-> (Stream (Of ByteString) IO () -> IO a) -> Recipe () (Maybe a)
forall a.
Stream (Of ByteString) (Recipe ()) ()
-> (Stream (Of ByteString) IO () -> IO a) -> Parser (Maybe a)
P.consume Stream (Of ByteString) (Recipe ()) ()
chunks (ValueStream -> IO a
use (ValueStream -> IO a)
-> (Stream (Of ByteString) IO () -> ValueStream)
-> Stream (Of ByteString) IO ()
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo
-> Maybe Int64 -> Stream (Of ByteString) IO () -> ValueStream
ValueStream ColumnInfo
col Maybe Int64
total)

-- | 'streamField' for character and XML columns, as 'Text' chunks.  A column whose
-- encoding can't be decoded is rejected before any row is read.
streamTextField :: (ColumnInfo -> Stream (Of Text) IO () -> IO a) -> FieldDecoder a
streamTextField :: forall a.
(ColumnInfo -> Stream (Of Text) IO () -> IO a) -> FieldDecoder a
streamTextField ColumnInfo -> Stream (Of Text) IO () -> IO a
use = (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a.
(TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
FieldDecoder ((TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
 -> FieldDecoder a)
-> (TdsContext -> ColumnInfo -> Either [Char] (CellDecoder a))
-> FieldDecoder a
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ColumnInfo
col -> do
  encoding <- TypeInfo -> Either [Char] TextEncoding
textEncodingOf (ColumnInfo -> TypeInfo
columnType ColumnInfo
col)
  compileField (streamField (\ValueStream
v -> ColumnInfo -> Stream (Of Text) IO () -> IO a
use ColumnInfo
col (TextEncoding
-> Stream (Of ByteString) IO () -> Stream (Of Text) IO ()
forall (m :: * -> *) r.
Monad m =>
TextEncoding -> Stream (Of ByteString) m r -> Stream (Of Text) m r
decodeTextChunks TextEncoding
encoding (ValueStream -> Stream (Of ByteString) IO ()
valueChunks ValueStream
v)))) ctx col

decodeTextChunks :: Monad m => TextEncoding -> Stream (Of B.ByteString) m r -> Stream (Of Text) m r
decodeTextChunks :: forall (m :: * -> *) r.
Monad m =>
TextEncoding -> Stream (Of ByteString) m r -> Stream (Of Text) m r
decodeTextChunks TextEncoding
TextUtf16 = Stream (Of ByteString) m r -> Stream (Of Text) m r
forall (m :: * -> *) r.
Monad m =>
Stream (Of ByteString) m r -> Stream (Of Text) m r
Utf16.decodeUtf16Chunks
decodeTextChunks (TextCodec TextCodec
codec) = TextCodec -> Stream (Of ByteString) m r -> Stream (Of Text) m r
forall (m :: * -> *) r.
Monad m =>
TextCodec -> Stream (Of ByteString) m r -> Stream (Of Text) m r
decodeCodecChunks TextCodec
codec

-- | Read past each row of a result set without decoding it or keeping its values
-- in memory.
skipRowDecoder :: [ColumnInfo] -> CompiledRow ()
skipRowDecoder :: [ColumnInfo] -> CompiledRow ()
skipRowDecoder [ColumnInfo]
cols =
  let info :: ResultSetInfo
info = [ColumnInfo] -> ResultSetInfo
compileResultSet [ColumnInfo]
cols
   in (Int -> Prepared (Parser ())) -> CompiledRow ()
forall a. (Int -> Prepared (Parser a)) -> CompiledRow a
CompiledRow ((Int -> Prepared (Parser ())) -> CompiledRow ())
-> (Int -> Prepared (Parser ())) -> CompiledRow ()
forall a b. (a -> b) -> a -> b
$ \Int
_ -> Parser () -> Prepared (Parser ())
forall a. a -> Prepared a
Prepared (Parser () -> Prepared (Parser ()))
-> Parser () -> Prepared (Parser ())
forall a b. (a -> b) -> a -> b
$ do
        bitmap <- Int -> Parser ByteString
rowBitmap (ResultSetInfo -> Int
rsColumnCount ResultSetInfo
info)
        skipCells bitmap (rsCells info)

-- | Read and decode one value, given the column, its decoder, the column's
-- 'Hmssql.Connection.connectValueAllocAhead' and the value's header.  A value that
-- doesn't decode fails the recipe ('P.failValue') once its bytes have been read.
readCellRecipe :: ColumnInfo -> CellDecoder a -> Int -> Cell -> Parser a
readCellRecipe :: forall a. ColumnInfo -> CellDecoder a -> Int -> Cell -> Parser a
readCellRecipe ColumnInfo
col CellDecoder a
decoder Int
ahead Cell
cell = case CellDecoder a
decoder of
  CellDecoder Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned -> Either [Char] a -> ValueReader a -> ValueReader a -> Parser a
whole Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned
  FoldingCell Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
fold
    | Cell -> Bool
withinLimit Cell
cell -> Either [Char] a -> ValueReader a -> ValueReader a -> Parser a
whole Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned
    | Bool
otherwise -> ColumnInfo
-> Either [Char] a
-> ValueReader a
-> ValueReader a
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure a))
-> Int
-> Cell
-> Parser a
forall a.
ColumnInfo
-> Either [Char] a
-> ValueReader a
-> ValueReader a
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure a))
-> Int
-> Cell
-> Parser a
foldingCellRecipe ColumnInfo
col Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
fold Int
ahead Cell
cell
  StreamingCell StreamedValue -> Parser (Either ReadFailure a)
read -> ColumnInfo
-> (StreamedValue -> Parser (Either ReadFailure a))
-> Int
-> Cell
-> Parser a
forall a.
ColumnInfo
-> (StreamedValue -> Parser (Either ReadFailure a))
-> Int
-> Cell
-> Parser a
streamingCellRecipe ColumnInfo
col StreamedValue -> Parser (Either ReadFailure a)
read Int
ahead Cell
cell
  where
    -- Both uses are in tail position, so this is a join point, compiled once.
    whole :: Either [Char] a -> ValueReader a -> ValueReader a -> Parser a
whole Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned = case Cell
cell of
      -- The common case, a value of known length, goes straight to its conversion.
      Sized Int
n -> Int
-> Int
-> (ByteString -> Either ReadFailure a)
-> (ByteString -> Either ReadFailure a)
-> Parser a
forall a.
Int
-> Int
-> (ByteString -> Either ReadFailure a)
-> (ByteString -> Either ReadFailure a)
-> Parser a
P.convertBytes Int
ahead Int
n (Either [Char] a -> Either ReadFailure a
failed (Either [Char] a -> Either ReadFailure a)
-> ValueReader a -> ByteString -> Either ReadFailure a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueReader a
borrowed) (Either [Char] a -> Either ReadFailure a
failed (Either [Char] a -> Either ReadFailure a)
-> ValueReader a -> ByteString -> Either ReadFailure a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueReader a
owned)
      Cell
_ -> do
        value <- Int -> Cell -> Parser WholeValue
wholeValueBytes Int
ahead Cell
cell
        case value of
          -- A drain took over while this value was being assembled.  The row has no
          -- result now, and the drain ignores this one.
          WholeValue
DiscardedValue -> ReadFailure -> Parser a
forall env a. ReadFailure -> Recipe env a
P.failValue ReadFailure
ReadDiscarded
          WholeValue
NullValue -> Either [Char] a -> Parser a
named Either [Char] a
onNull
          PresentValue (P.Borrowed ByteString
bytes) -> Either [Char] a -> Parser a
named (ValueReader a
borrowed ByteString
bytes)
          PresentValue (P.Owned ByteString
bytes) -> Either [Char] a -> Parser a
named (ValueReader a
owned ByteString
bytes)
    failed :: Either [Char] a -> Either ReadFailure a
failed = ([Char] -> Either ReadFailure a)
-> (a -> Either ReadFailure a)
-> Either [Char] a
-> Either ReadFailure a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ReadFailure -> Either ReadFailure a
forall a b. a -> Either a b
Left (ReadFailure -> Either ReadFailure a)
-> ([Char] -> ReadFailure) -> [Char] -> Either ReadFailure a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeError -> ReadFailure
DecodeFailed (DecodeError -> ReadFailure)
-> ([Char] -> DecodeError) -> [Char] -> ReadFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> [Char] -> DecodeError
DecodeError (Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnInfo -> Text
columnName ColumnInfo
col))) a -> Either ReadFailure a
forall a b. b -> Either a b
Right
    named :: Either [Char] a -> Parser a
named = (ReadFailure -> Parser a)
-> (a -> Parser a) -> Either ReadFailure a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ReadFailure -> Parser a
forall env a. ReadFailure -> Recipe env a
P.failValue a -> Parser a
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ReadFailure a -> Parser a)
-> (Either [Char] a -> Either ReadFailure a)
-> Either [Char] a
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either [Char] a -> Either ReadFailure a
failed
{-# INLINE readCellRecipe #-}

-- A value read whole, converted.
presentCell :: ColumnInfo -> Either String a -> ValueReader a -> ValueReader a -> WholeValue -> Parser a
presentCell :: forall a.
ColumnInfo
-> Either [Char] a
-> ValueReader a
-> ValueReader a
-> WholeValue
-> Parser a
presentCell ColumnInfo
col Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned = \case
  -- A drain took over while this value was being assembled.  The row has no
  -- result now, and the drain ignores this one.
  WholeValue
DiscardedValue -> ReadFailure -> Parser a
forall env a. ReadFailure -> Recipe env a
P.failValue ReadFailure
ReadDiscarded
  WholeValue
NullValue -> Either [Char] a -> Parser a
named Either [Char] a
onNull
  PresentValue (P.Borrowed ByteString
bytes) -> Either [Char] a -> Parser a
named (ValueReader a
borrowed ByteString
bytes)
  PresentValue (P.Owned ByteString
bytes) -> Either [Char] a -> Parser a
named (ValueReader a
owned ByteString
bytes)
  where named :: Either [Char] a -> Parser a
named = (ReadFailure -> Parser a)
-> (a -> Parser a) -> Either ReadFailure a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ReadFailure -> Parser a
forall env a. ReadFailure -> Recipe env a
P.failValue a -> Parser a
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ReadFailure a -> Parser a)
-> (Either [Char] a -> Either ReadFailure a)
-> Either [Char] a
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnInfo -> Either [Char] a -> Either ReadFailure a
forall a. ColumnInfo -> Either [Char] a -> Either ReadFailure a
failed ColumnInfo
col
{-# INLINE presentCell #-}

failed :: ColumnInfo -> Either String a -> Either ReadFailure a
failed :: forall a. ColumnInfo -> Either [Char] a -> Either ReadFailure a
failed ColumnInfo
col = ([Char] -> Either ReadFailure a)
-> (a -> Either ReadFailure a)
-> Either [Char] a
-> Either ReadFailure a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ReadFailure -> Either ReadFailure a
forall a b. a -> Either a b
Left (ReadFailure -> Either ReadFailure a)
-> ([Char] -> ReadFailure) -> [Char] -> Either ReadFailure a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeError -> ReadFailure
DecodeFailed (DecodeError -> ReadFailure)
-> ([Char] -> DecodeError) -> [Char] -> ReadFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> [Char] -> DecodeError
DecodeError (Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnInfo -> Text
columnName ColumnInfo
col))) a -> Either ReadFailure a
forall a b. b -> Either a b
Right
{-# INLINE failed #-}

-- Whether a value is NULL or of a length known to be within 'streamWholeLimit'.
withinLimit :: Cell -> Bool
withinLimit :: Cell -> Bool
withinLimit = \case
  Sized Int
n -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
streamWholeLimit
  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
streamWholeLimit
  Unsized Maybe Word64
Nothing -> Bool
False
  Cell
NullCell -> Bool
True
{-# INLINE withinLimit #-}

-- The reading of a value past the limit or of a total not sent, by a folding cell,
-- and of any value by a streaming one, out of line: each is read in one place,
-- rather than in every copy of 'readCellRecipe', since its value is a long one,
-- whose reading costs far more than the call.  Inlined there, with 'boundedValue',
-- they made "Hmssql.Decoding" 62 KB larger.  A folding cell's short value is read
-- by 'readCellRecipe' itself: through a call here, a short @nvarchar(max)@ into
-- 'Text' allocated 96 bytes more.
foldingCellRecipe :: ColumnInfo -> Either String a -> ValueReader a -> ValueReader a
  -> (Stream (Of B.ByteString) Parser () -> Parser (Either ReadFailure a)) -> Int -> Cell -> Parser a
foldingCellRecipe :: forall a.
ColumnInfo
-> Either [Char] a
-> ValueReader a
-> ValueReader a
-> (Stream (Of ByteString) (Recipe ()) ()
    -> Parser (Either ReadFailure a))
-> Int
-> Cell
-> Parser a
foldingCellRecipe ColumnInfo
col Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
fold Int
ahead Cell
cell = Int
-> Int
-> Cell
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
boundedValue Int
ahead Int
streamWholeLimit Cell
cell Parser (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
-> (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue
    -> Recipe () a)
-> Recipe () a
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right WholeValue
value -> ColumnInfo
-> Either [Char] a
-> ValueReader a
-> ValueReader a
-> WholeValue
-> Recipe () a
forall a.
ColumnInfo
-> Either [Char] a
-> ValueReader a
-> ValueReader a
-> WholeValue
-> Parser a
presentCell ColumnInfo
col Either [Char] a
onNull ValueReader a
borrowed ValueReader a
owned WholeValue
value
  Left Stream (Of ByteString) (Recipe ()) ()
chunks -> Stream (Of ByteString) (Recipe ()) ()
-> Parser (Either ReadFailure a)
fold Stream (Of ByteString) (Recipe ()) ()
chunks Parser (Either ReadFailure a)
-> (Either ReadFailure a -> Recipe () a) -> Recipe () a
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ReadFailure -> Recipe () a)
-> (a -> Recipe () a) -> Either ReadFailure a -> Recipe () a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ReadFailure -> Recipe () a
forall env a. ReadFailure -> Recipe env a
P.failValue a -> Recipe () a
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# NOINLINE foldingCellRecipe #-}

streamingCellRecipe :: ColumnInfo -> (StreamedValue -> Parser (Either ReadFailure a)) -> Int -> Cell -> Parser a
streamingCellRecipe :: forall a.
ColumnInfo
-> (StreamedValue -> Parser (Either ReadFailure a))
-> Int
-> Cell
-> Parser a
streamingCellRecipe ColumnInfo
_ StreamedValue -> Parser (Either ReadFailure a)
read Int
ahead Cell
cell = Recipe () StreamedValue
streamed Recipe () StreamedValue
-> (StreamedValue -> Parser (Either ReadFailure a))
-> Parser (Either ReadFailure a)
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StreamedValue -> Parser (Either ReadFailure a)
read Parser (Either ReadFailure a)
-> (Either ReadFailure a -> Recipe () a) -> Recipe () a
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ReadFailure -> Recipe () a)
-> (a -> Recipe () a) -> Either ReadFailure a -> Recipe () a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ReadFailure -> Recipe () a
forall env a. ReadFailure -> Recipe env a
P.failValue a -> Recipe () a
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    streamed :: Recipe () StreamedValue
streamed = Int
-> Int
-> Cell
-> Parser
     (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
boundedValue Int
ahead Int
streamWholeLimit Cell
cell Parser (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue)
-> (Either (Stream (Of ByteString) (Recipe ()) ()) WholeValue
    -> Recipe () StreamedValue)
-> Recipe () StreamedValue
forall a b. Recipe () a -> (a -> Recipe () b) -> Recipe () b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right WholeValue
NullValue -> StreamedValue -> Recipe () StreamedValue
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StreamedValue
StreamedNull
      Right (PresentValue ValueBytes
bytes) -> StreamedValue -> Recipe () StreamedValue
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValueBytes -> StreamedValue
StreamedWhole ValueBytes
bytes)
      Right WholeValue
DiscardedValue -> ReadFailure -> Recipe () StreamedValue
forall env a. ReadFailure -> Recipe env a
P.failValue ReadFailure
ReadDiscarded
      Left Stream (Of ByteString) (Recipe ()) ()
chunks -> StreamedValue -> Recipe () StreamedValue
forall a. a -> Recipe () a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int64
-> Stream (Of ByteString) (Recipe ()) () -> StreamedValue
StreamedBytes (Cell -> Maybe Int64
cellLength Cell
cell) Stream (Of ByteString) (Recipe ()) ()
chunks)
{-# NOINLINE streamingCellRecipe #-}

-- | Decode a stream of a character column's bytes to 'Text' chunks, or why the
-- column's encoding can't be decoded.
decodeColumnChunks :: Monad m => TypeInfo -> Either String (Stream (Of B.ByteString) m r -> Stream (Of Text) m r)
decodeColumnChunks :: forall (m :: * -> *) r.
Monad m =>
TypeInfo
-> Either
     [Char] (Stream (Of ByteString) m r -> Stream (Of Text) m r)
decodeColumnChunks TypeInfo
ti = TextEncoding -> Stream (Of ByteString) m r -> Stream (Of Text) m r
forall (m :: * -> *) r.
Monad m =>
TextEncoding -> Stream (Of ByteString) m r -> Stream (Of Text) m r
decodeTextChunks (TextEncoding
 -> Stream (Of ByteString) m r -> Stream (Of Text) m r)
-> Either [Char] TextEncoding
-> Either
     [Char] (Stream (Of ByteString) m r -> Stream (Of Text) m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeInfo -> Either [Char] TextEncoding
textEncodingOf TypeInfo
ti