mirror of
https://github.com/c-cube/ezcurl.git
synced 2025-12-06 11:15:44 -05:00
feat: add some printers
This commit is contained in:
parent
879272f313
commit
637674f6d0
2 changed files with 62 additions and 0 deletions
|
|
@ -26,6 +26,34 @@ module Config = struct
|
|||
let follow_location x self = {self with follow_location=x}
|
||||
let max_redirects x self = {self with max_redirects=max 1 x}
|
||||
let authmethod x self = {self with authmethod=Some x}
|
||||
|
||||
let string_of_authmethod = function
|
||||
| Curl.CURLAUTH_ANY -> "any"
|
||||
| Curl.CURLAUTH_BASIC -> "basic"
|
||||
| Curl.CURLAUTH_DIGEST -> "digest"
|
||||
| Curl.CURLAUTH_GSSNEGOTIATE -> "gss_negotiate"
|
||||
| Curl.CURLAUTH_NTLM -> "ntlm"
|
||||
| Curl.CURLAUTH_ANYSAFE -> "any_safe"
|
||||
|
||||
let str_of_str_opt = function
|
||||
| None -> "<none>"
|
||||
| Some s -> s
|
||||
|
||||
let pp out (self:t) =
|
||||
let {
|
||||
verbose; authmethod; max_redirects; follow_location;
|
||||
username; password;
|
||||
} = self in
|
||||
Format.fprintf out
|
||||
"{@[verbose=%B;@ max_redirects=%d;@ follow_location=%B;@ \
|
||||
username=%s;@ password=%s;@ authmethod=%s@]}"
|
||||
verbose max_redirects follow_location
|
||||
(str_of_str_opt username) (str_of_str_opt password)
|
||||
(match authmethod with
|
||||
| None -> "none"
|
||||
| Some l -> List.map string_of_authmethod l |> String.concat ",")
|
||||
|
||||
let to_string s = Format.asprintf "%a" pp s
|
||||
end
|
||||
|
||||
type t = Curl.t
|
||||
|
|
@ -80,6 +108,13 @@ type response_info = {
|
|||
ri_redirect_count: int;
|
||||
}
|
||||
|
||||
let pp_response_info out r =
|
||||
let {ri_response_time; ri_redirect_count} = r in
|
||||
Format.fprintf out "{@[response_time=%.3fs;@ redirect_count=%d@]}"
|
||||
ri_response_time ri_redirect_count
|
||||
|
||||
let string_of_response_info s = Format.asprintf "%a" pp_response_info s
|
||||
|
||||
type response = {
|
||||
code: int;
|
||||
headers: (string * string) list;
|
||||
|
|
@ -87,6 +122,21 @@ type response = {
|
|||
info: response_info;
|
||||
}
|
||||
|
||||
let pp_response out r =
|
||||
let pp_header out (s1,s2) =
|
||||
Format.fprintf out "@[<2>%s:@ %s@]" s1 s2
|
||||
in
|
||||
let pp_headers out l =
|
||||
Format.fprintf out "@[<v>%a@]" (Format.pp_print_list pp_header) l
|
||||
in
|
||||
let {code; body; headers; info; } = r in
|
||||
Format.fprintf out "{@[code=%d;@ headers=@[%a@];@ info=%a;@ body=@[%a@]@]}"
|
||||
code pp_headers headers pp_response_info info
|
||||
Format.pp_print_text body
|
||||
|
||||
|
||||
let string_of_response s = Format.asprintf "%a" pp_response s
|
||||
|
||||
type meth =
|
||||
| GET
|
||||
| POST of Curl.curlHTTPPost list
|
||||
|
|
@ -97,6 +147,8 @@ let string_of_meth = function
|
|||
| POST _ -> "POST"
|
||||
| PUT -> "PUT"
|
||||
|
||||
let pp_meth out m = Format.pp_print_string out (string_of_meth m)
|
||||
|
||||
module type IO = sig
|
||||
type 'a t
|
||||
val return : 'a -> 'a t
|
||||
|
|
|
|||
|
|
@ -10,6 +10,9 @@ module Config : sig
|
|||
val follow_location : bool -> t -> t
|
||||
val username : string -> t -> t
|
||||
val password : string -> t -> t
|
||||
|
||||
val pp : Format.formatter -> t -> unit
|
||||
val to_string : t -> string
|
||||
end
|
||||
|
||||
type t = Curl.t
|
||||
|
|
@ -34,6 +37,9 @@ type response_info = {
|
|||
ri_redirect_count: int;
|
||||
}
|
||||
|
||||
val pp_response_info : Format.formatter -> response_info -> unit
|
||||
val string_of_response_info : response_info -> string
|
||||
|
||||
type response = {
|
||||
code: int;
|
||||
headers: (string * string) list;
|
||||
|
|
@ -41,11 +47,15 @@ type response = {
|
|||
info: response_info;
|
||||
}
|
||||
|
||||
val pp_response : Format.formatter -> response -> unit
|
||||
val string_of_response : response -> string
|
||||
|
||||
type meth =
|
||||
| GET
|
||||
| POST of Curl.curlHTTPPost list
|
||||
| PUT
|
||||
|
||||
val pp_meth : Format.formatter -> meth -> unit
|
||||
val string_of_meth : meth -> string
|
||||
|
||||
(** {2 Underlying IO Monad} *)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue