initial parsing of INSERT and DELETE queries and string literals

src/NpgsqlFSharpParser/Parser.fs

@@ -42,6 +42,20 @@ let boolean : Parser<Expr, unit> =
     (text "true" |>> fun _ -> Expr.Boolean true)
     <|> (text "false" |>> fun _ -> Expr.Boolean false)
 
+// Applies popen, then pchar repeatedly until pclose succeeds,
+// returns the string in the middle
+let manyCharsBetween popen pclose pchar = popen >>? manyCharsTill pchar pclose
+
+// Parses any string between popen and pclose
+let anyStringBetween popen pclose = manyCharsBetween popen pclose anyChar
+
+// Parses any string between double quotes
+let quotedString = skipChar '\'' |> anyStringBetween <| skipChar '\''
+
+let stringLiteral : Parser<Expr, unit> =
+    quotedString
+    |>> Expr.StringLiteral
+
 let commaSeparatedExprs = sepBy expr comma
 
 let selections =
@@ -122,6 +136,12 @@ let optionalOrderingExpr =
         | Some exprs -> exprs
         | None -> [ ]
 
+let optionalRetuningExpr =
+    optionalExpr (text "RETURNING " >>. selections)
+    |>> function
+        | Some exprs -> exprs
+        | None -> [ ]
+
 let optionalDistinct =
     optional (attempt (text "DISTINCT ON") <|> attempt (text "DISTINCT"))
 
@@ -154,7 +174,7 @@ let selectQuery =
     optionalHavingClause >>= fun havingExpr ->
     optionalOrderingExpr >>= fun orderingExprs ->
     optionalLimit >>= fun limitExpr ->
-    optionalOffset |>> fun offsetExpr -> 
+    optionalOffset >>= fun offsetExpr -> 
         let query =
             { SelectExpr.Default with
                 Columns = selections
@@ -167,7 +187,36 @@ let selectQuery =
                 Limit = limitExpr
                 Offset = offsetExpr }
 
-        Expr.Query (TopLevelExpr.Select query)
+        preturn (Expr.SelectQuery query)
+
+let deleteQuery =
+    text "DELETE FROM " >>. simpleIdentifier >>= fun tableName ->
+    optionalWhereClause >>= fun where ->
+    optionalRetuningExpr >>= fun returningExpr ->
+        let query = {
+            DeleteExpr.Default with
+                Table = tableName
+                Where = where
+                Returning = returningExpr
+        }
+
+        preturn (Expr.DeleteQuery query)
+
+let insertQuery =
+    text "INSERT INTO " >>. simpleIdentifier >>= fun tableName ->
+    (parens (sepBy1 simpleIdentifier comma)) >>= fun columns ->
+    text "VALUES" >>= fun _ ->
+    (parens (sepBy1 expr comma)) >>= fun values ->
+    optionalRetuningExpr >>= fun returningExpr ->
+        let query = {
+            InsertExpr.Default with 
+                Table = tableName
+                Columns = columns
+                Values = values
+                Returning = returningExpr
+        }
+
+        preturn (Expr.InsertQuery query)
 
 opp.AddOperator(InfixOperator("AND", spaces, 7, Associativity.Left, fun left right -> Expr.And(left, right)))
 opp.AddOperator(InfixOperator("OR", notFollowedBy (text "DER BY"), 6, Associativity.Left, fun left right -> Expr.Or(left, right)))
@@ -182,14 +231,17 @@ opp.AddOperator(PostfixOperator("IS NULL", spaces, 8, false, fun value -> Expr.E
 opp.AddOperator(PostfixOperator("IS NOT NULL", spaces, 8, false, fun value -> Expr.Not(Expr.Equals(Expr.Null, value))))
 
 opp.TermParser <- choice [
+    (attempt insertQuery)
+    (attempt deleteQuery)
     (attempt selectQuery)
     (attempt functionExpr)
     (text "(") >>. expr .>> (text ")")
     star
-    parameter
-    identifier
     integer
     boolean
+    stringLiteral
+    identifier
+    parameter
 ]
 
 let fullParser = (optional spaces) >>. expr .>> (optional spaces <|> (text ";" |>> fun _ -> ()))
@@ -198,3 +250,8 @@ let parse (input: string) : Result<Expr, string> =
     match run fullParser input with
     | Success(result,_,_) -> Result.Ok result
     | Failure(errMsg,_,_) -> Result.Error errMsg
+
+let parseUnsafe query =
+    match parse query with
+    | Result.Ok output -> output
+    | Result.Error errorMsg -> failwith errorMsg

src/NpgsqlFSharpParser/Types.fs

@@ -1,18 +1,12 @@
 namespace rec NpgsqlFSharpParser
 
-[<RequireQualifiedAccess>]
-type TopLevelExpr =
-    | Select of SelectExpr
-    | Insert of InsertExpr
-    | Delete of DeleteExpr
-    | Update of UpdateExpr
-
 [<RequireQualifiedAccess>]
 type Expr =
     | Star
     | Ident of string
     | Parameter of string
     | Boolean of bool
+    | StringLiteral of string
     | Integer of int
     | Float of float
     | Null
@@ -27,7 +21,9 @@ type Expr =
     | GreaterThanOrEqual of left:Expr * right:Expr
     | LessThanOrEqual of left:Expr * right:Expr
     | Between of value:Expr * leftBound:Expr * rightBound:Expr
-    | Query of expr:TopLevelExpr
+    | SelectQuery of expr:SelectExpr
+    | DeleteQuery of expr:DeleteExpr
+    | InsertQuery of expr: InsertExpr
 
 type Ordering =
     | Asc of columnName:string
@@ -69,20 +65,36 @@ type SelectExpr = {
 
 type UpdateExpr = {
     Table : string
-    Assignments : Map<string, Expr list>
-    ConflictResolution : Map<string, Expr list>
+    Where : Expr option
+    Assignments : (string * Expr) list
+    ConflictResolution : (string * Expr) list
     Returning : Expr list
 }
 
 type DeleteExpr = {
     Table : string
     Where : Expr option
-}
+    Returning : Expr list
+} with
+    static member Default =
+        {
+            Table = "";
+            Where = None
+            Returning = [ ]
+        }
 
 type InsertExpr = {
     Table: string
     Columns : string list
     Values : Expr list
-    ConflictResolution : Map<string, Expr list>
+    ConflictResolution : (string * Expr) list
     Returning : Expr list
-}
+} with
+    static member Default =
+        {
+            Table = "";
+            Columns = [ ]
+            Values = [ ]
+            ConflictResolution = [ ]
+            Returning = [ ]
+        }

tests/NpgsqlFSharpAnalyzer.Tests/NpgsqlFSharpAnalyzer.Tests.fsproj

@@ -6,7 +6,9 @@
         <CopyLocalLockFileAssemblies>true</CopyLocalLockFileAssemblies>
     </PropertyGroup>
     <ItemGroup>
-        <Compile Include="ParserTests.fs" />
+        <Compile Include="ParseInsertTests.fs" />
+        <Compile Include="ParseDeleteTests.fs" />
+        <Compile Include="ParseSelectTests.fs" />
         <Compile Include="AssemblyInfo.fs" />
         <Compile Include="Analyzer.fs" />
         <Compile Include="Tests.fs" />

tests/NpgsqlFSharpAnalyzer.Tests/ParseDeleteTests.fs

@@ -0,0 +1,42 @@
+module ParserDeleteTests
+
+open Expecto
+open NpgsqlFSharpParser
+
+let testDelete inputQuery expected =
+    test inputQuery {
+        match Parser.parse inputQuery with
+        | Ok (Expr.DeleteQuery query) ->
+            Expect.equal query expected "The query is parsed correctly"
+        | Ok somethingElse ->
+            failwithf "Unexpected delete statement %A" somethingElse
+        | Error errorMsg ->
+            failwith errorMsg
+    }
+
+let ftestDelete inputQuery expected =
+    ftest inputQuery {
+        match Parser.parse inputQuery with
+        | Ok (Expr.DeleteQuery query) ->
+            Expect.equal query expected "The query is parsed correctly"
+        | Ok somethingElse ->
+            failwithf "Unexpected delete statement %A" somethingElse
+        | Error errorMsg ->
+            failwith errorMsg
+    }
+
+[<Tests>]
+let deleteQueryTests = testList "Parse DELETE tests" [
+    testDelete "DELETE FROM users WHERE last_login IS NULL" {
+        DeleteExpr.Default with
+            Table = "users"
+            Where = Some (Expr.Equals(Expr.Null, Expr.Ident "last_login"))
+    }
+
+    testDelete "DELETE FROM users WHERE luck = 'bad' RETURNING *" {
+        DeleteExpr.Default with
+            Table = "users"
+            Where = Some (Expr.Equals(Expr.Ident "luck", Expr.StringLiteral "bad"))
+            Returning = [Expr.Star]
+    }
+]

tests/NpgsqlFSharpAnalyzer.Tests/ParseInsertTests.fs

@@ -0,0 +1,44 @@
+module ParseInsertTests
+
+open Expecto
+open NpgsqlFSharpParser
+
+let testInsert inputQuery expected =
+    test inputQuery {
+        match Parser.parse inputQuery with
+        | Ok (Expr.InsertQuery query) ->
+            Expect.equal query expected "The query is parsed correctly"
+        | Ok somethingElse ->
+            failwithf "Unexpected insert statement %A" somethingElse
+        | Error errorMsg ->
+            failwith errorMsg
+    }
+
+let ftestInsert inputQuery expected =
+    ftest inputQuery {
+        match Parser.parse inputQuery with
+        | Ok (Expr.InsertQuery query) ->
+            Expect.equal query expected "The query is parsed correctly"
+        | Ok somethingElse ->
+            failwithf "Unexpected insert statement %A" somethingElse
+        | Error errorMsg ->
+            failwith errorMsg
+    }
+
+[<Tests>]
+let insertQueryTests = testList "Parse INSERT queries" [
+    testInsert "INSERT INTO users (username, active) VALUES (@username, true)" {
+        InsertExpr.Default with
+            Table = "users"
+            Columns = ["username"; "active"]
+            Values = [ Expr.Parameter("@username"); Expr.Boolean true ]
+    }
+
+    testInsert "INSERT INTO users (username, active) VALUES (@username, true) RETURNING *" {
+        InsertExpr.Default with
+            Table = "users"
+            Columns = ["username"; "active"]
+            Values = [ Expr.Parameter("@username"); Expr.Boolean true ]
+            Returning = [Expr.Star]
+    }
+]