(**
 	Module: Faustio	
	Description: audio input/output, csv input/output
	@author WANG Haisheng	
	Created: 12/08/2013	Modified: 13/08/2013
*)

open Types;;
open Basic;;
open Value;;
open Signal;;
open Beam;;
open Aux;;
open Nest;;

exception IO_Error of string;;

let csv_read_buffer_length = 0xFFFF;;
let nst_read_buffer_length = 0xFFFF;;

class virtual io = 
  object
    val mutable _filename = ""
    val mutable _basename = ""
    val mutable _dir = ""
    method set : string -> string -> string -> unit = 
      fun (filename : string) ->
	fun (dir : string) ->
	  fun (basename : string) ->
	    _filename <- filename; _basename <- basename; _dir <- dir

    method virtual read : string array -> beam
    (*method virtual write : rate array -> data -> string * string -> string array*)
    
    method private concat : data -> matrix = 
      fun (origin : data) ->
	Array.map Array.concat (Array.map Array.to_list origin)

    method private channels : data -> int array = 
      fun data ->
	let get_channel = fun s -> 
	  let l = Array.length s in
	  Array.length s.(l - 1) in
	Array.map get_channel data  
  end;;

class waveio : io_type = 
  object (self)
    inherit io
    method read : string array -> beam = 
      fun (paths : string array) ->
	let n = Array.length paths in
	if n = 0 then
	  new beam [||]
	else 
	  let signals = 
	    let files = Array.map Sndfile.openfile paths in
	    let frames = Array.map Int64.to_int 
		(Array.map Sndfile.frames files) in
	    let make_rate = 
	      fun (denom : int) ->
		fun (num : int) ->
		  new rate num denom in
	    let nums = Array.map Sndfile.samplerate files in
	    let rates = Array.map (make_rate 1) nums in
	    let create_container = fun l -> Array.create l 1. in
	    let containers = Array.map create_container frames in
	    let _ = array_map2 Sndfile.read files containers in
	    let _ = Array.map Sndfile.close files in
	    let stream2func = 
	      fun stream -> fun t -> new value (R stream.(t)) in
	    array_map2 (new signal) rates (Array.map stream2func containers) in
	  new beam signals

    method write : rate array -> data -> string * string -> string array = 
      fun (rates : rate array) ->
	fun (output : data) ->
	  fun (info : string * string) ->
	    let stdoutput = fst info in
	    let basename = snd info in
	    let n = Array.length output in
	    let paths = 
	      if n = 1 && stdoutput <> "" && basename = "" then 
		let () = Unix.unlink stdoutput in [|stdoutput|]
	      else if stdoutput = "" && basename <> "" then 
		Array.init n (fun i -> 
		  _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".wav") 		
	      else if stdoutput = "" && basename = "" then
		raise (IO_Error "Please specify stdout or output basename.")
	      else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
            let get_freq = fun (r : rate) -> r#to_int in
	    let freqs = Array.map get_freq rates in
	    
	    let files = 
	      let channels = self#channels output in 
	      let file_format = Sndfile.format 
		  Sndfile.MAJOR_WAV Sndfile.MINOR_PCM_16 in
	      let openwr = fun path -> fun channel -> fun freq ->
		Sndfile.openfile ~info:(Sndfile.RDWR, file_format, channel, freq) path in
	      array_map3 openwr paths channels freqs in 
	    
	    let data = self#concat output in
	    let _ = array_map2 Sndfile.write files data in
	    let _ = Array.map Sndfile.close files in
	    paths
  end;;



class csvio : io_type = 
  object (self)
    inherit io
    method private csvread : in_channel -> signal = 
      fun (ic : in_channel) ->
	let buffer = Buffer.create csv_read_buffer_length in
	let () = 
	  try
	    while true do
	      Buffer.add_string buffer (input_line ic);
	      Buffer.add_char buffer '\t';
	    done; 
	  with End_of_file -> () in
	let content = Buffer.contents buffer in
	let lines = Str.split (Str.regexp "\t") content in
	let elements = List.map (Str.split (Str.regexp ",")) lines in
	let data = 
	  let data_in_list = List.map (List.map float_of_string) elements in
	  Array.of_list (List.map Array.of_list data_in_list) in      
	let values = 
	  let convertor = new value Zero in
	  Array.map (convertor#of_float_array) data in
	new signal (new rate 0 1) (Array.get values)

    method read : string array -> beam =
      fun (paths : string array) ->
	let files = Array.map open_in paths in
	let signals = Array.map self#csvread files in
	new beam signals

    method write : rate array -> data -> string * string -> string array = 
      fun (rates : rate array) ->
	fun (data : data) ->
	  fun (info : string * string) -> 
	    let stdoutput = fst info in
	    let basename = snd info in
	    let n = Array.length data in
	    let strings = 
	      let value2string : float array -> string =
		fun (v : float array) ->
		  let strings = Array.map string_of_float v in
		  String.concat "," (Array.to_list strings) in
	      let signal2string : float array array -> string = 
		fun (s : float array array) -> 
		  let lines = Array.map value2string s in
		  String.concat "\n" (Array.to_list lines) in
	      Array.map signal2string data in

	    if stdoutput = "" && basename = "" then
	      let _ = Array.map (output_string stdout) strings in
	      [|"Stdout"|]
	    else 
	      let paths = 
		if n = 1 && stdoutput <> "" && basename = "" then 
		  let () = Unix.unlink stdoutput in [|stdoutput|]
		else if stdoutput = "" && basename <> "" then 
		  Array.init n (fun i -> 
		    _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".csv") 
		else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
              let files = Array.map open_out paths in
	      let _ = array_map2 output_string files strings in
	      let _ = Array.map close_out files in
	      paths
  end;;



class nstio = 
  object (self)
    inherit io
    method private nstread : in_channel -> signal = 
      fun (ic : in_channel) ->
	let buffer = Buffer.create nst_read_buffer_length in
	let () = 
	  try
	    while true do
	      Buffer.add_string buffer (input_line ic);
	      Buffer.add_char buffer '\t';
	    done; 
	  with End_of_file -> () in
	let content = Buffer.contents buffer in
	let lines = Str.split (Str.regexp "\t") content in
        let basics = List.map basic_from_nest (List.map nest_from_string lines) in
        let values = Array.map (new value) (Array.of_list basics) in
	new signal (new rate 0 1) (Array.get values)

    method read : string array -> beam =
      fun (paths : string array) ->
	let files = Array.map open_in paths in
	let signals = Array.map self#nstread files in
	new beam signals

    method write : rate array -> raw_data -> string * string -> string array = 
      fun (rates : rate array) ->
	fun (data : raw_data) ->
	  fun (info : string * string) -> 
	    let stdoutput = fst info in
	    let basename = snd info in
	    let length = Array.length data in
            let width = Array.length rates in

	    let strings = 
              let value2string : value -> string =
                fun (v : value) -> v#to_neststring in
              let init = "" in
              let container = Array.make length (Array.make width init) in
              let index = ref 0 in

              try 
                while !index < length do
                  container.(!index) <- Array.map value2string data.(!index);
                  incr index;
                done;
                Array.map (String.concat "\n") 
                  (Array.map Array.to_list (transpose width container))

              with x -> 
                match x with
                | Invalid_argument s -> 
                    let fragments = Array.sub container 0 !index in
                    let string_lists = 
                      Array.map Array.to_list (transpose width fragments) in
                    Array.map (String.concat "\n") string_lists
                | _ -> raise x in

	    if stdoutput = "" && basename = "" then
	      let _ = Array.map (output_string stdout) strings in
	      [|"Stdout"|]
	    else 
	      let paths = 
		if width = 1 && stdoutput <> "" && basename = "" then 
		  let () = Unix.unlink stdoutput in [|stdoutput|]
		else if stdoutput = "" && basename <> "" then 
		  Array.init width (fun i -> 
		    _dir ^ _basename ^ (string_of_int (i + 1)) ^ ".nst") 
		else raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.") in
              let files = Array.map open_out paths in
	      let _ = array_map2 output_string files strings in
	      let _ = Array.map close_out files in
	      paths
  end;;

class iomanager = 
  object (self)
    val wave = new waveio
    val csv = new csvio
    val nst = new nstio
    val mutable _filename = ""
    val mutable _dir = ""
    val mutable _format = ""
    val mutable _basename = ""

    method read : string list -> beam_type = 
      fun (paths : string list) ->
	let formats = List.map format_of_file paths in
	let read_one : string -> string -> beam_type = 
	  fun (format : string) ->
	    fun (path : string) ->
	      if format = "wav" then wave#read [|path|]
	      else if format = "csv" then csv#read [|path|]
	      else if format = "nst" then nst#read [|path|]
	      else raise (Invalid_argument "Unknown format.") in
	let beams = List.map2 read_one formats paths in
	let concat : beam_type -> beam_type -> beam_type = 
	  fun b1 -> fun b2 -> b1#append b2 in
	List.fold_left concat (new beam [||]) beams
	      
    method set : string -> string -> string -> string -> unit = 
      fun (filename : string) ->
	fun (dir : string) ->
	  fun (format : string) ->
	    fun (basename : string) ->
	      _filename <- filename;
	      _dir <- dir; 
	      _format <- format; 
	      _basename <- basename;
	      wave#set _filename _dir _basename;
	      csv#set _filename _dir _basename;
	      nst#set _filename _dir _basename

    method write : rate array -> data -> string array = 
      fun (rates : rate array) ->
	fun (data : data) ->
	  let n = Array.length rates in
	  if n = 1 then (
	    if _filename <> "" then (
	      let fmt = format_of_file _filename in
	      if fmt = "csv" then csv#write rates data (_filename, "")
	      else if fmt = "wav" then wave#write rates data (_filename, "")
	      else raise (IO_Error "Unknown stdout format."))
	    else if _basename <> "" && _format <> "" then (
	      if _format = "csv" then csv#write rates data ("", _basename)
	      else if _format = "wav" then wave#write rates data ("", _basename)
	      else raise (IO_Error "Unknown --oformat."))
	    else if _filename = "" && _basename = "" && _format = "" then
	      csv#write rates data ("", "")
	    else raise (IO_Error "Please specify both --obasename and --oformat."))

	  else if n > 1 then (
	    if _filename <> "" then
	      raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.")
            else if _basename <> "" && _format <> "" then (
	      if _format = "csv" then csv#write rates data ("", _basename)
	      else if _format = "wav" then wave#write rates data ("", _basename)
	      else raise (IO_Error "Unknown --oformat."))
	    else raise (IO_Error "Please specify both --obasename and --oformat."))

	  else 
	    [|"no output signal."|]

    method write_nst : rate array -> raw_data -> string array = 
      fun (rates : rate array) ->
	fun (rd : raw_data) ->
	  let n = Array.length rates in	  
          let info = 
              if _filename <> "" && n = 1 then (_filename, "")
              else if _basename <> "" && _format <> "" then ("", _basename)
              else if _filename = "" && _basename = "" && _format = "" then
                ("", "")             
              else if _filename <> "" && n > 1 then 
                raise (IO_Error "Stdout doesn't support multi-output process. Please remove '> stdout' and use --obasename --oformat.")
              else raise (IO_Error "Please specify both --obasename and --oformat.") in
          nst#write rates rd info

  end;;