http://stackoverflow.com/questions/9215975/differentiating-l

module SqlAst =

    open System

    type BinaryOp =
        | Add
        | Sub
        | Mul
        | Div
        | Mod
        | BitAnd
        | BitOr
        | BitXor

    type UnaryOp =
        | Neg
        | BitNot

    type Comparison =
        | Eq
        | Ne

    type Constant =
        | Int32 of int
        | Float of float
        | DateTime of DateTime
        | Bool of bool
        | String of string
        | Null

    type ScalarExpr =
        | Identifier of string list
        | Constant of Constant
        | Binary of BinaryOp * ScalarExpr * ScalarExpr
        | Unary of UnaryOp * ScalarExpr

    type SearchCondition =
        | Comparison of Comparison * ScalarExpr * ScalarExpr
        | Or of SearchCondition * SearchCondition
        | And of SearchCondition * SearchCondition

module (*private*) SqlParserImpl =

    open FParsec
    open FParsec.Primitives
    open FParsec.CharParsers
    open SqlAst

    type Assoc = Associativity

    let ws = spaces

    let nameStartChar = pchar '_' <|> asciiLetter
    let nameChar = nameStartChar <|> digit
    let name = many1Chars2 nameStartChar nameChar
    let id = sepBy1 name (pstring ".") .>> ws |>> Identifier
    let trueLiteral = stringCIReturn "true" (Bool true) .>> ws
    let falseLiteral = stringCIReturn "false" (Bool false) .>> ws
    let boolLiteral = (trueLiteral <|> falseLiteral)
    let nullLiteral = stringCIReturn "null" Null .>> ws
    let quoteChar = pstring "'"
    let pChar = satisfy ((<>) '\'')
    let stringLiteral = (quoteChar >>. (manyCharsTill pChar quoteChar)) |>> String .>> ws
    let floatLiteral = pfloat |>> Float .>> ws
    let int32Literal = pint32 |>> Int32 .>> ws
    let constant =
        [ boolLiteral; nullLiteral; int32Literal; floatLiteral; stringLiteral ]
        |> choice
        |>> Constant
    let strOrSymOp str sym x = ((stringCIReturn str x) <|> (stringCIReturn sym x)) .>> ws

    let lparen = pstring "(" >>. ws
    let rparen = pstring ")" >>. ws
    let tryBetweenParens p = lparen >>? (p .>>? rparen)

    let opp = OperatorPrecedenceParser<_,_,_>()
    let scalarExpr = opp.ExpressionParser
    opp.TermParser <- constant <|> id <|> tryBetweenParens scalarExpr

    let addInfixOp (str, prec, op) = opp.AddOperator(InfixOperator(str, ws, prec, Assoc.Left, fun l r -> Binary(op, l, r)))
    let addPrefixOp (str, prec, op) = opp.AddOperator(PrefixOperator(str, ws, prec, false, fun x -> Unary(op, x)))
    [ "|", 1, BitOr
      "^", 2, BitXor
      "&", 3, BitAnd
      "+", 4, Add
      "-", 4, Sub
      "*", 5, Mul
      "/", 5, Div
      "%", 5, Mod ]
    |> List.iter addInfixOp
    [ "-", 6, Neg
      "~", 6, BitNot ]
    |> List.iter addPrefixOp

    let eqOp = strOrSymOp "eq" "=" Eq
    let neOp = strOrSymOp "ne" "<>" Ne
    let compareOp = [ eqOp; neOp ] |> choice
    let comparison = // doesn't currently allow chained comparisons ( e.g. 1 = 2 = 3)
        let compareExpr = pipe3 scalarExpr compareOp scalarExpr (fun l op r -> Comparison(op, l, r))
        compareExpr <|> tryBetweenParens compareExpr

    let andTerm = stringCIReturn "and" (fun l r -> And(l, r)) .>> ws
    let orTerm = stringCIReturn "or" (fun l r -> Or(l, r)) .>> ws
    let searchCondition, searchConditionRef = createParserForwardedToRef()
    do searchConditionRef:=
        chainl1 (comparison <|> between lparen rparen searchCondition)
                (andTerm <|> orTerm)

    let filter : Parser<_,unit> = ws >>. searchCondition .>> eof

open FParsec
do printf "%A" (run SqlParserImpl.filter "((((((1) = ((1 + (2)))))) or ((2 + ((3))) = 2)) or (3 = 3))")