F #, FParsec, и вызывать поток анализатора рекурсивно, второй принять

Question

Благодарим вас за ответы на вопросы my first post и my second post по этому проекту. Этот вопрос в основном совпадает с первым вопросом, но с моим кодом, обновленным в соответствии с отзывами, полученными по этим двум вопросам. Как я рекурсивно вызываю свой парсер?

Я почесываю голову и безучастно смотрю на код. Я не знаю, куда идти отсюда. Вот когда я перехожу к stackoverflow.

Я включил в код комментарии ошибки компиляции, которые я получаю. Один камнем преткновения может быть мой дискриминационный союз. Я не работал с дискриминированными профсоюзами, поэтому я могу неправильно использовать мои.

Пример POST, с которым я работаю, бит, который я включил в мои предыдущие два вопроса, состоит из одной границы, которая включает второй пост с новой границей. Эта вторая должность включает в себя несколько дополнительных частей, разделенных второй границей. Каждая из этих нескольких дополнительных частей представляет собой новую запись, состоящую из заголовков и XML.

Моя цель в этом проекте состоит в том, чтобы создать библиотеку, которая будет использоваться в нашем решении C#, с библиотекой, принимающей поток и возвращающей POST, анализируемой в заголовки и части рекурсивно. I действительно хочу 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" 

EDIT

В ответ на обратной связи я получил до сих пор (! Спасибо), я сделал следующие настройки, получая ошибки аннотированный:

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

I пытались бросить в Reply() с, но они просто вернули синтаксические анализаторы, то есть c выше стал Parser<...>, а не Content. Казалось, это был шаг назад или, по крайней мере, в неправильном направлении. Однако я признаю свое невежество и приветствую исправление!

Answer 1

Я могу помочь с одной из ошибок.

F # обычно связывают аргументы слева направо, так что вам нужно использовать либо круглые скобки вокруг рекурсивных вызовов на pContent или трубчатый назад операторе <|, чтобы показать, что вы хотите, чтобы оценить рекурсивный вызов и связать возвращаемое значение.

Стоит также отметить, что <| - это то же самое, что и ваш оператор $.

Content.Postне конструктор объекта Post. Вам нужна функция для приема списка сообщений и возврата сообщения. (Делает что-то из List module, что вам нужно?)

Answer 2

Мой первый ответ был совершенно неправильным, но я думал, что оставлю его.

Типы Post и Content определяется как:

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

Post является записью, и Content является дискриминированным союзом.

F # рассматривает случаи для Discriminated Unions как отдельное пространство имен из типов. Таким образом, Content отличается от Content.Content и Post отличается от Content.Post. Потому что они разные, один и тот же идентификатор сбивает с толку.

Что должно быть возвращено pContent? Если это должно быть возвращение дискриминированного Союза Content, вам нужно обернуть Post записи вы возвращаете в первом случае в Content.Post случае т.е.

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

(F # может сделать вывод о том, что «сообщение» относится к Content.Post case, а не тип записи Post.)