Better suggestions and code fixes for non-nullable parameters

src/NpgsqlFSharpVs/NpgsqlFSharpVs.csproj

@@ -105,6 +105,9 @@
     <PackageReference Include="Dotnet.ProjInfo.Workspace.FCS">
       <Version>0.43.0</Version>
     </PackageReference>
+    <PackageReference Include="FParsec">
+      <Version>1.1.1</Version>
+    </PackageReference>
     <PackageReference Include="Microsoft.VisualStudio.SDK" Version="16.0.206" ExcludeAssets="runtime">
       <IncludeAssets>compile; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>
     </PackageReference>
@@ -133,6 +136,10 @@
       <Project>{5964bb56-97b8-4fae-9933-8113db11438d}</Project>
       <Name>NpgsqlFSharpAnalyzer.Core</Name>
     </ProjectReference>
+    <ProjectReference Include="..\NpgsqlFSharpParser\NpgsqlFSharpParser.fsproj">
+      <Project>{bc524f8e-6282-4e31-9a0e-29fce38832e7}</Project>
+      <Name>NpgsqlFSharpParser</Name>
+    </ProjectReference>
   </ItemGroup>
   <Import Project="$(MSBuildToolsPath)\Microsoft.CSharp.targets" />
   <Import Project="$(VSToolsPath)\VSSDK\Microsoft.VsSDK.targets" Condition="'$(VSToolsPath)' != ''" />

tests/NpgsqlFSharpAnalyzer.Tests/Tests.fs

@@ -14,6 +14,10 @@ let analyzers = [
 let inline find file = IO.Path.Combine(__SOURCE_DIRECTORY__ , file)
 let project = IO.Path.Combine(__SOURCE_DIRECTORY__, "../examples/hashing/examples.fsproj")
 
+let raiseWhenFailed = function
+    | Result.Ok _ -> ()
+    | Result.Error error -> raise error
+
 let inline context file =
     AnalyzerBootstrap.context file
     |> Option.map SqlAnalyzer.sqlAnalyzerContext
@@ -166,7 +170,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id bigserial primary key, roles text[] not null)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             let databaseMetadata = InformationSchema.getDbSchemaLookups db.ConnectionString
 
@@ -193,7 +197,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id bigserial primary key, username text not null, active bit not null)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             let databaseMetadata = InformationSchema.getDbSchemaLookups db.ConnectionString
 
@@ -209,7 +213,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id bigserial primary key, username text not null, active bit not null)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             let databaseMetadata = InformationSchema.getDbSchemaLookups db.ConnectionString
             let query = "SELECT COUNT(*) FROM users"
@@ -236,7 +240,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query createFuncQuery
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             let databaseMetadata = InformationSchema.getDbSchemaLookups db.ConnectionString
             let query = "SELECT Increment(@Input)"
@@ -257,7 +261,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id bigserial primary key, username text not null, active bit not null)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             match context (find "../examples/hashing/semanticAnalysis-missingColumn.fs") with
             | None -> failwith "Could not crack project"
@@ -282,7 +286,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id bigserial primary key, username text not null, active bit not null)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             match context (find "../examples/hashing/semanticAnalysis-missingParameter.fs") with
             | None -> failwith "Could not crack project"
@@ -307,7 +311,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id bigserial primary key, username text not null, active bit not null)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             match context (find "../examples/hashing/semanticAnalysis-typeMismatch.fs") with
             | None -> failwith "Could not crack project"
@@ -331,7 +335,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id bigserial primary key, roles text[] not null)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             match context (find "../examples/hashing/readingTextArray.fs") with
             | None -> failwith "Could not crack project"
@@ -355,7 +359,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id bigserial primary key, codes uuid[] not null)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             match context (find "../examples/hashing/readingUuidArray.fs") with
             | None -> failwith "Could not crack project"
@@ -379,7 +383,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id bigserial primary key, username text)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             match context (find "../examples/hashing/usingIntArrayParameter.fs") with
             | None -> failwith "Could not crack project"
@@ -451,7 +455,7 @@ let tests =
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id serial primary key, username text not null, active bit not null)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             match context (find "../examples/hashing/readAttemptIntegerTypeMismatch.fs") with
             | None -> failwith "Could not crack project"
@@ -469,13 +473,93 @@ let tests =
                         failwith "Expected only one error message"
         }
 
+        test "SQL query semantic analysis: type mismatch with comparing against non-nullable column during SELECT" {
+            use db = createTestDatabase()
+
+            Sql.connect db.ConnectionString
+            |> Sql.query "CREATE TABLE users (user_id serial primary key, username text not null)"
+            |> Sql.executeNonQuery
+            |> raiseWhenFailed
+
+            match context (find "../examples/hashing/selectWithNonNullableColumnComparison.fs") with
+            | None -> failwith "Could not crack project"
+            | Some context ->
+                match SqlAnalysis.databaseSchema db.ConnectionString with
+                | Result.Error connectionError ->
+                    failwith connectionError
+                | Result.Ok schema ->
+                    let operation = List.exactlyOne (SyntacticAnalysis.findSqlOperations context)
+                    let messages = SqlAnalysis.analyzeOperation operation db.ConnectionString schema
+                    match messages with
+                    | [ message ] ->
+                        Expect.stringContains message.Message "Sql.int instead" "Message contains suggestion to use Sql.readBool"
+                    | _ ->
+                        failwith "Expected only one error message"
+        }
+
+
+        test "SQL query semantic analysis: type mismatch with comparing against non-nullable column during SELECT with JOINS" {
+            use db = createTestDatabase()
+
+            Sql.connect db.ConnectionString
+            |> Sql.query "CREATE TABLE users (user_id serial primary key, username text not null)"
+            |> Sql.executeNonQuery
+            |> raiseWhenFailed
+
+            Sql.connect db.ConnectionString
+            |> Sql.query "CREATE TABLE user_roles (user_role_id serial primary key, role_description text not null, user_id int not null references users(user_id))"
+            |> Sql.executeNonQuery
+            |> raiseWhenFailed
+
+            match context (find "../examples/hashing/selectWithInnerJoins.fs") with
+            | None -> failwith "Could not crack project"
+            | Some context ->
+                match SqlAnalysis.databaseSchema db.ConnectionString with
+                | Result.Error connectionError ->
+                    failwith connectionError
+                | Result.Ok schema ->
+                    let operation = List.exactlyOne (SyntacticAnalysis.findSqlOperations context)
+                    let messages = SqlAnalysis.analyzeOperation operation db.ConnectionString schema
+                    match messages with
+                    | [ message ] ->
+                        Expect.stringContains message.Message "Sql.int instead" "Message contains suggestion to use Sql.readBool"
+                    | _ ->
+                        failwith "Expected only one error message"
+        }
+
+
+        test "SQL query semantic analysis: type mismatch with comparing against non-nullable column during UPDATE with assignments" {
+            use db = createTestDatabase()
+
+            Sql.connect db.ConnectionString
+            |> Sql.query "CREATE TABLE users (user_id serial primary key, username text not null, last_login timestamptz)"
+            |> Sql.executeNonQuery
+            |> raiseWhenFailed
+
+            match context (find "../examples/hashing/updateQueryWithParametersInAssignments.fs") with
+            | None -> failwith "Could not crack project"
+            | Some context ->
+                match SqlAnalysis.databaseSchema db.ConnectionString with
+                | Result.Error connectionError ->
+                    failwith connectionError
+                | Result.Ok schema ->
+                    let operation = List.exactlyOne (SyntacticAnalysis.findSqlOperations context)
+                    let messages = SqlAnalysis.analyzeOperation operation db.ConnectionString schema
+                    match messages with
+                    | [ firstMessage; secondMessage ] ->
+                        Expect.stringContains firstMessage.Message "Sql.int instead" "Suggest to use non-nullable Sql.int"
+                        Expect.stringContains secondMessage.Message "Sql.text or Sql.string" "Suggest to use non-nullable text"
+                    | _ ->
+                        failwith "Expected only one error message"
+        }
+
         test "SQL query semantic analysis: redundant parameters" {
             use db = createTestDatabase()
 
             Sql.connect db.ConnectionString
             |> Sql.query "CREATE TABLE users (user_id bigserial primary key, username text not null, active bit not null)"
             |> Sql.executeNonQuery
-            |> ignore
+            |> raiseWhenFailed
 
             match context (find "../examples/hashing/semanticAnalysis-redundantParameters.fs") with
             | None -> failwith "Could not crack project"

tests/examples/hashing/examples.fsproj

@@ -5,6 +5,9 @@
   </PropertyGroup>
 
   <ItemGroup>
+    <Compile Include="updateQueryWithParametersInAssignments.fs" />
+    <Compile Include="selectWithInnerJoins.fs" />
+    <Compile Include="selectWithNonNullableColumnComparison.fs" />
     <Compile Include="insertQueryWithNonNullableParameter.fs" />
     <Compile Include="executingQueryInsteadOfNonQuery.fs" />
     <Compile Include="usingIntArrayParameter.fs" />

tests/examples/hashing/selectWithInnerJoins.fs

@@ -0,0 +1,16 @@
+module SelectWithInnerJoins
+
+open Npgsql.FSharp
+
+let [<Literal>] usersWithRoles = """
+    SELECT * FROM users
+    JOIN user_roles ON users.user_id = user_roles.user_id
+    WHERE users.user_id = @user_id AND role_description = @role
+"""
+
+let usersAndTheirRoles connectionString =
+    connectionString
+    |> Sql.connect
+    |> Sql.query usersWithRoles
+    |> Sql.parameters [ "@user_id", Sql.intOrNone None; "@role", Sql.text "User" ]
+    |> Sql.execute (fun read -> read.int "user_id")

tests/examples/hashing/selectWithNonNullableColumnComparison.fs

@@ -0,0 +1,10 @@
+module SelectWithNonNullableColumnComparison
+
+open Npgsql.FSharp
+
+let findUsernames connectionString =
+    connectionString
+    |> Sql.connect
+    |> Sql.query "SELECT * FROM users WHERE user_id = @user_id AND username = @username"
+    |> Sql.parameters [ "@user_id", Sql.intOrNone None; "@username", Sql.text "User" ]
+    |> Sql.execute (fun read -> read.int "user_id")

tests/examples/hashing/updateQueryWithParametersInAssignments.fs

@@ -0,0 +1,22 @@
+module UpdateQueryWithParametersInAssignments
+
+open Npgsql.FSharp
+open System
+
+let [<Literal>] updateUsernameQuery = """
+    UPDATE users
+    SET username = @username, last_login = @last_login
+    WHERE user_id = @user_id
+    RETURNING *
+"""
+
+let usersAndTheirRoles connectionString =
+    connectionString
+    |> Sql.connect
+    |> Sql.query updateUsernameQuery
+    |> Sql.parameters [
+        "@user_id", Sql.intOrNone (Some 10)
+        "@username", Sql.textOrNone (Some "John")
+        "@last_login", Sql.timestamptz DateTime.Now
+    ]
+    |> Sql.execute (fun read -> read.int "user_id")