#include <glib.h>

#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/fail.h>
#include <caml/callback.h>
#include <caml/signals.h>

#include "wrappers.h"
#include "ml_glib.h"

#define Val_none Val_unit

CAMLprim value
ml_g_spawn_init (value unit)
{
  ml_register_exn_map (G_SPAWN_ERROR, "g_spawn_error");
  return Val_unit;
}

#include "gspawn_tags.h"
#include "gspawn_tags.c"
static Make_Flags_val(Spawn_flags_val)

static gchar **
convert_stringv (value argv)
{
  gchar **res;
  guint i, len;
  value l;
  for (l = argv, len = 0; l != Val_emptylist; l = Field(l, 1))
    len++;
  res = g_new (gchar *, len + 1);
  for (i = 0; i < len; i++)
    {
      res[i] = g_strdup (String_val (Field (argv, 0)));
      argv = Field (argv, 1);
    }
  res[len] = NULL;
  return res;
}

static void
ml_g_spawn_child_setup (gpointer user_data)
{
  value *closure = user_data;
  callback_exn (*closure, Val_unit);
}

static value
wrap_pid (GPid pid)
{
#if defined (G_OS_UNIX)
  return Val_int (pid);
#elif defined (G_OS_WIN32)
  return Val_pointer (pid);
#else
# error "unsupported OS"
#endif
}

#define copy_caml_string(v) g_strdup (String_val (v))

#define PIPE_IN  (1 << (0 + 1))
#define PIPE_OUT (1 << (1 + 1))
#define PIPE_ERR (1 << (2 + 1))

CAMLprim value
ml_g_spawn_async_with_pipes (value o_working_directory,
			     value o_envp,
			     value o_child_setup,
			     value v_flags,
			     value v_pipes,
			     value v_argv)
{
  GError *error = NULL;
  gchar *working_directory;
  gchar **argv;
  gchar **envp;
  GSpawnFlags flags;
  value child_setup;
  GPid pid, *child_pid;
  gint s_in, *p_in, s_out, *p_out, s_err, *p_err;

  flags = Flags_Spawn_flags_val (v_flags);
  if (   (v_pipes & PIPE_IN  && flags & G_SPAWN_CHILD_INHERITS_STDIN)
      || (v_pipes & PIPE_OUT && flags & G_SPAWN_STDOUT_TO_DEV_NULL)
      || (v_pipes & PIPE_ERR && flags & G_SPAWN_STDERR_TO_DEV_NULL))
    invalid_argument ("Gspawn.async_with_pipes: incompatible flags arguments");

  working_directory = Option_val (o_working_directory, copy_caml_string, NULL);
  argv = convert_stringv (v_argv);
  envp = Option_val (o_envp, convert_stringv, NULL);
  p_in  = v_pipes & PIPE_IN  ? &s_in  : NULL;
  p_out = v_pipes & PIPE_OUT ? &s_out : NULL;
  p_err = v_pipes & PIPE_ERR ? &s_err : NULL;
  child_setup = Option_val (o_child_setup, ID, 0);
  child_pid = flags & G_SPAWN_DO_NOT_REAP_CHILD ? &pid : NULL;

  g_spawn_async_with_pipes (working_directory,
			    argv,
			    envp,
			    flags,
			    child_setup ? ml_g_spawn_child_setup : NULL,
			    &child_setup,
			    child_pid,
			    p_in,
			    p_out,
			    p_err,
			    &error);

  g_free (working_directory);
  g_strfreev (argv);
  g_strfreev (envp);

  if (error)
    ml_raise_gerror (error);

  {
    CAMLparam0();
    CAMLlocal5(res, v_pid, v_in, v_out, v_err);
    
    v_pid = child_pid ? ml_some (wrap_pid (pid))  : Val_none;
    v_in  = p_in      ? ml_some (Val_int (s_in))  : Val_none;
    v_out = p_out     ? ml_some (Val_int (s_out)) : Val_none;
    v_err = p_err     ? ml_some (Val_int (s_err)) : Val_none;
    res = alloc_small (4, 0);
    Field (res, 0) = v_pid;
    Field (res, 1) = v_in;
    Field (res, 2) = v_out;
    Field (res, 3) = v_err;

    CAMLreturn (res);
  }  
}

ML_bc6 (ml_g_spawn_async_with_pipes)

#include <sys/wait.h>
static value
convert_exit_status (int status)
{
  value r;
  if (WIFEXITED(status))
    {
      r = alloc_small (1, 0);
      Field (r, 0) = Val_long (WEXITSTATUS(status));
    }
  else if (WIFSIGNALED(status))
    {
      r = alloc_small (1, 1);
      Field (r, 0) = Val_long (WTERMSIG(status));
    }
  else if (WIFSTOPPED(status))
    {
      r = alloc_small (1, 2);
      Field (r, 0) = Val_long (WSTOPSIG(status));
    }
  else
    invalid_argument ("Gspawn.sync: don't know how to convert the exit status");
  return r;
}

static value 
convert_sync_status (int exit_status, gchar *standard_output, gchar *standard_error)
{
  CAMLparam0();
  CAMLlocal4(res, status, out, err);
    
  status = convert_exit_status (exit_status);
  out = copy_string (standard_output ? standard_output : "");
  g_free (standard_output);
  err = copy_string (standard_error ? standard_error : "");
  g_free (standard_error);

  res = alloc_small (3, 0);
  Field (res, 0) = status;
  Field (res, 1) = out;
  Field (res, 2) = err;

  CAMLreturn (res);
}

CAMLprim value
ml_g_spawn_sync (value o_working_directory,
		 value o_envp,
		 value o_child_setup,
		 value v_flags,
		 value v_argv)
{
  GError *error = NULL;
  gchar *working_directory;
  gchar **argv;
  gchar **envp;
  GSpawnFlags flags;
  value child_setup;
  gchar *standard_output;
  gchar *standard_error;
  gint exit_status;

  flags = Flags_Spawn_flags_val (v_flags);
  working_directory = Option_val (o_working_directory, copy_caml_string, NULL);
  argv = convert_stringv (v_argv);
  envp = Option_val (o_envp, convert_stringv, NULL);
  child_setup = Option_val (o_child_setup, ID, 0);
  standard_output = NULL;
  standard_error  = NULL;

  caml_enter_blocking_section ();
  g_spawn_sync (working_directory,
		argv,
		envp,
		flags,
		child_setup ? ml_g_spawn_child_setup : NULL,
		&child_setup,
		&standard_output,
		&standard_error,
		&exit_status,
		&error);
  caml_leave_blocking_section ();

  g_free (working_directory);
  g_strfreev (argv);
  g_strfreev (envp);

  if (error)
    ml_raise_gerror (error);

  return convert_sync_status (exit_status, standard_output, standard_error);  
}

CAMLprim value
ml_g_spawn_command_line_sync (value cmd)
{
  GError *error = NULL;
  gchar *command;
  gchar *standard_output;
  gchar *standard_error;
  gint exit_status;

  standard_output = NULL;
  standard_error  = NULL;

  command = copy_caml_string (cmd);
  caml_enter_blocking_section ();
  g_spawn_command_line_sync (command,
			     &standard_output,
			     &standard_error,
			     &exit_status,
			     &error);
  caml_leave_blocking_section ();
  g_free (command);

  if (error)
    ml_raise_gerror (error);

  return convert_sync_status (exit_status, standard_output, standard_error);
}

CAMLprim value
ml_g_spawn_command_line_async (value cmd)
{
  GError *error = NULL;
  gchar *command;

  command = copy_caml_string (cmd);
  caml_enter_blocking_section ();
  g_spawn_command_line_async (command, &error);
  caml_leave_blocking_section ();
  g_free (command);

  if (error)
    ml_raise_gerror (error);

  return Val_unit;
}

#if defined (G_OS_UNIX)
# define GPid_val(v) (GPid)Int_val(v)
#elif defined (G_OS_WIN32)
# define GPid_val(v) (GPid)Pointer_val(v)
#else
# error "unsupported OS"
#endif

CAMLprim value
ml_int_of_pid (value pid)
{
#ifndef G_OS_UNIX
  return Val_int (0);
#else
  return pid;
#endif
}

ML_1(g_spawn_close_pid, GPid_val, Unit)

static void
ml_g_child_watch_func (GPid pid, gint status, gpointer data)
{
  value *closure = data;
  callback_exn (*closure, Val_int (status));
}

CAMLprim value
ml_g_add_child_watch_full (value o_prio, value pid, value callback)
{
  guint id;
  id = g_child_watch_add_full (Option_val (o_prio, Int_val, G_PRIORITY_DEFAULT),
			       GPid_val (pid),
			       ml_g_child_watch_func,
			       ml_global_root_new (callback),
			       ml_global_root_destroy);
  return Val_long (id);
}