
package Parse;

use strict;
use Carp;
use Graph;

use Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(parse_input_graph o plag_prs %region %c);

our %c;
require 'misc-data.pl';

our %region;
# $region{NAME}{Colour}
# $region{NAME}{Water}
# $region{NAME}{Name}
# $region{NAME}{L} # line number
# $region{NAME}{Adj}[]{Name}
# $region{NAME}{Adj}[]{DisplayName}[]
# $region{NAME}{Adj}[]{Pattern}
# $region{NAME}{Adj}[]{Regexp}
# $region{NAME}{Adj}[]{Dikes}
# $region{NAME}{Adj}[]{L}

our %adj;
# $adj{EARLIER}{LATER}{Dikes}
# $adj{EARLIER}{LATER}{L}[]
# $adj{EARLIER}{LATER}{T}[]

sub read_in () {
  my $ccolour;
  my $cregion;

  while (<>) {
    next if m{^\s*\#};
    next unless m{\S};
    s{\s+$}{} or confess;
    if (m{^\w+}) {
      $ccolour = $&;
      next;
    }
    if (my ($name, $water) = m{^\t(\S.*\w|L\d?)(?: \[(\d+)\])?$}) {
      confess unless defined $ccolour;
      my $dname = $c{DisplayNames}{$name} // $name;
      $name =~ s{/}{}g;
      confess "$name ?" if $region{$name};
      $region{$name}{Colour} = $ccolour;
      $region{$name}{Water} = $water;
      $region{$name}{L} = $.;
      if ($dname =~ m{/}) {
	$dname =~ s{(?<!-)/(?! )}{-/}g;
	$region{$name}{DisplayName} = [ grep m/./, split m{ */ *}, $dname ];
      } else {
	$region{$name}{DisplayName} = [ split m{(?<=-)| }, $dname ];
      }
      $cregion = $name;
      next;
    }
    if (my ($aref, $adikes) = m{^\t\t(\S.*[A-Za-z.]|L\d?)(?: (\+\+?))?$}) {
      my $adj = { Dikes => (length $adikes // 0), L => $. };
      if ($aref =~ m{\.}) {
	$adj->{Pattern} = $aref;
	$aref =~ s{\-}{[^- ]*-}g;
	$aref =~ s{\.+}{
            length $& eq 1 ? qr{[^- ]* ?} :
            length $& eq 2 ? qr{.*}       : confess "$aref"
        }ge;
	$adj->{Regexp} = $aref;
      } else {
	$adj->{Name} = $aref;
      }
      push @{ $region{$cregion}{Adj} }, $adj;
      next;
    }
    confess "$_ ?";
  }
}

sub unique_aref ($$) {
  my ($ra, $adja) = @_;
  my $re = $adja->{Regexp};
  return $adja->{Name} unless defined $re;
  my @cands;
  foreach my $rb (sort keys %region) {
    #print STDERR "?? $ra -> $re $rb ?\n";
    foreach my $adjb (@{ $region{$rb}{Adj} }) {
      my $adjbn = $adjb->{Name};
      next unless defined $adjbn;
      #print STDERR "?? $ra -> $re $rb ?? $adjbn\n";
      next unless $adjbn eq $ra;
      push @cands, [ $rb, "$region{$rb}{L},$adjb->{L}" ];
    }
  }
  my @found = grep { $_->[0] =~ m{^$re$} } @cands;
  my $pr = sub {
    join ' / ', map { "$_->[0] ($_->[1])" } @_;
  };
  confess "$adja->{L} $adja->{Pattern} /$re/ | ".$pr->(@cands)
      ." | ".$pr->(@found)." | ?"
      unless @found==1;
  my $r = $found[0][0];
  #print STDERR "resolve $ra -> $adja->{Pattern} = $r\n";
  return $r;
}

sub region_cmp {
  ($a eq 'L' ) <=> ($b eq 'L' ) or
  ($a eq 'L2') <=> ($b eq 'L2') or
  ($a eq 'L3') <=> ($b eq 'L3') or
  ($a eq 'NZ') <=> ($b eq 'NZ') or
   $a          cmp  $b
}

sub resolve_arefs () {
  #print Dumper(\%region);
  foreach my $ra (sort keys %region) {
    foreach my $adj (@{ $region{$ra}{Adj} }) {
      next if defined $adj->{Name};
      $adj->{ProspectiveName} = unique_aref $ra, $adj;
    }
  }
  foreach my $ra (sort keys %region) {
    foreach my $adj (@{ $region{$ra}{Adj} }) {
      $adj->{Name} //= $adj->{ProspectiveName};
    }
  }
  foreach my $ra (sort keys %region) {
    foreach my $adj (@{ $region{$ra}{Adj} }) {
      confess unless $adj->{Name} eq unique_aref $ra, $adj;
    }
  }
}

sub adjacencies () {
  foreach my $ra (sort keys %region) {
    my $adjs = $region{$ra}{Adj};
    foreach my $adji (0..$#$adjs) {
      my $adja = $adjs->[$adji];
      my $rb = $adja->{Name};
      my ($r0,$r1) = sort region_cmp ($ra,$rb);
      push @{ $adj{$r0}{$r1}{L} }, $adja->{L};
      push @{ $adj{$r0}{$r1}{T} }, substr($ra,0,1)."#".$adji;
      my $e = $adj{$r0}{$r1};
      $e->{Dikes} //= $adja->{Dikes};
      confess "$r0 - $r1 | @{ $e->{L} } | $e->{Dikes} $adja->{Dikes} ?"
	  unless $e->{Dikes} == $adja->{Dikes};
    }
  }
  my $ndikes = 0;
  foreach my $r0 (sort keys %adj) {
    foreach my $r1 (sort keys %{ $adj{$r0} }) {
      my $e = $adj{$r0}{$r1};
      confess "$r0 / $r1 : @{ $e->{L} } ?" unless @{ $e->{L} } == 2;
      $ndikes += $e->{Dikes};
    }
  }
  #print STDERR "total $ndikes dikes\n";
}

sub names () {
  foreach my $r (sort keys %region) {
    $region{$r}{Name} = $r;
  }
}

sub edge_id_to_other_id ($$) {
  my ($ra, $adjia) = @_;
  my $adjsa = $region{$ra}{Adj};
  my $adja = $adjsa->[$adjia];
  my $rb = $adja->{Name};
  my $adjsb = $region{$rb}{Adj};
  foreach my $adjib (0..$#$adjsb) {
    my $adjb = $adjsb->[$adjib];
    next unless $adjb->{Name} eq $ra;
    # $adjb is the same edge seen from the other side
    return ($rb, $adjib);
  }
  confess "$ra $adjia ?";
}

sub o { print @_ or die $!; }

sub plag_prs ($) {
    my ($t) = @_;
    $t = $` if $t =~ m/\n/;
    $t =~ s/ //g;
    $t =~ s/-//g;
    return "$t";
}

sub parse_input_graph () {
  read_in();
  resolve_arefs();
  adjacencies();
  names();
}

1;
