1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
type 'a t =
| Content_type : Content_type.t t
| Content_encoding : Content_encoding.t t
| Content_disposition : Content_disposition.t t
| Field : Unstrctrd.t t
type witness = Witness : 'a t -> witness
type field = Field : Field_name.t * 'a t * 'a -> field
let pp_unstrctrd ppf v = Fmt.string ppf (Unstrctrd.to_utf_8_string v)
let pp ppf (Field (field_name, w, v)) =
let of_witness : type a. a t -> a Fmt.t = function
| Content_type -> Content_type.pp
| Content_encoding -> Content_encoding.pp
| Content_disposition -> Content_disposition.pp
| Field -> pp_unstrctrd in
let is_unstructured = match w with Field -> true | _ -> false in
Fmt.pf ppf "%a[%c]: @[<hov>%a@]" Field_name.pp field_name
(if is_unstructured then '!' else '*')
(of_witness w) v
let ( <.> ) f g x = f (g x)
let of_field_name : Field_name.t -> witness =
fun field_name ->
match String.lowercase_ascii (field_name :> string) with
| "content-type" -> Witness Content_type
| "content-transfer-encoding" -> Witness Content_encoding
| "content-disposition" -> Witness Content_disposition
| _ -> Witness Field
let parser : type a. a t -> a Angstrom.t = function
| Content_type -> Content_type.Decoder.content
| Content_encoding -> Content_encoding.Decoder.mechanism
| Content_disposition -> Content_disposition.Decoder.disposition
| Field ->
let buf = Bytes.create 0x7f in
Unstrctrd_parser.unstrctrd buf
module Decoder = struct
open Angstrom
let field ?g field_name =
let buf = Bytes.create 0x7f in
Unstrctrd_parser.unstrctrd buf >>= fun v ->
let (Witness w) =
match Option.bind g (Field_name.Map.find_opt field_name) with
| None -> of_field_name field_name
| Some w -> w in
let parser = parser w in
let res =
let open Rresult in
Unstrctrd.without_comments v
>>| Unstrctrd.fold_fws
>>| Unstrctrd.to_utf_8_string
>>= (R.reword_error R.msg
<.> (parse_string ~consume:Consume.Prefix) parser)
>>| fun v -> Field (field_name, w, v) in
match res with
| Ok v -> return v
| Error _ -> return (Field (field_name, Field, v))
end
let encoder : type a. a t -> a Prettym.t = function
| Content_type -> Content_type.Encoder.content_type
| Content_encoding -> Content_encoding.Encoder.mechanism
| Content_disposition -> Content_disposition.Encoder.disposition
| Field -> assert false
module Encoder = struct
open Prettym
let field ppf field =
let (Field (field_name, w, v)) = field in
let e = encoder w in
eval ppf
[
tbox 1;
!!Field_name.Encoder.field_name;
string $ ":";
spaces 1;
!!e;
close;
new_line;
]
field_name v
end