Skip to content

wsproxy: code removal and stylistic changes #7099

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
contificate merged 4 commits into from
May 29, 2026
Merged

wsproxy: code removal and stylistic changes #7099

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
1e14802
Use let-operators in wsproxy iteratees
contificate May 26, 2026
b2877d2
Use let-operators in websockets.ml
contificate May 27, 2026
3708203
Use point-free style in int unmarshallers
contificate May 27, 2026
1d74774
Remove unused code in iteratees
contificate May 27, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
233 changes: 96 additions & 137 deletions ocaml/wsproxy/src/iteratees.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,9 +39,16 @@ module Iteratee (IO : Monad) = struct
| IE_done of 'a
| IE_cont of err option * (stream -> ('a t * stream) IO.t)

module IO_Ops = struct
let ( let* ) = IO.bind

let return = IO.return
end

let return x = IE_done x

let rec bind i f =
let open IO_Ops in
match i with
| IE_done result ->
f result
Expand All @@ -52,12 +59,16 @@ module Iteratee (IO : Monad) = struct
| IE_cont (None, k) ->
k stream
| x ->
IO.return (x, stream)
return (x, stream)
Copy link
Copy Markdown
Member

@minglumlu minglumlu May 28, 2026 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I need to keep this in mind: in the continuation k, the return is always IO.return; while in f, it is Iteratee.return.

)
| x, stream ->
IO.return (bind x f, stream)
return (bind x f, stream)
in
let go s =
let* p = k s in
docase p
in
IE_cont (e, fun s -> IO.bind (k s) docase)
IE_cont (e, go)

let ( >>= ) = bind

Expand All @@ -67,14 +78,6 @@ module Iteratee (IO : Monad) = struct

let ie_errM msg k x = IO.return (IE_cont (Some msg, k), x)

let state = function
| IE_done _ ->
"Done"
| IE_cont (None, _) ->
"Ready"
| IE_cont (Some e, _) ->
Printf.sprintf "Error (%s)" e

(* Simplest iteratees *)

let rec peek =
Expand Down Expand Up @@ -107,14 +110,14 @@ module Iteratee (IO : Monad) = struct
IE_cont (None, step)

let writer really_write _ =
let open IO_Ops in
let rec step st =
match st with
| Chunk s ->
IO.bind (really_write s) (fun () ->
IO.return (IE_cont (None, step), Chunk "")
)
let* () = really_write s in
return (IE_cont (None, step), Chunk "")
| Eof _ ->
IO.return (IE_done (), st)
return (IE_done (), st)
in
IE_cont (None, step)

Expand Down Expand Up @@ -188,11 +191,13 @@ module Iteratee (IO : Monad) = struct
in
IE_cont (None, step "" n)

let read_int8 = readn 1 >>= fun s -> return (unmarshal_int8 s)
let ( >> ) f g x = g (f x)

let read_int8 = readn 1 >>= (unmarshal_int8 >> return)

let read_int16 = readn 2 >>= fun s -> return (unmarshal_int16 s)
let read_int16 = readn 2 >>= (unmarshal_int16 >> return)

let read_int32 = readn 4 >>= fun s -> return (unmarshal_int32 s)
let read_int32 = readn 4 >>= (unmarshal_int32 >> return)

let drop_while pred =
let rec step st =
Expand All @@ -208,26 +213,6 @@ module Iteratee (IO : Monad) = struct
in
IE_cont (None, step)

let accumulate =
let rec step acc st =
match st with
| Chunk s ->
ie_contM (step (acc ^ s)) (Chunk "")
| Eof _ ->
ie_doneM acc st
in
IE_cont (None, step "")

let apply f =
let rec step st =
match st with
| Chunk s ->
f s ; ie_contM step (Chunk "")
| Eof _ ->
ie_doneM () st
in
IE_cont (None, step)

let liftI m =
let step st i =
match i with
Expand All @@ -245,145 +230,119 @@ module Iteratee (IO : Monad) = struct
(* Simplest enumarator *)

let enum_eof i =
let open IO_Ops in
let result =
match i with
| IE_cont (None, f) ->
IO.bind (f (Eof None)) (fun x -> IO.return (fst x))
let* i, _ = f (Eof None) in
return i
| _ ->
IO.return i
return i
in
IO.bind result (function
| IE_done _ ->
result
| IE_cont (Some _, _) ->
result
| _ ->
failwith "Divergent Iteratee"
)
let* it = result in
match it with
| IE_done _ | IE_cont (Some _, _) ->
result
| _ ->
failwith "Divergent iteratee"

let enum_1chunk str = function
let enum_1chunk str =
let open IO_Ops in
function
| IE_cont (None, f) ->
IO.bind (f (Chunk str)) (fun x -> IO.return (fst x))
let* i, _ = f (Chunk str) in
return i
| x ->
IO.return x
return x

let rec enum_nchunk str n =
if str = "" then
fun x ->
IO.return x
else
let str1, str2 = split str n in
function
| IE_cont (None, f) ->
IO.bind
(IO.bind (f (Chunk str1)) (fun x -> IO.return (fst x)))
(enum_nchunk str2 n)
| x ->
IO.return x

let extract_result_from_iteratee = function
| IE_done x ->
x
| _ ->
failwith "Not done!"

type 'a enumeratee = 'a t -> 'a t t
let open IO_Ops in
match str with
| "" ->
return
| _ -> (
function
| IE_cont (None, f) ->
let s1, s2 = split str n in
let* i =
let* i, _ = f (Chunk s1) in
return i
in
enum_nchunk s2 n i
| x ->
return x
)

let rec take =
let step n k s =
let open IO_Ops in
match s with
| Chunk str ->
let len = String.length str in
if len < n then
IO.bind (k s) (fun (i, _) -> IO.return (take (n - len) i, Chunk ""))
let* i, _ = k s in
return (take (n - len) i, Chunk "")
else
let str1, str2 = split str n in
IO.bind (k (Chunk str1)) (fun (i, _) ->
IO.return (IE_done i, Chunk str2)
)
let s1, s2 = split str n in
let* i, _ = k (Chunk s1) in
return (IE_done i, Chunk s2)
| Eof _ ->
IO.bind (k s) (fun (i, _) -> IO.return (IE_done i, s))
let* i, _ = k s in
return (IE_done i, s)
in
function
| 0 ->
return
| n -> (
fun s ->
match s with
| IE_cont (None, k) ->
IE_cont (None, step n k)
| IE_cont (Some _, _) | IE_done _ ->
bind (drop n) (fun () -> return s)
function
Copy link
Copy Markdown
Member

@minglumlu minglumlu May 28, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is neater. But to be honest, fun s -> makes me think more quickly this is a continuation. 😄

| IE_cont (None, k) ->
IE_cont (None, step n k)
| (IE_cont (Some _, _) | IE_done _) as it ->
bind (drop n) (fun () -> return it)
)

let stream_printer name =
let rec step k s =
let open IO_Ops in
Printf.printf "%s: %s\n" name (string_of_stream s) ;
IO.bind (k s) (fun i ->
match i with
| IE_cont (None, f), s ->
IO.return (IE_cont (None, step f), s)
| IE_cont (err, f), s ->
IO.return (IE_cont (err, step f), s)
| i, s ->
IO.return (IE_done i, s)
)
let* i, s = k s in
match i with
| IE_cont (err, f) ->
return (IE_cont (err, step f), s)
| _ ->
return (IE_done i, s)
in
fun s ->
match s with
| IE_cont (None, k) ->
IE_cont (None, step k)
| IE_cont (Some _, _) | IE_done _ ->
return s
function
| IE_cont (None, k) ->
IE_cont (None, step k)
| (IE_cont (Some _, _) | IE_done _) as it ->
return it

let modify f =
let rec step k s =
let open IO_Ops in
match s with
| Chunk c ->
| Chunk c -> (
let s =
try f c
with e ->
Printf.printf "got exception %s\n%!" (Printexc.to_string e) ;
raise e
in
IO.bind (k (Chunk s)) (fun i ->
match i with
| IE_cont (None, f), s ->
IO.return (IE_cont (None, step f), s)
| IE_cont (err, f), s ->
IO.return (IE_cont (err, step f), s)
| i, s ->
IO.return (IE_done i, s)
)
let* i, s = k (Chunk s) in
match i with
| IE_cont (err, f) ->
return (IE_cont (err, step f), s)
| _ ->
return (IE_done i, s)
)
| Eof _ ->
IO.bind (k s) (fun (i, _) -> IO.return (IE_done i, s))
let* i, _ = k s in
return (IE_done i, s)
in
fun s ->
match s with
| IE_cont (None, k) ->
IE_cont (None, step k)
| IE_cont (Some _, _) ->
return s
| IE_done _ ->
return s

type 'a either = Left of 'a | Right of 'a

let read_lines =
let ( >>= ) = bind in
let iscrlf = function '\r' | '\n' -> true | _ -> false in
let terminators =
heads "\r\n" >>= function 0 -> heads "\n" | n -> return n
in
let rec lines' acc = break iscrlf >>= fun l -> terminators >>= check acc l
and check acc l n =
match (l, n) with
| _, 0 ->
return (Left (List.rev acc))
| "", _ ->
return (Right (List.rev acc))
| l, _ ->
lines' (l :: acc)
in
lines' []
function
| IE_cont (None, k) ->
IE_cont (None, step k)
| (IE_cont (Some _, _) | IE_done _) as it ->
return it
end
23 changes: 1 addition & 22 deletions ocaml/wsproxy/src/iteratees.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -61,9 +61,6 @@ module Iteratee : functor (IO : Monad) -> sig
val ie_errM :
err -> (stream -> ('a t * stream) IO.t) -> 'b -> ('a t * 'b) IO.t

val state : 'a t -> string
(** Return a string representation of the state of the monad *)

val peek : char option t
(** Here are the first iteratees
peek - iteratee that look at the first character in the stream
Expand Down Expand Up @@ -105,12 +102,6 @@ module Iteratee : functor (IO : Monad) -> sig
(** drop_while - iteratee that drops characters from the stream while they
satisfy the supplied predicate *)

val accumulate : string t
(** accumulate - Simply accumulate the stream until EOF *)

val apply : (string -> unit) -> unit t
(** apply - applies the chunks to the supplied function (for side effect) *)

val liftI : 'a t IO.t -> 'a t
(** liftI - turn an iteratee hiding inside the monad into an iteratee *)

Expand All @@ -129,19 +120,11 @@ module Iteratee : functor (IO : Monad) -> sig
(** enum_nchunk - Gives the supplied string to the iteratee in chunks of length n.
Good for testing *)

val extract_result_from_iteratee : 'a t -> 'a
(** extract_result_from_iteratee - Given a 'done' iteratee, pull the result out *)

(** Enumeratees *)

(** An enumeratee is a function that takes an iteratee and returns a new iteratee.
It acts as an iteratee to the outside world, but as an enumerator to the supplied
iteratee *)
type 'a enumeratee = 'a t -> 'a t t

val take : int -> 'a t -> 'a t t
(** take - takes exactly n characters from the input stream and applies them to
the inner stream *)
the (supplied) inner stream *)

val stream_printer : string -> 'a t -> 'a t t
(** stream_printer - given a name and an iteratee i, returns an iteratee that
Expand All @@ -150,8 +133,4 @@ module Iteratee : functor (IO : Monad) -> sig
val modify : (string -> string) -> 'a t -> 'a t t
(** modify - Modify the stream in some way before giving the result to the
inner stream. For example, one could base64 encode things this way *)

type 'a either = Left of 'a | Right of 'a

val read_lines : string list either t
end
Loading
Loading