1

感谢您对我的第一篇文章和我关于这个项目的第二篇文章的回复。这个问题与第一个问题基本相同,但我的代码根据收到的关于这两个问题的反馈进行了更新。如何递归调用我的解析器?

我在挠头,茫然地盯着代码。我不知道从这里去哪里。那是我转向stackoverflow的时候。

我在代码注释中包含了我收到的编译时错误。一个绊脚石可能是我受歧视的工会。我与受歧视的工会合作的不多,所以我可能会错误地使用我的工会。

我正在使用的示例 POST(我在前两个问题中包含的部分内容)由一个边界组成,该边界包括具有新边界的第二个帖子。第二个帖子包括由第二个边界分隔的几个附加部分。这几个附加部分中的每一个都是由标题和 XML 组成的新帖子。

我在这个项目中的目标是构建一个在我们的 C# 解决方案中使用的库,该库采用流并将 POST 递归地解析为标题和部分。我真的希望 F# 在这里大放异彩。

namespace MultipartMIMEParser

open FParsec
open System.IO

type Header = { name  : string
              ; value : string
              ; addl  : (string * string) list option }

type Content = Content of string
             | Post of Post list
and Post = { headers : Header list
           ; content : Content }

type UserState = { Boundary : string }
  with static member Default = { Boundary="" }

module internal P =
  let ($) f x = f x
  let undefined = failwith "Undefined."
  let ascii = System.Text.Encoding.ASCII
  let str cs = System.String.Concat (cs:char list)

  let makeHeader ((n,v),nvps) = { name=n; value=v; addl=nvps}

  let runP p s = match runParserOnStream p UserState.Default "" s ascii with
                 | Success (r,_,_) -> r
                 | Failure (e,_,_) -> failwith (sprintf "%A" e)

  let blankField = parray 2 newline

  let delimited d e =
      let pEnd = preturn () .>> e
      let part = spaces
                 >>. (manyTill
                      $ noneOf d
                      $ (attempt (preturn () .>> pstring d)
                                  <|> pEnd)) |>> str
       in part .>>. part

  let delimited3 firstDelimiter secondDelimiter thirdDelimiter endMarker =
      delimited firstDelimiter endMarker
      .>>. opt (many (delimited secondDelimiter endMarker
                      >>. delimited thirdDelimiter endMarker))

  let isBoundary ((n:string),_) = n.ToLower() = "boundary"

  let pHeader =
      let includesBoundary (h:Header) = match h.addl with
                                        | Some xs -> xs |> List.exists isBoundary
                                        | None    -> false
      let setBoundary b = { Boundary=b }
       in delimited3 ":" ";" "=" blankField
          |>> makeHeader
          >>= fun header stream -> if includesBoundary header
                                   then
                                     stream.UserState <- setBoundary (header.addl.Value
                                                                      |> List.find isBoundary
                                                                      |> snd)
                                     Reply ()
                                   else Reply ()

  let pHeaders = manyTill pHeader $ attempt (preturn () .>> blankField)

  let rec pContent (stream:CharStream<UserState>) =
      match stream.UserState.Boundary with
      | "" -> // Content is text.
              let nl = System.Environment.NewLine
              let unlines (ss:string list) = System.String.Join (nl,ss)
              let line = restOfLine false
              let lines = manyTill line $ attempt (preturn () .>> blankField)
               in pipe2 pHeaders lines
                        $ fun h c -> { headers=h
                                     ; content=Content $ unlines c }
      | _  -> // Content contains boundaries.
              let b = "--" + stream.UserState.Boundary
              // VS complains about pContent in the following line: 
              // Type mismatch. Expecting a
              //    Parser<'a,UserState>
              // but given a
              //    CharStream<UserState> -> Parser<Post,UserState>
              // The type 'Reply<'a>' does not match the type 'Parser<Post,UserState>'
              let p = pipe2 pHeaders pContent $ fun h c -> { headers=h; content=c }
               in skipString b
                  >>. manyTill p (attempt (preturn () .>> blankField))
                  // VS complains about Content.Post in the following line: 
                  // Type mismatch. Expecting a
                  //     Post list -> Post
                  // but given a
                  //     Post list -> Content
                  // The type 'Post' does not match the type 'Content'
                  |>> Content.Post

  // VS complains about pContent in the following line: 
  // Type mismatch. Expecting a
  //    Parser<'a,UserState>    
  // but given a
  //    CharStream<UserState> -> Parser<Post,UserState>
  // The type 'Reply<'a>' does not match the type 'Parser<Post,UserState>'
  let pStream = runP (pipe2 pHeaders pContent $ fun h c -> { headers=h; content=c })


type MParser (s:Stream) =
  let r = P.pStream s

  let findHeader name =
    match r.headers |> List.tryFind (fun h -> h.name.ToLower() = name) with
    | Some h -> h.value
    | None   -> ""

  member p.Boundary =
    let header = r.headers
                 |> List.tryFind (fun h -> match h.addl with
                                           | Some xs -> xs |> List.exists P.isBoundary
                                           | None    -> false)
     in match header with
        | Some h -> h.addl.Value |> List.find P.isBoundary |> snd
        | None   -> ""
  member p.ContentID = findHeader "content-id"
  member p.ContentLocation = findHeader "content-location"
  member p.ContentSubtype = findHeader "type"
  member p.ContentTransferEncoding = findHeader "content-transfer-encoding"
  member p.ContentType = findHeader "content-type"
  member p.Content = r.content
  member p.Headers = r.headers
  member p.MessageID = findHeader "message-id"
  member p.MimeVersion = findHeader "mime-version"

编辑

为了回应我迄今为止收到的反馈(谢谢!),我做了以下调整,收到注释的错误:

let rec pContent (stream:CharStream<UserState>) =
    match stream.UserState.Boundary with
    | "" -> // Content is text.
            let nl = System.Environment.NewLine
            let unlines (ss:string list) = System.String.Join (nl,ss)
            let line = restOfLine false
            let lines = manyTill line $ attempt (preturn () .>> blankField)
             in pipe2 pHeaders lines
                      $ fun h c -> { headers=h
                                   ; content=Content $ unlines c }
    | _  -> // Content contains boundaries.
            let b = "--" + stream.UserState.Boundary
            // The following complaint is about `pContent stream`:
            // This expression was expected to have type
            //     Reply<'a>    
            // but here has type
            //     Parser<Post,UserState>
            let p = pipe2 pHeaders (fun stream -> pContent stream) $ fun h c -> { headers=h; content=c }
             in skipString b
                >>. manyTill p (attempt (preturn () .>> blankField))
                // VS complains about the line above:
                // Type mismatch. Expecting a
                //     Parser<Post,UserState>    
                // but given a
                //     Parser<'a list,UserState>    
                // The type 'Post' does not match the type ''a list'

// See above complaint about `pContent stream`. Same complaint here.
let pStream = runP (pipe2 pHeaders (fun stream -> pContent stream) $ fun h c -> { headers=h; content=c })

我尝试加入Reply ()s,但它们只是返回解析器,意思是c上面变成了 aParser<...>而不是Content. 这似乎是一种倒退,或者至少是在错误的方向上。不过我承认我的无知,欢迎指正!

4

2 回答 2

0

我可以帮助解决其中一个错误。

F# 通常从左到右绑定参数,因此您需要在递归调用周围使用括号pContent或使用管道向后运算符<|来表明您想要评估递归调用并绑定返回值。

还值得注意的是,<|这与您的$运营商相同。

Content.Post不是Post 对象构造函数。你需要一个函数来接受一个 Post 列表并返回一个 Post。(List 模块中的某些东西可以满足您的需要吗?)

于 2014-11-13T05:22:02.020 回答
0

我的第一个答案是完全错误的,但我想我会留下它。

类型PostContent定义为:

type Content =
    | Content of string
    | Post of Post list
and Post =
    { headers : Header list
    ; content : Content }

Post是一个记录,Content是一个受歧视的联盟。

F# 将区分联合的案例视为与类型分开的命名空间。所以Content是不同的Content.Content,又Post是不同的Content.Post。因为它们是不同的,所以具有相同的标识符是令人困惑的。

pContent应该返回什么?如果它应该返回 Discriminate Union Content,您需要将Post您在第一种情况下返回的记录包装在这种Content.Post情况下,即

$ fun h c -> Post [ { headers=h
                    ; content=Content $ unlines c } ]

(F# 能够推断出 'Post' 指的是Content.Post大小写,而不是Post这里的记录类型。)

于 2014-11-14T01:25:45.413 回答