(* Subclassable file-like streams module                            *)
(* by Travis Bemann                                                 *)
(*                                                                  *)
(* This program is free software; you can redistribute it and/or    *)
(* modify it under the terms of the GNU Lesser General Public       *)
(* License as published by the Free Software Foundation; either     *)
(* version 2 of the License, or (at your option) any later version. *)
(*                                                                  *)
(* This program is distributed in the hope that it will be useful,  *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of   *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    *)
(* GNU Lesser General Public License for more details.              *)

class virtual fstream_in =
  object
    method virtual length : int
    method virtual input_char : char
    method virtual input_line : string
    method virtual input : int -> string
    method virtual really_input : int -> string
    method virtual input_buf : string -> int -> int -> int
    method virtual really_input_buf : string -> int -> int -> unit
    method virtual seek : int -> unit
    method virtual pos : int
  end

class fstream_in_channel chan =
  object (self)
    inherit fstream_in
    method length = in_channel_length chan
    method input_char = input_char chan
    method input_line = input_line chan
    method input len =
      let buf = String.create len in
      let len_read = input chan buf 0 len in
      if len_read > 0 then
	String.sub buf 0 len_read
      else
	if self#pos = self#length then
	  raise End_of_file
	else ""
    method really_input len =
      let buf = String.create len in
      really_input chan buf 0 len;
      buf
    method input_buf buf off len =
      try input chan buf off len
      with Invalid_argument _ ->
	raise (Invalid_argument "Fstream.fstream_in#input_buf")
    method really_input_buf buf off len =
      try really_input chan buf off len
      with Invalid_argument _ ->
	raise (Invalid_argument "Fstream.fstream_in#really_input_buf")
    method seek off = seek_in chan off
    method pos = pos_in chan
  end

class fstream_in_string data =
  object (self)
    inherit fstream_in
    val data = data
    val mutable loc = 0
    method length = String.length data
    method input_char =
      if loc < String.length data then
	let ch = String.get data loc in
	loc <- loc + 1;
	ch
      else raise End_of_file
    method input_line =
      let rec find_endline off =
	if off < String.length data then
	  match String.get data off with
	    '\n' | '\r' -> off
	  | _ -> find_endline (off + 1)
	else off
      and skip_endline off =
	if off < String.length data then
	  match String.get data off with
	    '\n' -> off + 1
	  | '\r' ->
	      if off + 1 < String.length data then
		match String.get data (off + 1) with
		  '\n' -> off + 2
		| _ -> off + 1
	      else off + 1
	  | _ -> off
	else off
      in
      if loc < String.length data then
	let loc_end = find_endline loc in
	let line = String.sub data loc (loc_end - loc) in
	loc <- skip_endline loc_end;
	line
      else raise End_of_file
    method input len =
      let len_real =
	if loc + len <= String.length data then
	  len
	else
	  if loc <= String.length data then
	    (String.length data) - loc
	  else raise End_of_file
      in
      let buf = String.sub data loc len_real in
      loc <- loc + len_real;
      buf
    method really_input len =
      if loc + len <= String.length data then
	let buf = String.sub data loc len in
	loc <- loc + len;
	buf
      else raise End_of_file
    method input_buf buf off len =
      let len_real =
	if loc + len <= String.length data then
	  len
	else
	  if loc < String.length data then
	    (String.length data) - loc
	  else raise End_of_file
      in
      try
	String.blit data loc buf off len_real;
	loc <- loc + len_real;
	len_real
      with Invalid_argument _ ->
	raise (Invalid_argument "Fstream.fstream_in#input_buf")
    method really_input_buf buf off len =
      if loc + len <= String.length data then
	try
	  String.blit data loc buf off len;
	  loc <- loc + len
	with Invalid_argument _ ->
	  raise (Invalid_argument "Fstream.fstream_in#really_input_buf")
      else raise End_of_file
    method seek off =
      if off <= String.length data then
	loc <- off
      else raise End_of_file
    method pos = loc
  end
    
class virtual fstream_out =
  object
    method virtual output_char : char -> unit
    method virtual output_string : string -> unit
    method virtual output_buf : string -> int -> int -> unit
    method virtual output_byte : int -> unit
    method virtual clear : unit
  end
    
class fstream_out_null =
  object (self)
    inherit fstream_out
    method output_char _ = ()
    method output_string _ = ()
    method output_buf _ _ _ = ()
    method output_byte _ = ()
    method clear = ()
  end

class fstream_out_channel chan =
  object (self)
    inherit fstream_out
    method output_char ch = output_char chan ch
    method output_string data = output_string chan data
    method output_buf buf off len = output chan buf off len
    method output_byte byte = output_byte chan byte
    method clear = seek_out chan 0
  end

class fstream_out_buffer =
  object (self)
    inherit fstream_out
    val buf = Buffer.create 1000
    method output_char ch = Buffer.add_char buf ch
    method output_string data = Buffer.add_string buf data
    method output_buf data off len =
      Buffer.add_substring buf data off len
    method output_byte byte =
      Buffer.add_char buf (char_of_int (byte land 0xFF))
    method contents = Buffer.contents buf
    method clear = Buffer.reset buf
  end