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

Спасибо за ответы на мой первый пост и мой второй пост в этом проекте. Этот вопрос в основном такой же, как и первый, но мой код обновлен в соответствии с отзывами, полученными по этим двум вопросам. Как мне вызвать мой парсер рекурсивно?

Я чешу затылок и тупо смотрю на код. Я понятия не имею, куда идти отсюда. Вот когда я перехожу к 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 (), но они просто вернули парсеры, то есть c выше стало Parser<...>, а не Content. Казалось, это был шаг назад или, по крайней мере, в неправильном направлении. Я признаю свое невежество, однако, и приветствую исправления!


person Jeff Maner    schedule 12.11.2014    source источник
comment
Кажется, вы хотите определить pContent как функцию парсера, т.е. как функцию, которая возвращает значение Reply, но вместо этого вы возвращаете функции парсера на обеих ветвях.   -  person Stephan Tolksdorf    schedule 12.11.2014
comment
@StephanTolksdorf Я пытался добавить Reply (), но c затем изменил тип с Content на Parser<...>. Я признаю свое невежество, но думаю, что это неправильное направление. Пожалуйста, поправьте меня, если я не прав.   -  person Jeff Maner    schedule 13.11.2014
comment
Вы можете заставить свой код компилироваться, передав аргумент stream в pContent в качестве аргумента функциям синтаксического анализатора, которые вы создаете в обеих ветвях. В первой ветке вам также нужно обернуть значение Post {...} в список, а затем в Content.Post. Вы можете быстро убедиться в этом, добавив явную аннотацию типа для возвращаемого типа pContent.   -  person Stephan Tolksdorf    schedule 13.11.2014
comment
Обратите внимание, что построение функций синтаксического анализатора на лету, как в pContent, может быть весьма неэффективным. Я бы рекомендовал разбить анализатор на компоненты, а затем использовать createParserForwardedToRef, чтобы разбить прямую рекурсию. Я также рекомендую вам попытаться немного понять, как функции парсера и комбинаторы работают под капотом (например, прочитав исходный код или руководство пользователя), что должно облегчить вам создание и отладку парсеров.   -  person Stephan Tolksdorf    schedule 13.11.2014
comment
@StephanTolksdorf, спасибо за помощь. Я просматриваю Руководство пользователя и Справочник по FParsec, но не хочу тратить слишком много времени на изучение того, как все это работает под капотом. Может пора копать...   -  person Jeff Maner    schedule 14.11.2014


Ответы (2)


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

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

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

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

person Christopher Stevenson    schedule 13.11.2014
comment
1) Я не понимаю, как помогает добавление круглых скобок вокруг рекурсивного вызова pContent. Я возьму на себя вину и скажу, что я туплю. Вы уточните? 2) Я знал о тождестве между <| и $. Исходя из Haskell, я просто думаю, что $ красивее и лаконичнее. :) 3) Что меня смущает в вашем третьем пункте, так это то, что VS жалуется на то, что Post является Content. Итак, я добавляю конструктор Content, а он жалуется на то, что Content является Post. Но я не увидел в List ничего полезного. Поскольку я определяю Post как of Post list, кажется, что он должен ввести проверку. - person Jeff Maner; 13.11.2014
comment
На самом деле <| и $ не совсем эквивалентны. F# <| левоассоциативный, а Haskell $ правоассоциативный. Итак, f <| g <| x — это f g x, а f $ g $ x — это f (g x). - person Tarmil; 14.11.2014

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

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

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? Если предполагается, что он возвращает Discriminated Union Content, вам необходимо обернуть запись Post, которую вы возвращаете в первом случае, в случае Content.Post, т.е.

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

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

person Christopher Stevenson    schedule 14.11.2014