(* Simple generators according to:

   Kiselyov, Peyton-Jones, Sabry
   Lazy v. Yield: Incremental, Linear Pretty-printing
   Springer's LNCS 7705, pp. 190-206
   http://okmij.org/ftp/continuations/PPYield/

   But with type checked composition.

   This one also gets rid of producer as a generator returning
   unit. This was propagating in all the combinators in a bad
   way. Producers may want to return errors rather than unit.

   Removing the transducer abbreviation, which is less readable
   than its expansion. *)

module G : sig
  type 'a consumer = 'a -> unit
  type ('a, 'b) gen = 'a consumer -> 'b

  val iter : 'a consumer -> ('a, 'b) gen -> 'b
  val map : ('a -> 'b) -> ('a, 'c) gen -> ('b, 'c) gen
  val fold : ('a -> 'b -> 'a) -> 'a -> ('b, 'c) gen -> ('a, 'c) gen
end = struct
  type 'a consumer = 'a -> unit
  type ('a, 'b) gen = 'a consumer -> 'b

  let iter yield g = g yield
  let map f g = fun yield -> iter (fun x -> yield (f x)) g
  let fold f acc g = fun yield ->
    let acc = ref acc in
    let v = iter (fun v -> acc := f !acc v) g in
    yield !acc; v
end

module P : sig
  val lines_of_file : string -> (string, unit) G.gen
  val chars_of_file : string -> (char, unit) G.gen
end = struct
  let close_in ic = Printf.printf "trace: closing!%!\n"; close_in ic

  let with_inf fname loop =
    let ic = open_in fname in
    let v = try loop ic with e -> close_in ic; raise e in
    close_in ic; v

  let lines_of_file fname = fun yield ->
    let rec loop ic =
      match (try Some (input_line ic) with End_of_file -> None) with
      | None -> ()
      | Some line -> yield line; loop ic
    in
    with_inf fname loop

  let chars_of_file fname = fun yield ->
    let rec loop ic =
      match (try Some (input_char ic) with End_of_file -> None) with
      | None -> ()
      | Some c -> yield c; loop ic
    in
    with_inf fname loop
end

module C : sig
  val output_char : char -> unit
  val output_line : string -> unit
end = struct
  let output_char = print_char
  let output_line = print_endline
end

let test_file = "/tmp/testf.txt"

let make_test =
  let h = open_out test_file in
  output_string h "2\n3\n5\n7\n11\n13\nINVALID";
  close_out h;
  Printf.printf "\nWrote test file %s\n" test_file

let lines_of_char : (char, unit) G.gen -> (string, unit) G.gen =
  fun gen yield ->
    let tr b = function
    | '\n' ->
        Printf.printf "trace: line %S\n%!" (Buffer.contents b);
      yield (Buffer.contents b); Buffer.clear b; b
    | c -> Buffer.add_char b c; b
    in
    let eog = function
    | b when Buffer.length b = 0 -> ()
    | b -> yield (Buffer.contents b); ()
    in
    G.iter eog (G.fold tr (Buffer.create 80) gen)

let cat fname = G.iter C.output_char (P.chars_of_file fname)
let cat_lines fname =
  G.iter C.output_line (lines_of_char (P.chars_of_file fname))

exception Exists
let exists gen =
  try G.iter (fun v -> if v then raise Exists else ()) gen; false
  with Exists -> true

let any pred gen = exists (G.map (fun v -> (pred v)) gen)

let t2_gen () =
  any (function x -> x > 3)
    (G.map int_of_string (lines_of_char (P.chars_of_file test_file)))

let () =
  Printf.printf "\nCat by chars\n"; cat test_file;
  Printf.printf "\nCat by lines\n"; cat_lines test_file;
  assert (t2_gen ());
  ()

(*---------------------------------------------------------------------------
   Copyright (c) 2015 Daniel C. Bünzli.
   All rights reserved.

   Redistribution and use in source and binary forms, with or without
   modification, are permitted provided that the following conditions
   are met:

   1. Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

   2. Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

   3. Neither the name of Daniel C. Bünzli nor the names of
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  ---------------------------------------------------------------------------*)