(*---------------------------------------------------------------------------
   Copyright (c) 2015 Daniel C. Bünzli. All rights reserved.
   Distributed under the BSD3 license, see license at the end of the file.
   %%NAME%% release %%VERSION%%
  ---------------------------------------------------------------------------*)

(* 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. *)

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

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

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

module P : sig
  val lines_of_file : string -> string G.producer
  val chars_of_file : string -> char G.producer
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 k ->
    let rec loop ic =
      match (try Some (input_line ic) with End_of_file -> None) with
      | None -> ()
      | Some line -> G.yield k line; loop ic
    in
    with_inf fname loop

  let chars_of_file fname = fun k ->
    let rec loop ic =
      match (try Some (input_char ic) with End_of_file -> None) with
      | None -> ()
      | Some c -> G.yield k 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, string) G.transducer = fun gen k ->
  let tr b = function
  | '\n' ->
      Printf.printf "trace: line %S\n%!" (Buffer.contents b);
      G.yield k (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 -> G.yield k (Buffer.contents b); ()
  in
  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.
  ---------------------------------------------------------------------------*)