F #, FParsec и обновление UserState

Question

Хорошо, поскольку my last question не выдал никаких ответов, я продвигаюсь вперед в другом направлении. Лол!

Я не могу найти примеров за пределами the official documentation об управлении пользовательским состоянием или обращении к результатам предыдущего анализатора.

N.b. Этот код делает не компиляции.

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... 

Answer 1

Так в основном, то, что вы хотите сделать в pHeader, чтобы использовать анализатор как монады, а не аппликативном , Основываясь на вашем стиле кода, вы пришли из 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):

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() 
     }