├── .github └── workflows │ ├── gh-pages.yml │ └── main.yml ├── .gitignore ├── .ocamlformat ├── CHANGES.md ├── Makefile ├── README.md ├── dune-project ├── iostream-camlzip.opam ├── iostream.opam ├── src ├── camlzip │ ├── dune │ ├── iostream_camlzip.ml │ └── iostream_camlzip.mli ├── core │ ├── common_.ml │ ├── dune │ ├── in.ml │ ├── in.mli │ ├── in_buf.ml │ ├── in_buf.mli │ ├── iostream.ml │ ├── out.ml │ ├── out.mli │ ├── out_buf.ml │ ├── out_buf.mli │ ├── seekable.ml │ ├── seekable.mli │ └── slice.ml ├── dune ├── types │ ├── dune │ └── iostream_types.ml └── unix │ ├── dune │ └── iostream_unix.ml └── test ├── camlzip ├── dune └── t1.ml ├── dune ├── t_in.ml ├── t_in_buf.ml └── t_out_buf.ml /.github/workflows/gh-pages.yml: -------------------------------------------------------------------------------- 1 | name: github pages 2 | 3 | on: 4 | push: 5 | branches: 6 | - main # Set a branch name to trigger deployment 7 | 8 | jobs: 9 | deploy: 10 | name: Deploy doc 11 | runs-on: ubuntu-latest 12 | steps: 13 | - uses: actions/checkout@main 14 | 15 | - name: Use OCaml 16 | uses: ocaml/setup-ocaml@v2 17 | with: 18 | ocaml-compiler: '5.1' 19 | dune-cache: true 20 | allow-prerelease-opam: true 21 | 22 | - name: Deps 23 | run: opam install odig iostream iostream-camlzip 24 | 25 | - name: Build 26 | run: opam exec -- odig odoc --cache-dir=_doc/ iostream iostream-camlzip 27 | 28 | - name: Deploy 29 | uses: peaceiris/actions-gh-pages@v3 30 | with: 31 | github_token: ${{ secrets.GITHUB_TOKEN }} 32 | publish_dir: ./_doc/html/ 33 | destination_dir: . 34 | enable_jekyll: false 35 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Build and Test 2 | 3 | on: 4 | push: 5 | branches: 6 | - main 7 | pull_request: 8 | 9 | jobs: 10 | run: 11 | name: build 12 | strategy: 13 | fail-fast: true 14 | matrix: 15 | os: 16 | - ubuntu-latest 17 | #- macos-latest 18 | #- windows-latest 19 | ocaml-compiler: 20 | - '4.08' 21 | - '4.14' 22 | - '5.1' 23 | 24 | runs-on: ${{ matrix.os }} 25 | steps: 26 | - uses: actions/checkout@main 27 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 28 | uses: ocaml/setup-ocaml@v2 29 | with: 30 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 31 | dune-cache: true 32 | allow-prerelease-opam: true 33 | 34 | - run: opam install -t iostream iostream-camlzip --deps-only 35 | - run: opam exec -- dune build @install 36 | - run: opam exec -- dune runtest 37 | - run: opam exec -- dune build @install @runtest 38 | 39 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | _opam 3 | *.tmp 4 | *.exe 5 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.26.2 2 | profile=conventional 3 | margin=80 4 | if-then-else=k-r 5 | parens-ite=true 6 | parens-tuple=multi-line-only 7 | sequence-style=terminator 8 | type-decl=sparse 9 | break-cases=toplevel 10 | cases-exp-indent=2 11 | field-space=tight-decl 12 | leading-nested-match-parens=true 13 | module-item-spacing=compact 14 | quiet=true 15 | ocaml-version=4.08.0 16 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 2 | # 0.3 3 | 4 | - refactor: extract type definitions to `iostream.types` 5 | - perf slice: improve `Slice.find_index_from` 6 | 7 | # 0.2.2 8 | 9 | - bugfix for iostream-camlzip (assertion failure) 10 | 11 | # 0.2.1 12 | 13 | - bugfix for iostream-camlzip 14 | 15 | # 0.2 16 | 17 | - camlzip: add buffered version of the input stream transducers 18 | - add In_buf.skip 19 | - add `iostream-camlzip`, depends on `iostream` 20 | - rename Out to Out_buf, add Out 21 | - add `Slice` type, used for buffered input 22 | - add `iostream.unix` optional library 23 | - split seekable into its own class 24 | - breaking: use OO and `class type` for all types 25 | 26 | # 0.1 27 | 28 | initial release 29 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | DUNE_OPTS?= 3 | build: 4 | dune build @install $(DUNE_OPTS) 5 | 6 | clean: 7 | @dune clean 8 | 9 | test: 10 | @dune runtest $(DUNE_OPTS) 11 | 12 | doc: 13 | @dune build $(DUNE_OPTS) @doc 14 | 15 | format: 16 | @dune build $(DUNE_OPTS) @fmt --auto-promote 17 | @dune format-dune-file dune-project > dune-project.fmt && mv dune-project.fmt dune-project 18 | 19 | check-format: 20 | @dune build $(DUNE_OPTS) @fmt 21 | @dune format-dune-file dune-project > dune-project.fmt && diff dune-project dune-project.fmt && rm dune-project.fmt 22 | 23 | WATCH?= @check @runtest 24 | watch: 25 | dune build $(DUNE_OPTS) -w $(WATCH) 26 | 27 | .PHONY: test clean watch build 28 | 29 | VERSION=$(shell awk '/^version:/ {print $$2}' iostream.opam) 30 | update_next_tag: 31 | @echo "update version to $(VERSION)..." 32 | sed -i "s/NEXT_VERSION/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli) 33 | sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/*.ml) $(wildcard src/**/*.ml) $(wildcard src/*.mli) $(wildcard src/**/*.mli) 34 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Iostream 2 | 3 | [![Build and Test](https://github.com/c-cube/ocaml-iostream/actions/workflows/main.yml/badge.svg)](https://github.com/c-cube/ocaml-iostream/actions/workflows/main.yml) 4 | 5 | This library defines _generic_ I/O streams of bytes. The streams should be 6 | composable, user-definable, and agnostic to the underlying I/O mechanism; with 7 | OCaml 5 it means that they might be backed by an effect-based scheduler. 8 | 9 | The goal is to provide a reasonable interoperability layer that multiple libraries and applications 10 | in the OCaml ecosystem can rely on, while providing the modularity that standard IO channels lack. 11 | Modern statically typed languages like Go and Rust provide this layer in their stdlib and their whole 12 | ecosystem can build on it. 13 | 14 | ## Documentation 15 | 16 | https://c-cube.github.io/ocaml-iostream/ 17 | 18 | ## License 19 | 20 | MIT license. 21 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | 3 | (name iostream) 4 | (generate_opam_files true) 5 | (version 0.3) 6 | 7 | (source 8 | (github c-cube/ocaml-iostream)) 9 | 10 | (authors "Simon Cruanes") 11 | (maintainers "Simon Cruanes") 12 | (license MIT) 13 | (documentation https://c-cube.github.io/ocaml-iostream) 14 | 15 | (package 16 | (name iostream) 17 | (synopsis "Generic, composable IO input and output streams") 18 | (depends 19 | (ocaml (>= 4.08)) 20 | (dune (>= 2.0)) 21 | (ounit2 :with-test)) 22 | (depopts 23 | base-unix) 24 | (tags 25 | (topics io channels streams))) 26 | 27 | (package 28 | (name iostream-camlzip) 29 | (synopsis "Stream (de)compression using deflate") 30 | (depends 31 | (ocaml (>= 4.08)) 32 | (dune (>= 2.0)) 33 | (iostream (= :version)) 34 | camlzip 35 | (ounit2 :with-test)) 36 | (tags 37 | (topics io channels streams zip deflate))) 38 | 39 | ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/dune-files.html#dune-project 40 | -------------------------------------------------------------------------------- /iostream-camlzip.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.3" 4 | synopsis: "Stream (de)compression using deflate" 5 | maintainer: ["Simon Cruanes"] 6 | authors: ["Simon Cruanes"] 7 | license: "MIT" 8 | tags: ["topics" "io" "channels" "streams" "zip" "deflate"] 9 | homepage: "https://github.com/c-cube/ocaml-iostream" 10 | doc: "https://c-cube.github.io/ocaml-iostream" 11 | bug-reports: "https://github.com/c-cube/ocaml-iostream/issues" 12 | depends: [ 13 | "ocaml" {>= "4.08"} 14 | "dune" {>= "2.0"} 15 | "iostream" {= version} 16 | "camlzip" 17 | "ounit2" {with-test} 18 | ] 19 | build: [ 20 | ["dune" "subst"] {pinned} 21 | [ 22 | "dune" 23 | "build" 24 | "-p" 25 | name 26 | "-j" 27 | jobs 28 | "@install" 29 | "@runtest" {with-test} 30 | "@doc" {with-doc} 31 | ] 32 | ] 33 | dev-repo: "git+https://github.com/c-cube/ocaml-iostream.git" 34 | -------------------------------------------------------------------------------- /iostream.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.3" 4 | synopsis: "Generic, composable IO input and output streams" 5 | maintainer: ["Simon Cruanes"] 6 | authors: ["Simon Cruanes"] 7 | license: "MIT" 8 | tags: ["topics" "io" "channels" "streams"] 9 | homepage: "https://github.com/c-cube/ocaml-iostream" 10 | doc: "https://c-cube.github.io/ocaml-iostream" 11 | bug-reports: "https://github.com/c-cube/ocaml-iostream/issues" 12 | depends: [ 13 | "ocaml" {>= "4.08"} 14 | "dune" {>= "2.0"} 15 | "ounit2" {with-test} 16 | ] 17 | depopts: ["base-unix"] 18 | build: [ 19 | ["dune" "subst"] {pinned} 20 | [ 21 | "dune" 22 | "build" 23 | "-p" 24 | name 25 | "-j" 26 | jobs 27 | "@install" 28 | "@runtest" {with-test} 29 | "@doc" {with-doc} 30 | ] 31 | ] 32 | dev-repo: "git+https://github.com/c-cube/ocaml-iostream.git" 33 | -------------------------------------------------------------------------------- /src/camlzip/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name iostream_camlzip) 3 | (synopsis "Streaming (de)compression using deflate") 4 | (public_name iostream-camlzip) 5 | (libraries iostream camlzip)) 6 | -------------------------------------------------------------------------------- /src/camlzip/iostream_camlzip.ml: -------------------------------------------------------------------------------- 1 | open Iostream 2 | 3 | open struct 4 | let default_buf_size = 16 * 1024 5 | let _default_comp_level = 4 6 | 7 | let get_buf ?buf_size ?buf () = 8 | match buf with 9 | | Some b -> b 10 | | None -> 11 | let size = Option.value ~default:default_buf_size buf_size in 12 | Bytes.create size 13 | 14 | type decompress_state = 15 | | In_progress 16 | | Consuming_rest 17 | | Done 18 | end 19 | 20 | type mode = 21 | | Inflate 22 | | Deflate of int 23 | 24 | class transduce_in_ ~mode (ic : #In_buf.t) : In.t = 25 | let zlib_str = 26 | match mode with 27 | | Inflate -> Zlib.inflate_init false 28 | | Deflate lvl -> Zlib.deflate_init lvl false 29 | in 30 | let state = ref In_progress in 31 | object 32 | method close () = 33 | (match mode with 34 | | Inflate -> Zlib.inflate_end zlib_str 35 | | Deflate _ -> Zlib.deflate_end zlib_str); 36 | In.close ic 37 | 38 | method input buf i len = 39 | let n_written = ref 0 in 40 | 41 | while !n_written = 0 && !state != Done do 42 | match !state with 43 | | Done -> assert false 44 | | In_progress -> 45 | let islice = In_buf.fill_buf ic in 46 | if islice.len = 0 then 47 | state := Consuming_rest 48 | else ( 49 | let finished, used_in, used_out = 50 | (match mode with 51 | | Inflate -> Zlib.inflate 52 | | Deflate _ -> Zlib.deflate) 53 | zlib_str islice.bytes islice.off islice.len buf i len 54 | Zlib.Z_NO_FLUSH 55 | in 56 | if finished then state := Done; 57 | In_buf.consume ic used_in; 58 | n_written := used_out 59 | ) 60 | | Consuming_rest -> 61 | (* finish sending the internal state *) 62 | let islice = Slice.empty in 63 | let finished, used_in, used_out = 64 | (match mode with 65 | | Inflate -> Zlib.inflate 66 | | Deflate _ -> Zlib.deflate) 67 | zlib_str islice.bytes islice.off islice.len buf i len 68 | Zlib.Z_FINISH 69 | in 70 | assert (used_in = 0); 71 | if finished then state := Done; 72 | n_written := used_out 73 | done; 74 | !n_written 75 | end 76 | 77 | let[@inline] decompress_in (ic : #In_buf.t) : In.t = 78 | new transduce_in_ ~mode:Inflate ic 79 | 80 | let[@inline] compress_in ?(level = _default_comp_level) (ic : #In_buf.t) : In.t 81 | = 82 | new transduce_in_ ~mode:(Deflate level) ic 83 | 84 | let decompress_in_buf ?buf_size ?buf (ic : #In_buf.t) : In_buf.t = 85 | let bytes = get_buf ?buf_size ?buf () in 86 | object 87 | (* use [transduce_in_] but hide its [input] method *) 88 | inherit transduce_in_ ~mode:Inflate ic as underlying 89 | 90 | (* use regular bufferized [input] *) 91 | inherit! In_buf.t_from_refill ~bytes () 92 | 93 | method private refill (slice : Slice.t) = 94 | slice.len <- underlying#input slice.bytes 0 (Bytes.length slice.bytes) 95 | end 96 | 97 | let compress_in_buf ?buf_size ?buf ?(level = _default_comp_level) 98 | (ic : #In_buf.t) : In_buf.t = 99 | let bytes = get_buf ?buf_size ?buf () in 100 | object 101 | (* use [transduce_in_] but hide its [input] method *) 102 | inherit transduce_in_ ~mode:(Deflate level) ic as underlying 103 | 104 | (* use regular bufferized [input] *) 105 | inherit! In_buf.t_from_refill ~bytes () 106 | 107 | method private refill (slice : Slice.t) = 108 | slice.len <- underlying#input slice.bytes 0 (Bytes.length slice.bytes) 109 | end 110 | 111 | (* write output buffer to out *) 112 | let write_out (oc : #Out.t) (slice : Slice.t) : unit = 113 | if slice.len > 0 then ( 114 | Out.output oc slice.bytes slice.off slice.len; 115 | slice.off <- 0; 116 | slice.len <- 0 117 | ) 118 | 119 | let transduce_out_ ?buf_size ?buf ~mode ~flush_out (oc : #Out.t) : Out_buf.t = 120 | let b1 = Bytes.create 1 in 121 | 122 | (* output buffer *) 123 | let slice_out = 124 | let bytes = get_buf ?buf_size ?buf () in 125 | Slice.of_bytes bytes 126 | in 127 | 128 | let zlib_str = 129 | match mode with 130 | | Inflate -> Zlib.inflate_init false 131 | | Deflate n -> Zlib.deflate_init n false 132 | in 133 | 134 | (* write nothing, but flush the internal state *) 135 | let flush_zlib ~flush (oc : #Out.t) = 136 | let continue = ref true in 137 | while !continue do 138 | slice_out.off <- 0; 139 | let finished, used_in, used_out = 140 | (match mode with 141 | | Inflate -> Zlib.inflate 142 | | Deflate _ -> Zlib.deflate) 143 | zlib_str Bytes.empty 0 0 slice_out.bytes 0 144 | (Bytes.length slice_out.bytes) 145 | flush 146 | in 147 | assert (used_in = 0); 148 | slice_out.len <- used_out; 149 | write_out oc slice_out; 150 | if finished || used_out = 0 then continue := false 151 | done; 152 | flush_out () 153 | in 154 | 155 | (* compress and consume input buffer *) 156 | let write_zlib ~flush (oc : #Out.t) buf i len = 157 | let i = ref i in 158 | let len = ref len in 159 | while !len > 0 do 160 | write_out oc slice_out; 161 | let _finished, used_in, used_out = 162 | (match mode with 163 | | Inflate -> Zlib.inflate 164 | | Deflate _ -> Zlib.deflate) 165 | zlib_str buf !i !len slice_out.bytes 0 166 | (Bytes.length slice_out.bytes) 167 | flush 168 | in 169 | i := !i + used_in; 170 | len := !len - used_in; 171 | slice_out.len <- slice_out.len + used_out 172 | done; 173 | write_out oc slice_out 174 | in 175 | 176 | object 177 | method close () = 178 | flush_zlib oc ~flush:Zlib.Z_FINISH; 179 | assert (slice_out.len = 0); 180 | (match mode with 181 | | Inflate -> Zlib.inflate_end zlib_str 182 | | Deflate _ -> Zlib.deflate_end zlib_str); 183 | flush_out (); 184 | Out.close oc 185 | 186 | method output_char c = 187 | Bytes.set b1 0 c; 188 | write_zlib ~flush:Zlib.Z_NO_FLUSH oc b1 0 1 189 | 190 | method output buf i len = write_zlib ~flush:Zlib.Z_NO_FLUSH oc buf i len 191 | method flush () = flush_zlib ~flush:Zlib.Z_SYNC_FLUSH oc 192 | end 193 | 194 | let compressed_out ?buf_size ?buf ?(level = _default_comp_level) (oc : #Out.t) : 195 | Out_buf.t = 196 | transduce_out_ ?buf_size ?buf ~flush_out:ignore ~mode:(Deflate level) oc 197 | 198 | let compressed_out_buf ?buf_size ?buf ?(level = _default_comp_level) 199 | (oc : #Out_buf.t) : Out_buf.t = 200 | let flush_out () = Out_buf.flush oc in 201 | transduce_out_ ?buf_size ?buf ~flush_out ~mode:(Deflate level) (oc :> Out.t) 202 | 203 | let decompressed_out ?buf_size ?buf oc : Out_buf.t = 204 | transduce_out_ ?buf_size ?buf ~flush_out:ignore ~mode:Inflate oc 205 | 206 | let decompressed_out_buf ?buf_size ?buf (oc : #Out_buf.t) : Out_buf.t = 207 | let flush_out () = Out_buf.flush oc in 208 | transduce_out_ ?buf_size ?buf ~flush_out ~mode:Inflate (oc :> Out.t) 209 | -------------------------------------------------------------------------------- /src/camlzip/iostream_camlzip.mli: -------------------------------------------------------------------------------- 1 | open Iostream 2 | 3 | val decompress_in : #In_buf.t -> In.t 4 | (** [decompress_in ic] returns a new input stream 5 | that is the decompressed version of [ic] *) 6 | 7 | val decompress_in_buf : ?buf_size:int -> ?buf:bytes -> #In_buf.t -> In_buf.t 8 | (** Like {!decompress_in} but the output is buffered as well. *) 9 | 10 | val compress_in : ?level:int -> #In_buf.t -> In.t 11 | (** [compress_in ?level ic] is a new input stream 12 | that is the compressed version of [ic]. 13 | @param level optional Zlib compression level *) 14 | 15 | val compress_in_buf : 16 | ?buf_size:int -> ?buf:bytes -> ?level:int -> #In_buf.t -> In_buf.t 17 | (** Same as {!compress_in} but returning a buffered input. *) 18 | 19 | val compressed_out : 20 | ?buf_size:int -> ?buf:bytes -> ?level:int -> #Out.t -> Out_buf.t 21 | (** [compressed_out oc] takes a output stream [oc], and 22 | returns a new output stream [oc2]. Writing some (normal) bytes to [oc2] 23 | will write a compressed version of these bytes into [oc] (possibly 24 | after a flush). *) 25 | 26 | val compressed_out_buf : 27 | ?buf_size:int -> ?buf:bytes -> ?level:int -> #Out_buf.t -> Out_buf.t 28 | 29 | val decompressed_out : ?buf_size:int -> ?buf:bytes -> #Out.t -> Out_buf.t 30 | (** [decompressed_out oc] is a new output stream [oc2]. Writing 31 | (compressed) bytes to [oc2] will write their decompressed version 32 | into [oc] (possibly after a flush) *) 33 | 34 | val decompressed_out_buf : 35 | ?buf_size:int -> ?buf:bytes -> #Out_buf.t -> Out_buf.t 36 | -------------------------------------------------------------------------------- /src/core/common_.ml: -------------------------------------------------------------------------------- 1 | let _default_buf_size = 4_096 2 | -------------------------------------------------------------------------------- /src/core/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name iostream) 3 | (private_modules common_) 4 | (libraries iostream.types) 5 | (public_name iostream)) 6 | -------------------------------------------------------------------------------- /src/core/in.ml: -------------------------------------------------------------------------------- 1 | open Common_ 2 | 3 | class type t = Iostream_types.In.t 4 | (** @inline *) 5 | 6 | class type t_seekable = Iostream_types.In.t_seekable 7 | (** @inline *) 8 | 9 | let create ?(close = ignore) ~input () : t = 10 | object 11 | method close = close 12 | method input = input 13 | end 14 | 15 | class empty : t = 16 | object 17 | method close () = () 18 | method input _ _ _ = 0 19 | end 20 | 21 | let empty = new empty 22 | 23 | class of_in_channel ?(close_noerr = false) (ic : in_channel) : t_seekable = 24 | object 25 | method input buf i len = input ic buf i len 26 | 27 | method close () = 28 | if close_noerr then 29 | close_in_noerr ic 30 | else 31 | close_in ic 32 | 33 | method seek i = seek_in ic i 34 | method pos () = pos_in ic 35 | end 36 | 37 | let[@inline] of_in_channel ?close_noerr ic = new of_in_channel ?close_noerr ic 38 | 39 | class open_file ?close_noerr ?(mode = 0o644) 40 | ?(flags = [ Open_rdonly; Open_binary ]) filename : 41 | t_seekable = 42 | let ic = open_in_gen flags mode filename in 43 | of_in_channel ?close_noerr ic 44 | 45 | let[@inline] open_file ?close_noerr ?mode ?flags filename = 46 | new open_file ?close_noerr ?mode ?flags filename 47 | 48 | let with_open_file ?close_noerr ?mode ?flags filename f = 49 | let ic = open_file ?close_noerr ?mode ?flags filename in 50 | Fun.protect ~finally:ic#close (fun () -> f ic) 51 | 52 | class of_bytes ?(off = 0) ?len (b : bytes) : t_seekable = 53 | (* i: current position in [b] *) 54 | let i = ref off in 55 | 56 | let len = 57 | match len with 58 | | Some n -> 59 | if n > Bytes.length b - off then invalid_arg "Iostream.In.of_bytes"; 60 | n 61 | | None -> Bytes.length b - off 62 | in 63 | let end_ = off + len in 64 | 65 | object 66 | method input b_out i_out len_out = 67 | let n = min (end_ - !i) len_out in 68 | Bytes.blit b !i b_out i_out n; 69 | i := !i + n; 70 | n 71 | 72 | method close () = i := end_ 73 | method pos () = !i - off (* pos starts at 0 *) 74 | 75 | method seek j = 76 | if j < 0 || j > len then raise (Sys_error "Iostream.In.seek: invalid pos"); 77 | i := j + off 78 | end 79 | 80 | let[@inline] of_bytes ?off ?len b = new of_bytes ?off ?len b 81 | 82 | class of_string ?off ?len s : t_seekable = 83 | object 84 | inherit of_bytes ?off ?len (Bytes.unsafe_of_string s) 85 | end 86 | 87 | let[@inline] of_string ?off ?len s = new of_string ?off ?len s 88 | 89 | (** Read into the given slice. 90 | @return the number of bytes read, [0] means end of input. *) 91 | let[@inline] input (self : #t) buf i len = self#input buf i len 92 | 93 | (** Close the channel. *) 94 | let[@inline] close self : unit = self#close () 95 | 96 | let rec really_input (self : #t) buf i len = 97 | if len > 0 then ( 98 | let n = input self buf i len in 99 | if n = 0 then raise End_of_file; 100 | (really_input [@tailrec]) self buf (i + n) (len - n) 101 | ) 102 | 103 | let really_input_string self n : string = 104 | let buf = Bytes.create n in 105 | really_input self buf 0 n; 106 | Bytes.unsafe_to_string buf 107 | 108 | let copy_into ?(buf = Bytes.create _default_buf_size) (ic : #t) (oc : #Out.t) : 109 | unit = 110 | let continue = ref true in 111 | while !continue do 112 | let len = input ic buf 0 (Bytes.length buf) in 113 | if len = 0 then 114 | continue := false 115 | else 116 | Out.output oc buf 0 len 117 | done 118 | 119 | let concat (l0 : t list) : t = 120 | let ics = ref l0 in 121 | let rec input_rec b i len : int = 122 | match !ics with 123 | | [] -> 0 124 | | ic :: tl -> 125 | let n = ic#input b i len in 126 | if n > 0 then 127 | n 128 | else ( 129 | ics := tl; 130 | input_rec b i len 131 | ) 132 | in 133 | object 134 | method input bs i len = input_rec bs i len 135 | method close () = List.iter close l0 136 | end 137 | 138 | class map_char f (ic : #t) : t = 139 | object 140 | method close () = close ic 141 | 142 | method input b i len : int = 143 | let n = ic#input b i len in 144 | if n > 0 then 145 | for j = i to i + n - 1 do 146 | let c = Bytes.get b j in 147 | (* safety: the index is valid because [get] above didn't raise. *) 148 | Bytes.unsafe_set b j (f c) 149 | done; 150 | n 151 | end 152 | 153 | let[@inline] map_char f ic = new map_char f ic 154 | 155 | let input_all_into_buffer self buf : unit = 156 | let oc = Out.of_buffer buf in 157 | copy_into self oc 158 | 159 | let input_all ?(buf = Bytes.create 128) (self : #t) : string = 160 | let buf = ref buf in 161 | let i = ref 0 in 162 | 163 | let[@inline] full_ () = !i = Bytes.length !buf in 164 | 165 | let grow_ () = 166 | let old_size = Bytes.length !buf in 167 | let new_size = min Sys.max_string_length (old_size + (old_size / 4) + 10) in 168 | if old_size = new_size then 169 | failwith "input_all: maximum input size exceeded"; 170 | let new_buf = Bytes.extend !buf 0 (new_size - old_size) in 171 | buf := new_buf 172 | in 173 | 174 | let rec loop () = 175 | if full_ () then grow_ (); 176 | let available = Bytes.length !buf - !i in 177 | let n = input self !buf !i available in 178 | if n > 0 then ( 179 | i := !i + n; 180 | (loop [@tailrec]) () 181 | ) 182 | in 183 | loop (); 184 | 185 | if full_ () then 186 | Bytes.unsafe_to_string !buf 187 | else 188 | Bytes.sub_string !buf 0 !i 189 | -------------------------------------------------------------------------------- /src/core/in.mli: -------------------------------------------------------------------------------- 1 | (** Input stream. *) 2 | 3 | (** An input stream, i.e an incoming stream of bytes. 4 | 5 | This can be a [string], an [int_channel], an [Unix.file_descr], a 6 | decompression wrapper around another input stream, etc. *) 7 | class type t = object 8 | method input : bytes -> int -> int -> int 9 | (** Read into the slice. Returns [0] only if the 10 | stream is closed. *) 11 | 12 | method close : unit -> unit 13 | (** Close the input. Must be idempotent. *) 14 | end 15 | 16 | (** An input stream that is also seekable. *) 17 | class type t_seekable = object 18 | inherit t 19 | inherit Seekable.t 20 | end 21 | 22 | val create : 23 | ?close:(unit -> unit) -> input:(bytes -> int -> int -> int) -> unit -> t 24 | 25 | class empty : t 26 | 27 | val empty : t 28 | (** Empty input, contains 0 bytes. *) 29 | 30 | class of_in_channel : ?close_noerr:bool -> in_channel -> t_seekable 31 | 32 | val of_in_channel : ?close_noerr:bool -> in_channel -> t_seekable 33 | (** Wrap a standard input channel. *) 34 | 35 | class open_file : 36 | ?close_noerr:bool -> 37 | ?mode:int -> 38 | ?flags:open_flag list -> 39 | string -> 40 | t_seekable 41 | 42 | val open_file : 43 | ?close_noerr:bool -> 44 | ?mode:int -> 45 | ?flags:open_flag list -> 46 | string -> 47 | t_seekable 48 | 49 | val with_open_file : 50 | ?close_noerr:bool -> 51 | ?mode:int -> 52 | ?flags:open_flag list -> 53 | string -> 54 | (t_seekable -> 'a) -> 55 | 'a 56 | 57 | class of_string : ?off:int -> ?len:int -> string -> t_seekable 58 | 59 | val of_string : ?off:int -> ?len:int -> string -> t_seekable 60 | (** An input channel reading from the string. 61 | @param offset initial offset in the string. Default [0]. 62 | @param len the length of the slice we read from. Default [String.length s - off]. 63 | *) 64 | 65 | class of_bytes : ?off:int -> ?len:int -> bytes -> t_seekable 66 | 67 | val of_bytes : ?off:int -> ?len:int -> bytes -> t_seekable 68 | (** An input channel reading from the bytes buffer. See {!of_string} 69 | for more details. *) 70 | 71 | val input : #t -> bytes -> int -> int -> int 72 | (** Read bytes into the given buffer. This returns [0] only if 73 | the stream has reached its end. 74 | @raise Invalid_argument if the arguments do not denote a valid slice. 75 | *) 76 | 77 | val input_all_into_buffer : #t -> Buffer.t -> unit 78 | (** Read the whole content into the given buffer. 79 | @since 0.2 *) 80 | 81 | val input_all : ?buf:bytes -> #t -> string 82 | (** [input_all ic] reads the whole content of [ic] into a string. 83 | @param buf the initial buffer to use internally. 84 | @since 0.2 *) 85 | 86 | val really_input : #t -> bytes -> int -> int -> unit 87 | (** Same as [input], but reads exactly the demanded amount of bytes. 88 | @raise Invalid_argument if the arguments do not denote a valid slice. 89 | @raise End_of_file if the input does not contain enough data. 90 | @since 0.2 91 | *) 92 | 93 | val really_input_string : #t -> int -> string 94 | (** [really_input_string ic n] reads exactly [n] bytes of [ic] 95 | and returns them as a string. 96 | @raise End_of_file if the input does not contain enough data. 97 | @since 0.2 98 | *) 99 | 100 | val concat : t list -> t 101 | (** Read from each stream, in order *) 102 | 103 | val close : #t -> unit 104 | (** Close the input stream. This is idempotent. *) 105 | 106 | val copy_into : ?buf:bytes -> #t -> #Out.t -> unit 107 | (** Copy the whole stream into the given output. *) 108 | 109 | val map_char : (char -> char) -> #t -> t 110 | (** Transform the stream byte by byte *) 111 | -------------------------------------------------------------------------------- /src/core/in_buf.ml: -------------------------------------------------------------------------------- 1 | open Slice 2 | open Common_ 3 | 4 | class type t = Iostream_types.In_buf.t 5 | 6 | class virtual t_from_refill ?(bytes = Bytes.create _default_buf_size) () = 7 | let slice = Slice.of_bytes bytes in 8 | object (self) 9 | method virtual private refill : Slice.t -> unit 10 | 11 | method fill_buf () : Slice.t = 12 | if slice.len = 0 then self#refill slice; 13 | slice 14 | 15 | method consume (n : int) : unit = Slice.consume slice n 16 | (** Consume [n] bytes from the inner buffer. *) 17 | 18 | method input b i len : int = 19 | let buf = self#fill_buf () in 20 | 21 | if buf.len > 0 then ( 22 | let n = min len buf.len in 23 | Bytes.blit buf.bytes buf.off b i n; 24 | Slice.consume buf n; 25 | n 26 | ) else 27 | 0 28 | (** Default implementation of [input] using [fill_buf] *) 29 | end 30 | 31 | let[@inline] consume (self : #t) n = self#consume n 32 | let[@inline] fill_buf (self : #t) : Slice.t = self#fill_buf () 33 | 34 | let create ?(bytes = Bytes.create _default_buf_size) ?(close = ignore) ~refill 35 | () : t = 36 | object 37 | inherit t_from_refill ~bytes () 38 | method close () = close () 39 | 40 | method private refill buf : unit = 41 | buf.off <- 0; 42 | buf.len <- refill buf.bytes 43 | end 44 | 45 | let[@inline] input self b i len : int = self#input b i len 46 | let[@inline] close self = self#close () 47 | 48 | class bufferized ?(bytes = Bytes.create _default_buf_size) (ic : #In.t) : t = 49 | let eof = ref false in 50 | 51 | object 52 | inherit t_from_refill ~bytes () 53 | method close () = ic#close () 54 | 55 | method private refill buf = 56 | if not !eof then ( 57 | buf.off <- 0; 58 | buf.len <- ic#input buf.bytes 0 (Bytes.length buf.bytes); 59 | if buf.len = 0 then eof := true 60 | ) 61 | end 62 | 63 | let[@inline] bufferized ?bytes ic = new bufferized ?bytes ic 64 | 65 | class of_bytes ?(off = 0) ?len bytes : t = 66 | let len = 67 | match len with 68 | | None -> Bytes.length bytes - off 69 | | Some n -> 70 | if n > Bytes.length bytes - off then 71 | invalid_arg "In_buf.of_bytes: invalid length"; 72 | n 73 | in 74 | 75 | let slice = { bytes; off; len } in 76 | 77 | object 78 | method close () = () 79 | method fill_buf () = slice 80 | 81 | method input b i len : int = 82 | if slice.len > 0 then ( 83 | let n = min len slice.len in 84 | Bytes.blit slice.bytes slice.off b i n; 85 | Slice.consume slice n; 86 | n 87 | ) else 88 | 0 89 | 90 | method consume n = Slice.consume slice n 91 | end 92 | 93 | let[@inline] of_bytes ?off ?len bs = new of_bytes ?off ?len bs 94 | 95 | class of_string ?off ?len s = 96 | object 97 | inherit of_bytes ?off ?len (Bytes.unsafe_of_string s) 98 | end 99 | 100 | let[@inline] of_string ?off ?len bs = new of_string ?off ?len bs 101 | 102 | class of_in ?bytes ic = 103 | object 104 | inherit t_from_refill ?bytes () 105 | method close () = In.close ic 106 | 107 | method private refill buf = 108 | buf.off <- 0; 109 | buf.len <- In.input ic buf.bytes 0 (Bytes.length buf.bytes) 110 | end 111 | 112 | let[@inline] of_in ?bytes ic = new of_in ?bytes ic 113 | 114 | class of_in_channel ?bytes ic = 115 | object 116 | inherit of_in ?bytes (In.of_in_channel ic) 117 | end 118 | 119 | let[@inline] of_in_channel ?bytes ic : t = new of_in_channel ?bytes ic 120 | 121 | class open_file ?bytes ?mode ?flags filename : t = 122 | of_in ?bytes (In.open_file ?mode ?flags filename) 123 | 124 | let[@inline] open_file ?bytes ?mode ?flags filename = 125 | new open_file ?bytes ?mode ?flags filename 126 | 127 | let with_open_file ?bytes ?mode ?flags filename f = 128 | let ic = open_file ?bytes ?mode ?flags filename in 129 | Fun.protect ~finally:ic#close (fun () -> f ic) 130 | 131 | let[@inline] into_in (self : #t) : In.t = (self :> In.t) 132 | let input_all_into_buffer = In.input_all_into_buffer 133 | let input_all = In.input_all 134 | 135 | let copy_into (self : #t) (oc : #Out.t) : unit = 136 | let continue = ref true in 137 | while !continue do 138 | let buf = fill_buf self in 139 | if buf.len = 0 then 140 | continue := false 141 | else ( 142 | Out.output oc buf.bytes 0 buf.len; 143 | consume self buf.len 144 | ) 145 | done 146 | 147 | let input_line ?buffer (self : #t) : string option = 148 | (* see if we can directly extract a line from current buffer *) 149 | let slice = fill_buf self in 150 | if slice.len = 0 then 151 | None 152 | else ( 153 | match Slice.find_index_exn slice '\n' with 154 | | j -> 155 | (* easy case: buffer already contains a full line *) 156 | let line = Bytes.sub_string slice.bytes slice.off (j - slice.off) in 157 | consume self (j - slice.off + 1); 158 | Some line 159 | | exception Not_found -> 160 | (* Need to re-fill [self.buf]. We must first create a new holding buffer, 161 | already filled with beginning of line. *) 162 | let buf = 163 | match buffer with 164 | | Some b -> 165 | Buffer.clear b; 166 | b 167 | | None -> Buffer.create 256 168 | in 169 | 170 | Buffer.add_subbytes buf slice.bytes slice.off slice.len; 171 | consume self slice.len; 172 | 173 | (* now read until we find ['\n'] *) 174 | let continue = ref true in 175 | while !continue do 176 | let bs = fill_buf self in 177 | if bs.len = 0 then continue := false (* EOF *); 178 | match Slice.find_index_exn bs '\n' with 179 | | j -> 180 | Buffer.add_subbytes buf bs.bytes bs.off (j - bs.off); 181 | (* without '\n' *) 182 | consume self (j - bs.off + 1); 183 | (* consume, including '\n' *) 184 | continue := false 185 | | exception Not_found -> 186 | (* the whole [self.buf] is part of the current line. *) 187 | Buffer.add_subbytes buf bs.bytes bs.off bs.len; 188 | consume self bs.len 189 | done; 190 | Some (Buffer.contents buf) 191 | ) 192 | 193 | let input_lines ?(buffer = Buffer.create 32) ic = 194 | let rec loop l = 195 | match input_line ~buffer ic with 196 | | None -> List.rev l 197 | | Some s -> loop (s :: l) 198 | in 199 | loop [] 200 | 201 | let to_iter (self : #t) k : unit = 202 | let continue = ref true in 203 | while !continue do 204 | let bs = fill_buf self in 205 | if bs.len = 0 then 206 | continue := false 207 | else ( 208 | for i = 0 to bs.len - 1 do 209 | k (Bytes.get bs.bytes i) 210 | done; 211 | consume self bs.len 212 | ) 213 | done 214 | 215 | let to_seq (self : #t) : char Seq.t = 216 | let continue = ref true in 217 | let rec next () = 218 | if not !continue then 219 | Seq.Nil 220 | else ( 221 | let slice = fill_buf self in 222 | if slice.len = 0 then ( 223 | continue := false; 224 | Seq.Nil 225 | ) else ( 226 | let c = Bytes.get slice.bytes slice.off in 227 | Slice.consume slice 1; 228 | Seq.Cons (c, next) 229 | ) 230 | ) 231 | in 232 | next 233 | 234 | let of_seq ?bytes seq : t = 235 | let seq = ref seq in 236 | object 237 | inherit t_from_refill ?bytes () 238 | method close () = () 239 | 240 | method private refill bs = 241 | let rec loop idx = 242 | if idx >= Bytes.length bs.bytes then 243 | idx 244 | else ( 245 | match !seq () with 246 | | Seq.Nil -> idx 247 | | Seq.Cons (c, seq_tl) -> 248 | seq := seq_tl; 249 | Bytes.set bs.bytes idx c; 250 | loop (idx + 1) 251 | ) 252 | in 253 | bs.off <- 0; 254 | bs.len <- loop 0 255 | end 256 | 257 | let skip (self : #t) (n : int) : unit = 258 | let n = ref n in 259 | while !n > 0 do 260 | let slice = fill_buf self in 261 | let len = min !n slice.len in 262 | Slice.consume slice len; 263 | n := !n - len 264 | done 265 | -------------------------------------------------------------------------------- /src/core/in_buf.mli: -------------------------------------------------------------------------------- 1 | (** Buffered input stream. *) 2 | 3 | (** The implementation of buffered input streams. *) 4 | class type t = object 5 | inherit In.t 6 | 7 | method fill_buf : unit -> Slice.t 8 | (** [ic#fill_buf()] returns a slice into the [ic]'s internal buffer, 9 | and ensures it's empty only if [ic.ic] is empty. In other 10 | words, the invariant is that this only returns 11 | an empty slice if the input stream is exhausted. *) 12 | 13 | method consume : int -> unit 14 | (** Consume [n] bytes from the inner buffer. This is only 15 | valid if the last call to [fill_buf] returned a slice with 16 | at least [n] bytes. *) 17 | end 18 | 19 | (** A mixin to implement a buffered input by only providing 20 | a [refill] method. Add a [close] method and it's good to go. *) 21 | class virtual t_from_refill : ?bytes:bytes -> unit -> object 22 | method virtual private refill : Slice.t -> unit 23 | (** Implementation of the stream: this takes a slice, 24 | resets its offset, and fills it with bytes. It must write 25 | at least one byte in the slice, unless the underlying 26 | input has reached its end. *) 27 | 28 | method input : bytes -> int -> int -> int 29 | method fill_buf : unit -> Slice.t 30 | method consume : int -> unit 31 | end 32 | 33 | val create : 34 | ?bytes:bytes -> ?close:(unit -> unit) -> refill:(bytes -> int) -> unit -> t 35 | (** Create a new buffered input stream. 36 | @param refill will be called to refill the content of the bytes, 37 | returning how many bytes were added (starting at offset 0). 38 | @param buf the underlying buffer 39 | @raise Invalid_argument if the buffer's length is not at least 16. *) 40 | 41 | class of_bytes : ?off:int -> ?len:int -> bytes -> t 42 | 43 | val of_bytes : ?off:int -> ?len:int -> bytes -> t 44 | 45 | class of_string : ?off:int -> ?len:int -> string -> t 46 | 47 | val of_string : ?off:int -> ?len:int -> string -> t 48 | 49 | class bufferized : ?bytes:bytes -> In.t -> t 50 | 51 | val bufferized : ?bytes:bytes -> In.t -> t 52 | 53 | (* val of_bytes : ?off:int -> ?len:int -> bytes -> t *) 54 | (** Read from the given buffer. 55 | @param off initial offset (default 0) 56 | @param len length of the slice in the bytes. (default all available bytes from offset) *) 57 | 58 | class of_in_channel : ?bytes:bytes -> in_channel -> t 59 | 60 | val of_in_channel : ?bytes:bytes -> in_channel -> t 61 | (** Wrap a standard input channel. *) 62 | 63 | class open_file : 64 | ?bytes:bytes -> 65 | ?mode:int -> 66 | ?flags:open_flag list -> 67 | string -> 68 | t 69 | 70 | val open_file : 71 | ?bytes:bytes -> ?mode:int -> ?flags:open_flag list -> string -> t 72 | 73 | val with_open_file : 74 | ?bytes:bytes -> 75 | ?mode:int -> 76 | ?flags:open_flag list -> 77 | string -> 78 | (t -> 'a) -> 79 | 'a 80 | 81 | val fill_buf : #t -> Slice.t 82 | (** [fill_buffer bic] returns a slice into [bic]'s internal buffer, 83 | and ensures it's empty only if [bic.ic] 84 | is empty. *) 85 | 86 | val input : #t -> bytes -> int -> int -> int 87 | (** Read into the given slice of bytes. *) 88 | 89 | val of_in : ?bytes:bytes -> #In.t -> t 90 | (** Make a buffered version of the input stream. 91 | @param bytes the buffer to use. 92 | @raise Invalid_argument if the buffer's length is not at least 16. *) 93 | 94 | val consume : #t -> int -> unit 95 | (** [consume bic n] consumes [n] bytes from [bic]. 96 | Precondition: [n <= get_len bic], ie. one cannot consume bytes that have 97 | not yet been obtained via {!fill_buffer} or {!fill_and_get}. *) 98 | 99 | val close : #t -> unit 100 | (** Close the input stream. *) 101 | 102 | val into_in : #t -> In.t 103 | (** Cast into a {!In.t}. This doesn't allocate. *) 104 | 105 | val input_all_into_buffer : #t -> Buffer.t -> unit 106 | (** Read the whole content into the given buffer. *) 107 | 108 | val input_all : ?buf:bytes -> #t -> string 109 | (** [input_all ic] reads the whole content of [ic] into a string. 110 | @param buf the initial buffer to use internally. 111 | @since 0.2 *) 112 | 113 | val copy_into : #t -> #Out.t -> unit 114 | (** Copy the entire stream into the given output. *) 115 | 116 | val skip : #t -> int -> unit 117 | (** [skip ic n] reads and dicards the next [n] bytes in [ic]. *) 118 | 119 | val input_line : ?buffer:Buffer.t -> #t -> string option 120 | (** Read a line from the input. Return [None] if the stream is empty. 121 | @param buffer a buffer to use to hold the line. *) 122 | 123 | val input_lines : ?buffer:Buffer.t -> #t -> string list 124 | (** Read all lines from the input. *) 125 | 126 | val to_iter : #t -> (char -> unit) -> unit 127 | val to_seq : #t -> char Seq.t 128 | val of_seq : ?bytes:bytes -> char Seq.t -> t 129 | -------------------------------------------------------------------------------- /src/core/iostream.ml: -------------------------------------------------------------------------------- 1 | (** I/O streams. 2 | 3 | This module defines generic I/O streams. They can be user-defined 4 | and can be composed from other streams. 5 | *) 6 | 7 | module In = In 8 | module In_buf = In_buf 9 | module Out = Out 10 | module Out_buf = Out_buf 11 | module Slice = Slice 12 | module Seekable = Seekable 13 | -------------------------------------------------------------------------------- /src/core/out.ml: -------------------------------------------------------------------------------- 1 | class type t = Iostream_types.Out.t 2 | class type t_seekable = Iostream_types.Out.t_seekable 3 | 4 | class dummy : t = 5 | object 6 | method close () = () 7 | method output _ _ _ = () 8 | end 9 | 10 | let dummy : t = new dummy 11 | 12 | (** [of_out_channel oc] wraps the channel into a {!Out_channel.t}. 13 | @param close_noerr if true, then closing the result uses [close_out_noerr] 14 | instead of [close_out] to close [oc] *) 15 | class of_out_channel ?(close_noerr = false) (oc : out_channel) : t_seekable = 16 | object 17 | method output bs i len = output oc bs i len 18 | 19 | method close () = 20 | if close_noerr then 21 | close_out_noerr oc 22 | else ( 23 | flush oc; 24 | close_out oc 25 | ) 26 | 27 | method seek i = seek_out oc i 28 | method pos () = pos_out oc 29 | end 30 | 31 | let[@inline] of_out_channel ?close_noerr oc = new of_out_channel ?close_noerr oc 32 | 33 | let open_file ?close_noerr ?(mode = 0o644) 34 | ?(flags = [ Open_binary; Open_wronly; Open_creat; Open_trunc ]) filename : 35 | t_seekable = 36 | let oc = open_out_gen flags mode filename in 37 | of_out_channel ?close_noerr oc 38 | 39 | let with_open_file ?close_noerr ?mode ?flags filename f = 40 | let oc = open_file ?close_noerr ?mode ?flags filename in 41 | Fun.protect ~finally:oc#close (fun () -> f oc) 42 | 43 | class of_buffer (buf : Buffer.t) : t = 44 | object 45 | method close () = () 46 | method output bs i len = Buffer.add_subbytes buf bs i len 47 | end 48 | 49 | let[@inline] of_buffer buf = new of_buffer buf 50 | 51 | (** Output the buffer slice into this channel *) 52 | let[@inline] output (self : #t) buf i len : unit = self#output buf i len 53 | 54 | let[@inline] output_string (self : #t) (str : string) : unit = 55 | self#output (Bytes.unsafe_of_string str) 0 (String.length str) 56 | 57 | (** Close the channel. *) 58 | let[@inline] close self : unit = self#close () 59 | 60 | let output_int self i = 61 | let s = string_of_int i in 62 | output_string self s 63 | 64 | let tee (l : t list) : t = 65 | match l with 66 | | [] -> dummy 67 | | [ oc ] -> oc 68 | | _ -> 69 | object 70 | method output bs i len = List.iter (fun oc -> output oc bs i len) l 71 | method close () = List.iter close l 72 | end 73 | 74 | class map_char f (oc : #t) : t = 75 | object 76 | method output buf i len = 77 | for j = i to i + len - 1 do 78 | let c = Bytes.get buf j in 79 | (* safety: [j] is valid because [get] above did not raise *) 80 | Bytes.unsafe_set buf j (f c) 81 | done; 82 | output oc buf i len 83 | 84 | method close () = close oc 85 | end 86 | 87 | let[@inline] map_char f oc = new map_char f oc 88 | -------------------------------------------------------------------------------- /src/core/out.mli: -------------------------------------------------------------------------------- 1 | (** Output stream. *) 2 | 3 | (** An output stream, ie. a place into which we can write bytes. 4 | This can be a [Buffer.t], an [out_channel], a [Unix.file_descr], etc. *) 5 | class type t = object 6 | method output : bytes -> int -> int -> unit 7 | (** Output slice *) 8 | 9 | method close : unit -> unit 10 | (** Close the output. Must be idempotent. *) 11 | end 12 | 13 | class type t_seekable = object 14 | inherit t 15 | inherit Seekable.t 16 | end 17 | 18 | class dummy : t 19 | 20 | val dummy : t 21 | (** Dummy output, drops everything written to it. *) 22 | 23 | class of_out_channel : ?close_noerr:bool -> out_channel -> t_seekable 24 | 25 | val of_out_channel : ?close_noerr:bool -> out_channel -> t_seekable 26 | (** Wrap an out channel. *) 27 | 28 | class of_buffer : Buffer.t -> t 29 | 30 | val of_buffer : Buffer.t -> t 31 | (** [of_buffer buf] is an output channel that writes directly into [buf]. 32 | [flush] and [close] have no effect. *) 33 | 34 | val open_file : 35 | ?close_noerr:bool -> 36 | ?mode:int -> 37 | ?flags:open_flag list -> 38 | string -> 39 | t_seekable 40 | (** [open_file file] creates an out stream writing into the given file. 41 | @param mode permissions for the file creation 42 | @param flags set of unix flags to use. It must contain write permissions. *) 43 | 44 | val with_open_file : 45 | ?close_noerr:bool -> 46 | ?mode:int -> 47 | ?flags:open_flag list -> 48 | string -> 49 | (t_seekable -> 'a) -> 50 | 'a 51 | 52 | val output : #t -> bytes -> int -> int -> unit 53 | (** Write the slice of bytes. *) 54 | 55 | val close : #t -> unit 56 | (** Close the stream. Idempotent. *) 57 | 58 | val output_string : #t -> string -> unit 59 | (** Output the whole string. *) 60 | 61 | val output_int : #t -> int -> unit 62 | (** Output an integer in decimal notation. *) 63 | 64 | val tee : t list -> t 65 | (** [tee ocs] is an output that accepts bytes and writes them to every output 66 | in [ocs]. When closed, it closes all elements of [oc]. *) 67 | 68 | class map_char : (char -> char) -> #t -> t 69 | 70 | val map_char : (char -> char) -> #t -> t 71 | (** Transform the stream byte by byte *) 72 | -------------------------------------------------------------------------------- /src/core/out_buf.ml: -------------------------------------------------------------------------------- 1 | class type t = Iostream_types.Out_buf.t 2 | class type t_seekable = Iostream_types.Out_buf.t_seekable 3 | 4 | let create ?(flush = ignore) ?(close = ignore) ~output_char ~output () : t = 5 | object 6 | method flush () = flush () 7 | method close () = close () 8 | method output_char c = output_char c 9 | method output bs i len = output bs i len 10 | end 11 | 12 | class dummy : t = 13 | object 14 | inherit Out.dummy 15 | method flush () = () 16 | method output_char _ = () 17 | end 18 | 19 | let dummy = new dummy 20 | let _default_buf_size = 16 * 1024 21 | 22 | class virtual t_from_output ?bytes:(buf = Bytes.create _default_buf_size) () = 23 | let off = ref 0 in 24 | 25 | object (self) 26 | method virtual private output_underlying : bytes -> int -> int -> unit 27 | method virtual private close_underlying : unit -> unit 28 | 29 | method flush () = 30 | if !off > 0 then ( 31 | self#output_underlying buf 0 !off; 32 | off := 0 33 | ) 34 | 35 | method output bs i len : unit = 36 | let i = ref i in 37 | let len = ref len in 38 | while !len > 0 do 39 | if !off = Bytes.length buf then self#flush (); 40 | let n = min !len (Bytes.length buf - !off) in 41 | assert (n > 0); 42 | 43 | Bytes.blit bs !i buf !off n; 44 | i := !i + n; 45 | len := !len - n; 46 | off := !off + n 47 | done; 48 | if !off = Bytes.length buf then self#flush () 49 | 50 | method close () = 51 | self#flush (); 52 | self#close_underlying () 53 | 54 | method output_char c : unit = 55 | if !off = Bytes.length buf then self#flush (); 56 | Bytes.set buf !off c; 57 | incr off; 58 | if !off = Bytes.length buf then self#flush () 59 | end 60 | 61 | class bufferized ?bytes (oc : #Out.t) = 62 | object 63 | inherit t_from_output ?bytes () 64 | method private output_underlying bs i len = oc#output bs i len 65 | method private close_underlying () = oc#close () 66 | end 67 | 68 | let[@inline] bufferized ?bytes oc = new bufferized ?bytes oc 69 | 70 | (** [of_out_channel oc] wraps the channel into a {!Out_channel.t}. 71 | @param close_noerr if true, then closing the result uses [close_out_noerr] 72 | instead of [close_out] to close [oc] *) 73 | class of_out_channel ?close_noerr (oc : out_channel) : t_seekable = 74 | object 75 | inherit Out.of_out_channel ?close_noerr oc 76 | method output_char c = output_char oc c 77 | method flush () = flush oc 78 | end 79 | 80 | let[@inline] of_out_channel ?close_noerr oc = new of_out_channel ?close_noerr oc 81 | 82 | class open_file ?close_noerr ?(mode = 0o644) 83 | ?(flags = [ Open_binary; Open_wronly; Open_creat; Open_trunc ]) filename : 84 | t_seekable = 85 | let oc = open_out_gen flags mode filename in 86 | of_out_channel ?close_noerr oc 87 | 88 | let[@inline] open_file ?close_noerr ?mode ?flags filename = 89 | new open_file ?close_noerr ?mode ?flags filename 90 | 91 | let with_open_file ?close_noerr ?mode ?flags filename f = 92 | let oc = open_file ?close_noerr ?mode ?flags filename in 93 | Fun.protect ~finally:oc#close (fun () -> f oc) 94 | 95 | class of_buffer (buf : Buffer.t) : t = 96 | object 97 | inherit Out.of_buffer buf 98 | method flush () = () 99 | method output_char c = Buffer.add_char buf c 100 | end 101 | 102 | let[@inline] of_buffer buf = new of_buffer buf 103 | 104 | (** Output the buffer slice into this channel *) 105 | let[@inline] output_char (self : #t) c : unit = self#output_char c 106 | 107 | let output = Out.output 108 | let output_string = Out.output_string 109 | 110 | let output_line (self : #t) (str : string) : unit = 111 | output_string self str; 112 | output_char self '\n' 113 | 114 | let close = Out.close 115 | let output_int = Out.output_int 116 | 117 | (** Flush (ie. force write) any buffered bytes. *) 118 | let[@inline] flush self : unit = self#flush () 119 | 120 | let output_lines self seq = Seq.iter (output_line self) seq 121 | 122 | let tee (l : t list) : t = 123 | match l with 124 | | [] -> dummy 125 | | [ oc ] -> oc 126 | | _ -> 127 | object 128 | method output bs i len = List.iter (fun oc -> output oc bs i len) l 129 | method output_char c = List.iter (fun oc -> output_char oc c) l 130 | method close () = List.iter close l 131 | method flush () = List.iter flush l 132 | end 133 | 134 | class map_char f (oc : #t) : t = 135 | object 136 | method output_char c = output_char oc (f c) 137 | 138 | method output buf i len = 139 | for j = i to i + len - 1 do 140 | let c = Bytes.get buf j in 141 | (* safety: [j] is valid because [get] above did not raise *) 142 | Bytes.unsafe_set buf j (f c) 143 | done; 144 | output oc buf i len 145 | 146 | method flush () = flush oc 147 | method close () = close oc 148 | end 149 | 150 | let[@inline] map_char f oc = new map_char f oc 151 | -------------------------------------------------------------------------------- /src/core/out_buf.mli: -------------------------------------------------------------------------------- 1 | (** Buffered output stream. *) 2 | 3 | (** An output stream, ie. a place into which we can write bytes, 4 | with a buffer to amortize the cost of operations. 5 | 6 | This can be a [Buffer.t], an [out_channel], a [Unix.file_descr], etc. *) 7 | class type t = object 8 | inherit Out.t 9 | 10 | method output_char : char -> unit 11 | (** Output a single char *) 12 | 13 | method flush : unit -> unit 14 | (** Flush underlying buffer *) 15 | end 16 | 17 | class type t_seekable = object 18 | inherit t 19 | inherit Seekable.t 20 | end 21 | 22 | val create : 23 | ?flush:(unit -> unit) -> 24 | ?close:(unit -> unit) -> 25 | output_char:(char -> unit) -> 26 | output:(bytes -> int -> int -> unit) -> 27 | unit -> 28 | t 29 | (** Create a new output stream from raw components. *) 30 | 31 | class dummy : t 32 | 33 | val dummy : t 34 | (** Dummy output, drops everything written to it. *) 35 | 36 | (** Make a bufferized output from a non bufferized output+close. 37 | @param bytes the buffer to use. It's owned by this channel as long 38 | as the channel exists. *) 39 | class virtual t_from_output : ?bytes:bytes -> unit -> object 40 | inherit t 41 | 42 | method virtual private output_underlying : bytes -> int -> int -> unit 43 | (** Emit these private bytes, unbufferized *) 44 | 45 | method virtual private close_underlying : unit -> unit 46 | (** Close the underlying output. The bufferized output will 47 | flush and then call this. *) 48 | end 49 | 50 | class bufferized : ?bytes:bytes -> #Out.t -> t 51 | 52 | val bufferized : ?bytes:bytes -> #Out.t -> t 53 | 54 | class of_out_channel : ?close_noerr:bool -> out_channel -> t_seekable 55 | 56 | val of_out_channel : ?close_noerr:bool -> out_channel -> t_seekable 57 | (** Wrap an out channel. *) 58 | 59 | class of_buffer : Buffer.t -> t 60 | 61 | val of_buffer : Buffer.t -> t 62 | (** [of_buffer buf] is an output channel that writes directly into [buf]. 63 | [flush] and [close] have no effect. *) 64 | 65 | class open_file : 66 | ?close_noerr:bool -> 67 | ?mode:int -> 68 | ?flags:open_flag list -> 69 | string -> 70 | t_seekable 71 | 72 | val open_file : 73 | ?close_noerr:bool -> 74 | ?mode:int -> 75 | ?flags:open_flag list -> 76 | string -> 77 | t_seekable 78 | (** [open_file file] creates an out stream writing into the given file. 79 | @param mode permissions for the file creation 80 | @param flags set of unix flags to use. It must contain write permissions. *) 81 | 82 | val with_open_file : 83 | ?close_noerr:bool -> 84 | ?mode:int -> 85 | ?flags:open_flag list -> 86 | string -> 87 | (t_seekable -> 'a) -> 88 | 'a 89 | 90 | val output_char : #t -> char -> unit 91 | (** Output a single char *) 92 | 93 | val output : #t -> bytes -> int -> int -> unit 94 | (** Write the slice of bytes. *) 95 | 96 | val close : #t -> unit 97 | (** Close the stream. Idempotent. *) 98 | 99 | val flush : #t -> unit 100 | (** Ensure the bytes written so far are indeed written to the underlying 101 | storage/network socket/… and are not just sitting in a buffer. *) 102 | 103 | val output_string : #t -> string -> unit 104 | (** Output the whole string. *) 105 | 106 | val output_line : #t -> string -> unit 107 | (** Output the whole string followed by ['\n']. 108 | @since 0.2 *) 109 | 110 | val output_lines : #t -> string Seq.t -> unit 111 | (** Output a series of lines, each terminated by ['\n']. *) 112 | 113 | val output_int : #t -> int -> unit 114 | (** Output an integer in decimal notation. *) 115 | 116 | val tee : t list -> t 117 | (** [tee ocs] is an output that accepts bytes and writes them to every output 118 | in [ocs]. When closed, it closes all elements of [oc]. *) 119 | 120 | val map_char : (char -> char) -> #t -> t 121 | (** Transform the stream byte by byte *) 122 | -------------------------------------------------------------------------------- /src/core/seekable.ml: -------------------------------------------------------------------------------- 1 | class type t = Iostream_types.Seekable.t 2 | 3 | let[@inline] seek self i : unit = self#seek i 4 | let[@inline] pos self = self#pos () 5 | -------------------------------------------------------------------------------- /src/core/seekable.mli: -------------------------------------------------------------------------------- 1 | (** An object we can seek in. 2 | 3 | Files can be seeked in, i.e the read/write head can move 4 | around. *) 5 | 6 | class type t = object 7 | method seek : int -> unit 8 | (** Seek in the underlying stream. 9 | @raise Sys_error in case of failure *) 10 | 11 | method pos : unit -> int 12 | (** Return current offset in underlying stream. 13 | @raise Sys_error in case of failure *) 14 | end 15 | 16 | val seek : #t -> int -> unit 17 | val pos : #t -> int 18 | -------------------------------------------------------------------------------- /src/core/slice.ml: -------------------------------------------------------------------------------- 1 | (** Byte slice or buffer. *) 2 | 3 | type t = Iostream_types.Slice.t = { 4 | bytes: bytes; (** Bytes *) 5 | mutable off: int; (** Offset in bytes *) 6 | mutable len: int; (** Length of the slice. Empty slice has [len=0] *) 7 | } 8 | (** A slice of bytes. 9 | The valid bytes in the slice are [bytes[off], bytes[off+1], …, bytes[off+len-1]] 10 | (i.e [len] bytes starting at offset [off]). *) 11 | 12 | let empty : t = { bytes = Bytes.create 0; off = 0; len = 0 } 13 | 14 | let create size : t = 15 | let size = max 16 size in 16 | if size > Sys.max_string_length then 17 | invalid_arg "Slice.create: size is too big"; 18 | { bytes = Bytes.create size; off = 0; len = 0 } 19 | 20 | let[@inline] of_bytes bs : t = { bytes = bs; off = 0; len = 0 } 21 | let[@inline] bytes self = self.bytes 22 | let[@inline] off self = self.off 23 | let[@inline] len self = self.len 24 | 25 | (** Consume the first [n] bytes from the slice, making it [n] bytes 26 | shorter. This modifies the slice in place. *) 27 | let[@inline] consume (self : t) n : unit = 28 | if n < 0 || n > self.len then invalid_arg "In_buf.consume_buf"; 29 | self.off <- self.off + n; 30 | self.len <- self.len - n 31 | 32 | (** find index of [c] in slice, or raise [Not_found] *) 33 | let find_index_exn (self : t) c : int = 34 | let found = ref false in 35 | let i = ref self.off in 36 | let limit = self.off + self.len in 37 | while (not !found) && !i < limit do 38 | let c' = Bytes.unsafe_get self.bytes !i in 39 | if c = c' then 40 | found := true 41 | else 42 | incr i 43 | done; 44 | if !found then 45 | !i 46 | else 47 | raise Not_found 48 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (env 2 | (_ 3 | (flags :standard -warn-error -a+8))) 4 | -------------------------------------------------------------------------------- /src/types/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name iostream_types) 3 | (synopsis "Type definitions for iostreams") 4 | (public_name iostream.types)) 5 | -------------------------------------------------------------------------------- /src/types/iostream_types.ml: -------------------------------------------------------------------------------- 1 | module Slice = struct 2 | type t = { 3 | bytes: bytes; (** Bytes *) 4 | mutable off: int; (** Offset in bytes *) 5 | mutable len: int; (** Length of the slice. Empty slice has [len=0] *) 6 | } 7 | end 8 | 9 | module Seekable = struct 10 | class type t = object 11 | method seek : int -> unit 12 | method pos : unit -> int 13 | end 14 | end 15 | 16 | module In = struct 17 | class type t = object 18 | method input : bytes -> int -> int -> int 19 | (** Read into the slice. Returns [0] only if the 20 | stream is closed. *) 21 | 22 | method close : unit -> unit 23 | (** Close the input. Must be idempotent. *) 24 | end 25 | 26 | class type t_seekable = object 27 | inherit t 28 | inherit Seekable.t 29 | end 30 | end 31 | 32 | module In_buf = struct 33 | class type t = object 34 | inherit In.t 35 | method fill_buf : unit -> Slice.t 36 | method consume : int -> unit 37 | end 38 | end 39 | 40 | module Out = struct 41 | class type t = object 42 | method output : bytes -> int -> int -> unit 43 | method close : unit -> unit 44 | end 45 | 46 | class type t_seekable = object 47 | inherit t 48 | inherit Seekable.t 49 | end 50 | end 51 | 52 | module Out_buf = struct 53 | class type t = object 54 | method output_char : char -> unit 55 | method output : bytes -> int -> int -> unit 56 | method flush : unit -> unit 57 | method close : unit -> unit 58 | end 59 | 60 | class type t_seekable = object 61 | inherit t 62 | inherit Seekable.t 63 | end 64 | end 65 | -------------------------------------------------------------------------------- /src/unix/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name iostream_unix) 3 | (public_name iostream.unix) 4 | (synopsis "Build iostreams from Unix types") 5 | (optional) 6 | (libraries unix iostream)) 7 | -------------------------------------------------------------------------------- /src/unix/iostream_unix.ml: -------------------------------------------------------------------------------- 1 | open Iostream 2 | 3 | module In : sig 4 | open In 5 | 6 | val of_unix_fd : ?close_noerr:bool -> Unix.file_descr -> t_seekable 7 | (** Create an in stream from a raw Unix file descriptor. The file descriptor 8 | must be opened for reading. *) 9 | end = struct 10 | open In 11 | 12 | let of_unix_fd ?(close_noerr = false) (fd : Unix.file_descr) : t_seekable = 13 | object 14 | method input buf i len = Unix.read fd buf i len 15 | 16 | method close () = 17 | if close_noerr then ( 18 | try Unix.close fd with _ -> () 19 | ) else 20 | Unix.close fd 21 | 22 | method seek i = ignore (Unix.lseek fd i Unix.SEEK_SET : int) 23 | method pos () : int = Unix.lseek fd 0 Unix.SEEK_CUR 24 | end 25 | end 26 | 27 | module Out : sig 28 | open Out 29 | 30 | val of_unix_fd : Unix.file_descr -> t_seekable 31 | (** Output stream directly writing into the given Unix file descriptor. *) 32 | end = struct 33 | open Out 34 | 35 | let of_unix_fd fd : t_seekable = of_out_channel (Unix.out_channel_of_descr fd) 36 | end 37 | -------------------------------------------------------------------------------- /test/camlzip/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names t1) 3 | (package iostream-camlzip) 4 | (libraries iostream iostream-camlzip)) 5 | -------------------------------------------------------------------------------- /test/camlzip/t1.ml: -------------------------------------------------------------------------------- 1 | module IO = Iostream 2 | module IOZ = Iostream_camlzip 3 | 4 | let t_decompress_oc_of_compress_ic str = 5 | let ic = IO.In_buf.of_string str in 6 | let buf = Buffer.create 32 in 7 | let oc = IO.Out.of_buffer buf in 8 | IO.In.copy_into (IOZ.compress_in ic) (IOZ.decompressed_out oc); 9 | let str' = Buffer.contents buf in 10 | if str <> str' then (); 11 | () 12 | 13 | let t_decompress_oc_buf_of_compress_ic str = 14 | let ic = IO.In_buf.of_string str in 15 | let buf = Buffer.create 32 in 16 | let oc = IO.Out_buf.of_buffer buf in 17 | IO.In.copy_into (IOZ.compress_in ic) (IOZ.decompressed_out_buf oc); 18 | let str' = Buffer.contents buf in 19 | if str <> str' then (); 20 | () 21 | 22 | let t_decompress_ic_of_compress_ic str = 23 | let ic = IO.In_buf.of_string str in 24 | let buf = Buffer.create 32 in 25 | let oc = IO.Out.of_buffer buf in 26 | IO.In.copy_into 27 | (IOZ.decompress_in @@ IO.In_buf.bufferized @@ IOZ.compress_in ic) 28 | oc; 29 | let str' = Buffer.contents buf in 30 | if str <> str' then (); 31 | () 32 | 33 | let t_decompress_oc_of_compress_oc str = 34 | let ic = IO.In_buf.of_string str in 35 | let buf = Buffer.create 32 in 36 | let oc = IO.Out.of_buffer buf in 37 | IO.In.copy_into ic (IOZ.compressed_out @@ IOZ.decompressed_out oc); 38 | let str' = Buffer.contents buf in 39 | if str <> str' then (); 40 | () 41 | 42 | let t_decompress_oc_buf_of_compress_buf str = 43 | let ic = IO.In_buf.of_string str in 44 | let buf = Buffer.create 32 in 45 | let oc = IO.Out_buf.of_buffer buf in 46 | IO.In.copy_into ic (IOZ.compressed_out_buf @@ IOZ.decompressed_out oc); 47 | let str' = Buffer.contents buf in 48 | if str <> str' then (); 49 | () 50 | 51 | let t_decompress_oc_buf_of_compress_buf_oc str = 52 | let ic = IO.In_buf.of_string str in 53 | let buf = Buffer.create 32 in 54 | let oc = IO.Out_buf.of_buffer buf in 55 | IO.In.copy_into ic (IOZ.compressed_out_buf @@ IOZ.decompressed_out_buf oc); 56 | let str' = Buffer.contents buf in 57 | if str <> str' then (); 58 | () 59 | 60 | let test str = 61 | Printf.printf "oc of ic (len=%d)\n%!" (String.length str); 62 | t_decompress_oc_of_compress_ic str; 63 | Printf.printf "oc_buf of ic (len=%d)\n%!" (String.length str); 64 | t_decompress_oc_buf_of_compress_ic str; 65 | Printf.printf "ic of ic (len=%d)\n%!" (String.length str); 66 | t_decompress_ic_of_compress_ic str; 67 | Printf.printf "oc of oc (len=%d)\n%!" (String.length str); 68 | t_decompress_oc_of_compress_oc str; 69 | Printf.printf "oc_buf of oc (len=%d)\n%!" (String.length str); 70 | t_decompress_oc_buf_of_compress_buf str; 71 | Printf.printf "oc_buf of oc_buf (len=%d)\n%!" (String.length str); 72 | t_decompress_oc_buf_of_compress_buf_oc str; 73 | Printf.printf "passed\n%!"; 74 | () 75 | 76 | let () = test "hello world" 77 | 78 | let () = 79 | let s = String.init 26 (fun i -> Char.chr (Char.code 'a' + i)) in 80 | let l = List.init 1000 (fun _ -> s) in 81 | let str = String.concat "." l in 82 | test str 83 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names t_in t_out_buf t_in_buf) 3 | (package iostream) 4 | (libraries iostream ounit2)) 5 | -------------------------------------------------------------------------------- /test/t_in.ml: -------------------------------------------------------------------------------- 1 | open Iostream 2 | open OUnit2 3 | 4 | let spf = Printf.sprintf 5 | 6 | let t_of_str = 7 | "in1" >:: fun _ctx -> 8 | let ic = In.of_string "hello world" in 9 | let buf = Bytes.create 4 in 10 | assert_equal 4 (In.input ic buf 0 4); 11 | assert_equal "hell" (Bytes.to_string buf); 12 | assert_equal 4 (In.input ic buf 0 4); 13 | assert_equal "o wo" (Bytes.to_string buf); 14 | assert_equal 3 (In.input ic buf 0 3); 15 | assert_equal "rld" (Bytes.sub_string buf 0 3); 16 | assert_equal 0 (In.input ic buf 0 3); 17 | () 18 | 19 | let t_empty = 20 | "in empty" >:: fun _ctx -> 21 | let ic = In.empty in 22 | let buf = Bytes.create 4 in 23 | assert_equal 0 (In.input ic buf 0 4) 24 | 25 | let t_str_to_buf = 26 | "transfer string to buf" >:: fun _ctx -> 27 | let ic = In.of_string ~len:1_500 (String.make 2_000 'a') in 28 | let buf = Buffer.create 32 in 29 | In.copy_into ic (Out.of_buffer buf); 30 | assert_equal 1_500 (Buffer.length buf); 31 | assert_equal (String.make 1_500 'a') (Buffer.contents buf) 32 | 33 | let t_close_str = 34 | "close in string midway" >:: fun _ctx -> 35 | let ic = In.of_string (String.make 2_000 'a') in 36 | let buf = Bytes.create 100 in 37 | for _i = 1 to 10 do 38 | let n = In.input ic buf 0 100 in 39 | assert_equal 100 n 40 | done; 41 | In.close ic; 42 | let n = In.input ic buf 0 100 in 43 | assert_equal ~msg:"must be empty after close" 0 n 44 | 45 | let t_big_read = 46 | "big read" >:: fun _ctx -> 47 | let ic = In.of_string (String.make 2_000 'a') in 48 | let buf = Bytes.create 10_000 in 49 | let n = In.input ic buf 0 10_000 in 50 | assert_equal 2_000 n; 51 | let n = In.input ic buf 0 10_000 in 52 | assert_equal 0 n 53 | 54 | let t_concat = 55 | "concat" >:: fun _ctx -> 56 | let i = 57 | In.concat 58 | [ 59 | (In.of_string "hello" :> In.t); 60 | In.empty; 61 | (In.of_string " " :> In.t); 62 | (In.of_string "world" :> In.t); 63 | (In.of_string "!" :> In.t); 64 | ] 65 | in 66 | let r = In_buf.of_in i |> In_buf.input_all in 67 | assert_equal "hello world!" r 68 | 69 | let t_map = 70 | "map" >:: fun _ctx -> 71 | let i = In.of_string "hello world!" |> In.map_char Char.uppercase_ascii in 72 | assert_equal "HELLO WORLD!" (In_buf.of_in i |> In_buf.input_all) 73 | 74 | let t_read_all = 75 | "read all form large file" >:: fun ctx -> 76 | let path, oc = OUnit2.bracket_tmpfile ~prefix:"t_in" ~suffix:".txt" ctx in 77 | (* prepare file *) 78 | let content = List.init 20 (fun _ -> "lorem ipsum") |> String.concat "," in 79 | for _i = 1 to 1_000 do 80 | output_string oc content 81 | done; 82 | flush oc; 83 | close_out oc; 84 | 85 | let all_content = In.with_open_file path In.input_all in 86 | assert_equal ~printer:(spf "%d") 87 | (1_000 * String.length content) 88 | (String.length all_content); 89 | () 90 | 91 | let t_seek = 92 | "seek in string" >:: fun _ctx -> 93 | let ic = In.of_string ~off:4 ~len:16 "oh hello world, how are you?" in 94 | assert_equal ~printer:string_of_int 0 (Seekable.pos ic); 95 | assert_equal ~printer:(spf "%S") "ello w" (In.really_input_string ic 6); 96 | assert_equal ~printer:string_of_int 6 (Seekable.pos ic); 97 | assert_equal ~printer:(spf "%S") "orld, how " (In.really_input_string ic 10); 98 | assert_equal ~printer:string_of_int 16 (Seekable.pos ic); 99 | assert_raises End_of_file (fun () -> In.really_input_string ic 1); 100 | (* seek back to 0 *) 101 | Seekable.seek ic 0; 102 | assert_equal ~printer:string_of_int 0 (Seekable.pos ic); 103 | assert_equal ~printer:(spf "%S") "ello w" (In.really_input_string ic 6); 104 | assert_equal ~printer:string_of_int 6 (Seekable.pos ic); 105 | assert_equal ~printer:(spf "%S") "orld, how " (In.really_input_string ic 10); 106 | 107 | () 108 | 109 | let suite = 110 | "in" 111 | >::: [ 112 | t_of_str; 113 | t_empty; 114 | t_str_to_buf; 115 | t_close_str; 116 | t_big_read; 117 | t_concat; 118 | t_read_all; 119 | t_map; 120 | t_seek; 121 | ] 122 | 123 | let () = OUnit2.run_test_tt_main suite 124 | -------------------------------------------------------------------------------- /test/t_in_buf.ml: -------------------------------------------------------------------------------- 1 | open Iostream 2 | open OUnit2 3 | 4 | let spf = Printf.sprintf 5 | 6 | let t1 = 7 | "of_bytes" >:: fun _ctx -> 8 | let ic = In_buf.of_bytes (Bytes.of_string "hello world!") in 9 | let bs = In_buf.fill_buf ic in 10 | assert_equal (String.length "hello world!") bs.len; 11 | assert_equal "hello world!" (Bytes.sub_string bs.bytes bs.off bs.len); 12 | In_buf.consume ic 5; 13 | assert_equal (String.length " world!") bs.len; 14 | assert_equal " world!" (Bytes.sub_string bs.bytes bs.off bs.len); 15 | In_buf.consume ic 7; 16 | let bs = In_buf.fill_buf ic in 17 | assert_equal 0 bs.len; 18 | assert_equal "" (Bytes.sub_string bs.bytes bs.off bs.len); 19 | () 20 | 21 | let t2 = 22 | "read all form large file" >:: fun ctx -> 23 | let path, oc = OUnit2.bracket_tmpfile ~prefix:"t_in_buf" ~suffix:".txt" ctx in 24 | (* prepare file *) 25 | let content = List.init 20 (fun _ -> "lorem ipsum") |> String.concat "," in 26 | for _i = 1 to 1_000 do 27 | output_string oc content 28 | done; 29 | flush oc; 30 | close_out oc; 31 | 32 | let all_content = In_buf.with_open_file path In_buf.input_all in 33 | assert_equal ~printer:(spf "%d") 34 | (1_000 * String.length content) 35 | (String.length all_content); 36 | () 37 | 38 | let t3 = 39 | "read lines" >:: fun ctx -> 40 | let path, oc = OUnit2.bracket_tmpfile ~prefix:"t_in_buf" ~suffix:".txt" ctx in 41 | (* prepare file *) 42 | let content = List.init 20 (fun _ -> "lorem ipsum") |> String.concat "," in 43 | for _i = 1 to 1_000 do 44 | output_string oc content; 45 | output_char oc '\n' 46 | done; 47 | flush oc; 48 | close_out oc; 49 | 50 | let lines = In_buf.with_open_file path In_buf.input_lines in 51 | assert_equal 52 | ~printer:(fun l -> 53 | spf "[%s]" (String.concat ";" @@ List.map (spf "%S") @@ l)) 54 | (List.init 1_000 (fun _ -> content)) 55 | lines; 56 | () 57 | 58 | let suite = "in_buf" >::: [ t1; t2; t3 ] 59 | let () = OUnit2.run_test_tt_main suite 60 | -------------------------------------------------------------------------------- /test/t_out_buf.ml: -------------------------------------------------------------------------------- 1 | open Iostream 2 | open OUnit2 3 | module O = Out_buf 4 | 5 | let spf = Printf.sprintf 6 | 7 | let rot13 c = 8 | match c with 9 | | 'a' .. 'z' -> 10 | Char.chr (Char.code 'a' + ((Char.code c - Char.code 'a' + 13) mod 26)) 11 | | 'A' .. 'Z' -> 12 | Char.chr (Char.code 'A' + ((Char.code c - Char.code 'A' + 13) mod 26)) 13 | | c -> c 14 | 15 | let t1 = 16 | "map_char" >:: fun _ctx -> 17 | let buf = Buffer.create 32 in 18 | let oc = O.of_buffer buf |> O.map_char rot13 in 19 | O.output_string oc "hello"; 20 | assert_equal ~printer:(spf "%S") "uryyb" (Buffer.contents buf); 21 | O.output_string oc " world"; 22 | assert_equal ~printer:(spf "%S") "uryyb jbeyq" (Buffer.contents buf); 23 | Buffer.clear buf; 24 | O.output_string oc "!!"; 25 | assert_equal ~printer:(spf "%S") "!!" (Buffer.contents buf); 26 | () 27 | 28 | let t2 = 29 | "with_out" >:: fun ctx -> 30 | let path, _oc = OUnit2.bracket_tmpfile ~prefix:"tout" ~suffix:"tmp" ctx in 31 | close_out_noerr _oc; 32 | O.with_open_file path (fun out -> 33 | O.output_string out "hello world"; 34 | O.output_char out '!'); 35 | (* Printf.eprintf "done writing into %S\n%!" path; *) 36 | let content = In_buf.with_open_file path In_buf.input_all in 37 | assert_equal "hello world!" content 38 | 39 | let suite = "out" >::: [ t1; t2 ] 40 | let () = OUnit2.run_test_tt_main suite 41 | --------------------------------------------------------------------------------