#! /usr/bin/perl -w
#
# 1. Updates d/control.
# 2. Updates substvars to define `${rust-update-control:Depends}`
#
# TODO rust-update-control/dh-rust: document or steal/adapt this thing!

use strict;
use Data::Dumper;
use Dpkg::Substvars;
use Getopt::Long;
use TOML;

our $mode;
our @tomls;
our @updateish_outputs;

our $marker_re = qr{^\# \@\@ rust-update-control };

sub add_toml_1 ($) {
  my ($file) = @_;
  
  open C, $file or die "$file $!";
  my $toml = do { local $/ = undef; <C> // die "$file $!"; };
  C->error and die "$file $!";
  $toml = from_toml($toml) || die "$file ?";

  push @tomls, $toml;
  return $toml;
}

our (%depends, %test_depends);
our (@provides);

sub convert_version ($) {
  local ($_) = @_;
  # Ignore upper version bounds.  We'll detect any failures
  # due to newer versions in usual Debian QA (ci.debian.net etc.)
  s{^\>= ?([^,]+)\, \<[^,]+$}{$1};
  if (m{^=? ?\d+(?:\.\d+){0,2}$}) {
    return "(>= $_~)";
  } else {
    warn "don't know how to convert Cargo version spec \`$_`";
  }
}

sub process_deps_table ($$$) {
  my ($toml, $key, $ofield) = @_;

  my $table = $toml->{$key};
  return unless $table;

  my $our_crate = $toml->{package}{name};

  foreach my $crate (sort keys %$table) {
    # Ignore dependencies pointing  into the workspace
    next if grep { $_->{package}{name} eq $crate } @tomls;

    my $info = $table->{$crate};
    if (!ref $info) {
      $info = { 'version' => $info };
    }

    my $version = $info->{version} //
      die "$our_crate -$key-> $crate no version\n";

    $version = convert_version($version);
    $version = " $version" if length $version;

    my @feats = @{ $info->{features} // [] };
    unshift @feats, 'default' if $info->{'default-features'} // 1;

    my $pbase = $crate;
    $pbase =~ y/_/-/;

    my $add_dep = sub {
      my ($suffix) = @_;
      $ofield->{"librust-$pbase$suffix-dev$version"} = 1;
    };

    $add_dep->("+$_") foreach @feats;
    $add_dep->('') if !@feats;
  }
}  

sub add_deps ($) {
  my ($toml) = @_;
  my $crate = $toml->{package}{name};

  print "processing $crate\n";

  process_deps_table($toml, 'dependencies', \%depends);
  process_deps_table($toml, 'build-dependencies', \%depends);
  process_deps_table($toml, 'dev-dependencies', \%test_depends);
}

sub add_provides ($) {
  # TODO dh-rust: We don't really want to Provide -macros; upstream expects
  # dependers to use only the `derive-deftly` facade crate.
  # But this is needed to cause dh-rust to include the -macros package.

  my ($toml) = @_;
  return if ($toml->{package}{publish} // 'true') eq 'false';
  my $p = $toml->{package}{name};
  $p =~ s/_/-/g;
  my $v = $toml->{package}{version};

  # Upstream package has some cargo features for reducing deps.   We don't
  # support those here yet.  We could do if another pakcage wanted them.
  #
  # TODO dh-rust: We don't really want to Provide -macros; upstream expects
  # dependers to use only the `derive-deftly` facade crate.
  # But this is needed to cause dh-rust to include the -macros package.
  # dh-rust (or we) really ought to be generating this as a substvar, not
  # *reading* it out of d/control's Provides field.
  push @provides, "librust-$p-$v-dev (= \${binary:Version})"
}

sub add_tomls () {
  my $toml = add_toml_1('Cargo.toml');
  foreach my $subdir ($toml->{workspace}{members}->@*) {
    add_toml_1("$subdir/Cargo.toml");
  }
}

sub read_calculate () {
  add_tomls();
  add_deps($_) foreach @tomls;
  add_provides($_) foreach @tomls;
}

sub no_args () {
  die "$0: no further arguments/options allowed after mode $mode\n"
    if @ARGV;
}

sub mode_dumper () {
  no_args();
  read_calculate();

  print Dumper(\%depends, \%test_depends);
}

sub write_1_new_control ($$) {
  my ($file, $field_data) = @_;

  push @updateish_outputs, $file;

  my $any = 0;
  my $field;

  open I, "$file" or die $!;
  open O, ">$file.new" or die $!;
  while (<I>) {
    if (m/$marker_re/...!m/^[ \t]/) {
      if (m/$marker_re/) {
	$any++;
      } elsif (m/^[ \t]/) {
	next;
      } else {
	foreach (@{ $field_data->{$field} // die "$field ?" }) {
	  print O " $_,\n" or die $!;
	  # TODO <!nocheck>
	}
      }
    }
    $field = lc $1 if m{^([-0-9a-z]+):}i;
    print O or die $!;
  }
  I->error and die $!;
  O->error and die $!;
  close O or die $!;

  die "$0: missing marker in $file\n" unless $any;
}

sub write_new_controls () {
  write_1_new_control('debian/control', {
    'build-depends' => [ sort keys %depends ],
    'provides' => \@provides,
  });
}

sub update_substvars ($) {
  my ($file) = @_;
  my $sv = Dpkg::Substvars->new($file);
  $sv->set(
    'rust-update-control:Depends',
    join ' ', map { "$_," } sort keys %depends
  );
  $sv->save("$file.new");
  rename "$file.new", $file or die $!;
}  

sub check_diffs () {
  my @diffs;

  foreach my $file (@updateish_outputs) {
    $!=0; $?=0;
    my $r = system (qw(diff -u), "$file", "$file.new");

    if (!$r) {
      unlink "$file.new" or die "$file $!";
    } elsif ($r == 256) {
      push @diffs, $file;
    } else {
      die "diffing $file failed $? $!\n";
    }
  }
  foreach my $file (@diffs) {
    print STDERR "$0: $file changed, needs refresh!\n";
  }
  return @diffs;
}

sub mode_dh_gencontrol () {
  GetOptions() && @ARGV==1
    or die "$0: mode dh-gencontrol wants no options, jsut pkg";
  my ($pkg) = @ARGV;
  my $sv_file = "debian/$pkg.substvars";
  read_calculate();
  write_new_controls();
  update_substvars($sv_file);
  my @diffs = check_diffs();
  if (@diffs) {
    print STDERR "$0: warning: file(s) changed, refresh needed!\n";
  }
}

sub mode_refresh () {
  no_args();
  read_calculate();
  write_new_controls();
  foreach my $file (@updateish_outputs) {
    rename "$file.new", "$file" or die "$file: $!";
    print "$file refreshed\n";
  }
}

GetOptions()
  or die "$0: bad arguments/options\n";

$mode = shift @ARGV // die "$0: need mode argument\n";
my $mode_fn = $mode;
$mode_fn =~ y/-/_/;

$mode_fn = ${*::}{"mode_$mode_fn"};
$mode_fn or die "$0: unknown mode $mode\n";
$mode_fn->();