Спасибо за ответы на мой первый пост и мой второй пост в этом проекте. Этот вопрос в основном такой же, как и первый, но мой код обновлен в соответствии с отзывами, полученными по этим двум вопросам. Как мне вызвать мой парсер рекурсивно?
Я чешу затылок и тупо смотрю на код. Я понятия не имею, куда идти отсюда. Вот когда я перехожу к 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
. Казалось, это был шаг назад или, по крайней мере, в неправильном направлении. Я признаю свое невежество, однако, и приветствую исправления!
pContent
как функцию парсера, т.е. как функцию, которая возвращает значениеReply
, но вместо этого вы возвращаете функции парсера на обеих ветвях. - person Stephan Tolksdorf   schedule 12.11.2014Reply ()
, ноc
затем изменил тип сContent
наParser<...>
. Я признаю свое невежество, но думаю, что это неправильное направление. Пожалуйста, поправьте меня, если я не прав. - person Jeff Maner   schedule 13.11.2014stream
вpContent
в качестве аргумента функциям синтаксического анализатора, которые вы создаете в обеих ветвях. В первой ветке вам также нужно обернуть значениеPost {...}
в список, а затем вContent.Post
. Вы можете быстро убедиться в этом, добавив явную аннотацию типа для возвращаемого типаpContent
. - person Stephan Tolksdorf   schedule 13.11.2014pContent
, может быть весьма неэффективным. Я бы рекомендовал разбить анализатор на компоненты, а затем использоватьcreateParserForwardedToRef
, чтобы разбить прямую рекурсию. Я также рекомендую вам попытаться немного понять, как функции парсера и комбинаторы работают под капотом (например, прочитав исходный код или руководство пользователя), что должно облегчить вам создание и отладку парсеров. - person Stephan Tolksdorf   schedule 13.11.2014