Skip to content

Commit 6a8befc

Browse files
rspeelerspeele
committed
TSQL TPU testing mappings to geography, json.
Not happy with how either of these ended up, they exposed weaknesses that forced workarounds. Need to consider multi-attribute support for SQLParameterDbType so it can set UdtTypeName property on SqlParameter.
1 parent 5b1bc24 commit 6a8befc

9 files changed

Lines changed: 317 additions & 8 deletions

File tree

‎src/TypeProviderUsers/TypeProviderUser.TSQL.UserTypes/Library.fs‎

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
namespace TypeProviderUser.TSQL.UserTypes
2+
3+
open System.Text.Json
4+
open Rezoom.SQL.Annotations
5+
6+
/// Address as a user primitive that stores as TSQL `json` (SQL Server
7+
/// 2025+ native type). Same shape as the Postgres jsonb Address fixture:
8+
/// ToPrimitive serializes to a JSON string, FromPrimitive deserializes
9+
/// from one. The RawBackendSQLType pins the SQL column type as "json".
10+
///
11+
/// Note on SQLParameterDbType: SqlDbType.Json (= 35) exists in
12+
/// System.Data but Microsoft.Data.SqlClient 5.2.2 rejects it as
13+
/// "invalid" when assigned to a SqlParameter. Until SqlClient catches
14+
/// up we bind as NVarChar (= 12); SQL Server implicitly converts an
15+
/// nvarchar parameter value to json when assigning to a json column.
16+
// 12 = System.Data.SqlDbType.NVarChar
17+
[<RawBackendSQLType("json")>]
18+
[<SQLParameterDbType("SqlDbType", 12)>]
19+
type Address =
20+
{ Street : string
21+
City : string
22+
State : string
23+
Zip : string
24+
}
25+
static member ToPrimitive(a : Address) : obj =
26+
box (JsonSerializer.Serialize(a))
27+
static member FromPrimitive(o : obj) : Address =
28+
JsonSerializer.Deserialize<Address>(o :?> string)
29+
30+
/// 2D geographic location as a user primitive that stores as TSQL
31+
/// `geography`. Same intent as the Postgres Point2D fixture, but the
32+
/// in-flight CLR shape is asymmetric: parameter binding goes through
33+
/// nvarchar carrying WKT (SQL Server auto-converts to geography on
34+
/// INSERT), while reads come back as a SqlGeography UDT instance
35+
/// (which Microsoft.Data.SqlClient deserializes for any geography
36+
/// column). FromPrimitive consequently has to know how to unpack a
37+
/// SqlGeography.
38+
///
39+
/// Why not UDT-bind directly? Setting up a SqlParameter for a UDT
40+
/// requires both SqlDbType.Udt (= 29) AND the UdtTypeName property
41+
/// ("geography"). SQLParameterDbType is a one-property attribute; the
42+
/// nvarchar+server-conversion path sidesteps that.
43+
// 12 = System.Data.SqlDbType.NVarChar
44+
[<RawBackendSQLType("geography")>]
45+
[<SQLParameterDbType("SqlDbType", 12)>]
46+
type GeoLocation =
47+
{ Latitude : double
48+
Longitude : double
49+
}
50+
static member ToPrimitive(g : GeoLocation) : obj =
51+
// SRID 4326 (WGS84) — same coordinate system the read side
52+
// assumes. The WKT lon-lat order is intentional: SQL Server
53+
// STGeomFromText interprets POINT(x y) as POINT(lon lat).
54+
box (System.String.Format(System.Globalization.CultureInfo.InvariantCulture,
55+
"POINT({0} {1})", g.Longitude, g.Latitude))
56+
static member FromPrimitive(o : obj) : GeoLocation =
57+
let sg = o :?> Microsoft.SqlServer.Types.SqlGeography
58+
{ Latitude = sg.Lat.Value; Longitude = sg.Long.Value }

‎src/TypeProviderUsers/TypeProviderUser.TSQL.UserTypes/TypeProviderUser.TSQL.UserTypes.fsproj‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
<Project Sdk="Microsoft.NET.Sdk">
2+
<PropertyGroup>
3+
<TargetFramework>net10.0</TargetFramework>
4+
<GenerateDocumentationFile>true</GenerateDocumentationFile>
5+
</PropertyGroup>
6+
<ItemGroup>
7+
<Compile Include="Library.fs" />
8+
</ItemGroup>
9+
<ItemGroup>
10+
<ProjectReference Include="..\..\Rezoom.SQL.Annotations\Rezoom.SQL.Annotations.csproj" />
11+
</ItemGroup>
12+
<ItemGroup>
13+
<!-- SqlGeography is the CLR representation of the geography backend
14+
type. We only need it for the FromPrimitive read path; parameter
15+
binding goes through nvarchar because UDT binding requires
16+
setting UdtTypeName on the SqlParameter, which the current
17+
SQLParameterDbType attribute cannot drive. -->
18+
<PackageReference Include="Microsoft.SqlServer.Types" Version="160.1000.6" />
19+
</ItemGroup>
20+
</Project>

‎src/TypeProviderUsers/TypeProviderUser.TSQL/Shared.fs‎

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -13,15 +13,19 @@ type TestModel = SQLModel<".">
1313

1414
type CleanTestData = SQL<"""
1515
vendor tsql {
16-
drop table __RZSQL_MIGRATIONS;
17-
drop table ArticleComments;
18-
drop table Articles;
19-
drop table Users;
20-
drop table Pictures;
16+
drop table if exists __RZSQL_MIGRATIONS;
17+
drop table if exists UserLocations;
18+
drop table if exists UserAddresses;
19+
drop table if exists ArticleComments;
20+
drop table if exists Articles;
21+
drop table if exists Users;
22+
drop table if exists Pictures;
2123
}
2224
""">
2325

2426
type TestData = SQL<"""
27+
delete from UserLocations;
28+
delete from UserAddresses;
2529
delete from ArticleComments;
2630
delete from Articles;
2731
delete from Users;

‎src/TypeProviderUsers/TypeProviderUser.TSQL/TestUserPrimitiveGeography.fs‎

Lines changed: 114 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,114 @@
1+
module TypeProviderUser.TSQL.TestUserPrimitiveGeography
2+
open NUnit.Framework
3+
open Rezoom.SQL
4+
open TypeProviderUser.TSQL.UserTypes
5+
6+
// Same pattern as TypeProviderUser.Postgres.TestUserPrimitivePoint:
7+
// an obj-underlying user primitive that maps to a SQL Server backend
8+
// type with no `=` operator (geography). Parameter equality goes
9+
// through vendor + IMAGINE using TSQL's `.STEquals(other) = 1`
10+
// method-call style.
11+
12+
let private homerLoc = { Latitude = 44.0521; Longitude = -123.0868 }
13+
let private margeLoc = { Latitude = 44.0521; Longitude = -123.0868 }
14+
let private bartLoc = { Latitude = 47.6062; Longitude = -122.3321 }
15+
16+
type InsertAndSelectLocations = SQL<"""
17+
insert into UserLocations(UserId, Coord)
18+
values((select Id from Users where Name = 'Homer'), @homer);
19+
insert into UserLocations(UserId, Coord)
20+
values((select Id from Users where Name = 'Marge'), @marge);
21+
select Coord from UserLocations order by Id;
22+
""">
23+
24+
[<Test>]
25+
let ``select roundtrips a GeoLocation user primitive over TSQL geography`` () =
26+
let results = InsertAndSelectLocations.Command(homerLoc, margeLoc) |> runOnTestData
27+
Assert.AreEqual(2, results.Count)
28+
Assert.AreEqual(homerLoc, results.[0].Coord)
29+
Assert.AreEqual(margeLoc, results.[1].Coord)
30+
31+
// `geography = geography` raises "Invalid operator for data type" in
32+
// SQL Server. The canonical equality check is `.STEquals(other) = 1`.
33+
// Rezoom's parser doesn't know method-call syntax on UDT columns, so
34+
// we use vendor/imagine the same way the PG Point2D parameter test
35+
// does: vendor body runs the TSQL method call, IMAGINE typechecks
36+
// the parameter and result shape.
37+
//
38+
// On the parameter binding: the runtime applies the GeoLocation user
39+
// type's SQLParameterDbType (NVarChar), so @needle is sent as the WKT
40+
// nvarchar that ToPrimitive produces. SQL Server's STEquals takes a
41+
// geography on both sides; the parameter's nvarchar value is
42+
// implicitly converted to geography in the comparison context
43+
// (geography has higher data-type precedence and STEquals' parameter
44+
// is typed geography).
45+
type FindLocationByStEqualsVendor = SQL<"""
46+
insert into UserLocations(UserId, Coord)
47+
values((select Id from Users where Name = 'Homer'), @homer);
48+
insert into UserLocations(UserId, Coord)
49+
values((select Id from Users where Name = 'Marge'), @bart);
50+
vendor tsql {
51+
select Coord from UserLocations
52+
where Coord.STEquals(geography::STGeomFromText({@needle}, 4326)) = 1
53+
} imagine {
54+
select Coord from UserLocations where @needle = ''
55+
};
56+
""">
57+
58+
[<Test>]
59+
let ``select GeoLocation parameter equality matches via vendor STEquals`` () =
60+
// @needle is typed as string in IMAGINE because we're explicitly
61+
// building the geography from WKT inside the vendor body — this
62+
// exercises that the typechecker can still propagate the result-
63+
// set column type (Coord : GeoLocation) from the IMAGINE clause
64+
// even when the parameter type is something simpler. The @homer
65+
// and @bart INSERTs already cover the GeoLocation parameter
66+
// pipeline end-to-end.
67+
let results =
68+
FindLocationByStEqualsVendor.Command
69+
( bart = bartLoc
70+
, homer = homerLoc
71+
, needle =
72+
System.String.Format
73+
( System.Globalization.CultureInfo.InvariantCulture
74+
, "POINT({0} {1})", homerLoc.Longitude, homerLoc.Latitude )
75+
)
76+
|> runOnTestData
77+
Assert.AreEqual(1, results.Count)
78+
Assert.AreEqual(homerLoc, results.[0].Coord)
79+
80+
// Bonus: pass @needle as a real GeoLocation user-type parameter, fully
81+
// preserving type-safety from F# all the way through to TSQL's
82+
// STEquals. Mirrors the second Postgres Point2D vendor test (the one
83+
// where the user-type parameter pipeline is fully engaged on both
84+
// the INSERT and the WHERE side).
85+
type FindLocationByGeoLocationVendor = SQL<"""
86+
insert into UserLocations(UserId, Coord)
87+
values((select Id from Users where Name = 'Homer'), @homer);
88+
insert into UserLocations(UserId, Coord)
89+
values((select Id from Users where Name = 'Marge'), @bart);
90+
vendor tsql {
91+
select Coord from UserLocations
92+
where Coord.STEquals(geography::STGeomFromText(cast({@needle} as nvarchar(max)), 4326)) = 1
93+
} imagine {
94+
select Coord from UserLocations where Coord = @needle
95+
};
96+
""">
97+
98+
[<Test>]
99+
let ``select GeoLocation parameter equality matches via vendor STEquals with typed needle`` () =
100+
// The IMAGINE clause types @needle as GeoLocation (column = param),
101+
// so the F# caller passes a real GeoLocation. The vendor body
102+
// casts the bound nvarchar back to nvarchar(max) for safety, then
103+
// STGeomFromText. Demonstrates that vendor/imagine keeps the
104+
// user-type parameter pipeline intact even for backend operators
105+
// Rezoom can't parse.
106+
let results =
107+
FindLocationByGeoLocationVendor.Command
108+
( bart = bartLoc
109+
, homer = homerLoc
110+
, needle = homerLoc
111+
)
112+
|> runOnTestData
113+
Assert.AreEqual(1, results.Count)
114+
Assert.AreEqual(homerLoc, results.[0].Coord)

‎src/TypeProviderUsers/TypeProviderUser.TSQL/TestUserPrimitiveJson.fs‎

Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
module TypeProviderUser.TSQL.TestUserPrimitiveJson
2+
open NUnit.Framework
3+
open Rezoom.SQL
4+
open TypeProviderUser.TSQL.UserTypes
5+
6+
// Same pattern as TypeProviderUser.Postgres.TestUserPrimitiveSystemObject:
7+
// an obj-underlying user primitive whose value travels as a JSON string.
8+
// On TSQL the backing column is the SQL Server 2025 `json` type, which
9+
// is the natural counterpart to PG's `jsonb`.
10+
11+
let private homerAddr =
12+
{ Street = "742 Evergreen Terrace"
13+
City = "Springfield"
14+
State = "OR"
15+
Zip = "97477"
16+
}
17+
18+
let private margeAddr =
19+
{ Street = "742 Evergreen Terrace"
20+
City = "Springfield"
21+
State = "OR"
22+
Zip = "97477"
23+
}
24+
25+
let private bartAddr =
26+
{ Street = "1313 Mockingbird Lane"
27+
City = "Shelbyville"
28+
State = "OR"
29+
Zip = "97001"
30+
}
31+
32+
type InsertAndSelectAddresses = SQL<"""
33+
insert into UserAddresses(UserId, Home)
34+
values((select Id from Users where Name = 'Homer'), @homer);
35+
insert into UserAddresses(UserId, Home)
36+
values((select Id from Users where Name = 'Marge'), @marge);
37+
select Home from UserAddresses order by Id;
38+
""">
39+
40+
[<Test>]
41+
let ``select roundtrips an Address user primitive over TSQL json`` () =
42+
let results = InsertAndSelectAddresses.Command(homerAddr, margeAddr) |> runOnTestData
43+
Assert.AreEqual(2, results.Count)
44+
Assert.AreEqual(homerAddr, results.[0].Home)
45+
Assert.AreEqual(margeAddr, results.[1].Home)
46+
47+
// SQL Server's `json` type has no `=` operator (SQL Server raises "The
48+
// JSON data type cannot be compared or sorted, except when using the
49+
// IS NULL operator"), mirroring PG's lack of `=` for `point`. We test
50+
// parameter equality the recommended way: vendor body runs TSQL-native
51+
// SQL using JSON_VALUE on a known field, IMAGINE clause informs the
52+
// typechecker of the parameter types and result shape.
53+
type FindAddressByJsonValueVendor = SQL<"""
54+
insert into UserAddresses(UserId, Home)
55+
values((select Id from Users where Name = 'Homer'), @homer);
56+
insert into UserAddresses(UserId, Home)
57+
values((select Id from Users where Name = 'Marge'), @bart);
58+
vendor tsql {
59+
select Home from UserAddresses where JSON_VALUE(Home, '$.City') = {@city}
60+
} imagine {
61+
select Home from UserAddresses where @city = ''
62+
};
63+
""">
64+
65+
[<Test>]
66+
let ``select Address by JSON_VALUE matches via vendor/imagine`` () =
67+
// @city stays typed as string in Rezoom's view; the vendor body
68+
// uses TSQL's JSON_VALUE function on the json column to compare a
69+
// specific field. The Home parameters (@homer, @bart) are typed
70+
// Address and exercise the user-type → nvarchar pipeline on the
71+
// INSERT side.
72+
let results =
73+
FindAddressByJsonValueVendor.Command
74+
( bart = bartAddr
75+
, city = "Shelbyville"
76+
, homer = homerAddr
77+
)
78+
|> runOnTestData
79+
Assert.AreEqual(1, results.Count)
80+
Assert.AreEqual(bartAddr, results.[0].Home)

‎src/TypeProviderUsers/TypeProviderUser.TSQL/TypeProviderUser.TSQL.fsproj‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,8 @@
1212
<Compile Include="AssemblyInfo.fs" />
1313
<Compile Include="Shared.fs" />
1414
<Compile Include="TestSelects.fs" />
15+
<Compile Include="TestUserPrimitiveJson.fs" />
16+
<Compile Include="TestUserPrimitiveGeography.fs" />
1517
<Compile Include="TestMigrateConnectionString.fs" />
1618
<Compile Include="Program.fs" />
1719
<None Include="appsettings.json" CopyToOutputDirectory="PreserveNewest" />
@@ -34,4 +36,8 @@
3436
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0" />
3537
</ItemGroup>
3638

39+
<ItemGroup>
40+
<ProjectReference Include="..\TypeProviderUser.TSQL.UserTypes\TypeProviderUser.TSQL.UserTypes.fsproj" />
41+
</ItemGroup>
42+
3743
</Project>

‎src/TypeProviderUsers/TypeProviderUser.TSQL/V1.model.sql‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,3 +30,15 @@ create table ArticleComments
3030

3131
create index IX_ArticleComments_AuthorId on ArticleComments(AuthorId);
3232

33+
create table UserAddresses
34+
( Id int64 primary key autoincrement
35+
, UserId int64 references Users(Id)
36+
, Home Address
37+
);
38+
39+
create table UserLocations
40+
( Id int64 primary key autoincrement
41+
, UserId int64 references Users(Id)
42+
, Coord GeoLocation
43+
);
44+

‎src/TypeProviderUsers/TypeProviderUser.TSQL/rzsql.json‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1-
{
2-
"backend": "tsql"
3-
}
1+
{
2+
"backend": "tsql",
3+
"usertypes": [ "TypeProviderUser.TSQL.UserTypes" ]
4+
}

‎src/TypeProviderUsers/TypeProviderUsers.sln‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "TypeProviderUser.Postgres.U
1717
EndProject
1818
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Rezoom.SQL.Annotations", "..\Rezoom.SQL.Annotations\Rezoom.SQL.Annotations.csproj", "{7E963635-41D8-411E-B521-9A41AE5CA3AC}"
1919
EndProject
20+
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "TypeProviderUser.TSQL.UserTypes", "TypeProviderUser.TSQL.UserTypes\TypeProviderUser.TSQL.UserTypes.fsproj", "{2ABDE072-FA83-4E30-8C6F-99EF334F4186}"
21+
EndProject
2022
Global
2123
GlobalSection(SolutionConfigurationPlatforms) = preSolution
2224
Debug|Any CPU = Debug|Any CPU
@@ -111,6 +113,18 @@ Global
111113
{7E963635-41D8-411E-B521-9A41AE5CA3AC}.Release|x64.Build.0 = Release|Any CPU
112114
{7E963635-41D8-411E-B521-9A41AE5CA3AC}.Release|x86.ActiveCfg = Release|Any CPU
113115
{7E963635-41D8-411E-B521-9A41AE5CA3AC}.Release|x86.Build.0 = Release|Any CPU
116+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
117+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Debug|Any CPU.Build.0 = Debug|Any CPU
118+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Debug|x64.ActiveCfg = Debug|Any CPU
119+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Debug|x64.Build.0 = Debug|Any CPU
120+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Debug|x86.ActiveCfg = Debug|Any CPU
121+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Debug|x86.Build.0 = Debug|Any CPU
122+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Release|Any CPU.ActiveCfg = Release|Any CPU
123+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Release|Any CPU.Build.0 = Release|Any CPU
124+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Release|x64.ActiveCfg = Release|Any CPU
125+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Release|x64.Build.0 = Release|Any CPU
126+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Release|x86.ActiveCfg = Release|Any CPU
127+
{2ABDE072-FA83-4E30-8C6F-99EF334F4186}.Release|x86.Build.0 = Release|Any CPU
114128
EndGlobalSection
115129
GlobalSection(SolutionProperties) = preSolution
116130
HideSolutionNode = FALSE

0 commit comments

Comments
 (0)