I want to parse the following text:
WHERE
( AND
ApplicationGroup.REFSTR = 5
BV_1.Year = 2009
BV_1.MonetaryCodeId = 'Commited'
BV_3.Year = 2009
BV_3.MonetaryCodeId = 'Commited'
BV_4.Year = 2009
BV_4.MonetaryCodeId = 'Commited
)
I started with a combinator for the list of conditions:
let multiConditionWhereList : Parser<WhereCondition list, unit> =
sepEndBy1 (ws >>. whereCondition) (newline)
<?> "where condition list"
When I give hand over the condition list of the where-statement (every line with an =) I get back a Reply with seven WhereConditions in its Result. The Status is "Ok". But the Error-list contains a "Expected newline" ErrorMessage.
But whenever I try to parse this kind of list wrapped in round braces with an oparator at the beginning with a combinator of the following shape:
let multiConditionWhereClause : Parser<WhereStatement, unit> =
pstringCI "where"
.>> spaces
>>. between (pchar '(') (pchar ')')
( ws >>. whereChainOperator .>> spaces1
.>>. multiConditionWhereList )
|>> (fun (chainOp, conds) -> { Operator = chainOp;
SearchConditions = conds } )
I get an Reply with Status "Error". But the Error-List is empty as well as the result.
So I'm kind of stuck at this point. First I don't understand, why the sepByEnd1 combinator in my multiConditionWhereList produces a non-empty error list and expects a newline at the end. And more important, I don't get why the list is not captured, when I wrap it in a between statement.
As a reference, I include the whole set of rules as well as an invocation of the rule which causes the problems:
#light
#r "System.Xml.Linq.dll"
#r @"..\packages\FParsec.1.0.1\lib\net40-client\FParsecCS.dll"
#r @"..\packages\FParsec.1.0.1\lib\net40-client\FParsec.dll"
module Ast =
open System
open System.Xml.Linq
type AlfabetParseError (msg: string) =
inherit Exception (msg)
type FindStatement =
{ TableReferences: TableReferences;}
and TableReferences =
{ PrimaryTableReference: TableReferenceWithAlias; JoinTableReferences: JoinTableReference list; }
and TableReferenceWithAlias =
{ Name: string; Alias: string }
and JoinTableReference =
{ JoinType:JoinType; TableReference: TableReferenceWithAlias; JoinCondition: JoinCondition; }
and JoinType =
| InnerJoin
| OuterJoin
| LeftJoin
| RightJoin
and JoinCondition =
{ LeftHandSide: FieldReference; RightHandSide: FieldReference; }
and WhereStatement =
{ Operator: WhereOperator; SearchConditions: WhereCondition list }
and WhereOperator =
| And
| Or
| Equal
| Is
| IsNot
| Contains
| Like
| NoOp
and WhereLeftHandSide =
| FieldReferenceLH of FieldReference
and WhereRightHandSide =
| FieldReferenceRH of FieldReference
| VariableReferenceRH of VariableReference
| LiteralRH of Literal
and WhereCondition =
{ LeftHandSide: WhereLeftHandSide; Operator: WhereOperator; RightHandSide: WhereRightHandSide; }
and FieldReference =
{ FieldName: Identifier; TableName: Identifier }
and VariableReference =
{ VariableName : Identifier; }
and Literal =
| Str of string
| Int of int
| Hex of int
| Bin of int
| Float of float
| Null
and Identifier =
Identifier of string
and QueryXml =
{ Doc : XDocument }
module AlfabetQueryParser =
open Ast
open FParsec
open System
open System.Xml.Linq
module Parsers =
(* Utilities *)
let toJoinType (str:string) =
match str.ToLowerInvariant() with
| "innerjoin" -> InnerJoin
| "outerjoin" -> OuterJoin
| "leftjoin" -> LeftJoin
| "rightjoin" -> RightJoin
| _ -> raise <| AlfabetParseError "Invalid join type"
let toWhereOperator (str:string) =
match str.ToLowerInvariant() with
| "and" -> And
| "or" -> Or
| "=" -> Equal
| "is" -> Is
| "is not" -> IsNot
| "contains" -> Contains
| "like" -> Like
| _ -> raise <| AlfabetParseError "Invalid where operator type"
(* Parsers *)
let ws : Parser<string, unit> =
manyChars (satisfy (fun c -> c = ' '))
let ws1 : Parser<string, unit> =
many1Chars (satisfy (fun c -> c = ' '))
let identifier : Parser<string, unit> =
many1Chars (satisfy (fun(c) -> isDigit(c) || isAsciiLetter(c) || c.Equals('_')))
let fieldReference : Parser<FieldReference, unit> =
identifier
.>> pstring "."
.>>. identifier
|>> (fun (tname, fname) -> {FieldName = Identifier(fname);
TableName = Identifier(tname) })
let variableReference : Parser<VariableReference, unit> =
pstring ":"
>>. identifier
|>> (fun vname -> { VariableName = Identifier(vname) })
let numeralOrDecimal : Parser<Literal, unit> =
numberLiteral NumberLiteralOptions.AllowFraction "number"
|>> fun num ->
if num.IsInteger then Int(int num.String)
else Float(float num.String)
let hexNumber : Parser<Literal, unit> =
pstring "#x" >>. many1SatisfyL isHex "hex digit"
|>> fun hexStr ->
Hex(System.Convert.ToInt32(hexStr, 16))
let binaryNumber : Parser<Literal, unit> =
pstring "#b" >>. many1SatisfyL (fun c -> c = '0' || c = '1') "binary digit"
|>> fun hexStr ->
Bin(System.Convert.ToInt32(hexStr, 2))
let numberLiteral : Parser<Literal, unit> =
choiceL [numeralOrDecimal
hexNumber
binaryNumber]
"number literal"
let strEscape =
pchar '\\' >>. pchar '\''
let strInnard =
strEscape <|> noneOf "\'"
let strInnards =
manyChars strInnard
let strLiteral =
between (pchar '\'') (pchar '\'') strInnards
|>> Str
let literal : Parser<Literal, unit> =
(pstringCI "null" |>> (fun str -> Null))
<|> numberLiteral
<|> strLiteral
let joinCondition : Parser<JoinCondition, unit> =
spaces .>> pstring "ON" .>> spaces
>>. fieldReference
.>> spaces .>> pstring "=" .>> spaces
.>>. fieldReference
|>> (fun(lhs, rhs) -> { LeftHandSide = lhs; RightHandSide = rhs })
let tableReferenceWithoutAlias : Parser<TableReferenceWithAlias, unit> =
identifier
|>> (fun (name) -> { Name = name; Alias = ""})
let tableReferenceWithAlias : Parser<TableReferenceWithAlias, unit> =
identifier
.>> spaces .>> pstringCI "as" .>> spaces
.>>. identifier
|>> (fun (name, alias) -> { Name = name; Alias = alias})
let primaryTableReference : Parser<TableReferenceWithAlias, unit> =
attempt tableReferenceWithAlias <|> tableReferenceWithoutAlias
let joinTableReference : Parser<JoinTableReference, unit> =
identifier
.>> spaces
.>>. (attempt tableReferenceWithAlias <|> tableReferenceWithoutAlias)
.>> spaces
.>>. joinCondition
|>> (fun ((joinTypeStr, tableRef), condition) -> { JoinType = toJoinType(joinTypeStr);
TableReference = tableRef;
JoinCondition = condition } )
let tableReferences : Parser<TableReferences, unit> =
primaryTableReference
.>> spaces
.>>. many (joinTableReference .>> spaces)
|>> (fun (pri, joinTables) -> { PrimaryTableReference = pri;
JoinTableReferences = joinTables; } )
let whereConditionOperator : Parser<WhereOperator, unit> =
choice [
pstringCI "="
; pstringCI "is not"
; pstringCI "is"
; pstringCI "contains"
; pstringCI "like"
]
|>> toWhereOperator
let whereChainOperator : Parser<WhereOperator, unit> =
choice [
pstringCI "and"
; pstringCI "or"
]
|>> toWhereOperator
let whereCondition : Parser<WhereCondition, unit> =
let leftHandSide : Parser<WhereLeftHandSide, unit> =
fieldReference |>> FieldReferenceLH
let rightHandSide : Parser<WhereRightHandSide, unit> =
(attempt fieldReference |>> FieldReferenceRH)
<|> (attempt variableReference |>> VariableReferenceRH)
<|> (literal |>> LiteralRH)
leftHandSide
.>> ws1 .>>. whereConditionOperator .>> ws1
.>>. rightHandSide
|>> (fun((lhs, op), rhs) -> { LeftHandSide = lhs;
Operator = op;
RightHandSide = rhs })
let singleConditionWhereClause : Parser<WhereStatement, unit> =
pstringCI "where" .>> spaces
>>. whereCondition
|>> (fun (cond) -> { Operator = NoOp;
SearchConditions = [ cond ] } );
let multiConditionChainOperator : Parser<WhereOperator, unit> =
pstring "(" .>> spaces >>. whereChainOperator .>> spaces
<?> "where multi-condition operator"
let multiConditionWhereList : Parser<WhereCondition list, unit> =
sepEndBy1 (ws >>. whereCondition) (newline)
<?> "where condition list"
let multiConditionWhereClause : Parser<WhereStatement, unit> =
pstringCI "where"
.>> spaces
>>. between (pchar '(') (pchar ')')
( ws >>. whereChainOperator .>> spaces1
.>>. multiConditionWhereList )
|>> (fun (chainOp, conds) -> { Operator = chainOp;
SearchConditions = conds } )
let whereClause : Parser<WhereStatement, unit> =
(attempt multiConditionWhereClause)
<|> singleConditionWhereClause
let findStatement : Parser<FindStatement, unit> =
spaces .>> pstringCI "find" .>> spaces
>>. tableReferences
|>> (fun (tableRef) -> { TableReferences = tableRef; } )
let queryXml : Parser<QueryXml, unit> =
pstringCI "QUERY_XML" .>> newline
>>. manyCharsTill anyChar eof
|>> (fun (xmlStr) -> { Doc = XDocument.Parse(xmlStr) } )
let parse input =
match run Parsers.findStatement input with
| Success (x, _, _) -> x
| Failure (x, _, _) -> raise <| AlfabetParseError x
open FParsec
let input = @"WHERE
( AND
ApplicationGroup.REFSTR CONTAINS :BASE
BV_1.Year = 2009
BV_1.MonetaryCodeId = 'Commited'
BV_3.Year = 2009
BV_3.MonetaryCodeId = 'Commited'
BV_4.Year = 2009
BV_4.MonetaryCodeId = 'Commited'
)"
let r = run AlfabetQueryParser.Parsers.multiConditionWhereClause input