package PIL2JS;

use warnings;
use strict;

use FindBin;
use IPC::Open2;
use Config;
use File::Spec;
use File::Temp;
use Encode;

our $VERSION = 0.0.1;

use base "Exporter";
our @EXPORT    = qw<
  compile_perl6_to_standalone_js
  compile_perl6_to_mini_js
  compile_perl6_to_htmljs_with_links
  compile_perl6_to_pil
  precomp_module_to_mini_js
  jsbin_hack
  run_pugs run_pil2js run_js run_js_on_jssm run_js_on_jspm
>;
our @EXPORT_OK = qw< pwd >;

sub pwd { File::Spec->catfile($FindBin::Bin, @_) }
sub try_files {
  my @cands = @_;
  -e $_ and return $_ for @cands;
  return $cands[0];
}

sub jsprelude_path { try_files pwd(qw< libjs PIL2JS.js >), pwd(qw< .. .. js lib PIL2JS.js >) }

our %cfg = (
  js        => "js",
  pugs      => pwd(qw< .. .. >, "pugs$Config{_exe}"),
  pil2js    => pwd('pil2js.pl'),
  preludepc => pwd('Prelude.js'),
  testpc    => pwd('Test.js'),
  prelude   => try_files(pwd(qw< lib6 Prelude JS.pm >), pwd(qw< .. .. perl6 lib Prelude JS.pm>)),
  metamodel_base => try_files(pwd(qw< libjs >), pwd(qw< .. .. js lib >)) . "/", # hack?
);

sub diag($) { warn "# $_[0]\n" if $cfg{verbose} }

# bin/js's only output function is print, which is like Perl 6's &say, i.e.
# there's always a newline at the end. So our fake document.write outputs
# "string_to_output#IGNORE NEXT LINEFEED#\n", and we can s/#IGNORE NEXT
# LINEFEED#\n// later.
our $MAGIC_NOLF = "#PIL2JS // IGNORE NEXT LINEFEED#";

sub preludepc_check {
  unless(-e $cfg{preludepc} and -s $cfg{preludepc}) {
    die "* Error: Precompiled Prelude (\"$cfg{preludepc}\") does not exist.\n";
  #} elsif(-e $cfg{prelude} and -M $cfg{prelude} <= -M $cfg{preludepc}) {
  #  die "* Error: Your precompiled Prelude is outdated.\n";
  #} elsif(not -e $cfg{prelude}) {
  #  warn "* Warning: Couldn't check whether your compiled Prelude is outdated.\n";
  #  warn "           Please run runjs.pl with an approproate --p6prelude option.\n";
  }
}

sub compile_perl6_to_standalone_js {
  preludepc_check();

  my $pil  = run_pugs("-CPIL1-Perl5", @_);
  die "Error: Couldn't compile to PIL!\n" if not defined $pil;
  my $mini = run_pil2js(\$pil);
  my $js   = run_pil2js("--link=js", "METAMODEL", jsprelude_path(), $cfg{preludepc}, $cfg{testpc}, \$mini);

  return $js;
}

sub compile_perl6_to_mini_js {
  my $pil = run_pugs("-CPIL1-Perl5", @_);
  die "Error: Couldn't compile to PIL!\n" if not defined $pil;

  local $ENV{PIL2JS_INDENT} = "true";
  my $js  = run_pil2js(\$pil);

  return $js;
}

sub compile_perl6_to_htmljs_with_links {
  preludepc_check();

  my $mini = compile_perl6_to_mini_js(@_);
  die "Error: Couldn't compile to PIL!\n" if not defined $mini;
  my $js   = run_pil2js("--link=html", "~METAMODEL", "~".jsprelude_path(), "~$cfg{preludepc}", "~$cfg{testpc}", \$mini);

  return $js;
}

sub precomp_module_to_mini_js {
  my $pil = eval { run_pugs("-CPIL1-Perl5", @_, "-e", "''") };
  die $@ if $@;
  my $js  = eval { run_pil2js("-v", \$pil) };
  die $@ if $@;
  return $js;
}

sub compile_perl6_to_pil {
  my $pil = run_pugs("-CPIL1-Perl5", @_);
  die "Error: Couldn't compile to PIL!\n" if not defined $pil;
  return $pil;
}

sub run_pugs {
  my @args = @_;
  local $_;

  # -CPIL1 doesn't load the Prelude, though, so we have to kludge around this.
  @args = map { /^-M(.+)$/ ? ('-e', "use $1;") : ($_) } @args;

  diag "$cfg{pugs} @args";

  $ENV{PERL5LIB} = join $Config{path_sep}, pwd('lib'), ($ENV{PERL5LIB} || "");
  unshift @args, "-Ilib6", "-Iblib6/lib", "-I../../blib6/lib";

  my $pid = open2 my($read_fh), my($write_fh), "$cfg{pugs}", @args
    or die "Couldn't open pipe to \"$cfg{pugs} @args\": $!\n";
  close $write_fh;

  local $/;
  my $res = <$read_fh>;
  return undef if not defined $res or length($res) == 0;
  close $read_fh or
    warn "Couldn't close pipe to \"$cfg{pugs} @args\": $!\n" and return;

  return $res;
}

# Runs pil2js.pl. If there's a reference in @args, it will be substituted by
# "-" and the contents of the reference will be written to pil2js.pl's STDIN.
sub run_pil2js {
  my @args = @_;
  unshift @args, "--pugs=" . $cfg{pugs}, "--metamodel-base=" . $cfg{metamodel_base};

  my $tmp;
  for(@args) {
    if(ref $_ and defined $tmp) {
      die "Only one reference argument may be given to &PIL2JS::run_pil2js!";
    } elsif(ref $_) {
      my ($fh, $fn) = File::Temp::tempfile(UNLINK => 1);
      print $fh $$_;
      $_ = $fn;
    }
  }
  my @cmd = ($^X, $cfg{pil2js}, @args);
  diag "@cmd";

  my $pid = open2 my($read_fh), my($write_fh), @cmd
    or die "Couldn't open pipe to \"@cmd\": $!\n";

  close $write_fh       or die "Couldn't close pipe to \"@cmd\": $!\n";

  local $/;
  my $ret = <$read_fh>;
}

sub run_js {
  my $js = shift;
  diag $cfg{js};

  my $pid = open2 my($read_fh), my($write_fh), $cfg{js}
    or die "Couldn't open pipe to \"$cfg{js}\": $!\n";

  print $write_fh $js or die "Couldn't write into pipe to \"$cfg{js}\": $!\n";
  close $write_fh     or die "Couldn't close pipe to \"$cfg{js}\": $!\n";

  $|++;
  while(defined(my $line = <$read_fh>)) {
    $line =~ s/\Q$MAGIC_NOLF\E\n//g;
    print Encode::encode("utf-8", $line);
  }
}

sub run_js_on_jssm {
  my $js = shift;
  diag $cfg{js};

  # "require" instead of "use" here so users which don't want to use JSSM
  # aren't forced to install it.
  require JavaScript::SpiderMonkey;
  my $jssm = JavaScript::SpiderMonkey->new();
  $jssm->init();
  $jssm->function_set("print",               sub { print encode "utf-8", "@_\n"; });
  $jssm->function_set("printWithoutNewline", sub { print encode "utf-8", "@_"; });
  # open F,">deleteme_eval.js"; print F $js; close F; # XXX - debugging output
  my $rc = $jssm->eval($js);
  warn "JavaScript::SpiderMonkey: $@" if $@;
  $jssm->destroy();
}

sub run_js_on_jspm {
  my $js = shift;
  diag $cfg{js};

  require JavaScript;
  require PIL2JS::JSPM;
  my $rt = JavaScript::Runtime->new;
  my $ct = $rt->create_context;

  PIL2JS::JSPM::init_js_for_perl5($ct)
    if $cfg{perl5};
  $ct->bind_function( name => 'print',
		      func => sub { print encode "utf-8", "@_\n" });
  $ct->bind_function( name => 'printWithoutNewline',
		      func => sub { print encode "utf-8", "@_" });

  my $rc = $ct->eval($js);
  warn "JavaScript: $@" if $@;
  $ct->destroy;
}

sub jsbin_hack {
  my $js = <<EOF . "\n" . $_[0];
// Stubs inserted by lib/PIL2JS.pm.
var PIL2JS_printWithoutNewline;
try { printWithoutNewline } catch(err) {
  PIL2JS_printWithoutNewline = function (str) {
    print(str + "$MAGIC_NOLF");
  };
}
if(!PIL2JS_printWithoutNewline) PIL2JS_printWithoutNewline = printWithoutNewline;
var document = {
  write: PIL2JS_printWithoutNewline,
  body:  {},
  getElementById: function (id) {}
};

var window    = {
  scrollTo:   function (x, y) {},

  // Hack -- this is a CPU-burning implementation of setTimeout
  // (needed for &sleep). Is there a better way?
  setTimeout: function (f, millis) {
    var loop_till = (new Date).getTime() + millis;
    while((new Date).getTime() < loop_till)
      1;
    f();
  }
};
var navigator = { userAgent: undefined };
var alert     = function (msg) { document.write("Alert: " + msg) };
EOF
}

1;