{-# LANGUAGE MagicHash #-}
-- | SQL Server's data types by name, as T-SQL and the catalog spell them:
-- @nvarchar(50)@, @decimal(10,2)@, @vector(3)@.  This is the vocabulary
-- for code that handles SQL generically, such as checking that a database
-- has the columns an application expects, generating record types from
-- tables, or serializing whatever a table holds; "Hmssql.Catalog" reads
-- these types from a database.
--
-- 'SqlDataType' is the closed list of the types a server ships with, so a
-- @case@ over it can be total, and a type this library doesn't know yet
-- makes a lookup return 'Nothing' rather than a catch-all constructor.
-- 'SqlType' adds a type's arguments: a length, a precision and scale, a
-- scale, a vector's dimensions or an @xml@ schema collection.
--
-- The wire has its own view of types, 'TypeInfo': the encodings values are
-- carried in, which name lengths in bytes and don't tell @json@ (sent as
-- @nvarchar(max)@), @vector@ (sent as @varchar@) or @rowversion@ (sent as
-- @binary(8)@) from what they are sent as.  'typeInfoSqlType' and
-- 'sqlTypeTypeInfo' go between the two views. 'columnSqlType' also uses
-- the column's user-type tag to recognize @rowversion@.
module Hmssql.SqlType
  ( -- * Data types
    SqlDataType (..)
  , dataTypeName
  , dataTypeFromName
  , TypeCategory (..)
  , dataTypeCategory

    -- * Types with their arguments
  , SqlType (..)
  , TypeArgs (..)
  , Length (..)
  , sqlTypeName
  , sqlTypeProblem

    -- * The wire's types
  , typeInfoDataType
  , typeInfoSqlType
  , sqlTypeTypeInfo
  , columnSqlType
  ) where

import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word16)
import GHC.Exts (Addr#, unpackCString#)

import Hmssql.Internal.Derived
import Hmssql.Internal.SqlDataType (SqlDataType (..), typeInfoDataType)
import Hmssql.Tds.Primitives (Collation (..), Precision, Scale)
import Hmssql.Tds.Token (ColumnInfo (..))
import Hmssql.Tds.TypeInfo

-- | The type's name in T-SQL and in @sys.types@, except that
-- 'TyRowVersion' is @rowversion@ (the catalog says @timestamp@, the older
-- name, which 'dataTypeFromName' accepts).
dataTypeName :: SqlDataType -> Text
dataTypeName :: SqlDataType -> Text
dataTypeName = \case
  SqlDataType
TyBit -> Addr# -> Text
literalName Addr#
"bit"#
  SqlDataType
TyTinyInt -> Addr# -> Text
literalName Addr#
"tinyint"#
  SqlDataType
TySmallInt -> Addr# -> Text
literalName Addr#
"smallint"#
  SqlDataType
TyInt -> Addr# -> Text
literalName Addr#
"int"#
  SqlDataType
TyBigInt -> Addr# -> Text
literalName Addr#
"bigint"#
  SqlDataType
TyDecimal -> Addr# -> Text
literalName Addr#
"decimal"#
  SqlDataType
TyNumeric -> Addr# -> Text
literalName Addr#
"numeric"#
  SqlDataType
TyMoney -> Addr# -> Text
literalName Addr#
"money"#
  SqlDataType
TySmallMoney -> Addr# -> Text
literalName Addr#
"smallmoney"#
  SqlDataType
TyFloat -> Addr# -> Text
literalName Addr#
"float"#
  SqlDataType
TyReal -> Addr# -> Text
literalName Addr#
"real"#
  SqlDataType
TyDate -> Addr# -> Text
literalName Addr#
"date"#
  SqlDataType
TyTime -> Addr# -> Text
literalName Addr#
"time"#
  SqlDataType
TyDateTime -> Addr# -> Text
literalName Addr#
"datetime"#
  SqlDataType
TySmallDateTime -> Addr# -> Text
literalName Addr#
"smalldatetime"#
  SqlDataType
TyDateTime2 -> Addr# -> Text
literalName Addr#
"datetime2"#
  SqlDataType
TyDateTimeOffset -> Addr# -> Text
literalName Addr#
"datetimeoffset"#
  SqlDataType
TyChar -> Addr# -> Text
literalName Addr#
"char"#
  SqlDataType
TyVarChar -> Addr# -> Text
literalName Addr#
"varchar"#
  SqlDataType
TyText -> Addr# -> Text
literalName Addr#
"text"#
  SqlDataType
TyNChar -> Addr# -> Text
literalName Addr#
"nchar"#
  SqlDataType
TyNVarChar -> Addr# -> Text
literalName Addr#
"nvarchar"#
  SqlDataType
TyNText -> Addr# -> Text
literalName Addr#
"ntext"#
  SqlDataType
TyBinary -> Addr# -> Text
literalName Addr#
"binary"#
  SqlDataType
TyVarBinary -> Addr# -> Text
literalName Addr#
"varbinary"#
  SqlDataType
TyImage -> Addr# -> Text
literalName Addr#
"image"#
  SqlDataType
TyUniqueIdentifier -> Addr# -> Text
literalName Addr#
"uniqueidentifier"#
  SqlDataType
TyRowVersion -> Addr# -> Text
literalName Addr#
"rowversion"#
  SqlDataType
TyXml -> Addr# -> Text
literalName Addr#
"xml"#
  SqlDataType
TySqlVariant -> Addr# -> Text
literalName Addr#
"sql_variant"#
  SqlDataType
TyJson -> Addr# -> Text
literalName Addr#
"json"#
  SqlDataType
TyVector -> Addr# -> Text
literalName Addr#
"vector"#
  SqlDataType
TyHierarchyId -> Addr# -> Text
literalName Addr#
"hierarchyid"#
  SqlDataType
TyGeometry -> Addr# -> Text
literalName Addr#
"geometry"#
  SqlDataType
TyGeography -> Addr# -> Text
literalName Addr#
"geography"#

-- The conversion of a name from its static bytes to 'Text' is compiled once here,
-- rather than inlined into each of the 35 alternatives as it was for 'Text'
-- literals: 4,568 bytes less of code (GHC 9.12.4, 2026-11-04).  Each alternative
-- is still a CAF, so a name is converted once and never allocated again.  The
-- names are ASCII, which is all 'unpackCString#' reads.
literalName :: Addr# -> Text
literalName :: Addr# -> Text
literalName Addr#
addr = [Char] -> Text
T.pack (Addr# -> [Char]
unpackCString# Addr#
addr)
{-# OPAQUE literalName #-}

-- | The type of a name as @sys.types@ or T-SQL spells it, ignoring case
-- and surrounding space: the inverse of 'dataTypeName', plus the aliases
-- @timestamp@ ('TyRowVersion') and @sysname@ ('TyNVarChar').  'Nothing'
-- for a user-defined type, and for a type newer than this library.
dataTypeFromName :: Text -> Maybe SqlDataType
dataTypeFromName :: Text -> Maybe SqlDataType
dataTypeFromName Text
name = Text -> Map Text SqlDataType -> Maybe SqlDataType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Text
T.toLower (Text -> Text
T.strip Text
name)) Map Text SqlDataType
namedTypes

namedTypes :: Map.Map Text SqlDataType
namedTypes :: Map Text SqlDataType
namedTypes = [(Text, SqlDataType)] -> Map Text SqlDataType
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, SqlDataType)] -> Map Text SqlDataType)
-> [(Text, SqlDataType)] -> Map Text SqlDataType
forall a b. (a -> b) -> a -> b
$
  (Text
"timestamp", SqlDataType
TyRowVersion) (Text, SqlDataType)
-> [(Text, SqlDataType)] -> [(Text, SqlDataType)]
forall a. a -> [a] -> [a]
: (Text
"sysname", SqlDataType
TyNVarChar) (Text, SqlDataType)
-> [(Text, SqlDataType)] -> [(Text, SqlDataType)]
forall a. a -> [a] -> [a]
:
  [(SqlDataType -> Text
dataTypeName SqlDataType
t, SqlDataType
t) | SqlDataType
t <- [SqlDataType
forall a. Bounded a => a
minBound .. SqlDataType
forall a. Bounded a => a
maxBound]]
{-# NOINLINE namedTypes #-}

-- | The groups of SQL Server's data type documentation.
data TypeCategory
  = ExactNumeric
  | ApproximateNumeric
  | DateAndTime
  | CharacterString          -- ^ single-byte: @char@, @varchar@, @text@
  | UnicodeCharacterString   -- ^ @nchar@, @nvarchar@, @ntext@
  | BinaryString             -- ^ @binary@, @varbinary@, @image@
  | OtherDataType            -- ^ @uniqueidentifier@, @rowversion@, @xml@, @sql_variant@, @json@, @vector@, the CLR types
  deriving stock (TypeCategory -> TypeCategory -> Bool
(TypeCategory -> TypeCategory -> Bool)
-> (TypeCategory -> TypeCategory -> Bool) -> Eq TypeCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeCategory -> TypeCategory -> Bool
== :: TypeCategory -> TypeCategory -> Bool
$c/= :: TypeCategory -> TypeCategory -> Bool
/= :: TypeCategory -> TypeCategory -> Bool
Eq, Eq TypeCategory
Eq TypeCategory =>
(TypeCategory -> TypeCategory -> Ordering)
-> (TypeCategory -> TypeCategory -> Bool)
-> (TypeCategory -> TypeCategory -> Bool)
-> (TypeCategory -> TypeCategory -> Bool)
-> (TypeCategory -> TypeCategory -> Bool)
-> (TypeCategory -> TypeCategory -> TypeCategory)
-> (TypeCategory -> TypeCategory -> TypeCategory)
-> Ord TypeCategory
TypeCategory -> TypeCategory -> Bool
TypeCategory -> TypeCategory -> Ordering
TypeCategory -> TypeCategory -> TypeCategory
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeCategory -> TypeCategory -> Ordering
compare :: TypeCategory -> TypeCategory -> Ordering
$c< :: TypeCategory -> TypeCategory -> Bool
< :: TypeCategory -> TypeCategory -> Bool
$c<= :: TypeCategory -> TypeCategory -> Bool
<= :: TypeCategory -> TypeCategory -> Bool
$c> :: TypeCategory -> TypeCategory -> Bool
> :: TypeCategory -> TypeCategory -> Bool
$c>= :: TypeCategory -> TypeCategory -> Bool
>= :: TypeCategory -> TypeCategory -> Bool
$cmax :: TypeCategory -> TypeCategory -> TypeCategory
max :: TypeCategory -> TypeCategory -> TypeCategory
$cmin :: TypeCategory -> TypeCategory -> TypeCategory
min :: TypeCategory -> TypeCategory -> TypeCategory
Ord, Int -> TypeCategory -> ShowS
[TypeCategory] -> ShowS
TypeCategory -> [Char]
(Int -> TypeCategory -> ShowS)
-> (TypeCategory -> [Char])
-> ([TypeCategory] -> ShowS)
-> Show TypeCategory
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeCategory -> ShowS
showsPrec :: Int -> TypeCategory -> ShowS
$cshow :: TypeCategory -> [Char]
show :: TypeCategory -> [Char]
$cshowList :: [TypeCategory] -> ShowS
showList :: [TypeCategory] -> ShowS
Show, ReadPrec [TypeCategory]
ReadPrec TypeCategory
Int -> ReadS TypeCategory
ReadS [TypeCategory]
(Int -> ReadS TypeCategory)
-> ReadS [TypeCategory]
-> ReadPrec TypeCategory
-> ReadPrec [TypeCategory]
-> Read TypeCategory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TypeCategory
readsPrec :: Int -> ReadS TypeCategory
$creadList :: ReadS [TypeCategory]
readList :: ReadS [TypeCategory]
$creadPrec :: ReadPrec TypeCategory
readPrec :: ReadPrec TypeCategory
$creadListPrec :: ReadPrec [TypeCategory]
readListPrec :: ReadPrec [TypeCategory]
Read, Int -> TypeCategory
TypeCategory -> Int
TypeCategory -> [TypeCategory]
TypeCategory -> TypeCategory
TypeCategory -> TypeCategory -> [TypeCategory]
TypeCategory -> TypeCategory -> TypeCategory -> [TypeCategory]
(TypeCategory -> TypeCategory)
-> (TypeCategory -> TypeCategory)
-> (Int -> TypeCategory)
-> (TypeCategory -> Int)
-> (TypeCategory -> [TypeCategory])
-> (TypeCategory -> TypeCategory -> [TypeCategory])
-> (TypeCategory -> TypeCategory -> [TypeCategory])
-> (TypeCategory -> TypeCategory -> TypeCategory -> [TypeCategory])
-> Enum TypeCategory
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TypeCategory -> TypeCategory
succ :: TypeCategory -> TypeCategory
$cpred :: TypeCategory -> TypeCategory
pred :: TypeCategory -> TypeCategory
$ctoEnum :: Int -> TypeCategory
toEnum :: Int -> TypeCategory
$cfromEnum :: TypeCategory -> Int
fromEnum :: TypeCategory -> Int
$cenumFrom :: TypeCategory -> [TypeCategory]
enumFrom :: TypeCategory -> [TypeCategory]
$cenumFromThen :: TypeCategory -> TypeCategory -> [TypeCategory]
enumFromThen :: TypeCategory -> TypeCategory -> [TypeCategory]
$cenumFromTo :: TypeCategory -> TypeCategory -> [TypeCategory]
enumFromTo :: TypeCategory -> TypeCategory -> [TypeCategory]
$cenumFromThenTo :: TypeCategory -> TypeCategory -> TypeCategory -> [TypeCategory]
enumFromThenTo :: TypeCategory -> TypeCategory -> TypeCategory -> [TypeCategory]
Enum, TypeCategory
TypeCategory -> TypeCategory -> Bounded TypeCategory
forall a. a -> a -> Bounded a
$cminBound :: TypeCategory
minBound :: TypeCategory
$cmaxBound :: TypeCategory
maxBound :: TypeCategory
Bounded)

-- | The group of SQL Server's documentation the type is listed under.
dataTypeCategory :: SqlDataType -> TypeCategory
dataTypeCategory :: SqlDataType -> TypeCategory
dataTypeCategory = \case
  SqlDataType
TyBit -> TypeCategory
ExactNumeric
  SqlDataType
TyTinyInt -> TypeCategory
ExactNumeric
  SqlDataType
TySmallInt -> TypeCategory
ExactNumeric
  SqlDataType
TyInt -> TypeCategory
ExactNumeric
  SqlDataType
TyBigInt -> TypeCategory
ExactNumeric
  SqlDataType
TyDecimal -> TypeCategory
ExactNumeric
  SqlDataType
TyNumeric -> TypeCategory
ExactNumeric
  SqlDataType
TyMoney -> TypeCategory
ExactNumeric
  SqlDataType
TySmallMoney -> TypeCategory
ExactNumeric
  SqlDataType
TyFloat -> TypeCategory
ApproximateNumeric
  SqlDataType
TyReal -> TypeCategory
ApproximateNumeric
  SqlDataType
TyDate -> TypeCategory
DateAndTime
  SqlDataType
TyTime -> TypeCategory
DateAndTime
  SqlDataType
TyDateTime -> TypeCategory
DateAndTime
  SqlDataType
TySmallDateTime -> TypeCategory
DateAndTime
  SqlDataType
TyDateTime2 -> TypeCategory
DateAndTime
  SqlDataType
TyDateTimeOffset -> TypeCategory
DateAndTime
  SqlDataType
TyChar -> TypeCategory
CharacterString
  SqlDataType
TyVarChar -> TypeCategory
CharacterString
  SqlDataType
TyText -> TypeCategory
CharacterString
  SqlDataType
TyNChar -> TypeCategory
UnicodeCharacterString
  SqlDataType
TyNVarChar -> TypeCategory
UnicodeCharacterString
  SqlDataType
TyNText -> TypeCategory
UnicodeCharacterString
  SqlDataType
TyBinary -> TypeCategory
BinaryString
  SqlDataType
TyVarBinary -> TypeCategory
BinaryString
  SqlDataType
TyImage -> TypeCategory
BinaryString
  SqlDataType
TyUniqueIdentifier -> TypeCategory
OtherDataType
  SqlDataType
TyRowVersion -> TypeCategory
OtherDataType
  SqlDataType
TyXml -> TypeCategory
OtherDataType
  SqlDataType
TySqlVariant -> TypeCategory
OtherDataType
  SqlDataType
TyJson -> TypeCategory
OtherDataType
  SqlDataType
TyVector -> TypeCategory
OtherDataType
  SqlDataType
TyHierarchyId -> TypeCategory
OtherDataType
  SqlDataType
TyGeometry -> TypeCategory
OtherDataType
  SqlDataType
TyGeography -> TypeCategory
OtherDataType

------------------------------------------------------------------------------
-- Types with their arguments

-- | The declared length of a character or binary type: in characters
-- (@nvarchar(50)@ is @Length 50@, whatever its storage takes), or in bytes
-- for the binary types.
data Length
  = Length !Int
  | Max       -- ^ @varchar(max)@, @nvarchar(max)@, @varbinary(max)@
  deriving stock (Eq Length
Eq Length =>
(Length -> Length -> Ordering)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Length)
-> (Length -> Length -> Length)
-> Ord Length
Length -> Length -> Bool
Length -> Length -> Ordering
Length -> Length -> Length
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Length -> Length -> Ordering
compare :: Length -> Length -> Ordering
$c< :: Length -> Length -> Bool
< :: Length -> Length -> Bool
$c<= :: Length -> Length -> Bool
<= :: Length -> Length -> Bool
$c> :: Length -> Length -> Bool
> :: Length -> Length -> Bool
$c>= :: Length -> Length -> Bool
>= :: Length -> Length -> Bool
$cmax :: Length -> Length -> Length
max :: Length -> Length -> Length
$cmin :: Length -> Length -> Length
min :: Length -> Length -> Length
Ord)

instance Show Length where
  showsPrec :: Int -> Length -> ShowS
showsPrec Int
p = \case
    Length Int
a -> Int -> Addr# -> Int -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"Length"# Int
a
    Length
Max -> [Char] -> ShowS
showString [Char]
"Max"
  {-# OPAQUE showsPrec #-}

instance Eq Length where
  Length
x == :: Length -> Length -> Bool
== Length
y = case (Length
x, Length
y) of
    (Length Int
a, Length Int
a') -> Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a'
    (Length
Max, Length
Max) -> Bool
True
    (Length, Length)
_ -> Bool
False
  {-# OPAQUE (==) #-}

-- | A type's arguments.  Which a type takes is fixed ('sqlTypeProblem'):
-- a length for the character and binary types, a precision and scale for
-- @decimal@ and @numeric@, a scale for @time@, @datetime2@ and
-- @datetimeoffset@, dimensions for @vector@, nothing or a schema
-- collection for @xml@, and nothing for the rest.
data TypeArgs
  = NoArgs
  | LengthArg !Length
  | PrecisionScaleArg !Precision !Scale
  | ScaleArg !Scale
  | DimensionsArg !Int
  | XmlSchemaArg !Text !Text
    -- ^ the schema and the name of the collection: @xml([dbo].[Person])@
  deriving stock (Eq TypeArgs
Eq TypeArgs =>
(TypeArgs -> TypeArgs -> Ordering)
-> (TypeArgs -> TypeArgs -> Bool)
-> (TypeArgs -> TypeArgs -> Bool)
-> (TypeArgs -> TypeArgs -> Bool)
-> (TypeArgs -> TypeArgs -> Bool)
-> (TypeArgs -> TypeArgs -> TypeArgs)
-> (TypeArgs -> TypeArgs -> TypeArgs)
-> Ord TypeArgs
TypeArgs -> TypeArgs -> Bool
TypeArgs -> TypeArgs -> Ordering
TypeArgs -> TypeArgs -> TypeArgs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeArgs -> TypeArgs -> Ordering
compare :: TypeArgs -> TypeArgs -> Ordering
$c< :: TypeArgs -> TypeArgs -> Bool
< :: TypeArgs -> TypeArgs -> Bool
$c<= :: TypeArgs -> TypeArgs -> Bool
<= :: TypeArgs -> TypeArgs -> Bool
$c> :: TypeArgs -> TypeArgs -> Bool
> :: TypeArgs -> TypeArgs -> Bool
$c>= :: TypeArgs -> TypeArgs -> Bool
>= :: TypeArgs -> TypeArgs -> Bool
$cmax :: TypeArgs -> TypeArgs -> TypeArgs
max :: TypeArgs -> TypeArgs -> TypeArgs
$cmin :: TypeArgs -> TypeArgs -> TypeArgs
min :: TypeArgs -> TypeArgs -> TypeArgs
Ord)

instance Show TypeArgs where
  showsPrec :: Int -> TypeArgs -> ShowS
showsPrec Int
p = \case
    TypeArgs
NoArgs -> [Char] -> ShowS
showString [Char]
"NoArgs"
    LengthArg Length
a -> Int -> Addr# -> Length -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"LengthArg"# Length
a
    PrecisionScaleArg Precision
a Precision
b -> Int -> Addr# -> [Arg] -> ShowS
showCon Int
p Addr#
"PrecisionScaleArg"# [Precision -> Arg
forall a. Show a => a -> Arg
Arg Precision
a, Precision -> Arg
forall a. Show a => a -> Arg
Arg Precision
b]
    ScaleArg Precision
a -> Int -> Addr# -> Precision -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"ScaleArg"# Precision
a
    DimensionsArg Int
a -> Int -> Addr# -> Int -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"DimensionsArg"# Int
a
    XmlSchemaArg Text
a Text
b -> Int -> Addr# -> [Arg] -> ShowS
showCon Int
p Addr#
"XmlSchemaArg"# [Text -> Arg
forall a. Show a => a -> Arg
Arg Text
a, Text -> Arg
forall a. Show a => a -> Arg
Arg Text
b]
  {-# OPAQUE showsPrec #-}

instance Eq TypeArgs where
  TypeArgs
x == :: TypeArgs -> TypeArgs -> Bool
== TypeArgs
y = case (TypeArgs
x, TypeArgs
y) of
    (TypeArgs
NoArgs, TypeArgs
NoArgs) -> Bool
True
    (LengthArg Length
a, LengthArg Length
a') -> Length -> Length -> Bool
forall a. Eq a => a -> a -> Bool
eq Length
a Length
a'
    (PrecisionScaleArg Precision
a Precision
b, PrecisionScaleArg Precision
a' Precision
b') -> Precision
a Precision -> Precision -> Bool
forall a. Eq a => a -> a -> Bool
== Precision
a' Bool -> Bool -> Bool
&& Precision
b Precision -> Precision -> Bool
forall a. Eq a => a -> a -> Bool
== Precision
b'
    (ScaleArg Precision
a, ScaleArg Precision
a') -> Precision
a Precision -> Precision -> Bool
forall a. Eq a => a -> a -> Bool
== Precision
a'
    (DimensionsArg Int
a, DimensionsArg Int
a') -> Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a'
    (XmlSchemaArg Text
a Text
b, XmlSchemaArg Text
a' Text
b') -> Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
b Text
b'
    (TypeArgs, TypeArgs)
_ -> Bool
False
  {-# OPAQUE (==) #-}

-- | A data type with its arguments: what a column is declared as.
data SqlType = SqlType
  { SqlType -> SqlDataType
sqlDataType :: !SqlDataType
  , SqlType -> TypeArgs
sqlTypeArgs :: !TypeArgs
  }
  deriving stock (Eq SqlType
Eq SqlType =>
(SqlType -> SqlType -> Ordering)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> SqlType)
-> (SqlType -> SqlType -> SqlType)
-> Ord SqlType
SqlType -> SqlType -> Bool
SqlType -> SqlType -> Ordering
SqlType -> SqlType -> SqlType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SqlType -> SqlType -> Ordering
compare :: SqlType -> SqlType -> Ordering
$c< :: SqlType -> SqlType -> Bool
< :: SqlType -> SqlType -> Bool
$c<= :: SqlType -> SqlType -> Bool
<= :: SqlType -> SqlType -> Bool
$c> :: SqlType -> SqlType -> Bool
> :: SqlType -> SqlType -> Bool
$c>= :: SqlType -> SqlType -> Bool
>= :: SqlType -> SqlType -> Bool
$cmax :: SqlType -> SqlType -> SqlType
max :: SqlType -> SqlType -> SqlType
$cmin :: SqlType -> SqlType -> SqlType
min :: SqlType -> SqlType -> SqlType
Ord)

instance Show SqlType where
  showsPrec :: Int -> SqlType -> ShowS
showsPrec Int
p (SqlType SqlDataType
a TypeArgs
b) =
    Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"SqlType"# [Addr#
"sqlDataType"# Addr# -> SqlDataType -> Field
forall a. Show a => Addr# -> a -> Field
:= SqlDataType
a, Addr#
"sqlTypeArgs"# Addr# -> TypeArgs -> Field
forall a. Show a => Addr# -> a -> Field
:= TypeArgs
b]
  {-# OPAQUE showsPrec #-}

instance Eq SqlType where
  SqlType SqlDataType
a TypeArgs
b == :: SqlType -> SqlType -> Bool
== SqlType SqlDataType
a' TypeArgs
b' = SqlDataType -> SqlDataType -> Bool
forall a. Eq a => a -> a -> Bool
eq SqlDataType
a SqlDataType
a' Bool -> Bool -> Bool
&& TypeArgs -> TypeArgs -> Bool
forall a. Eq a => a -> a -> Bool
eq TypeArgs
b TypeArgs
b'
  {-# OPAQUE (==) #-}

-- | The type as T-SQL declares it: @nvarchar(50)@, @varbinary(max)@,
-- @decimal(10,2)@, @time(4)@, @vector(3)@, @xml([dbo].[Person])@, @int@.
-- Rendered as it is; check 'sqlTypeProblem' first for a type built by
-- hand.
sqlTypeName :: SqlType -> Text
sqlTypeName :: SqlType -> Text
sqlTypeName (SqlType SqlDataType
t TypeArgs
args) = case TypeArgs
args of
  TypeArgs
NoArgs -> Text
name
  LengthArg (Length Int
n) -> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  LengthArg Length
Max -> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(max)"
  PrecisionScaleArg Precision
p Precision
s -> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Precision -> Text
forall a. Show a => a -> Text
tshow Precision
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Precision -> Text
forall a. Show a => a -> Text
tshow Precision
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  ScaleArg Precision
s -> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Precision -> Text
forall a. Show a => a -> Text
tshow Precision
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  DimensionsArg Int
n -> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  XmlSchemaArg Text
schema Text
collection -> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quote Text
schema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quote Text
collection Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    name :: Text
name = SqlDataType -> Text
dataTypeName SqlDataType
t
    quote :: Text -> Text
quote Text
n = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"]" Text
"]]" Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

tshow :: Show a => a -> Text
tshow :: forall a. Show a => a -> Text
tshow = [Char] -> Text
T.pack ([Char] -> Text) -> (a -> [Char]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show

-- | Why this isn't a type SQL Server has, if it isn't: an argument the type
-- doesn't take, a missing one (the length of an @nvarchar@, the precision
-- and scale of a @decimal@, ...; nothing is defaulted), or one out of
-- range: a length outside 1 through 8000 (4000 for @nchar@ and
-- @nvarchar@), @max@ on a fixed-length type, a precision outside 1
-- through 38 or a scale above it, a scale above 7, dimensions below 1.
sqlTypeProblem :: SqlType -> Maybe String
sqlTypeProblem :: SqlType -> Maybe [Char]
sqlTypeProblem (SqlType SqlDataType
t TypeArgs
args) = case (SqlDataType
t, TypeArgs
args) of
  (SqlDataType
TyChar, LengthArg Length
len) -> Int -> Length -> Maybe [Char]
fixedLength Int
8000 Length
len
  (SqlDataType
TyVarChar, LengthArg Length
len) -> Int -> Length -> Maybe [Char]
varLength Int
8000 Length
len
  (SqlDataType
TyNChar, LengthArg Length
len) -> Int -> Length -> Maybe [Char]
fixedLength Int
4000 Length
len
  (SqlDataType
TyNVarChar, LengthArg Length
len) -> Int -> Length -> Maybe [Char]
varLength Int
4000 Length
len
  (SqlDataType
TyBinary, LengthArg Length
len) -> Int -> Length -> Maybe [Char]
fixedLength Int
8000 Length
len
  (SqlDataType
TyVarBinary, LengthArg Length
len) -> Int -> Length -> Maybe [Char]
varLength Int
8000 Length
len
  (SqlDataType
TyDecimal, PrecisionScaleArg Precision
p Precision
s) -> Precision -> Precision -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> a -> Maybe [Char]
decimal Precision
p Precision
s
  (SqlDataType
TyNumeric, PrecisionScaleArg Precision
p Precision
s) -> Precision -> Precision -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> a -> Maybe [Char]
decimal Precision
p Precision
s
  (SqlDataType
TyTime, ScaleArg Precision
s) -> Precision -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
scale Precision
s
  (SqlDataType
TyDateTime2, ScaleArg Precision
s) -> Precision -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
scale Precision
s
  (SqlDataType
TyDateTimeOffset, ScaleArg Precision
s) -> Precision -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
scale Precision
s
  (SqlDataType
TyVector, DimensionsArg Int
n)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" needs at least one dimension")
    | Bool
otherwise -> Maybe [Char]
forall a. Maybe a
Nothing
  (SqlDataType
TyXml, TypeArgs
NoArgs) -> Maybe [Char]
forall a. Maybe a
Nothing
  (SqlDataType
TyXml, XmlSchemaArg Text
_ Text
_) -> Maybe [Char]
forall a. Maybe a
Nothing
  (SqlDataType
_, TypeArgs
NoArgs)
    | SqlDataType -> Bool
takesArgs SqlDataType
t -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" needs " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SqlDataType -> [Char]
argsOf SqlDataType
t)
    | Bool
otherwise -> Maybe [Char]
forall a. Maybe a
Nothing
  (SqlDataType, TypeArgs)
_ -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" takes " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (if SqlDataType -> Bool
takesArgs SqlDataType
t then SqlDataType -> [Char]
argsOf SqlDataType
t else [Char]
"no arguments"))
  where
    name :: [Char]
name = Text -> [Char]
T.unpack (SqlDataType -> Text
dataTypeName SqlDataType
t)
    takesArgs :: SqlDataType -> Bool
takesArgs = \case
      SqlDataType
TyChar -> Bool
True
      SqlDataType
TyVarChar -> Bool
True
      SqlDataType
TyNChar -> Bool
True
      SqlDataType
TyNVarChar -> Bool
True
      SqlDataType
TyBinary -> Bool
True
      SqlDataType
TyVarBinary -> Bool
True
      SqlDataType
TyDecimal -> Bool
True
      SqlDataType
TyNumeric -> Bool
True
      SqlDataType
TyTime -> Bool
True
      SqlDataType
TyDateTime2 -> Bool
True
      SqlDataType
TyDateTimeOffset -> Bool
True
      SqlDataType
TyVector -> Bool
True
      SqlDataType
_ -> Bool
False
    argsOf :: SqlDataType -> [Char]
argsOf = \case
      SqlDataType
TyDecimal -> [Char]
"a precision and scale"
      SqlDataType
TyNumeric -> [Char]
"a precision and scale"
      SqlDataType
TyTime -> [Char]
"a scale"
      SqlDataType
TyDateTime2 -> [Char]
"a scale"
      SqlDataType
TyDateTimeOffset -> [Char]
"a scale"
      SqlDataType
TyVector -> [Char]
"dimensions"
      SqlDataType
_ -> [Char]
"a length"
    fixedLength :: Int -> Length -> Maybe [Char]
fixedLength Int
limit = \case
      Length
Max -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" has no (max) form")
      Length Int
n -> Int -> Int -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> a -> Maybe [Char]
inRange Int
limit Int
n
    varLength :: Int -> Length -> Maybe [Char]
varLength Int
limit = \case
      Length
Max -> Maybe [Char]
forall a. Maybe a
Nothing
      Length Int
n -> Int -> Int -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> a -> Maybe [Char]
inRange Int
limit Int
n
    inRange :: a -> a -> Maybe [Char]
inRange a
limit a
n
      | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1 Bool -> Bool -> Bool
|| a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
limit = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" length " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is outside 1 through " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
limit)
      | Bool
otherwise = Maybe [Char]
forall a. Maybe a
Nothing
    decimal :: a -> a -> Maybe [Char]
decimal a
p a
s
      | a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1 Bool -> Bool -> Bool
|| a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
38 = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" precision " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
p [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is outside 1 through 38")
      | a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
p = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" scale " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is above its precision " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
p)
      | Bool
otherwise = Maybe [Char]
forall a. Maybe a
Nothing
    scale :: a -> Maybe [Char]
scale a
s
      | a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
7 = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" scale " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is above 7")
      | Bool
otherwise = Maybe [Char]
forall a. Maybe a
Nothing

------------------------------------------------------------------------------
-- The wire's types

-- | The type with its arguments: 'typeInfoDataType' plus the length,
-- precision and scale or schema collection the wire carries.  This
-- allocates the result, so prefer 'typeInfoDataType' where the arguments
-- don't matter.
typeInfoSqlType :: TypeInfo -> Maybe SqlType
typeInfoSqlType :: TypeInfo -> Maybe SqlType
typeInfoSqlType TypeInfo
ti = SqlDataType -> TypeArgs -> SqlType
SqlType (SqlDataType -> TypeArgs -> SqlType)
-> Maybe SqlDataType -> Maybe (TypeArgs -> SqlType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeInfo -> Maybe SqlDataType
typeInfoDataType TypeInfo
ti Maybe (TypeArgs -> SqlType) -> Maybe TypeArgs -> Maybe SqlType
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeArgs -> Maybe TypeArgs
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeArgs
args
  where
    args :: TypeArgs
args = case TypeInfo
ti of
      TIDecimalN Precision
p Precision
s -> Precision -> Precision -> TypeArgs
PrecisionScaleArg Precision
p Precision
s
      TINumericN Precision
p Precision
s -> Precision -> Precision -> TypeArgs
PrecisionScaleArg Precision
p Precision
s
      TITimeN Precision
s -> Precision -> TypeArgs
ScaleArg Precision
s
      TIDateTime2N Precision
s -> Precision -> TypeArgs
ScaleArg Precision
s
      TIDateTimeOffsetN Precision
s -> Precision -> TypeArgs
ScaleArg Precision
s
      TIBigChar Word16
len Collation
_ -> Length -> TypeArgs
LengthArg (Int -> Length
Length (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len))
      TIBigVarChar Word16
len Collation
_ -> Length -> TypeArgs
LengthArg (Word16 -> Length
bytes Word16
len)
      TINChar Word16
len Collation
_ -> Length -> TypeArgs
LengthArg (Int -> Length
Length (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2))
      TINVarChar Word16
len Collation
_ -> Length -> TypeArgs
LengthArg (Word16 -> Length
chars Word16
len)
      TIBigBinary Word16
len -> Length -> TypeArgs
LengthArg (Int -> Length
Length (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len))
      TIBigVarBinary Word16
len -> Length -> TypeArgs
LengthArg (Word16 -> Length
bytes Word16
len)
      TIXml (Just XmlSchema{Text
xmlDbName :: Text
xmlOwningSchema :: Text
xmlSchemaCollection :: Text
xmlDbName :: XmlSchema -> Text
xmlOwningSchema :: XmlSchema -> Text
xmlSchemaCollection :: XmlSchema -> Text
..}) -> Text -> Text -> TypeArgs
XmlSchemaArg Text
xmlOwningSchema Text
xmlSchemaCollection
      TypeInfo
_ -> TypeArgs
NoArgs
    bytes :: Word16 -> Length
bytes Word16
len
      | Word16
len Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
maxLength = Length
Max
      | Bool
otherwise = Int -> Length
Length (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len)
    chars :: Word16 -> Length
chars Word16
len
      | Word16
len Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
maxLength = Length
Max
      | Bool
otherwise = Int -> Length
Length (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)

-- | The wire type to declare a parameter of this type with, as
-- @RawParam@'s: the nullable encodings, the server's default collation
-- for character types, a schema collection in the current database.
-- 'Nothing' for a type with a 'sqlTypeProblem', and for @json@, @vector@
-- and the CLR types, which a TDS 7.4 or 8.0 client can't send as such
-- (send @json@ as @nvarchar(max)@, a @vector@ as its JSON array text).
sqlTypeTypeInfo :: SqlType -> Maybe TypeInfo
sqlTypeTypeInfo :: SqlType -> Maybe TypeInfo
sqlTypeTypeInfo st :: SqlType
st@(SqlType SqlDataType
t TypeArgs
args) = case SqlType -> Maybe [Char]
sqlTypeProblem SqlType
st of
  Just [Char]
_ -> Maybe TypeInfo
forall a. Maybe a
Nothing
  Maybe [Char]
Nothing -> case (SqlDataType
t, TypeArgs
args) of
    (SqlDataType
TyBit, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just TypeInfo
TIBitN
    (SqlDataType
TyTinyInt, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIIntN Precision
1)
    (SqlDataType
TySmallInt, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIIntN Precision
2)
    (SqlDataType
TyInt, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIIntN Precision
4)
    (SqlDataType
TyBigInt, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIIntN Precision
8)
    (SqlDataType
TyDecimal, PrecisionScaleArg Precision
p Precision
s) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> Precision -> TypeInfo
TIDecimalN Precision
p Precision
s)
    (SqlDataType
TyNumeric, PrecisionScaleArg Precision
p Precision
s) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> Precision -> TypeInfo
TINumericN Precision
p Precision
s)
    (SqlDataType
TyMoney, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIMoneyN Precision
8)
    (SqlDataType
TySmallMoney, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIMoneyN Precision
4)
    (SqlDataType
TyFloat, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIFltN Precision
8)
    (SqlDataType
TyReal, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIFltN Precision
4)
    (SqlDataType
TyDate, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just TypeInfo
TIDateN
    (SqlDataType
TyTime, ScaleArg Precision
s) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TITimeN Precision
s)
    (SqlDataType
TyDateTime, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIDateTimeN Precision
8)
    (SqlDataType
TySmallDateTime, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIDateTimeN Precision
4)
    (SqlDataType
TyDateTime2, ScaleArg Precision
s) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIDateTime2N Precision
s)
    (SqlDataType
TyDateTimeOffset, ScaleArg Precision
s) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Precision -> TypeInfo
TIDateTimeOffsetN Precision
s)
    (SqlDataType
TyChar, LengthArg (Length Int
n)) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word16 -> Collation -> TypeInfo
TIBigChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Collation
defaultCollation)
    (SqlDataType
TyVarChar, LengthArg Length
len) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word16 -> Collation -> TypeInfo
TIBigVarChar (Length -> Word16
bytes Length
len) Collation
defaultCollation)
    (SqlDataType
TyText, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word32 -> Collation -> TypeInfo
TIText Word32
longest Collation
defaultCollation)
    (SqlDataType
TyNChar, LengthArg (Length Int
n)) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word16 -> Collation -> TypeInfo
TINChar (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)) Collation
defaultCollation)
    (SqlDataType
TyNVarChar, LengthArg Length
len) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word16 -> Collation -> TypeInfo
TINVarChar (Length -> Word16
chars Length
len) Collation
defaultCollation)
    (SqlDataType
TyNText, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word32 -> Collation -> TypeInfo
TINText Word32
longest Collation
defaultCollation)
    (SqlDataType
TyBinary, LengthArg (Length Int
n)) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word16 -> TypeInfo
TIBigBinary (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
    (SqlDataType
TyVarBinary, LengthArg Length
len) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word16 -> TypeInfo
TIBigVarBinary (Length -> Word16
bytes Length
len))
    (SqlDataType
TyImage, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word32 -> TypeInfo
TIImage Word32
longest)
    (SqlDataType
TyUniqueIdentifier, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just TypeInfo
TIGuid
    (SqlDataType
TyRowVersion, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word16 -> TypeInfo
TIBigBinary Word16
8)
    (SqlDataType
TyXml, XmlSchemaArg Text
schema Text
collection) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Maybe XmlSchema -> TypeInfo
TIXml (XmlSchema -> Maybe XmlSchema
forall a. a -> Maybe a
Just (Text -> Text -> Text -> XmlSchema
XmlSchema Text
"" Text
schema Text
collection)))
    (SqlDataType
TyXml, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Maybe XmlSchema -> TypeInfo
TIXml Maybe XmlSchema
forall a. Maybe a
Nothing)
    (SqlDataType
TySqlVariant, TypeArgs
_) -> TypeInfo -> Maybe TypeInfo
forall a. a -> Maybe a
Just (Word32 -> TypeInfo
TISqlVariant Word32
8016)
    (SqlDataType, TypeArgs)
_ -> Maybe TypeInfo
forall a. Maybe a
Nothing
  where
    -- The server's default collation, as "Hmssql.Encoding" declares
    -- character parameters.
    defaultCollation :: Collation
defaultCollation = Word32 -> Precision -> Collation
Collation Word32
0 Precision
0
    -- The longest a text, ntext or image value can be.
    longest :: Word32
longest = Word32
0x7FFFFFFF
    bytes :: Length -> Word16
    bytes :: Length -> Word16
bytes = \case
      Length
Max -> Word16
maxLength
      Length Int
n -> Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
    chars :: Length -> Word16
chars = \case
      Length
Max -> Word16
maxLength
      Length Int
n -> Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)

-- | The declared type of a result set's column, as far as its metadata
-- says. The user-type tag identifies @rowversion@; otherwise this is
-- 'typeInfoSqlType' of the column's storage type. An alias type's user
-- ID does not carry its name, so its underlying type is returned.
columnSqlType :: ColumnInfo -> Maybe SqlType
columnSqlType :: ColumnInfo -> Maybe SqlType
columnSqlType ColumnInfo
col
  | ColumnInfo -> Word32
columnUserType ColumnInfo
col Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x50 = SqlType -> Maybe SqlType
forall a. a -> Maybe a
Just (SqlDataType -> TypeArgs -> SqlType
SqlType SqlDataType
TyRowVersion TypeArgs
NoArgs)
  | Bool
otherwise = TypeInfo -> Maybe SqlType
typeInfoSqlType (ColumnInfo -> TypeInfo
columnType ColumnInfo
col)