Add fetch queries

src/NpgsqlFSharpParser/Parser.fs

@@ -149,7 +149,7 @@ let text value : Parser<string, unit> =
 let star : Parser<Expr, unit> =
     text "*" |>> fun _ -> Expr.Star
 
-let opp = new OperatorPrecedenceParser<Expr, unit, unit>()
+let opp = OperatorPrecedenceParser<Expr, unit, unit>()
 
 let expr = opp.ExpressionParser
 
@@ -185,16 +185,37 @@ let quotedString =
     <|> (skipChar '\'' |> anyStringBetween <| skipChar '\'')
 
 let stringLiteral : Parser<Expr, unit> =
-    quotedString .>> spacesOrComment
+    spacesOrComment >>. quotedString .>> spacesOrComment
     |>> Expr.StringLiteral
 
+let between' : Parser<Expr, unit> =
+    attempt (
+        identifier >>= (fun value ->
+        text "BETWEEN" >>.
+        (integer <|> number <|> date) >>= (fun left ->
+        text "AND" >>.
+        expr >>= (fun right ->
+            preturn (Expr.Between (value, left, right)))))
+    )
+
 /// Parses 2 or more comma separated values. I.e (1, 2), but not (3) which will become an integer.
-let valueList =
+let numericList =
     let numeric = integer <|> number
-    attempt(
-        numeric .>> (pstring ",") >>= fun head ->
-        sepBy1 numeric (pstring ",") >>= fun tail ->
-        preturn (Expr.List (head::tail))
+
+    attempt (
+        parens (numeric .>> (pstring ",")
+        >>= fun head ->
+                sepBy1 numeric (pstring ",")
+                >>= fun tail -> preturn (Expr.List(head :: tail)))
+    )
+
+// TODO: Not sure why, but letting the parser accept spaces before a quoted string makes some tests fail
+let stringList =
+    attempt (
+        parens (stringLiteral .>> (pstring ",") // .>> spaces)
+        >>= fun head ->
+                sepBy1 stringLiteral (pstring ",") // .>> spaces)
+                >>= fun tail -> preturn (Expr.List(head :: tail)))
     )
 
 let commaSeparatedExprs = sepBy expr comma
@@ -437,6 +458,17 @@ let declareQuery =
         }
         preturn (Expr.DeclareQuery (Cursor query))
 
+let fetchQuery =
+    text "FETCH" >>.
+    pint32 >>= fun count ->
+    text "FROM" >>.
+    simpleIdentifier >>= fun cursor ->
+        let query = {
+            CursorName = cursor
+            Direction = Direction.Forward count
+        }
+        preturn (Expr.FetchQuery query)
+
 let spacesOrComment =
     let comment = skipString "/*" >>. (charsTillString "*/" true 8096)
     let commentEol = skipString "--" >>. skipRestOfLine true
@@ -458,6 +490,8 @@ opp.AddOperator(InfixOperator("OR", notFollowedBy (text "DER BY") .>> spacesOrCo
 opp.AddOperator(InfixOperator("or", notFollowedBy (text "der by") .>> spacesOrComment, 6, Associativity.Left, fun left right -> Expr.Or(left, right)))
 opp.AddOperator(InfixOperator("IN", spacesOrComment, 8, Associativity.Left, fun left right -> Expr.In(left, right)))
 opp.AddOperator(InfixOperator("in", spacesOrComment, 8, Associativity.Left, fun left right -> Expr.In(left, right)))
+opp.AddOperator(InfixOperator("LIKE", spacesOrComment, 8, Associativity.Left, fun left right -> Expr.Like(left, right)))
+opp.AddOperator(InfixOperator("like", spacesOrComment, 8, Associativity.Left, fun left right -> Expr.Like(left, right)))
 opp.AddOperator(InfixOperator(">", spaces, 9, Associativity.Left, fun left right -> Expr.GreaterThan(left, right)))
 opp.AddOperator(InfixOperator("<", spaces, 9, Associativity.Left, fun left right -> Expr.LessThan(left, right)))
 opp.AddOperator(InfixOperator("<=", spaces, 9, Associativity.Left, fun left right -> Expr.LessThanOrEqual(left, right)))
@@ -482,9 +516,12 @@ opp.TermParser <- choice [
     (attempt selectQuery)
     (attempt setQuery)
     (attempt declareQuery)
+    (attempt fetchQuery)
     (attempt functionExpr)
+    between'
+    numericList
+    stringList
     (text "(") >>. expr .>> (text ")")
-    valueList
     star
     integer
     boolean

src/NpgsqlFSharpParser/Types.fs

@@ -15,6 +15,7 @@ type Expr =
     | Date of string
     | Timestamp of string
     | Function of name:string * arguments:Expr list
+    | Like of left:Expr * right:Expr
     | And of left:Expr * right:Expr
     | Or of left:Expr * right:Expr
     | In of left:Expr * right:Expr
@@ -37,6 +38,7 @@ type Expr =
     | UpdateQuery of expr: UpdateExpr
     | SetQuery of expr: SetExpr
     | DeclareQuery of expr: DeclareExpr
+    | FetchQuery of expr: FetchExpr
 
 type Ordering =
     | Asc of columnName:string
@@ -148,6 +150,32 @@ type CursorDeclaration = {
 type DeclareExpr =
     | Cursor of CursorDeclaration
 
+[<RequireQualifiedAccess>]
+type Direction =
+    /// Fetch next row. Same as Forward
+    | Next
+    /// Fetch prior row. Same as Backward
+    | Prior
+    | Absolute of int // First = Absolute 1, Last = Absolute -1
+    | Relative of int
+    | Forward of int // Same as count
+    | Backward of int
+    /// Fetch all remaining rows. Same as ForwardAll
+    | All
+    | BackwardAll
+
+type FetchExpr = {
+    // An open cursor name.
+    CursorName: string
+    // Defines the fetch direction.
+    Direction: Direction
+} with
+    static member Default =
+        {
+            CursorName = ""
+            Direction = Direction.Next
+        }
+
 [<RequireQualifiedAccess>]
 type DataType =
     | Integer

tests/NpgsqlFSharpAnalyzer.Tests/NpgsqlFSharpAnalyzer.Tests.fsproj

@@ -12,6 +12,7 @@
         <Compile Include="ParseSelectTests.fs" />
         <Compile Include="ParseSetTests.fs" />
         <Compile Include="ParseDeclareTests.fs" />
+        <Compile Include="ParseFetchTests.fs" />
         <Compile Include="AssemblyInfo.fs" />
         <Compile Include="Analyzer.fs" />
         <Compile Include="Tests.fs" />

tests/NpgsqlFSharpAnalyzer.Tests/ParseFetchTests.fs

@@ -0,0 +1,35 @@
+module ParseFetchTests
+
+open Expecto
+open NpgsqlFSharpParser
+
+let testFetch inputQuery expected =
+    test inputQuery {
+        match Parser.parse inputQuery with
+        | Ok (Expr.FetchQuery query) ->
+            Expect.equal query expected "The query is parsed correctly"
+        | Ok somethingElse ->
+            failwithf "Unexpected fetch statement %A" somethingElse
+        | Error errorMsg ->
+            failwith errorMsg
+    }
+
+let ftestFetch inputQuery expected =
+    ftest inputQuery {
+        match Parser.parse inputQuery with
+        | Ok (Expr.FetchQuery query) ->
+            Expect.equal query expected "The query is parsed correctly"
+        | Ok somethingElse ->
+            failwithf "Unexpected fetch statement %A" somethingElse
+        | Error errorMsg ->
+            failwith errorMsg
+    }
+
+[<Tests>]
+let fetchQueryTests = testList "Parse FETCH queries" [
+    testFetch "FETCH 10 FROM c1" {
+        FetchExpr.Default with
+            CursorName = "c1"
+            Direction = Direction.Forward 10
+    }
+]

tests/NpgsqlFSharpAnalyzer.Tests/ParseSelectTests.fs

@@ -283,6 +283,29 @@ let selectQueryTests = testList "Parse SELECT tests" [
             Where = Some (Expr.In(Expr.Ident "user_id", Expr.List([Expr.Integer 1L; Expr.Integer 2L;  Expr.Integer 3L])))
     }
 
+    testSelect """
+        SELECT username, email
+        FROM users
+        WHERE username IN ('foo','bar')
+    """ {
+        SelectExpr.Default with
+            Columns = [Expr.Ident "username"; Expr.Ident "email"]
+            From = Some (Expr.Ident "users")
+            Where = Some (Expr.In(Expr.Ident "username", Expr.List([Expr.StringLiteral "foo"; Expr.StringLiteral "bar"])))
+    }
+
+    // space before `bar`
+    testSelect """
+        SELECT username, email
+        FROM users
+        WHERE username IN ('foo', 'bar')
+    """ {
+        SelectExpr.Default with
+            Columns = [Expr.Ident "username"; Expr.Ident "email"]
+            From = Some (Expr.Ident "users")
+            Where = Some (Expr.In(Expr.Ident "username", Expr.List([Expr.StringLiteral "foo"; Expr.StringLiteral "bar"])))
+    }
+
     testSelect """
         SELECT username, email
         FROM users
@@ -603,6 +626,14 @@ let selectQueryTests = testList "Parse SELECT tests" [
             Where = Some (Expr.GreaterThan(Expr.Ident "last_login", Expr.Date("2021-01-04 00:00:00")))
     }
 
+    testSelect """
+        SELECT aggregate('ID', '2020-01-10', '2020-03-10', '1d')
+    """ {
+        SelectExpr.Default with
+            Columns = [Expr.Function("aggregate", [Expr.StringLiteral "ID"; Expr.StringLiteral "2020-01-10";
+            Expr.StringLiteral "2020-03-10"; Expr.StringLiteral "1d"]) ]
+    }
+
     testSelect """
         select timestamp '2021-01-04 00:00:00'
     """ {
@@ -656,5 +687,30 @@ let selectQueryTests = testList "Parse SELECT tests" [
                     )
                 )
     }
+
+    testSelect "SELECT * FROM users WHERE user_id LIKE '%foo'" {
+        SelectExpr.Default with
+            Columns = [Expr.Star]
+            From = Some (Expr.Ident "users")
+            Where = Some (Expr.Like(Expr.Ident "user_id", Expr.StringLiteral("%foo")))
+    }
+
+    testSelect """
+        SELECT *
+        FROM employees
+        WHERE employee_id BETWEEN 200 AND 300;
+    """ {
+        SelectExpr.Default with
+            Columns = [ Expr.Star ]
+            From = Some (Expr.Ident "employees")
+            Where =
+                Some(
+                    Expr.Between(
+                        Expr.Ident "employee_id",
+                        Expr.Integer(200L),
+                        Expr.Integer(300L)
+                    )
+                )
+    }
 ]
 

tests/NpgsqlFSharpAnalyzer.Tests/Tests.fs

@@ -25,8 +25,8 @@ let inline context file =
 let createTestDatabase() =
     Sql.host "localhost"
     |> Sql.port 5432
-    |> Sql.username "postgres"
-    |> Sql.password "postgres"
+    |> Sql.username "dbrattli"
+    |> Sql.password "secret"
     |> Sql.formatConnectionString
     |> ThrowawayDatabase.Create
 
@@ -55,7 +55,7 @@ let tests =
             | Some context ->
                 let operationBlocks = SyntacticAnalysis.findSqlOperations context
                 Expect.equal (List.length operationBlocks) 1 "Found 1 operation"
-                let parameters = 
+                let parameters =
                     [
                         for operation in operationBlocks do
                         for block in operation.blocks do
@@ -166,7 +166,7 @@ let tests =
             | Some context ->
                 match SyntacticAnalysis.findSqlOperations context with
                 | [ operation ] ->
-                    let transactionQueries = 
+                    let transactionQueries =
                         operation.blocks
                         |> List.tryPick (fun block ->
                             match block with
@@ -190,7 +190,7 @@ let tests =
             | Some context ->
                 match SyntacticAnalysis.findSqlOperations context with
                 | [ operation; secondOperation ] ->
-                    let transactionQueries = 
+                    let transactionQueries =
                         operation.blocks
                         |> List.tryPick (fun block ->
                             match block with
@@ -204,7 +204,7 @@ let tests =
                         Expect.equal 1 query.parameterSets.Length "There is one parameter set"
                         Expect.equal 1 query.parameterSets.[0].parameters.Length "There are no parameters provided"
 
-                    let secondTransactionQueries = 
+                    let secondTransactionQueries =
                         secondOperation.blocks
                         |> List.tryPick (fun block ->
                             match block with
@@ -235,7 +235,7 @@ let tests =
                 match SyntacticAnalysis.findSqlOperations context with
                 | [ operation; secondOperation ] ->
 
-                    let transactionQueries = 
+                    let transactionQueries =
                         operation.blocks
                         |> List.tryPick (fun block ->
                             match block with
@@ -249,7 +249,7 @@ let tests =
                         Expect.equal 1 query.parameterSets.Length "There is one parameter set"
                         Expect.equal 1 query.parameterSets.[0].parameters.Length "There are no parameters provided"
 
-                    let secondTransactionQueries = 
+                    let secondTransactionQueries =
                         secondOperation.blocks
                         |> List.tryPick (fun block ->
                             match block with
@@ -277,7 +277,7 @@ let tests =
 
         test "Semantic analysis: skip analysis doesn't give any errors" {
             use db = createTestDatabase()
-            
+
             match context (find "../examples/hashing/syntaxAnalysis-detectingSkipAnalysis.fs") with
             | None -> failwith "Could not crack project"
             | Some context ->
@@ -452,22 +452,22 @@ let tests =
 
         test "SQL schema analysis with user defined arrays" {
             use db = createTestDatabase ()
-  
+
             Sql.connect db.ConnectionString
             |> Sql.executeTransaction [
                 "CREATE TYPE role AS ENUM ('admin')", []
                 "CREATE TABLE users (roles role[])", [] ]
             |> raiseWhenFailed
-  
+
             let databaseMetadata =
                 InformationSchema.getDbSchemaLookups db.ConnectionString
-  
+
             let userColumns =
                 databaseMetadata.Schemas.["public"].Tables
                 |> Seq.tryFind (fun pair -> pair.Key.Name = "users")
                 |> Option.map (fun pair -> pair.Value)
                 |> Option.map List.ofSeq
-  
+
             match userColumns with
             | None -> failwith "Expected to find columns for users table"
             | Some columns ->