{-# LANGUAGE MagicHash #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | The representations of the query types, constructors and fields
-- included, for the tests and for libraries built on top of hmssql (a
-- quasiquoter, a reader of responses token by token).  "Hmssql.Query"
-- exports these types with only the constructors that code running queries
-- uses; nothing here is stable.
--
-- A 'Query' is a tree of pieces.  Each piece holds fragments (static text
-- and placeholders numbered from 1 among the piece's own positional
-- parameters) and its parameters; a node caches how many positional
-- parameters are below it.  So '<>' is a constant-time node, and the
-- absolute numbering (@\@p1@, @\@p2@, ... across the whole query) is
-- computed in one pass when the query is flattened ('queryFragments',
-- 'queryParams', 'queryText'): building a query from @n@ pieces costs
-- @O(n)@ however the '<>'s associate.
module Hmssql.Query.Types
  ( -- * Queries
    Query (..)
  , Node (..)
  , piece
  , Fragment (..)
  , QueryParam (..)
  , queryFragments
  , queryParams
  , queryText
  , renderFragments
  , placeholderText
  , queryProblem
  , fragmentsProblem

    -- * Requests
  , Request (..)

    -- * Responses
  , ResponseReader (..)
  , BatchScope (..)
  , RowBatch (..)
  , ResponseStep (..)

    -- * Result sets
  , ResultSet (..)
  , ResultSets (..)
  ) where

import Data.IORef (IORef)
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Void (Void)

import Hmssql.Internal.Derived
import Hmssql.Tds.PacketWriter (PacketWriter)
import Hmssql.Connection.Internal (ActiveResponse, Connection, ResponseStep (..), RowBatch (..))
import Hmssql.Encoding (EncodedParam)
import Hmssql.Query.Lexer
import Hmssql.Tds.Context (TdsContext)
import Hmssql.Tds.Packet (PacketType)
import Hmssql.Tds.Token (ColumnInfo, Done, ServerMessage, Token)

------------------------------------------------------------------------------
-- Queries

-- | SQL text together with the parameters it refers to.  Build one from a
-- string literal, with 'Hmssql.Query.mkQuery', or from pieces joined with
-- '<>'; "Hmssql.Query#g:building" shows each way.
--
-- The positional parameters are sent as @\@p1@, @\@p2@, ... in the order
-- 'queryParams' lists them, and the named parameters by name.  '<>'
-- appends the text and the parameters of two queries and renumbers the
-- right operand's placeholders past the left operand's positional
-- parameters, so any two queries can be joined.  A placeholder that
-- refers to no parameter makes sending the query throw
-- 'Hmssql.Errors.EncodeError'.
--
-- A query with no parameters is sent as a plain SQL batch, and one with
-- parameters through @sp_executesql@.  'fromString' (@OverloadedStrings@)
-- is text as it is, with no parameters.  'Show' is the text as it would
-- be sent, without the parameter values.
data Query = Query
  { Query -> Int
queryPositional :: !Int
    -- ^ How many positional parameters the query has.
  , Query -> Node
queryNode :: Node
  }

-- | The tree of a 'Query': empty, one piece, or two queries appended.
data Node
  = Empty
  | Piece [Fragment] [QueryParam]
    -- ^ Placeholders are numbered among this piece's own positional
    -- parameters, from 1.
  | Append Query Query

-- | A parameter: its name (@\"\"@ for a positional one, otherwise with the
-- leading @\@@) and how to encode its value for a connection.
data QueryParam = QueryParam
  { QueryParam -> Text
paramName :: !Text
  , QueryParam -> TdsContext -> Either [Char] EncodedParam
paramEncode :: TdsContext -> Either String EncodedParam
  }

-- | The name only; the value is not shown.
instance Show QueryParam where
  showsPrec :: Int -> QueryParam -> ShowS
showsPrec Int
d QueryParam
p = Int -> Addr# -> [Arg] -> ShowS
showCon Int
d Addr#
"QueryParam"# [Text -> Arg
forall a. Show a => a -> Arg
Arg (QueryParam -> Text
paramName QueryParam
p), Verbatim -> Arg
forall a. Show a => a -> Arg
Arg ([Char] -> Verbatim
Verbatim [Char]
"<value>")]
  {-# OPAQUE showsPrec #-}

-- | A query of one piece: fragments whose placeholders are numbered among
-- the positional parameters given, from 1.
piece :: [Fragment] -> [QueryParam] -> Query
piece :: [Fragment] -> [QueryParam] -> Query
piece [] [] = Query
forall a. Monoid a => a
mempty
piece [Fragment]
frags [QueryParam]
params = Int -> Node -> Query
Query ([QueryParam] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((QueryParam -> Bool) -> [QueryParam] -> [QueryParam]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
T.null (Text -> Bool) -> (QueryParam -> Text) -> QueryParam -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryParam -> Text
paramName) [QueryParam]
params)) ([Fragment] -> [QueryParam] -> Node
Piece [Fragment]
frags [QueryParam]
params)

instance Semigroup Query where
  Query Int
_ Node
Empty <> :: Query -> Query -> Query
<> Query
b = Query
b
  Query
a <> Query Int
_ Node
Empty = Query
a
  Query
a <> Query
b = Int -> Node -> Query
Query (Query -> Int
queryPositional Query
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Query -> Int
queryPositional Query
b) (Query -> Query -> Node
Append Query
a Query
b)
  -- Inlined, each '<>' of an application's query was a tree of cases on both
  -- operands, and a query composed of four 'param's and their text was 4.4 KB of
  -- object code; called, it is a few instructions.
  {-# NOINLINE (<>) #-}

instance Monoid Query where
  mempty :: Query
mempty = Int -> Node -> Query
Query Int
0 Node
Empty

instance IsString Query where
  fromString :: [Char] -> Query
fromString [Char]
s = [Fragment] -> [QueryParam] -> Query
piece [Text -> Fragment
Static ([Char] -> Text
T.pack [Char]
s) | Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s)] []

instance Show Query where
  showsPrec :: Int -> Query -> ShowS
showsPrec Int
d Query
q = Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (Query -> Text
queryText Query
q)

-- | The fragments of the whole query, placeholders numbered across it.
-- Built strictly, right to left (the whole list is always consumed):
-- lazily, every node and fragment left a thunk, about 190 bytes per
-- fragment.
queryFragments :: Query -> [Fragment]
queryFragments :: Query -> [Fragment]
queryFragments Query
q = Int -> Query -> [Fragment] -> [Fragment]
go Int
0 Query
q []
  where
    go :: Int -> Query -> [Fragment] -> [Fragment]
go !Int
off (Query Int
_ Node
node) [Fragment]
rest = case Node
node of
      Node
Empty -> [Fragment]
rest
      Piece [Fragment]
frags [QueryParam]
_ -> Int -> [Fragment] -> [Fragment] -> [Fragment]
shiftAll Int
off [Fragment]
frags [Fragment]
rest
      Append Query
l Query
r -> let !rest' :: [Fragment]
rest' = Int -> Query -> [Fragment] -> [Fragment]
go (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Query -> Int
queryPositional Query
l) Query
r [Fragment]
rest in Int -> Query -> [Fragment] -> [Fragment]
go Int
off Query
l [Fragment]
rest'
    shiftAll :: Int -> [Fragment] -> [Fragment] -> [Fragment]
shiftAll !Int
off [Fragment]
frags [Fragment]
rest = case [Fragment]
frags of
      [] -> [Fragment]
rest
      Fragment
f : [Fragment]
fs -> let !more :: [Fragment]
more = Int -> [Fragment] -> [Fragment] -> [Fragment]
shiftAll Int
off [Fragment]
fs [Fragment]
rest; !f' :: Fragment
f' = Int -> Fragment -> Fragment
shift Int
off Fragment
f in Fragment
f' Fragment -> [Fragment] -> [Fragment]
forall a. a -> [a] -> [a]
: [Fragment]
more
    shift :: Int -> Fragment -> Fragment
shift Int
0 Fragment
f = Fragment
f
    shift Int
off (Placeholder Int
n) = Int -> Fragment
Placeholder (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off)
    shift Int
_ Fragment
f = Fragment
f

-- | The parameters of the whole query, in order.
queryParams :: Query -> [QueryParam]
queryParams :: Query -> [QueryParam]
queryParams Query
q = Query -> [QueryParam] -> [QueryParam]
go Query
q []
  where
    go :: Query -> [QueryParam] -> [QueryParam]
go (Query Int
_ Node
node) [QueryParam]
rest = case Node
node of
      Node
Empty -> [QueryParam]
rest
      Piece [Fragment]
_ [QueryParam]
params -> [QueryParam]
params [QueryParam] -> [QueryParam] -> [QueryParam]
forall a. [a] -> [a] -> [a]
++ [QueryParam]
rest
      Append Query
l Query
r -> Query -> [QueryParam] -> [QueryParam]
go Query
l (Query -> [QueryParam] -> [QueryParam]
go Query
r [QueryParam]
rest)

-- | The SQL text as it is sent, with @\@pN@ for the placeholders.
--
-- A placeholder next to a character that could continue a variable name
-- gets a space between them: @\"x = \" <> param 1 <> \"1\"@ is sent as
-- @x = \@p1 1@, not @x = \@p11@ (another parameter), and @\"N\" <> param s@
-- as @N \@p1@, not the identifier @N\@p1@.
queryText :: Query -> Text
queryText :: Query -> Text
queryText = [Fragment] -> Text
renderFragments ([Fragment] -> Text) -> (Query -> [Fragment]) -> Query -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> [Fragment]
queryFragments

-- | 'queryText' of the fragments: the static text as it is, each
-- placeholder as @\@pN@ with a space on either side where a variable-name
-- character would otherwise run into it, concatenated once.
renderFragments :: [Fragment] -> Text
renderFragments :: [Fragment] -> Text
renderFragments = \case
  [] -> Text
T.empty
  [Static Text
t] -> Text
t
  [Fragment]
frags -> [Text] -> Text
T.concat (Char -> [Fragment] -> [Text]
go Char
'\0' [Fragment]
frags)
  where
    -- @prev@ is the character before, or NUL at the start.
    go :: Char -> [Fragment] -> [Text]
go Char
_ [] = []
    go Char
prev (Fragment
f : [Fragment]
fs) = case Fragment
f of
      Static Text
t -> Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Char -> [Fragment] -> [Text]
go (if Text -> Bool
T.null Text
t then Char
prev else HasCallStack => Text -> Char
Text -> Char
T.last Text
t) [Fragment]
fs
      Placeholder Int
n ->
        (if Char -> Bool
isVariableChar Char
prev then [Text
" "] else [])
          [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Int -> Text
placeholderText Int
n
          Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (if [Fragment] -> Bool
spaceAfter [Fragment]
fs then [Text
" "] else [])
          [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Char -> [Fragment] -> [Text]
go Char
' ' [Fragment]
fs
    -- A space after a placeholder: before a character that could continue
    -- a variable name, or before another placeholder.
    spaceAfter :: [Fragment] -> Bool
spaceAfter = \case
      Static Text
t : [Fragment]
_ | Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
t -> Char -> Bool
isVariableChar Char
c
      Placeholder Int
_ : [Fragment]
_ -> Bool
True
      [Fragment]
_ -> Bool
False

-- | @\@p@ and the number, as 'queryText' writes a placeholder.
placeholderText :: Int -> Text
placeholderText :: Int -> Text
placeholderText Int
n = [Char] -> Text
T.pack (Char
'@' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'p' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)

-- | Why the query can't be sent, if it can't: a placeholder that refers to
-- a positional parameter it doesn't have.
queryProblem :: Query -> Maybe String
queryProblem :: Query -> Maybe [Char]
queryProblem Query
q = Int -> [Fragment] -> Maybe [Char]
fragmentsProblem (Query -> Int
queryPositional Query
q) (Query -> [Fragment]
queryFragments Query
q)

-- | 'queryProblem' of a query's fragments, given how many positional
-- parameters it has.
fragmentsProblem :: Int -> [Fragment] -> Maybe String
fragmentsProblem :: Int -> [Fragment] -> Maybe [Char]
fragmentsProblem Int
count [Fragment]
frags = case [Int
n | Placeholder Int
n <- [Fragment]
frags, Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
count] of
  [] -> Maybe [Char]
forall a. Maybe a
Nothing
  Int
n : [Int]
_ -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$
    [Char]
"the query refers to @p" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" but has "
      [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (case Int
count of
            Int
0 -> [Char]
"no positional parameters"
            Int
1 -> [Char]
"one positional parameter"
            Int
_ -> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
count [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" positional parameters")
      [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then [Char]
" (they are numbered from 1)" else [Char]
"")

------------------------------------------------------------------------------
-- Requests and responses

-- | A message to send: its packet type and its body, written for the
-- connection's context when it is sent.  'Hmssql.Query.queryRequest'
-- builds one from a 'Query'; 'Hmssql.Query.startResponse' and
-- 'Hmssql.Query.responseS' send one.
data Request = Request
  { Request -> PacketType
requestPacketType :: !PacketType
  , Request -> TdsContext -> PacketWriter -> IO ()
requestBody :: !(TdsContext -> PacketWriter -> IO ())
  , Request -> Maybe Text
requestStatement :: !(Maybe Text)
    -- ^ For error messages.
  }

-- | A response being read: the reader the query functions share, pulling
-- one step at a time ('Hmssql.Query.readStep') until 'StepEnd'.  ERROR
-- tokens are withheld (the first kept) and thrown as
-- 'Hmssql.Errors.SqlServerError' once the response is complete, so the
-- connection is never left mid-message; a DONE flagged as failed in a
-- response with no ERROR token is thrown as 'Hmssql.Errors.SevereError'
-- then.
--
-- Not a SQL cursor: it reads one response forwards, once.
data ResponseReader = ResponseReader
  { ResponseReader -> Connection
respConn :: !Connection
  , ResponseReader -> ActiveResponse
respActive :: !ActiveResponse
  , ResponseReader -> IORef (Maybe ServerMessage)
respFirstError :: !(IORef (Maybe ServerMessage))
  , ResponseReader -> IORef (Maybe Done)
respFailedDone :: !(IORef (Maybe Done))
  , ResponseReader -> IORef (Maybe Token)
respPushback :: !(IORef (Maybe Token))
    -- ^ A token read ahead, returned by the next 'Hmssql.Query.readStep'.
  , ResponseReader -> Maybe Text
respStatement :: !(Maybe Text)
  , ResponseReader -> IORef Bool
respEnded :: !(IORef Bool)
    -- ^ The response's end has been read: reading on would throw
    -- 'Hmssql.Errors.ResultAbandoned', so 'Hmssql.Query.drainResponse'
    -- stops here.
  , ResponseReader -> Maybe BatchScope
respBatch :: !(Maybe BatchScope)
    -- ^ Reading one statement of a batch query
    -- ('Hmssql.BatchQuery.BatchQuery'): 'StepEnd' at the statement's
    -- DONEPROC, and an ERROR ends the batch at once.
  }

-- | One result set of a response: its columns and its rows.
data ResultSet r = ResultSet
  { forall r. ResultSet r -> [ColumnInfo]
resultColumns :: ![ColumnInfo]
  , forall r. ResultSet r -> [r]
resultRows :: ![r]
  }
  deriving stock (ResultSet r -> ResultSet r -> Bool
(ResultSet r -> ResultSet r -> Bool)
-> (ResultSet r -> ResultSet r -> Bool) -> Eq (ResultSet r)
forall r. Eq r => ResultSet r -> ResultSet r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => ResultSet r -> ResultSet r -> Bool
== :: ResultSet r -> ResultSet r -> Bool
$c/= :: forall r. Eq r => ResultSet r -> ResultSet r -> Bool
/= :: ResultSet r -> ResultSet r -> Bool
Eq, (forall a b. (a -> b) -> ResultSet a -> ResultSet b)
-> (forall a b. a -> ResultSet b -> ResultSet a)
-> Functor ResultSet
forall a b. a -> ResultSet b -> ResultSet a
forall a b. (a -> b) -> ResultSet a -> ResultSet b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ResultSet a -> ResultSet b
fmap :: forall a b. (a -> b) -> ResultSet a -> ResultSet b
$c<$ :: forall a b. a -> ResultSet b -> ResultSet a
<$ :: forall a b. a -> ResultSet b -> ResultSet a
Functor)

instance Show r => Show (ResultSet r) where
  showsPrec :: Int -> ResultSet r -> ShowS
showsPrec Int
p (ResultSet [ColumnInfo]
a [r]
b) =
    Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ResultSet"# [Addr#
"resultColumns"# Addr# -> [ColumnInfo] -> Field
forall a. Show a => Addr# -> a -> Field
:= [ColumnInfo]
a, Addr#
"resultRows"# Addr# -> [r] -> Field
forall a. Show a => Addr# -> a -> Field
:= [r]
b]
  {-# OPAQUE showsPrec #-}

-- | How to decode a response that holds several result sets, one at a
-- time in order, for 'Hmssql.Query.queryResultSets'.  Build one from
-- 'Hmssql.Query.resultSet' and 'Hmssql.Query.skipResultSet' with the
-- 'Applicative' or 'Monad' combinators; as a 'Monad', a later decoder may
-- depend on earlier rows.  Statements that produce no result set, such as
-- @DECLARE@, @SET@ and @UPDATE@, are skipped over.
--
-- > (parents, children) <- queryResultSets ((,) <$> resultSet <*> resultSet) conn
-- >   "SELECT id, name FROM dbo.parent; SELECT id, parent_id FROM dbo.child"
newtype ResultSets a = ResultSets
  { forall a. ResultSets a -> TdsContext -> ResponseReader -> IO a
runResultSets :: TdsContext -> ResponseReader -> IO a
  }

-- The instances run once per result set, so they are out of line: inlined, a
-- composition such as @(,) <$> resultSet <*> resultSet@ was its own copy of them
-- at each use.  A function calling 'Hmssql.Query.queryResultSets' with that
-- composition was 881 bytes of object code, and is 305 with these, 'resultSetWith'
-- and the 'Only' decoder out of line.
instance Functor ResultSets where
  fmap :: forall a b. (a -> b) -> ResultSets a -> ResultSets b
fmap a -> b
f (ResultSets TdsContext -> ResponseReader -> IO a
m) = (TdsContext -> ResponseReader -> IO b) -> ResultSets b
forall a. (TdsContext -> ResponseReader -> IO a) -> ResultSets a
ResultSets ((TdsContext -> ResponseReader -> IO b) -> ResultSets b)
-> (TdsContext -> ResponseReader -> IO b) -> ResultSets b
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ResponseReader
resp -> a -> b
f (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TdsContext -> ResponseReader -> IO a
m TdsContext
ctx ResponseReader
resp
  {-# NOINLINE fmap #-}

instance Applicative ResultSets where
  pure :: forall a. a -> ResultSets a
pure a
a = (TdsContext -> ResponseReader -> IO a) -> ResultSets a
forall a. (TdsContext -> ResponseReader -> IO a) -> ResultSets a
ResultSets ((TdsContext -> ResponseReader -> IO a) -> ResultSets a)
-> (TdsContext -> ResponseReader -> IO a) -> ResultSets a
forall a b. (a -> b) -> a -> b
$ \TdsContext
_ ResponseReader
_ -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  ResultSets (a -> b)
mf <*> :: forall a b. ResultSets (a -> b) -> ResultSets a -> ResultSets b
<*> ResultSets a
ma = ResultSets (a -> b)
mf ResultSets (a -> b) -> ((a -> b) -> ResultSets b) -> ResultSets b
forall a b. ResultSets a -> (a -> ResultSets b) -> ResultSets b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
f -> (a -> b) -> ResultSets a -> ResultSets b
forall a b. (a -> b) -> ResultSets a -> ResultSets b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ResultSets a
ma
  {-# NOINLINE (<*>) #-}
  liftA2 :: forall a b c.
(a -> b -> c) -> ResultSets a -> ResultSets b -> ResultSets c
liftA2 a -> b -> c
f ResultSets a
ma ResultSets b
mb = ResultSets a
ma ResultSets a -> (a -> ResultSets c) -> ResultSets c
forall a b. ResultSets a -> (a -> ResultSets b) -> ResultSets b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> (b -> c) -> ResultSets b -> ResultSets c
forall a b. (a -> b) -> ResultSets a -> ResultSets b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
a) ResultSets b
mb
  {-# NOINLINE liftA2 #-}

instance Monad ResultSets where
  ResultSets TdsContext -> ResponseReader -> IO a
m >>= :: forall a b. ResultSets a -> (a -> ResultSets b) -> ResultSets b
>>= a -> ResultSets b
k = (TdsContext -> ResponseReader -> IO b) -> ResultSets b
forall a. (TdsContext -> ResponseReader -> IO a) -> ResultSets a
ResultSets ((TdsContext -> ResponseReader -> IO b) -> ResultSets b)
-> (TdsContext -> ResponseReader -> IO b) -> ResultSets b
forall a b. (a -> b) -> a -> b
$ \TdsContext
ctx ResponseReader
resp -> do
    a <- TdsContext -> ResponseReader -> IO a
m TdsContext
ctx ResponseReader
resp
    runResultSets (k a) ctx resp
  {-# NOINLINE (>>=) #-}

-- | What bounds a 'ResponseReader' to one statement of a batch.
data BatchScope = BatchScope
  { BatchScope -> IORef Bool
scopeEnded :: !(IORef Bool)
    -- ^ The statement's DONEPROC has been returned.
  , BatchScope -> IORef Text
scopeStatement :: !(IORef Text)
    -- ^ The statement's text, for its error.
  , BatchScope -> ServerMessage -> IO Void
scopeFail :: ServerMessage -> IO Void
    -- ^ An ERROR token arrived: read the rest of the batch, then throw.
  }