#!/usr/bin/perl

use strict;
use warnings;
use utf8;

use Devel::MAT;
use Getopt::Long;
use List::Util qw( pairs );
use List::UtilsBy qw( nsort_by );

STDOUT->binmode( ":encoding(UTF-8)" );

my $YELLOW = "\e[33m";
my $CYAN   = "\e[36m";

my $NORMAL = "\e[m";

# Default to strong direct only
my $STRONG = 1;
my $DIRECT = 1;

GetOptions(
   'depth|d=i' => \my $DEPTH,
   'weak'      => sub { $STRONG = 0 },
   'all'       => sub { $STRONG = 0; $DIRECT = 0 },
) or exit 1;

my $pmat = Devel::MAT->load( $ARGV[0] // die "Need dumpfile\n" );
my $addr = $ARGV[1] // die "Need an SV addr\n";
$addr = hex $addr if $addr =~ m/^0x/;

my $df = $pmat->dumpfile;

my $next_id = "A";
my %id_for;
my %seen;

my %STRENGTH_ORDER = (
   strong   => 1,
   weak     => 2,
   indirect => 3,
   inferred => 4,
);

sub walk_graph
{
   my ( $node ) = @_;

   my @roots = $node->roots;
   my @edges = $node->edges_in;

   if( !@roots and !@edges ) {
      return "└─not found";
   }

   if( @roots == 1 and $roots[0] eq "EDEPTH" ) {
      return "└─not found at this depth";
   }

   if( @edges > 0 and $seen{$node->addr}++ ) {
      my $id = $id_for{$node->addr};
      return "└─already found as $YELLOW*$id$NORMAL";
   }

   my @blocks = map { [ $_ ] } @roots;

   foreach ( nsort_by { $STRENGTH_ORDER{$_->[0]->strength} } pairs @edges ) {
      my ( $ref, $refnode ) = @$_;

      my $str = "";
      $str = "$CYAN\[${\$ref->strength}]$NORMAL" if $ref->strength ne "strong";

      my $ref_id;
      if( $refnode->edges_out > 1 and not $refnode->roots and not $id_for{$refnode->addr} ) {
         $ref_id = $id_for{$refnode->addr} = $next_id++;
      }

      my $header = sprintf "%s%s of %s, which is%s:",
         $str, $ref->name, $refnode->sv->desc_addr, $ref_id ? " $YELLOW(*$ref_id)$NORMAL" : "";

      if( $refnode->addr == $node->addr ) {
         push @blocks, [ $header, "itself" ];
      }
      else {
         push @blocks, [ $header, walk_graph( $refnode ) ];
      }
   }

   my @ret;
   foreach my $i ( 0 .. $#blocks ) {
      my $block = $blocks[$i];
      my $firstline = shift @$block;

      if( $i < $#blocks ) {
         push @ret, "├─$firstline",
              map { "│ $_" } @$block;
      }
      else {
         push @ret, "└─$firstline",
              map { "  $_" } @$block;
      }
   }

   return @ret;
}

my $sv = $df->sv_at( $addr );

printf "%s is:\n", $sv->desc_addr;

print "$_\n" for walk_graph( $pmat->inref_graph( $sv,
   depth => $DEPTH,
   strong => $STRONG,
   direct => $DIRECT,
) );
