-- | The pure conversions of SQL Server's scalar values, and the type checks
-- the field decoders make.
--
-- A reader is given exactly its value's bytes, whether they lay in one packet
-- or several, so it knows nothing about packets, and a wrong length is an
-- ordinary 'Left'.  Offsets into the bytes stay inside this module.
module Hmssql.Tds.Scalar
  ( -- * Scalar value readers
    integerValue, integerAt, bitValue, readFloating, float32Value
  , decimalValue, dayTimeValue, localTimeValue
  , SelectedReader (..), selectSqlValueReader, readSqlVariant
    -- * Character values
  , columnTextDecoder, decodeColumnText, textValue
  , TextEncoding (..), textEncodingOf, ansiCollation
    -- * Type selection and errors
  , hasDataType, rejectAs, unsupportedUdt
  , isIntegerType, unsignedByteType, isFloatType
  , isDecimalType, isMoneyType
  , isUnicodeType, isAnsiType, isBinaryType
  , isLocalTimeType, isDateTimeOffsetType
  ) where

import qualified Data.ByteString as B
import Data.Decimal (Decimal, DecimalRaw (..))
import Data.Fixed (Fixed (..))
import Data.Int (Int64)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time
import GHC.Float (castWord32ToFloat, castWord64ToDouble, float2Double)
import Hmssql.SqlValue
import Hmssql.Internal.SqlDataType (SqlDataType (..), typeInfoDataType)
import Hmssql.Tds.Bytes
import Hmssql.Tds.CodePage (TextCodec, collationCodec, collationTextDecoder, decodeCodec)
import Hmssql.Tds.Context
import Hmssql.Tds.Primitives
import Hmssql.Tds.TypeInfo
import qualified Hmssql.Tds.Utf16 as Utf16

-- | The integer types and @bit@.
isIntegerType :: TypeInfo -> Bool
isIntegerType :: TypeInfo -> Bool
isIntegerType = (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType ((SqlDataType -> Bool) -> TypeInfo -> Bool)
-> (SqlDataType -> Bool) -> TypeInfo -> Bool
forall a b. (a -> b) -> a -> b
$ \case
  SqlDataType
TyTinyInt -> Bool
True
  SqlDataType
TySmallInt -> Bool
True
  SqlDataType
TyInt -> Bool
True
  SqlDataType
TyBigInt -> Bool
True
  SqlDataType
TyBit -> Bool
True
  SqlDataType
_ -> Bool
False

-- | The value of an integer-typed column ('isIntegerType').  Integers
-- arrive as 1, 2, 4 or 8 little-endian bytes; the value's own length is
-- authoritative.  A @tinyint@ is unsigned on the wire.
integerValue :: TypeInfo -> ValueReader Int64
integerValue :: TypeInfo -> ValueReader Int64
integerValue TypeInfo
ti = case TypeInfo
ti of
  TypeInfo
TIInt1 -> Bool -> ValueReader Int64
integerAt Bool
True
  TIIntN Word8
1 -> Bool -> ValueReader Int64
integerAt Bool
True
  TypeInfo
_ -> Bool -> ValueReader Int64
integerAt Bool
False
{-# INLINE integerValue #-}

-- | 'integerValue', given whether a one-byte value is unsigned.
integerAt :: Bool -> ValueReader Int64
integerAt :: Bool -> ValueReader Int64
integerAt Bool
unsignedByte ByteString
bs = case ByteString -> Int
B.length ByteString
bs of
  Int
1 | Bool
unsignedByte -> Int64 -> Either [Char] Int64
forall a b. b -> Either a b
Right (Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
word8At ByteString
bs Int
0))
    | Bool
otherwise -> Int64 -> Either [Char] Int64
forall a b. b -> Either a b
Right (Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Int8
int8At ByteString
bs Int
0))
  Int
n | Bool
unsignedByte -> [Char] -> Either [Char] Int64
forall a b. a -> Either a b
Left ([Char] -> Int -> [Char]
invalidLength [Char]
"tinyint" Int
n)
  Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 -> Int64 -> Either [Char] Int64
forall a b. b -> Either a b
Right (ByteString -> Int64
signedIntegerAt ByteString
bs)
  Int
n -> [Char] -> Either [Char] Int64
forall a b. a -> Either a b
Left ([Char] -> Int -> [Char]
invalidLength [Char]
"integer" Int
n)
{-# INLINE integerAt #-}

-- The caller has checked the length.  The three signed widths are read out of
-- line, so that every built-in integer row decoder calls this one reader rather
-- than inlining a copy of the three: 4,160 bytes less of code, and the same
-- allocation in every typed decoding benchmark, because the worker takes the
-- slice's fields and returns the 'Int64' unboxed (GHC 9.12.4, 2026-11-04).
signedIntegerAt :: B.ByteString -> Int64
signedIntegerAt :: ByteString -> Int64
signedIntegerAt ByteString
bs = case ByteString -> Int
B.length ByteString
bs of
  Int
2 -> Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Int16
int16LeAt ByteString
bs Int
0)
  Int
4 -> Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Int32
int32LeAt ByteString
bs Int
0)
  Int
_ -> ByteString -> Int -> Int64
int64LeAt ByteString
bs Int
0
{-# NOINLINE signedIntegerAt #-}

-- Out of line, so that a copy of 'integerAt' doesn't hold the message's 'show'.
invalidLength :: String -> Int -> String
invalidLength :: [Char] -> Int -> [Char]
invalidLength [Char]
what Int
n = [Char]
"invalid " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
what [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" length " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
{-# NOINLINE invalidLength #-}

-- | Whether an integer type's one-byte values are unsigned (@tinyint@).
unsignedByteType :: TypeInfo -> Bool
unsignedByteType :: TypeInfo -> Bool
unsignedByteType = \case
  TypeInfo
TIInt1 -> Bool
True
  TIIntN Word8
1 -> Bool
True
  TypeInfo
_ -> Bool
False

-- | @bit@.
bitValue :: ValueReader Bool
bitValue :: ValueReader Bool
bitValue ByteString
bs
  | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Bool -> Either [Char] Bool
forall a b. b -> Either a b
Right (ByteString -> Int -> Word8
word8At ByteString
bs Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
  | Bool
otherwise = [Char] -> Either [Char] Bool
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Bool) -> [Char] -> Either [Char] Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid bit length " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
B.length ByteString
bs)

-- | @float@ and @real@.
isFloatType :: TypeInfo -> Bool
isFloatType :: TypeInfo -> Bool
isFloatType = (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType ((SqlDataType -> Bool) -> TypeInfo -> Bool)
-> (SqlDataType -> Bool) -> TypeInfo -> Bool
forall a b. (a -> b) -> a -> b
$ \case
  SqlDataType
TyFloat -> Bool
True
  SqlDataType
TyReal -> Bool
True
  SqlDataType
_ -> Bool
False

-- | @real@ or @float@, by the value's length.
readFloating :: ValueReader Double
readFloating :: ValueReader Double
readFloating ByteString
bs = case ByteString -> Int
B.length ByteString
bs of
  Int
4 -> Double -> Either [Char] Double
forall a b. b -> Either a b
Right (Float -> Double
float2Double (ByteString -> Float
float4At ByteString
bs))
  Int
8 -> Double -> Either [Char] Double
forall a b. b -> Either a b
Right (ByteString -> Double
float8At ByteString
bs)
  Int
n -> [Char] -> Either [Char] Double
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Double) -> [Char] -> Either [Char] Double
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid float length " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n

-- | @real@; a @float@ value is refused rather than narrowed.
float32Value :: ValueReader Float
float32Value :: ValueReader Float
float32Value ByteString
bs
  | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Float -> Either [Char] Float
forall a b. b -> Either a b
Right (ByteString -> Float
float4At ByteString
bs)
  | Bool
otherwise = [Char] -> Either [Char] Float
forall a b. a -> Either a b
Left [Char]
"float(53) cannot be decoded as Float without losing precision; use Double"

float4At :: B.ByteString -> Float
float4At :: ByteString -> Float
float4At ByteString
bs = Word32 -> Float
castWord32ToFloat (ByteString -> Int -> Word32
word32LeAt ByteString
bs Int
0)

float8At :: B.ByteString -> Double
float8At :: ByteString -> Double
float8At ByteString
bs = Word64 -> Double
castWord64ToDouble (ByteString -> Int -> Word64
word64LeAt ByteString
bs Int
0)

-- | @decimal@ and @numeric@.
isDecimalType :: TypeInfo -> Bool
isDecimalType :: TypeInfo -> Bool
isDecimalType = (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType ((SqlDataType -> Bool) -> TypeInfo -> Bool)
-> (SqlDataType -> Bool) -> TypeInfo -> Bool
forall a b. (a -> b) -> a -> b
$ \case
  SqlDataType
TyDecimal -> Bool
True
  SqlDataType
TyNumeric -> Bool
True
  SqlDataType
_ -> Bool
False

-- | @money@ and @smallmoney@.
isMoneyType :: TypeInfo -> Bool
isMoneyType :: TypeInfo -> Bool
isMoneyType = (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType ((SqlDataType -> Bool) -> TypeInfo -> Bool)
-> (SqlDataType -> Bool) -> TypeInfo -> Bool
forall a b. (a -> b) -> a -> b
$ \case
  SqlDataType
TyMoney -> Bool
True
  SqlDataType
TySmallMoney -> Bool
True
  SqlDataType
_ -> Bool
False

-- | A @decimal@ or @numeric@ at the type's precision and scale, a @money@
-- type, or an integer type, as a 'Decimal'.
decimalValue :: TypeInfo -> ValueReader Decimal
decimalValue :: TypeInfo -> ValueReader Decimal
decimalValue TypeInfo
ti = case TypeInfo
ti of
  TIDecimalN Word8
p Word8
s -> Word8 -> Word8 -> ValueReader Decimal
readDecimal Word8
p Word8
s
  TINumericN Word8
p Word8
s -> Word8 -> Word8 -> ValueReader Decimal
readDecimal Word8
p Word8
s
  TypeInfo
_ | TypeInfo -> Bool
isMoneyType TypeInfo
ti -> \ByteString
bs -> Money -> Decimal
moneyToDecimal (Money -> Decimal) -> Either [Char] Money -> Either [Char] Decimal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueReader Money
readMoney ByteString
bs
  TypeInfo
_ | TypeInfo -> Bool
isIntegerType TypeInfo
ti -> \ByteString
bs -> do
        i <- TypeInfo -> ValueReader Int64
integerValue TypeInfo
ti ByteString
bs
        Right $! Decimal 0 (toInteger i)
  TypeInfo
_ -> \ByteString
_ -> [Char] -> Either [Char] Decimal
forall a b. a -> Either a b
Left [Char]
"not a decimal type"
  where
    moneyToDecimal :: Money -> Decimal
moneyToDecimal (Money (MkFixed Integer
i)) = Word8 -> Integer -> Decimal
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
4 Integer
i
{-# INLINE decimalValue #-}

-- | The UTF-16 character types, @xml@ included; the single-byte character
-- types; and the binary types.
isUnicodeType, isAnsiType, isBinaryType :: TypeInfo -> Bool
isUnicodeType :: TypeInfo -> Bool
isUnicodeType = (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType ((SqlDataType -> Bool) -> TypeInfo -> Bool)
-> (SqlDataType -> Bool) -> TypeInfo -> Bool
forall a b. (a -> b) -> a -> b
$ \case
  SqlDataType
TyNChar -> Bool
True
  SqlDataType
TyNVarChar -> Bool
True
  SqlDataType
TyNText -> Bool
True
  SqlDataType
TyXml -> Bool
True
  SqlDataType
_ -> Bool
False
isAnsiType :: TypeInfo -> Bool
isAnsiType = (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType ((SqlDataType -> Bool) -> TypeInfo -> Bool)
-> (SqlDataType -> Bool) -> TypeInfo -> Bool
forall a b. (a -> b) -> a -> b
$ \case
  SqlDataType
TyChar -> Bool
True
  SqlDataType
TyVarChar -> Bool
True
  SqlDataType
TyText -> Bool
True
  SqlDataType
_ -> Bool
False
isBinaryType :: TypeInfo -> Bool
isBinaryType = (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType ((SqlDataType -> Bool) -> TypeInfo -> Bool)
-> (SqlDataType -> Bool) -> TypeInfo -> Bool
forall a b. (a -> b) -> a -> b
$ \case
  SqlDataType
TyBinary -> Bool
True
  SqlDataType
TyVarBinary -> Bool
True
  SqlDataType
TyImage -> Bool
True
  SqlDataType
_ -> Bool
False

-- | Compile a decoder for a character column.  Unicode types are UTF-16LE.
-- Single-byte types are decoded according to their collation's code page
-- (see "Hmssql.Tds.CodePage"); a collation whose code page hmssql can't
-- decode (a double-byte code page, or an unknown collation) is rejected.
columnTextDecoder :: TypeInfo -> Either String (ValueReader Text)
columnTextDecoder :: TypeInfo -> Either [Char] (ValueReader Text)
columnTextDecoder TypeInfo
ti = case TypeInfo
ti of
  TIBigChar Word16
_ Collation
c -> Collation -> Either [Char] (ValueReader Text)
collationTextDecoder Collation
c
  TIBigVarChar Word16
_ Collation
c -> Collation -> Either [Char] (ValueReader Text)
collationTextDecoder Collation
c
  TIText Word32
_ Collation
c -> Collation -> Either [Char] (ValueReader Text)
collationTextDecoder Collation
c
  TypeInfo
_ | TypeInfo -> Bool
isUnicodeType TypeInfo
ti -> ValueReader Text -> Either [Char] (ValueReader Text)
forall a b. b -> Either a b
Right ValueReader Text
forall {a}. ByteString -> Either a Text
utf16
  TypeInfo
_ -> [Char] -> Either [Char] (ValueReader Text)
forall a b. a -> Either a b
Left [Char]
"not a character type"
  where
    utf16 :: ByteString -> Either a Text
utf16 ByteString
bs = Text -> Either a Text
forall a b. b -> Either a b
Right (ByteString -> Text
Utf16.decodeUtf16LE ByteString
bs)

-- | The collation of a single-byte character type.
ansiCollation :: TypeInfo -> Maybe Collation
ansiCollation :: TypeInfo -> Maybe Collation
ansiCollation = \case
  TIBigChar Word16
_ Collation
c -> Collation -> Maybe Collation
forall a. a -> Maybe a
Just Collation
c
  TIBigVarChar Word16
_ Collation
c -> Collation -> Maybe Collation
forall a. a -> Maybe a
Just Collation
c
  TIText Word32
_ Collation
c -> Collation -> Maybe Collation
forall a. a -> Maybe a
Just Collation
c
  TypeInfo
_ -> Maybe Collation
forall a. Maybe a
Nothing

-- | Decode a character value; see 'columnTextDecoder'.
decodeColumnText :: TypeInfo -> B.ByteString -> Either String Text
decodeColumnText :: TypeInfo -> ValueReader Text
decodeColumnText TypeInfo
ti ByteString
bs = TypeInfo -> Either [Char] (ValueReader Text)
columnTextDecoder TypeInfo
ti Either [Char] (ValueReader Text)
-> (ValueReader Text -> Either [Char] Text) -> Either [Char] Text
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
>>= \ValueReader Text
decode -> ValueReader Text
decode ByteString
bs

isTextual :: TypeInfo -> Bool
isTextual :: TypeInfo -> Bool
isTextual TypeInfo
ti = TypeInfo -> Bool
isUnicodeType TypeInfo
ti Bool -> Bool -> Bool
|| TypeInfo -> Bool
isAnsiType TypeInfo
ti

-- | How a character column's values are encoded: UTF-16LE, or a
-- single-byte code page's codec, chosen by the collation once per column.
data TextEncoding = TextUtf16 | TextCodec !TextCodec
-- Two constructors, so that the 'Text' reader is a @case@ between two known
-- decoders.

-- | The 'TextEncoding' of a character column, or why it can't be decoded
-- as 'Text' (not a character type, or a collation whose code page hmssql
-- can't decode).
textEncodingOf :: TypeInfo -> Either String TextEncoding
textEncodingOf :: TypeInfo -> Either [Char] TextEncoding
textEncodingOf TypeInfo
ti
  | TypeInfo -> Bool
isUnicodeType TypeInfo
ti = TextEncoding -> Either [Char] TextEncoding
forall a b. b -> Either a b
Right TextEncoding
TextUtf16
  | Just Collation
c <- TypeInfo -> Maybe Collation
ansiCollation TypeInfo
ti = TextCodec -> TextEncoding
TextCodec (TextCodec -> TextEncoding)
-> Either [Char] TextCodec -> Either [Char] TextEncoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Collation -> Either [Char] TextCodec
collationCodec Collation
c
  | Bool
otherwise = [Char] -> Either [Char] TextEncoding
forall a b. a -> Either a b
Left ([Char] -> TypeInfo -> [Char]
rejectAs [Char]
"Text" TypeInfo
ti)

-- | A character value as 'Text', in the column's encoding.
textValue :: TextEncoding -> ValueReader Text
textValue :: TextEncoding -> ValueReader Text
textValue TextEncoding
TextUtf16 ByteString
bs = Text -> Either [Char] Text
forall a b. b -> Either a b
Right (Text -> Either [Char] Text) -> Text -> Either [Char] Text
forall a b. (a -> b) -> a -> b
$! ByteString -> Text
Utf16.decodeUtf16LE ByteString
bs
textValue (TextCodec TextCodec
codec) ByteString
bs = Text -> Either [Char] Text
forall a b. b -> Either a b
Right (Text -> Either [Char] Text) -> Text -> Either [Char] Text
forall a b. (a -> b) -> a -> b
$! TextCodec -> ByteString -> Text
decodeCodec TextCodec
codec ByteString
bs

-- | A date-and-time type's value, given to the function as the day and the
-- picoseconds since midnight.
dayTimeValue :: (Day -> Int64 -> a) -> TypeInfo -> ValueReader a
dayTimeValue :: forall a. (Day -> Int64 -> a) -> TypeInfo -> ValueReader a
dayTimeValue Day -> Int64 -> a
k TypeInfo
ti = case TypeInfo
ti of
  TypeInfo
TIDateTime4 -> (Day -> Int64 -> a) -> ValueReader a
forall a. (Day -> Int64 -> a) -> ValueReader a
readDateTime4With Day -> Int64 -> a
k
  TypeInfo
TIDateTime8 -> (Day -> Int64 -> a) -> ValueReader a
forall a. (Day -> Int64 -> a) -> ValueReader a
readDateTime8With Day -> Int64 -> a
k
  TIDateTimeN Word8
_ -> \ByteString
bs -> case ByteString -> Int
B.length ByteString
bs of
    Int
4 -> (Day -> Int64 -> a) -> ValueReader a
forall a. (Day -> Int64 -> a) -> ValueReader a
readDateTime4With Day -> Int64 -> a
k ByteString
bs
    Int
8 -> (Day -> Int64 -> a) -> ValueReader a
forall a. (Day -> Int64 -> a) -> ValueReader a
readDateTime8With Day -> Int64 -> a
k ByteString
bs
    Int
n -> [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]
"invalid datetime length " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
  TIDateTime2N Word8
s -> (Day -> Int64 -> a) -> Word8 -> ValueReader a
forall a. (Day -> Int64 -> a) -> Word8 -> ValueReader a
readDateTime2With Day -> Int64 -> a
k Word8
s
  TypeInfo
TIDateN -> (Day -> a) -> ValueReader a
forall a. (Day -> a) -> ValueReader a
readDateWith (Day -> Int64 -> a
`k` Int64
0)
  TypeInfo
_ -> \ByteString
_ -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
"not a datetime type"
{-# INLINE dayTimeValue #-}

-- | 'dayTimeValue' as a 'LocalTime'.
localTimeValue :: TypeInfo -> ValueReader LocalTime
localTimeValue :: TypeInfo -> ValueReader LocalTime
localTimeValue TypeInfo
ti = (Day -> Int64 -> LocalTime) -> TypeInfo -> ValueReader LocalTime
forall a. (Day -> Int64 -> a) -> TypeInfo -> ValueReader a
dayTimeValue Day -> Int64 -> LocalTime
localTimeOf TypeInfo
ti
{-# INLINE localTimeValue #-}

-- | The date and time types without an offset, @date@ included.
isLocalTimeType :: TypeInfo -> Bool
isLocalTimeType :: TypeInfo -> Bool
isLocalTimeType = (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType ((SqlDataType -> Bool) -> TypeInfo -> Bool)
-> (SqlDataType -> Bool) -> TypeInfo -> Bool
forall a b. (a -> b) -> a -> b
$ \case
  SqlDataType
TyDateTime -> Bool
True
  SqlDataType
TySmallDateTime -> Bool
True
  SqlDataType
TyDateTime2 -> Bool
True
  SqlDataType
TyDate -> Bool
True
  SqlDataType
_ -> Bool
False

-- | @datetimeoffset@.
isDateTimeOffsetType :: TypeInfo -> Bool
isDateTimeOffsetType :: TypeInfo -> Bool
isDateTimeOffsetType = (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType (SqlDataType -> SqlDataType -> Bool
forall a. Eq a => a -> a -> Bool
== SqlDataType
TyDateTimeOffset)

-- | The 'SqlValue' reader of a column's type, which 'selectSqlValueReader'
-- chooses once per column.
data SelectedReader = SelectedReader !(ValueReader SqlValue)
-- Data, not a function, on purpose.  A function that returns a function after
-- a @case@ can be eta-expanded by GHC, and the type switch with its guards
-- would then run for every cell.  Returning a constructor makes the selection
-- finish first, so it runs once per column.

-- | The reader of a column's values as 'SqlValue', by the column's type; for
-- a type it can't decode, a reader that fails on every value.
selectSqlValueReader :: TdsContext -> TypeInfo -> SelectedReader
selectSqlValueReader :: TdsContext -> TypeInfo -> SelectedReader
selectSqlValueReader TdsContext
ctx TypeInfo
ti = case TypeInfo
ti of
  TypeInfo
TINull -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
_ -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right SqlValue
SqlNull)
  TypeInfo
TIBit -> ValueReader SqlValue -> SelectedReader
SelectedReader ValueReader SqlValue
bool
  TypeInfo
TIBitN -> ValueReader SqlValue -> SelectedReader
SelectedReader ValueReader SqlValue
bool
  TypeInfo
TIInt1 -> ValueReader SqlValue -> SelectedReader
SelectedReader (Int -> [Char] -> (ByteString -> SqlValue) -> ValueReader SqlValue
fixed Int
1 [Char]
"tinyint" (\ByteString
bs -> Word8 -> SqlValue
SqlWord8 (ByteString -> Int -> Word8
word8At ByteString
bs Int
0)))
  TypeInfo
TIInt2 -> ValueReader SqlValue -> SelectedReader
SelectedReader (Int -> [Char] -> (ByteString -> SqlValue) -> ValueReader SqlValue
fixed Int
2 [Char]
"smallint" (\ByteString
bs -> Int16 -> SqlValue
SqlInt16 (ByteString -> Int -> Int16
int16LeAt ByteString
bs Int
0)))
  TypeInfo
TIInt4 -> ValueReader SqlValue -> SelectedReader
SelectedReader (Int -> [Char] -> (ByteString -> SqlValue) -> ValueReader SqlValue
fixed Int
4 [Char]
"int" (\ByteString
bs -> Int32 -> SqlValue
SqlInt32 (ByteString -> Int -> Int32
int32LeAt ByteString
bs Int
0)))
  TypeInfo
TIInt8 -> ValueReader SqlValue -> SelectedReader
SelectedReader (Int -> [Char] -> (ByteString -> SqlValue) -> ValueReader SqlValue
fixed Int
8 [Char]
"bigint" (\ByteString
bs -> Int64 -> SqlValue
SqlInt64 (ByteString -> Int -> Int64
int64LeAt ByteString
bs Int
0)))
  TIIntN Word8
_ -> ValueReader SqlValue -> SelectedReader
SelectedReader (ValueReader SqlValue -> SelectedReader)
-> ValueReader SqlValue -> SelectedReader
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> case ByteString -> Int
B.length ByteString
bs of
    Int
1 -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (Word8 -> SqlValue
SqlWord8 (ByteString -> Int -> Word8
word8At ByteString
bs Int
0))
    Int
2 -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (Int16 -> SqlValue
SqlInt16 (ByteString -> Int -> Int16
int16LeAt ByteString
bs Int
0))
    Int
4 -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (Int32 -> SqlValue
SqlInt32 (ByteString -> Int -> Int32
int32LeAt ByteString
bs Int
0))
    Int
8 -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (Int64 -> SqlValue
SqlInt64 (ByteString -> Int -> Int64
int64LeAt ByteString
bs Int
0))
    Int
n -> [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SqlValue)
-> [Char] -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid integer length " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
  TypeInfo
TIFlt4 -> ValueReader SqlValue -> SelectedReader
SelectedReader (Int -> [Char] -> (ByteString -> SqlValue) -> ValueReader SqlValue
fixed Int
4 [Char]
"real" (\ByteString
bs -> Float -> SqlValue
SqlFloat (ByteString -> Float
float4At ByteString
bs)))
  TypeInfo
TIFlt8 -> ValueReader SqlValue -> SelectedReader
SelectedReader (Int -> [Char] -> (ByteString -> SqlValue) -> ValueReader SqlValue
fixed Int
8 [Char]
"float" (\ByteString
bs -> Double -> SqlValue
SqlDouble (ByteString -> Double
float8At ByteString
bs)))
  TIFltN Word8
_ -> ValueReader SqlValue -> SelectedReader
SelectedReader (ValueReader SqlValue -> SelectedReader)
-> ValueReader SqlValue -> SelectedReader
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> case ByteString -> Int
B.length ByteString
bs of
    Int
4 -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (Float -> SqlValue
SqlFloat (ByteString -> Float
float4At ByteString
bs))
    Int
8 -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (Double -> SqlValue
SqlDouble (ByteString -> Double
float8At ByteString
bs))
    Int
n -> [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SqlValue)
-> [Char] -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid float length " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
  TypeInfo
_ | TypeInfo -> Bool
isMoneyType TypeInfo
ti -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> Money -> SqlValue
SqlMoney (Money -> SqlValue)
-> Either [Char] Money -> Either [Char] SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueReader Money
readMoney ByteString
bs)
  TypeInfo
_ | TypeInfo -> Bool
isDecimalType TypeInfo
ti -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> Decimal -> SqlValue
SqlDecimal (Decimal -> SqlValue)
-> Either [Char] Decimal -> Either [Char] SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeInfo -> ValueReader Decimal
decimalValue TypeInfo
ti ByteString
bs)
  TypeInfo
TIGuid -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> UUID -> SqlValue
SqlGuid (UUID -> SqlValue) -> Either [Char] UUID -> Either [Char] SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueReader UUID
readGuid ByteString
bs)
  TypeInfo
TIDateN -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> Day -> SqlValue
SqlDate (Day -> SqlValue) -> Either [Char] Day -> Either [Char] SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueReader Day
readDate ByteString
bs)
  TITimeN Word8
s -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> TimeOfDay -> SqlValue
SqlTime (TimeOfDay -> SqlValue)
-> Either [Char] TimeOfDay -> Either [Char] SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> ValueReader TimeOfDay
readTime Word8
s ByteString
bs)
  TIDateTimeOffsetN Word8
s -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> DateTimeOffset -> SqlValue
SqlDateTimeOffset (DateTimeOffset -> SqlValue)
-> Either [Char] DateTimeOffset -> Either [Char] SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> ValueReader DateTimeOffset
readDateTimeOffset Word8
s ByteString
bs)
  TypeInfo
_ | TypeInfo -> Bool
isLocalTimeType TypeInfo
ti -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> LocalTime -> SqlValue
SqlDateTime (LocalTime -> SqlValue)
-> Either [Char] LocalTime -> Either [Char] SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeInfo -> ValueReader LocalTime
localTimeValue TypeInfo
ti ByteString
bs)
  TIXml Maybe XmlSchema
_ -> (Text -> SqlValue) -> SelectedReader
text Text -> SqlValue
SqlXml
  TypeInfo
_ | TypeInfo -> Bool
isUnicodeType TypeInfo
ti -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (Text -> SqlValue
SqlText (ByteString -> Text
Utf16.decodeUtf16LE ByteString
bs)))
  TypeInfo
_ | Just Collation
c <- TypeInfo -> Maybe Collation
ansiCollation TypeInfo
ti -> case Collation -> Either [Char] TextCodec
collationCodec Collation
c of
        Right TextCodec
codec -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (Text -> SqlValue
SqlText (TextCodec -> ByteString -> Text
decodeCodec TextCodec
codec ByteString
bs)))
        Left [Char]
e -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
_ -> [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left [Char]
e)
  TypeInfo
_ | TypeInfo -> Bool
isTextual TypeInfo
ti -> (Text -> SqlValue) -> SelectedReader
text Text -> SqlValue
SqlText
  TypeInfo
_ | TypeInfo -> Bool
isBinaryType TypeInfo
ti -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (ByteString -> SqlValue
SqlBinary (ByteString -> ByteString
B.copy ByteString
bs)))
  TISqlVariant Word32
_ -> ValueReader SqlValue -> SelectedReader
SelectedReader (TdsContext -> ValueReader SqlValue
readSqlVariant TdsContext
ctx)
  TypeInfo
_ -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
_ -> [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SqlValue)
-> [Char] -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ [Char]
"unsupported type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TypeInfo -> [Char]
forall a. Show a => a -> [Char]
show TypeInfo
ti)
  where
    bool :: ValueReader SqlValue
bool ByteString
bs = Bool -> SqlValue
SqlBool (Bool -> SqlValue) -> Either [Char] Bool -> Either [Char] SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueReader Bool
bitValue ByteString
bs
    fixed :: Int -> String -> (B.ByteString -> SqlValue) -> ValueReader SqlValue
    fixed :: Int -> [Char] -> (ByteString -> SqlValue) -> ValueReader SqlValue
fixed Int
n [Char]
name ByteString -> SqlValue
f ByteString
bs
      | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = SqlValue -> Either [Char] SqlValue
forall a b. b -> Either a b
Right (ByteString -> SqlValue
f ByteString
bs)
      | Bool
otherwise = [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SqlValue)
-> [Char] -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" length " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
B.length ByteString
bs)
    text :: (Text -> SqlValue) -> SelectedReader
text Text -> SqlValue
mk = case TypeInfo -> Either [Char] (ValueReader Text)
columnTextDecoder TypeInfo
ti of
      Left [Char]
e -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
_ -> [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left [Char]
e)
      Right ValueReader Text
d -> ValueReader SqlValue -> SelectedReader
SelectedReader (\ByteString
bs -> Text -> SqlValue
mk (Text -> SqlValue) -> Either [Char] Text -> Either [Char] SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueReader Text
d ByteString
bs)

-- | MS-TDS 2.2.5.5.4 sql_variant: base type, property bytes, then the
-- value using the rest of the buffer.  The number of property bytes is
-- fixed by the base type.
readSqlVariant :: TdsContext -> ValueReader SqlValue
readSqlVariant :: TdsContext -> ValueReader SqlValue
readSqlVariant TdsContext
ctx ByteString
bs
  | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SqlValue)
-> [Char] -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ [Char]
"sql_variant: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
B.length ByteString
bs) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" bytes, no base type and property count"
  | Bool
otherwise = case Word8
baseType of
      Word8
0x24 -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIGuid
      Word8
0x32 -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIBit
      Word8
0x30 -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIInt1
      Word8
0x34 -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIInt2
      Word8
0x38 -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIInt4
      Word8
0x7F -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIInt8
      Word8
0x3D -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIDateTime8
      Word8
0x3A -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIDateTime4
      Word8
0x3B -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIFlt4
      Word8
0x3E -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIFlt8
      Word8
0x3C -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIMoney8
      Word8
0x7A -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIMoney4
      Word8
0x28 -> TypeInfo -> Either [Char] SqlValue
fixed TypeInfo
TIDateN
      Word8
0x29 -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
1 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word8 -> TypeInfo
TITimeN (ByteString -> Int -> Word8
word8At ByteString
props Int
0)
      Word8
0x2A -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
1 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word8 -> TypeInfo
TIDateTime2N (ByteString -> Int -> Word8
word8At ByteString
props Int
0)
      Word8
0x2B -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
1 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word8 -> TypeInfo
TIDateTimeOffsetN (ByteString -> Int -> Word8
word8At ByteString
props Int
0)
      Word8
0x6A -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
2 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word8 -> Word8 -> TypeInfo
TIDecimalN (ByteString -> Int -> Word8
word8At ByteString
props Int
0) (ByteString -> Int -> Word8
word8At ByteString
props Int
1)
      Word8
0x6C -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
2 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word8 -> Word8 -> TypeInfo
TINumericN (ByteString -> Int -> Word8
word8At ByteString
props Int
0) (ByteString -> Int -> Word8
word8At ByteString
props Int
1)
      Word8
0xAF -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
7 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word16 -> Collation -> TypeInfo
TIBigChar (ByteString -> Int -> Word16
word16LeAt ByteString
props Int
5) (ByteString -> Int -> Collation
collationAt ByteString
props Int
0)
      Word8
0xA7 -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
7 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word16 -> Collation -> TypeInfo
TIBigVarChar (ByteString -> Int -> Word16
word16LeAt ByteString
props Int
5) (ByteString -> Int -> Collation
collationAt ByteString
props Int
0)
      Word8
0xEF -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
7 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word16 -> Collation -> TypeInfo
TINChar (ByteString -> Int -> Word16
word16LeAt ByteString
props Int
5) (ByteString -> Int -> Collation
collationAt ByteString
props Int
0)
      Word8
0xE7 -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
7 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word16 -> Collation -> TypeInfo
TINVarChar (ByteString -> Int -> Word16
word16LeAt ByteString
props Int
5) (ByteString -> Int -> Collation
collationAt ByteString
props Int
0)
      Word8
0xAD -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
2 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word16 -> TypeInfo
TIBigBinary (ByteString -> Int -> Word16
word16LeAt ByteString
props Int
0)
      Word8
0xA5 -> Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
2 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (ByteString -> TypeInfo) -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ \ByteString
props -> Word16 -> TypeInfo
TIBigVarBinary (ByteString -> Int -> Word16
word16LeAt ByteString
props Int
0)
      Word8
t -> [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SqlValue)
-> [Char] -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ [Char]
"sql_variant: unsupported base type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
t
  where
    baseType :: Word8
baseType = ByteString -> Int -> Word8
word8At ByteString
bs Int
0
    propBytes :: Int
propBytes = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
word8At ByteString
bs Int
1) :: Int
    fixed :: TypeInfo -> Either [Char] SqlValue
fixed = Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
0 ((ByteString -> TypeInfo) -> Either [Char] SqlValue)
-> (TypeInfo -> ByteString -> TypeInfo)
-> TypeInfo
-> Either [Char] SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInfo -> ByteString -> TypeInfo
forall a b. a -> b -> a
const
    -- Parse the base type's properties from their own bounded value.
    withProps :: Int -> (B.ByteString -> TypeInfo) -> Either String SqlValue
    withProps :: Int -> (ByteString -> TypeInfo) -> Either [Char] SqlValue
withProps Int
n ByteString -> TypeInfo
typeFrom
      | Int
propBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n = [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SqlValue)
-> [Char] -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ [Char]
"sql_variant: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
propBytes [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" property bytes for base type "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
baseType [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", expected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
      | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n = [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SqlValue)
-> [Char] -> Either [Char] SqlValue
forall a b. (a -> b) -> a -> b
$ [Char]
"sql_variant: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
B.length ByteString
bs) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" bytes, at least " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" expected"
      | Just [Char]
e <- TypeInfo -> Maybe [Char]
typeInfoProblem TypeInfo
ti = [Char] -> Either [Char] SqlValue
forall a b. a -> Either a b
Left ([Char]
"sql_variant: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e)
      -- Selected per value: each sql_variant value names its own type.
      | Bool
otherwise = case TdsContext -> TypeInfo -> SelectedReader
selectSqlValueReader TdsContext
ctx TypeInfo
ti of
          SelectedReader ValueReader SqlValue
reader -> ValueReader SqlValue
reader (Int -> ByteString -> ByteString
B.drop (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) ByteString
bs)
      where
        ti :: TypeInfo
ti = ByteString -> TypeInfo
typeFrom (Int -> ByteString -> ByteString
B.take Int
n (Int -> ByteString -> ByteString
B.drop Int
2 ByteString
bs))

-- | Whether a wire type's SQL data type satisfies the predicate.
hasDataType :: (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType :: (SqlDataType -> Bool) -> TypeInfo -> Bool
hasDataType SqlDataType -> Bool
p = \TypeInfo
ti -> Bool -> (SqlDataType -> Bool) -> Maybe SqlDataType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False SqlDataType -> Bool
p (TypeInfo -> Maybe SqlDataType
typeInfoDataType TypeInfo
ti)
{-# INLINE hasDataType #-}

-- | The message for a column of a type the decoder of this name doesn't accept.
rejectAs :: String -> TypeInfo -> String
rejectAs :: [Char] -> TypeInfo -> [Char]
rejectAs [Char]
name TypeInfo
ti = case TypeInfo
ti of
  TIUdt UdtInfo
_ -> TypeInfo -> [Char] -> [Char]
unsupportedUdt TypeInfo
ti ([Char]
"as " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name)
  TypeInfo
_ -> [Char]
"SQL type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (TypeInfo -> Text
typeInfoSqlName TypeInfo
ti) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" cannot be decoded as " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name

-- | The message for a CLR user-defined type, which hmssql doesn't decode.
unsupportedUdt :: TypeInfo -> String -> String
unsupportedUdt :: TypeInfo -> [Char] -> [Char]
unsupportedUdt TypeInfo
ti [Char]
how =
  [Char]
"SQL type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (TypeInfo -> Text
typeInfoSqlName TypeInfo
ti) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is a CLR user-defined type, which hmssql does not decode "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
how [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"; convert it in the query (e.g. CAST(col AS varbinary(max)) or col.ToString()),"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" or read its serialized bytes as RawValue"