Simple SQL Parser

sqlparser.fsx

#r "nuget: fparsec"
open FParsec

let test p str =
    match run p str with
    | Success(result, _, _)   ->
        printfn "Success: %A" result
    | Failure(errorMsg, _, _) -> printfn "Failure: %s" errorMsg

let ws = spaces
let str_ws s = pstring s .>> ws
let strCI_ws s = pstringCI s .>> ws
let float_ws = pfloat .>> ws

let identifier =
    let isIdentifierFirstChar c = isLetter c || c = '_'
    let isIdentifierChar c = isLetter c || isDigit c || c = '_'

    many1Satisfy2L isIdentifierFirstChar isIdentifierChar "identifier" .>> ws // skips trailing whitespace

type SqlPrimitiveExpression = 
    | SqlFloatConstant of float
    | SqlIdentifier of string
type SqlExpression = 
    | BinaryArithmeticOperator of SqlExpression * string * SqlExpression
    | UnaryArithmeticOperator of string * SqlExpression
    | Primitive of SqlPrimitiveExpression

type SqlLogicalExpression =
    | BinaryLogicalOperator of SqlLogicalExpression * string * SqlLogicalExpression
    | BinaryComparisonOperator of SqlExpression * string * SqlExpression
    | UnaryLogicalOperator of string * SqlLogicalExpression
    | IsNull of SqlExpression
    | IsNotNull of SqlExpression

type Resultset = 
    | TableResultset of string

type SelectListItem =
    | AliasedExpression of SqlExpression * string option
type SelectClause = SelectListItem list
type FromClause = 
    | Resultset of Resultset
type WhereClause = 
    | WhereCondition of SqlLogicalExpression

type Query =
| SelectQuery of (SelectClause * (FromClause * WhereClause option) option)

let SQL_CONSTANT = float_ws |>> SqlFloatConstant
let SQL_IDENTIFIER = identifier |>> SqlIdentifier
let SQL_EXPRESSION = SQL_CONSTANT <|> SQL_IDENTIFIER |>> Primitive

let arithOpp = new OperatorPrecedenceParser<SqlExpression,unit,unit>()
let arithExpr = arithOpp.ExpressionParser
let arithExpressionTerm = (SQL_EXPRESSION) <|> between (str_ws "(") (str_ws ")") arithExpr
arithOpp.TermParser <- arithExpressionTerm

arithOpp.AddOperator(InfixOperator("+", ws, 1, Associativity.Left, fun x y -> BinaryArithmeticOperator(x, "+", y)))
arithOpp.AddOperator(InfixOperator("-", ws, 1, Associativity.Left, fun x y -> BinaryArithmeticOperator(x, "-", y)))
arithOpp.AddOperator(InfixOperator("*", ws, 2, Associativity.Left, fun x y -> BinaryArithmeticOperator(x, "*", y)))
arithOpp.AddOperator(InfixOperator("/", ws, 2, Associativity.Left, fun x y -> BinaryArithmeticOperator(x, "/", y)))
arithOpp.AddOperator(PrefixOperator("-", ws, 3, false, fun x -> UnaryArithmeticOperator("-", x)))

let flatten v =
    match v with
    | ((a, b), c) -> (a, b, c) 
 //   | _ -> failwith "Invalid tuple to flatten"

let logicOpp = new OperatorPrecedenceParser<SqlLogicalExpression,unit,unit>()
let SQL_LOGICAL_EXPRESSION = logicOpp.ExpressionParser
let primitiveLogicalExpression =
    (SQL_EXPRESSION .>>? strCI_ws "IS" .>>? strCI_ws "NULL" |>> IsNull)
    <|> (SQL_EXPRESSION .>>? strCI_ws "IS" .>>? strCI_ws "NOT" .>> strCI_ws "NULL" |>> IsNotNull)
    <|> (SQL_EXPRESSION .>>.? strCI_ws "=" .>>. SQL_EXPRESSION |>> flatten |>> BinaryComparisonOperator)
    <|> (SQL_EXPRESSION .>>.? strCI_ws "<>" .>>. SQL_EXPRESSION |>> flatten |>> BinaryComparisonOperator)
let logicExpressionTerm = (primitiveLogicalExpression) <|> between (str_ws "(") (str_ws ")") SQL_LOGICAL_EXPRESSION
logicOpp.TermParser <- logicExpressionTerm

logicOpp.AddOperator(InfixOperator("AND", ws, 1, Associativity.Left, fun x y -> BinaryLogicalOperator(x, "+", y)))
logicOpp.AddOperator(InfixOperator("OR", ws, 1, Associativity.Left, fun x y -> BinaryLogicalOperator(x, "-", y)))
logicOpp.AddOperator(PrefixOperator("NOT", ws, 3, false, fun x -> UnaryLogicalOperator("NOT", x)))

let ALIASED_EXPRESSION = SQL_EXPRESSION .>>. opt (strCI_ws "AS" >>. identifier) |>> AliasedExpression
let SELECT_LIST = sepBy ALIASED_EXPRESSION (str_ws ",")
let TABLE_RESULTSET = identifier |>> TableResultset
let FROM_CLAUSE = strCI_ws "FROM" >>. TABLE_RESULTSET |>> Resultset
let WHERE_CLAUSE = strCI_ws "WHERE" >>. SQL_LOGICAL_EXPRESSION |>> WhereCondition
let SELECT_STATEMENT = 
    spaces .>> strCI_ws "SELECT" >>. SELECT_LIST .>>. 
        (opt (FROM_CLAUSE .>>. (opt WHERE_CLAUSE))) |>> SelectQuery

test SELECT_STATEMENT " SELECT 6"
test SELECT_STATEMENT " SELECT 6 FROM tbl1"
test SELECT_STATEMENT " SELECT 6 as X FROM tbl2"
test SELECT_STATEMENT " SELECT 6 AS X FROM tbl2"
test SELECT_STATEMENT " SELECT test1 FROM tbl3"
test SELECT_STATEMENT " SELECT test2 as Y FROM tbl4" // TABLE SCAN
test SELECT_STATEMENT " SELECT test3 as Z FROM tbl5 WHERE ID IS NULL" // TABLE SCAN
test SELECT_STATEMENT " SELECT test3 as Z FROM tbl5 WHERE ID IS NOT NULL" // TABLE SCAN
test SELECT_STATEMENT " SELECT test3 as Z FROM tbl5 WHERE ID = 1" // Index Seek
test SELECT_STATEMENT " SELECT test3 as Z FROM tbl5 WHERE ID <> 1" // TABLE SCAN
test SELECT_STATEMENT " SELECT test3 as Z FROM tbl5 WHERE NOT ID <> 1" // TABLE SCAN, but can be Index Seek after optimization

(*
    Index Seek example

SELECT Title
FROM Books
WHERE Id = 100

let books = ctx.UseTable(ctx.Schema.Books.Table)
let selectProjection = fun book -> (book.Title)
let indexSeek key = books.Get key
let result = 
    indexSeek 100
    |> selectProjection
*)


(*
    Table Scan example

SELECT Title
FROM Books
WHERE Quantity > 100

let books = ctx.UseTable(ctx.Schema.Books.Table)
let selectProjection = fun book -> (book.Title)
let whereFilter = fun book -> book.Quantity > 100
let tableScan entity = 
    let ids = entity.GetIds()
    ids
        |> Seq.map (fun id -> entity.Get id)

tableScan books
    |> Seq.filter whereFilter
    |> Seq.map selectProjection

*)