1

次のテキストを解析したい:

 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
 )

条件のリストのコンビネータから始めました。

let multiConditionWhereList : Parser<WhereCondition list, unit> =
        sepEndBy1 (ws >>. whereCondition) (newline)
        <?> "where condition list"

where ステートメント (= を含むすべての行) の条件リストを渡すと、結果に 7 つの WhereConditions を含む応答が返されます。ステータスは「OK」です。しかし、エラーリストには「Expected newline」ErrorMessage が含まれています。

しかし、この種のリストを丸括弧で囲み、先頭に演算子を付けて、次の形のコンビネータで解析しようとすると、次のようになります。

let multiConditionWhereClause : Parser<WhereStatement, unit> =
        pstringCI "where"
        .>> spaces 
        >>. between (pchar '(') (pchar ')') 
                    ( ws  >>. whereChainOperator .>> spaces1
                      .>>. multiConditionWhereList )
        |>> (fun (chainOp, conds) -> { Operator = chainOp; 
                                       SearchConditions = conds } )

ステータス「エラー」の返信を受け取ります。しかし、エラーリストは結果と同様に空です。

だから私はこの時点でちょっと立ち往生しています。まず、私のmultiConditionWhereListのsepByEnd1コンビネータが空でないエラー リストを生成し、最後に改行が必要な理由がわかりません。さらに重要なことに、リストを between ステートメントでラップすると、リストがキャプチャされない理由がわかりません。

参考として、ルールのセット全体と、問題を引き起こすルールの呼び出しを含めます。

#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
4

1 に答える 1

4

FParsec があなたの例に対してより有用なエラー メッセージを生成できない理由は、プリミティブを使用してwsおよびidパーサーを定義したためです。satisfy述語関数のみを指定したため、FParsec は期待される入力を記述する方法を知りません。ユーザーズ ガイドでは、この問題とその回避方法について説明しています。コードでは、定義にsatisfyLorを使用できます。many1SatisfyL

wsおよびパーサーを修正するとid、空白の解析がめちゃくちゃになっているため、コードがリストを適切に解析していないことがすぐにわかります。可能であれば、空白を先頭の空白としてではなく、常に末尾の空白として解析する必要があります。これにより、バックトラックが不要になるためです。上記の入力に対してパーサーを修正するには、たとえば次のように置き換えます。

sepEndBy1 (ws >>. whereCondition) (newline)

と

sepEndBy1 (whereCondition .>> ws) (newline >>. ws)

の定義でmultiConditionWhereList。

FParsec は通常、パーサーが「オプション」であっても、ストリーム内の現在の位置に適用されたすべてのパーサーのエラー メッセージを収集するため、空でないエラー メッセージ リストは必ずしもエラーを意味しないことに注意してください。改行がその位置で受け入れられるため、これがおそらく「予想される改行」が表示された理由です。

于 2014-01-02T13:07:00.223 に答える