'sepEndBy' does not capture if wrapped in in 'between' - f#

Question

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

Answer 1

The reason FParsec can't generate more useful error messages for your example is that you've defined the ws and id parsers using the satisfy primitive. Since you only specified a predicate function, FParsec doesn't know how to describe the expected input. The User's Guide explains this issues and how to avoid it. In your code, you could e.g. use satisfyL or many1SatisfyL for the definitions.
After fixing the ws and id parsers you'll quickly discover that your code doesn't properly parse the list because the whitespace parsing is messed up. Where possible, you should always parse whitespace as trailing whitespace, not as leading whitespace, because this avoids the need for backtracking. To fix your parser for the input you gave above, you could e.g. replace
sepEndBy1 (ws >>. whereCondition) (newline)
with
sepEndBy1 (whereCondition .>> ws) (newline >>. ws)
in the definition of multiConditionWhereList.
Note that a non-empty error message list doesn't necessarily imply an error, as FParsec will generally collect the error messages of all parsers that were applied at the current position in the stream, even if the parser is "optional". This is probably the reason you were seeing the "expected newline", since a newline would have been accepted at that position.