F#、FParsec 和更新用户状态

好吧，自从我的最后一个问题没有引起任何反应，我正在朝不同的方向前进。哈哈！

我找不到任何超出的例子官方文档管理用户状态或访问先前解析器的结果。

注意：这段代码的作用是not编译。

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 private 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))

  // TODO: This is the parser I'm asking about.
  let pHeader =
      let includesBoundary s = undefined
      let setBoundary b = { Boundary=b }
       in delimited3 ":" ";" "=" blankField
          |>> makeHeader
          >>. fun stream -> if includesBoundary // How do I access the output from makeHeader here?
                            then stream.UserState <- setBoundary b // I need b to be read from the output of makeHeader.
                                 Reply ()
                            else Reply ()

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

  // N.b. This is the mess I'm currently wrestling with. It does not compile, and is
  // not sound yet.
  let rec pContent boundary =
      match boundary with
      | "" -> // Content is text.
              let line = restOfLine false
               in pipe2 pHeaders (manyTill line $ attempt (preturn () .>> blankField))
                  $ fun h c -> { headers=h
                               ; content=Content $ System.String.Join (System.Environment.NewLine,c) }
      | _  -> // Content contains boundaries.
              let b = "--"+boundary
              let p = pipe2 pHeaders (pContent b) $ fun h c -> { headers=h; content=c }
               in skipString b >>. manyTill p (attempt (preturn () .>> blankField))

  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 isBoundary ((s:string),_) = s.ToLower() = "boundary"
    let header = r.headers
                 |> List.tryFind (fun h -> if h.addl.IsSome
                                           then h.addl.Value |> List.exists isBoundary
                                           else false)
     in match header with
        | Some h -> h.addl.Value |> List.find 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"

我试图解析的 POST 的截断示例如下：

content-type: Multipart/related; boundary="RN-Http-Body-Boundary"; type="multipart/related"

--RN-Http-Body-Boundary
Message-ID: <25845033.1160080657073.JavaMail.webmethods@exshaw>
Mime-Version: 1.0
Content-Type: multipart/related; type="application/xml";
  boundary="----=_Part_235_11184805.1160080657052"

------=_Part_235_11184805.1160080657052
Content-Type: Application/XML
Content-Transfer-Encoding: binary
Content-Location: RN-Preamble
Content-ID: <1430586.1160080657050.JavaMail.webmethods@exshaw>

XML document begins here...

所以基本上，你想做什么pHeader是将解析器用作 monad，而不是应用程序。根据你的代码风格，你来自 Haskell，所以我假设你知道这些词。然后是这样的：

  let pHeader =
      let includesBoundary s = undefined
      let setBoundary b = { Boundary=b }
       in delimited3 ":" ";" "=" blankField
          |>> makeHeader
          >>= fun header stream ->
               if includesBoundary header
               then let b = undefined // some expression including header, if I understood correctly
                    stream.UserState <- setBoundary b
                    Reply ()
               else Reply ()

或者你可以将其写在计算表达式中（这对应于 Haskell 中的 do-notation）：

  let pHeader =
      let includesBoundary s = undefined
      let setBoundary b = { Boundary=b }
      parse {
          let! header =
              delimited3 ":" ";" "=" blankField
              |>> makeHeader
          return! fun stream ->
               if includesBoundary header
               then let b = undefined // some expression including header, if I understood correctly
                    stream.UserState <- setBoundary b
                    Reply ()
               else Reply ()
      }