FParsecworking.fs

open FParsec

let ws = spaces
let str_ws s = pstring s >>. ws

[<RequireQualifiedAccess>]
type QueryComparison = 
    | Equal
    | NotEqual

[<RequireQualifiedAccess>]
type TableOperators =
  | And
  | Or

[<RequireQualifiedAccess>]
type Filter =
  | Property of name: string * QueryComparison * value: string
  | Combined of Filter * TableOperators * Filter


let letterOrNumber = asciiLetter <|> digit
let manyLettersOrNumbers = many1Chars letterOrNumber
let manyCharsNotSingleQuote = (many1Chars (noneOf [ '\'' ]))

let stringParser =
  let quote = pchar '\''
  between quote quote manyCharsNotSingleQuote |>> (string)

let fieldValueParser = stringParser

let queryComparisonParser =
  [ ("eq", QueryComparison.Equal); ("ne", QueryComparison.NotEqual) ]
  |> List.map (fun (toMatch, qc) -> stringReturn toMatch qc <?> (sprintf "%O" qc))
  |> choice

let propertyParser =
  let name = manyLettersOrNumbers .>> spaces <?> "Name"

  let queryComparison = queryComparisonParser .>> spaces <?> "QueryComparison"

  let filterValue = fieldValueParser <?> "FilterValue"

  name .>>. queryComparison .>>. filterValue |>> (fun ((n, qc), fv) -> Filter.Property(n, qc, fv))

let opp = new OperatorPrecedenceParser<Filter,unit,unit>()
let expr = opp.ExpressionParser
let term = (propertyParser .>> ws) <|> between (str_ws "(") (str_ws ")") expr
opp.TermParser <- term

type Assoc = Associativity

opp.AddOperator(InfixOperator("and", spaces, 1, Associativity.Left, fun left right -> printfn "AND (%A, %A)" left right; Filter.Combined(left, TableOperators.And, right)))
opp.AddOperator(InfixOperator("or", spaces, 2, Associativity.Left, fun left right -> printfn "OR (%A, %A)" left right; Filter.Combined(left, TableOperators.Or, right)))

let filter = spaces >>. expr .>> spaces .>> eof

[<EntryPoint>]
let main argv =
    run filter "Name eq 'Dave' and Colour ne 'red'" |> printfn "%A"
    run filter "(Name eq 'Dave') and (Colour ne 'red')" |> printfn "%A"
    run filter "Name eq 'Dave'" |> printfn "%A"
    0 // return an integer exit code