#include <R.h>
#include <Rdefines.h>
#include <sstream>
#include <stdlib.h>
#include "Var.h"
#include "IPhreeqc.hpp"

#define CONVERT_TO_DATA_FRAME

class R {
public:
  static IPhreeqc& singleton() {
    static IPhreeqc instance;
    return instance;
  }
};


extern "C" {


SEXP
accumLine(SEXP line)
{
  const char* str_in;

  // check args
  if (!isString(line) || length(line) != 1) {
    error("AccumulateLine:line is not a single string\n");
  }

  str_in = CHAR(STRING_ELT(line, 0));

  if (R::singleton().AccumulateLine(str_in) != VR_OK) {
    std::ostringstream oss;
    oss << R::singleton().GetErrorString();
    error(oss.str().c_str());
  }

  return(R_NilValue);
}

SEXP
clearAccum(void)
{
  R::singleton().ClearAccumulatedLines();
  return(R_NilValue);
}

SEXP
getErrorFileOn(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(LGLSXP, 1));
  if (R::singleton().GetErrorFileOn()) {
    LOGICAL(ans)[0] = TRUE;
  }
  else {
    LOGICAL(ans)[0] = FALSE;
  }
  UNPROTECT(1);
  return(ans);
}

SEXP
setDumpFileOn(SEXP value)
{
  SEXP ans = R_NilValue;
  // check args
  if (!isLogical(value) || length(value) != 1) {
    error("SetDumpFileOn:value must either be \"TRUE\" or \"FALSE\"\n");
  }
  R::singleton().SetDumpFileOn(LOGICAL(value)[0]);
  return(ans);
}

SEXP
setErrorFileOn(SEXP value)
{
  SEXP ans = R_NilValue;
  // check args
  if (!isLogical(value) || length(value) != 1) {
    error("SetErrorFileOn:value must either be \"TRUE\" or \"FALSE\"\n");
  }
  R::singleton().SetErrorFileOn(LOGICAL(value)[0]);
  return(ans);
}

SEXP
setLogFileOn(SEXP value)
{
  SEXP ans = R_NilValue;
  // check args
  if (!isLogical(value) || length(value) != 1) {
    error("SetLogFileOn:value must either be \"TRUE\" or \"FALSE\"\n");
  }
  R::singleton().SetLogFileOn(LOGICAL(value)[0]);
  return(ans);
}

SEXP
setOutputFileOn(SEXP value)
{
  SEXP ans = R_NilValue;
  // check args
  if (!isLogical(value) || length(value) != 1) {
    error("SetOutputFileOn:value must either be \"TRUE\" or \"FALSE\"\n");
  }
  R::singleton().SetOutputFileOn(LOGICAL(value)[0]);
  return(ans);
}

SEXP
setSelectedOutputFileOn(SEXP value)
{
  SEXP ans = R_NilValue;
  // check args
  if (!isLogical(value) || length(value) != 1) {
    error("SetSelectedOutputFileOn:value must either be \"TRUE\" or \"FALSE\"\n");
  }
  R::singleton().SetSelectedOutputFileOn(LOGICAL(value)[0]);
  return(ans);
}

SEXP
setDumpStringOn(SEXP value)
{
  SEXP ans = R_NilValue;
  // check args
  if (!isLogical(value) || length(value) != 1) {
    error("SetDumpStringOn:value must either be \"TRUE\" or \"FALSE\"\n");
  }
  R::singleton().SetDumpStringOn(LOGICAL(value)[0]);
  return(ans);
}

SEXP
setErrorStringOn(SEXP value)
{
  SEXP ans = R_NilValue;
  // check args
  if (!isLogical(value) || length(value) != 1) {
    error("SetErrorStringOn:value must either be \"TRUE\" or \"FALSE\"\n");
  }
  R::singleton().SetErrorStringOn(LOGICAL(value)[0]);
  return(ans);
}

SEXP
setLogStringOn(SEXP value)
{
  SEXP ans = R_NilValue;
  // check args
  if (!isLogical(value) || length(value) != 1) {
    error("SetLogStringOn:value must either be \"TRUE\" or \"FALSE\"\n");
  }
  R::singleton().SetLogStringOn(LOGICAL(value)[0]);
  return(ans);
}

SEXP
setOutputStringOn(SEXP value)
{
  SEXP ans = R_NilValue;
  // check args
  if (!isLogical(value) || length(value) != 1) {
    error("SetOutputStringOn:value must either be \"TRUE\" or \"FALSE\"\n");
  }
  R::singleton().SetOutputStringOn(LOGICAL(value)[0]);
  return(ans);
}

SEXP
setSelectedOutputStringOn(SEXP value)
{
  SEXP ans = R_NilValue;
  // check args
  if (!isLogical(value) || length(value) != 1) {
    error("SetSelectedOutputStringOn:value must either be \"TRUE\" or \"FALSE\"\n");
  }
  R::singleton().SetSelectedOutputStringOn(LOGICAL(value)[0]);
  return(ans);
}

SEXP
setDumpFileName(SEXP filename)
{
  const char* name;
  SEXP ans = R_NilValue;
  // check args
  if (!isString(filename) || length(filename) != 1) {
    error("SetDumpFileName:filename is not a single string\n");
  }

  name = CHAR(STRING_ELT(filename, 0));
  R::singleton().SetDumpFileName(name);
  return(ans);
}

SEXP
setErrorFileName(SEXP filename)
{
  const char* name;
  SEXP ans = R_NilValue;
  // check args
  if (!isString(filename) || length(filename) != 1) {
    error("SetErrorFileName:filename is not a single string\n");
  }

  name = CHAR(STRING_ELT(filename, 0));
  R::singleton().SetErrorFileName(name);
  return(ans);
}

SEXP
setLogFileName(SEXP filename)
{
  const char* name;
  SEXP ans = R_NilValue;
  // check args
  if (!isString(filename) || length(filename) != 1) {
    error("SetLogFileName:filename is not a single string\n");
  }

  name = CHAR(STRING_ELT(filename, 0));
  R::singleton().SetLogFileName(name);
  return(ans);
}

SEXP
setOutputFileName(SEXP filename)
{
  const char* name;
  SEXP ans = R_NilValue;
  // check args
  if (!isString(filename) || length(filename) != 1) {
    error("SetOutputFileName:filename is not a single string\n");
  }

  name = CHAR(STRING_ELT(filename, 0));
  R::singleton().SetOutputFileName(name);
  return(ans);
}

SEXP
setSelectedOutputFileName(SEXP filename)
{
  const char* name;
  SEXP ans = R_NilValue;
  // check args
  if (!isString(filename) || length(filename) != 1) {
    error("SetSelectedOutputFileName:filename is not a single string\n");
  }

  name = CHAR(STRING_ELT(filename, 0));
  R::singleton().SetSelectedOutputFileName(name);
  return(ans);
}

SEXP
getDumpString(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetDumpString()));
  UNPROTECT(1);
  return ans;
}

SEXP
getLogString(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetLogString()));
  UNPROTECT(1);
  return ans;
}

SEXP
getOutputString(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetOutputString()));
  UNPROTECT(1);
  return ans;
}

SEXP
getSelectedOutputString(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetSelectedOutputString()));
  UNPROTECT(1);
  return ans;
}

SEXP
getWarningString(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetWarningString()));
  UNPROTECT(1);
  return ans;
}

SEXP
getDumpFileName(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetDumpFileName()));
  UNPROTECT(1);
  return ans;
}

SEXP
getErrorFileName(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetErrorFileName()));
  UNPROTECT(1);
  return ans;
}

SEXP
getLogFileName(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetLogFileName()));
  UNPROTECT(1);
  return ans;
}

SEXP
getOutputFileName(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetOutputFileName()));
  UNPROTECT(1);
  return ans;
}

SEXP
getSelectedOutputFileName(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetSelectedOutputFileName()));
  UNPROTECT(1);
  return ans;
}

SEXP
listComps(void)
{
  SEXP ans = R_NilValue;

  std::list< std::string > lc = R::singleton().ListComponents();
  if (lc.size() > 0) {
    PROTECT(ans = allocVector(STRSXP, lc.size()));
    std::list< std::string >::iterator li = lc.begin();
    for (int i = 0; li != lc.end(); ++i, ++li) {
      SET_STRING_ELT(ans, i, mkChar((*li).c_str()));
    }
    UNPROTECT(1);
    return(ans);
  }

  return(R_NilValue);
}

SEXP
loadDB(SEXP filename)
{
  const char* name;

  // check args
  if (!isString(filename) || length(filename) != 1) {
    error("filename is not a single string\n");
  }

  name = CHAR(STRING_ELT(filename, 0));

  if (R::singleton().LoadDatabase(name) != VR_OK) {
    std::ostringstream oss;
    oss << R::singleton().GetErrorString();
    error(oss.str().c_str());
  }

  return(R_NilValue);
}

SEXP
loadDBStr(SEXP input)
{
  const char* string;

  // check args
  if (!isString(input) || length(input) != 1) {
    error("input is not a single string\n");
  }

  string = CHAR(STRING_ELT(input, 0));

  if (R::singleton().LoadDatabaseString(string) != VR_OK) {
    std::ostringstream oss;
    oss << R::singleton().GetErrorString();
    error(oss.str().c_str());
  }

  return(R_NilValue);
}

SEXP
getAccumLines(void)
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetAccumulatedLines().c_str()));
  UNPROTECT(1);
  return ans;
}

//SEXP
//phreeqcDat(void)
//{
//  extern const char PHREEQC_DAT[];
//  SEXP ans = R_NilValue;
//  PROTECT(ans = allocVector(STRSXP, 1));
//  SET_STRING_ELT(ans, 0, mkChar(PHREEQC_DAT));
//  UNPROTECT(1);
//  return ans;
//}

SEXP
runAccum(void)
{
  if (R::singleton().RunAccumulated() != VR_OK) {
    std::ostringstream oss;
    oss << R::singleton().GetErrorString();
    error(oss.str().c_str());
  }
  return(R_NilValue);
}

SEXP
runFile(SEXP filename)
{
  const char* name;

  // check args
  if (!isString(filename) || length(filename) != 1) {
    error("RunFile: filename is not a single string\n");
  }

  name = CHAR(STRING_ELT(filename, 0));
  if (R::singleton().RunFile(name) != VR_OK) {
    std::ostringstream oss;
    oss << R::singleton().GetErrorString();
    error(oss.str().c_str());
  }

  return(R_NilValue);
}

SEXP
runString(SEXP input)
{
  const char* in;

  // check args
  if (!isString(input) || length(input) != 1) {
    error("RunString: input is not a single string\n");
  }

  in = CHAR(STRING_ELT(input, 0));
  if (R::singleton().RunString(in) != VR_OK) {
    std::ostringstream oss;
    oss << R::singleton().GetErrorString();
    error(oss.str().c_str());
  }

  return(R_NilValue);
}

SEXP
getCol(int ncol)
{
  VAR vv;
  char buffer[80];
  SEXP ans = R_NilValue;
  
  int cols = R::singleton().GetSelectedOutputColumnCount();
  int rows = R::singleton().GetSelectedOutputRowCount();
  if (cols == 0 || rows == 0) {
    return ans;
  }
  
  // count each type
  int nd, nl, ns;
  nd = nl = ns = 0;
  for (int r = 1; r < rows && ns == 0; ++r) {
    VarInit(&vv);
    // may want to implement (int) GetSelectedOutputType(r,c)
    R::singleton().GetSelectedOutputValue(r, ncol, &vv);
    switch (vv.type) {
    case TT_DOUBLE:  ++nd; break;
    case TT_LONG:    ++nl; break;
    case TT_STRING:  ++ns; break;
    }
    VarClear(&vv);
  }
  
  
  if (ns) {
    // all strings
    PROTECT(ans = allocVector(STRSXP, rows-1));
    for (int r = 1; r < rows; ++r) {
      VarInit(&vv);
      R::singleton().GetSelectedOutputValue(r, ncol, &vv);
      switch (vv.type) {
      case TT_EMPTY:
        SET_STRING_ELT(ans, r-1, mkChar(""));
        break;
      case TT_ERROR:
        switch (vv.vresult) {
        case VR_OK:          SET_STRING_ELT(ans, r-1, mkChar("VR_OK"));          break;
        case VR_OUTOFMEMORY: SET_STRING_ELT(ans, r-1, mkChar("VR_OUTOFMEMORY")); break;
        case VR_BADVARTYPE:  SET_STRING_ELT(ans, r-1, mkChar("VR_BADVARTYPE"));  break;
        case VR_INVALIDARG:  SET_STRING_ELT(ans, r-1, mkChar("VR_INVALIDARG"));  break;
        case VR_INVALIDROW:  SET_STRING_ELT(ans, r-1, mkChar("VR_INVALIDROW"));  break;
        case VR_INVALIDCOL:  SET_STRING_ELT(ans, r-1, mkChar("VR_INVALIDCOL"));  break;
        }
        break;
      case TT_LONG:
        if (vv.lVal == -99) {
          sprintf(buffer, "NA");
        } else {
          sprintf(buffer, "%ld", vv.lVal);
        }
        SET_STRING_ELT(ans, r-1, mkChar(buffer));
        break;
      case TT_DOUBLE:
        if (vv.dVal == -999.999 || vv.dVal == -99.) {
          sprintf(buffer, "NA");
        } else {
          sprintf(buffer, "%lg", vv.dVal);
        }
        SET_STRING_ELT(ans, r-1, mkChar(buffer));
        break;
      case TT_STRING:
        SET_STRING_ELT(ans, r-1, mkChar(vv.sVal));
        break;
      }
      VarClear(&vv);
    }
    UNPROTECT(1);
  } // if (ns)
  else if (nd) {
    // all reals
    PROTECT(ans = allocVector(REALSXP, rows-1));
    for (int r = 1; r < rows; ++r) {
      VarInit(&vv);
      R::singleton().GetSelectedOutputValue(r, ncol, &vv);
      switch (vv.type) {
      case TT_EMPTY:
        REAL(ans)[r-1] = NA_REAL;
        break;
      case TT_ERROR:
        REAL(ans)[r-1] = NA_REAL;
        break;
      case TT_LONG:
        if (vv.lVal == -99) {
          REAL(ans)[r-1] = NA_REAL;
        } else {
          REAL(ans)[r-1] = (double)vv.lVal;
        }
        break;
      case TT_DOUBLE:
        if (vv.dVal == -999.999 || vv.dVal == -99.) {
          REAL(ans)[r-1] = NA_REAL;
        } else {
          REAL(ans)[r-1] = (double)vv.dVal;
        }
        break;
      }
      VarClear(&vv);
    }
    UNPROTECT(1);
  } // if (nd)
  else if (nl) {
    // all ints
    PROTECT(ans = allocVector(INTSXP, rows-1));
    for (int r = 1; r < rows; ++r) {
      VarInit(&vv);
      R::singleton().GetSelectedOutputValue(r, ncol, &vv);
      switch (vv.type) {
      case TT_EMPTY:
        INTEGER(ans)[r-1] = NA_INTEGER;
        break;
      case TT_ERROR:
        INTEGER(ans)[r-1] = NA_INTEGER;
        break;
      case TT_LONG:
        if (vv.lVal == -99) {
          INTEGER(ans)[r-1] = NA_INTEGER;
        } else {
          INTEGER(ans)[r-1] = vv.lVal;
        }
        break;
      }
      VarClear(&vv);
    }
    UNPROTECT(1);
  } // if (nl)
  else {
    // all NA
    PROTECT(ans = allocVector(INTSXP, rows-1));
    for (int r = 1; r < rows; ++r) {
      INTEGER(ans)[r-1] = NA_INTEGER;
    } // for
    UNPROTECT(1);
  }
  return ans;
}


/* SEXP */
/* getColumn(SEXP column) */
/* { */
/*   int ncol; */

/*   PROTECT(column = AS_INTEGER(column)); */
/*   ncol = INTEGER_POINTER(column)[0]; */
/*   UNPROTECT(1); */

/*   return getCol(ncol); */
/* } */

SEXP
getSelOut(void)
{
  int r;
  int c;
  int cols;
  int rows;
  VAR vn;

  SEXP list;
  SEXP attr;
  SEXP col;

  SEXP klass;
  SEXP row_names;

  list = R_NilValue;

  cols = R::singleton().GetSelectedOutputColumnCount();
  rows = R::singleton().GetSelectedOutputRowCount();
  if (cols == 0 || rows == 0) {
    return list;
  }

  PROTECT(list = allocVector(VECSXP, cols));
  PROTECT(attr = allocVector(STRSXP, cols));
  for (c = 0; c < cols; ++c) {

    VarInit(&vn);
    R::singleton().GetSelectedOutputValue(0, c, &vn);

    PROTECT(col = getCol(c));

    SET_VECTOR_ELT(list, c, col);
    SET_STRING_ELT(attr, c, mkChar(vn.sVal));

    VarClear(&vn);
  }

  setAttrib(list, R_NamesSymbol, attr);

  /* Turn the data "list" into a "data.frame" */
  /* see model.c */

  PROTECT(klass = mkString("data.frame"));
  setAttrib(list, R_ClassSymbol, klass);
  UNPROTECT(1);

  PROTECT(row_names = allocVector(INTSXP, rows-1));
  for (r = 0; r < rows-1; ++r) INTEGER(row_names)[r] = r+1;
  setAttrib(list, R_RowNamesSymbol, row_names);
  UNPROTECT(1);

  UNPROTECT(2+cols);
  return list;
}

SEXP
getSelOuts(void)
{
  SEXP list;
  SEXP attr;

  list = R_NilValue;
  
  if (int n = R::singleton().GetSelectedOutputCount()) {
    SEXP so;
    char buffer[80];
    
    PROTECT(list = allocVector(VECSXP, n));
    PROTECT(attr = allocVector(STRSXP, n));

    int save = R::singleton().GetCurrentSelectedOutputUserNumber();
    for (int i = 0; i < n; ++i) {
      int d = R::singleton().GetNthSelectedOutputUserNumber(i);
      ::sprintf(buffer, "n%d", d);
      SET_STRING_ELT(attr, i, mkChar(buffer));
      R::singleton().SetCurrentSelectedOutputUserNumber(d);      
      PROTECT(so = getSelOut());
      SET_VECTOR_ELT(list, i, so);
      UNPROTECT(1);
    }
    R::singleton().SetCurrentSelectedOutputUserNumber(save);
    setAttrib(list, R_NamesSymbol, attr);

    UNPROTECT(2);
  }
  return list;
}

SEXP
getErrStr()
{
  SEXP ans = R_NilValue;
  PROTECT(ans = allocVector(STRSXP, 1));
  SET_STRING_ELT(ans, 0, mkChar(R::singleton().GetErrorString()));
  UNPROTECT(1);
  return ans;
}

} // extern "C"