문제

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
도움이 되었습니까?

해결책

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.

라이센스 : CC-BY-SA ~와 함께 속성
제휴하지 않습니다 StackOverflow
scroll top