main.ml

let compress stdin stdout =
  let jsonm = Jsonm.encoder `Manual in
  let o = Bigstringaf.create De.io_buffer_size in
  let i = Bytes.create De.io_buffer_size in
  let t = Bigstringaf.create De.io_buffer_size in
  let stop = ref false in
  let rec encode gz = function
    | `Partial ->
      let len = Bytes.length i - Jsonm.Manual.dst_rem jsonm in
      Bigstringaf.blit_from_bytes i ~src_off:0 t ~dst_off:0 ~len ;
      Jsonm.Manual.dst jsonm i 0 (Bytes.length i) ;
      compress (Gz.Def.src gz t 0 len)
    | `Ok ->
      match stdin () with
      | `End ->
        stop := true ; encode gz (Jsonm.encode jsonm `End)
      | #Jsonm.lexeme as lexeme -> encode gz (Jsonm.encode jsonm (`Lexeme lexeme))
  and compress gz = match Gz.Def.encode gz with
    | `Await gz when not !stop -> encode gz (Jsonm.encode jsonm `Await)
    | `Await gz ->
      compress (Gz.Def.src gz De.bigstring_empty 0 0)
    | `Flush gz ->
      let len = Bigstringaf.length o - Gz.Def.dst_rem gz in
      let tmp = Bigstringaf.substring o ~off:0 ~len in
      stdout (Some tmp) ;
      compress (Gz.Def.dst gz o 0 (Bigstringaf.length o))
    | `End gz ->
      let len = Bigstringaf.length o - Gz.Def.dst_rem gz in
      let tmp = Bigstringaf.substring o ~off:0 ~len in
      stdout (Some tmp) ;
      stdout None in
  let q = De.Queue.create 0x1000 in
  let w = De.Lz77.make_window ~bits:15 in
  let gz = Gz.Def.encoder `Manual `Manual ~mtime:0l Gz.Unix ~q ~w ~level:4 in
  let gz = Gz.Def.dst gz o 0 (Bigstringaf.length o) in
  Jsonm.Manual.dst jsonm i 0 (Bytes.length i) ;
  encode gz `Ok

let unserialize stdin (stdout : [ `End | Jsonm.lexeme ] -> unit) =
  let jsonm = Jsonm.decoder (`Channel stdin) in
  let rec unserialize () = match Jsonm.decode jsonm with
    | `Await -> assert false
    | `Error error -> failwith "Bad JSON input!"
    | `Lexeme lexeme ->
      stdout (lexeme :> [ `End | Jsonm.lexeme ]) ;
      unserialize ()
    | `End ->
      stdout `End in
  unserialize ()

let () =
  let q = Queue.create () in
  unserialize stdin (fun lexeme -> Queue.push lexeme q) ;
  match compress (fun () -> Queue.pop q) (Option.map (output_string stdout)) with
  | Some () -> assert false
  | None -> ()

(* echo "[1]" | ./a.out | gzip -d --stdout *)