#!/usr/bibn/env perl
use strict;
use warnings;

use Carp qw/croak/;

my $header_file = shift // croak 'require header file!';
my ($header_con,$interface_name) = search_slurp_header_file($header_file);

my %cbc_code_names = ( order => 0, codes => {});

while (@ARGV) {
  find_codes_from_cbc(shift @ARGV, $interface_name, \%cbc_code_names);
}

map  { push(@{$cbc_code_names{order_list}}, $_)}
        sort { $cbc_code_names{codes}->{$a}->{order} <=> $cbc_code_names{codes}->{$b}->{order} } keys %{$cbc_code_names{codes}};

my $write_codes = create_new_header_codes($header_con,\%cbc_code_names);
exit unless $write_codes;
update_header($header_file,$write_codes);

sub search_slurp_header_file {
  my $header_file = shift;

  my %contents;
  my %order;
  my $i = 0;
  my $interface_name;

  open my $fh, '<', $header_file;

  if (<$fh> =~ /struct (\w+)\s*</) {
    $interface_name = $1;
  }
  while (my $line = <$fh>) {
    chomp $line;
    if ($line =~ /\A\s*__code (\w+)\(/) {
      $contents{$1} = $line;
      $order{$1} = $i;
      $i++;
    }
  }
  close $fh;
  my @order_code_names;
  map  { push(@order_code_names, $_)}  sort { $order{$a} <=> $order{$b} } keys %order;
  return { codes => \%contents, order => \@order_code_names }, $interface_name;
}

sub find_codes_from_cbc {
  my ($cbc_file, $inter_name, $ccn) = @_;

  open my $fh, '<', $cbc_file;
  while (my $line = <$fh>) {
    chomp $line;
    if ($line =~ /\A\s*__code (\w+)\(/) {
      my $cg_name = $1;
      $line =~ s/\s*{\s*[\w\/\:]*/;/;
      $line =~ s/struct $inter_name/Type/g;
      $ccn->{codes}->{$cg_name} = { line =>$line, file => $cbc_file, order => $ccn->{order} };
      $ccn->{order}++;
    }
  }
  close $fh;
}

sub create_new_header_codes {
  my ($header_con, $cbc_con) = @_;
  return 0 if (@{$header_con->{order}} == $cbc_con->{order});

  my @res;
  my @hcodes = @{$header_con->{order}};
  my %cbc_codes = %{$cbc_con->{codes}};
  for my $hc (@hcodes) {
    if (exists $cbc_codes{$hc}) {
      push(@res, $cbc_codes{$hc}->{line});
      delete $cbc_codes{$hc};
    }
  }

  push(@res, "");
  if (%cbc_codes) {
    map { push(@res, $cbc_codes{$_}->{line})} sort { $cbc_codes{$a}->{order} <=> $cbc_codes{$b}->{order}} keys %cbc_codes;
  }
  return \@res;
}

sub update_header {
  my ($header_file,$write_codes) = @_;
  open my $fh, '<', $header_file;
  my $def_impl = <$fh>;
  my ($impl, $interface);
  if ($def_impl =~ /typedef\s*struct\s*(\w+)\s*<[\w\s,]+>\s*impl\s*(\w+)\s*{/) {
    $impl = $1;
    $interface = $2;
  }
  close $fh;
  open $fh, '>', $header_file;
  print $fh "typedef struct $impl <Type, Isa> impl $interface {\n";
  map { print $fh "    $_\n"}  @$write_codes;
  print $fh "    __code next(...);\n";
  print $fh "} $impl;\n";
  close $fh;
}