From 4eb28b00be3f9cde36d7046a382f2034bd38e03a Mon Sep 17 00:00:00 2001
From: Jonas Smedegaard <dr@jones.dk>
Date: Tue, 30 Nov 2021 21:53:46 +0100
Subject: draw as directed graph

---
 bin/feature-check.pl | 32 +++++++++++++++++++++++++++++++-
 1 file changed, 31 insertions(+), 1 deletion(-)

(limited to 'bin/feature-check.pl')

diff --git a/bin/feature-check.pl b/bin/feature-check.pl
index bc3d8c4..154bb2a 100755
--- a/bin/feature-check.pl
+++ b/bin/feature-check.pl
@@ -3,6 +3,7 @@
 use v5.14;
 use utf8;
 use warnings;
+use open qw( :std :encoding(UTF-8) );
 
 use Getopt::Long 2.24 qw(:config gnu_getopt);
 use IO::Interactive qw(is_interactive);
@@ -30,6 +31,8 @@ use Path::Tiny;
 use Log::Any qw($log);
 use Log::Any::Adapter;
 use Term::Table;
+use Graph::Easy;
+use Graph::Easy::Parser;
 
 # TODO: handle options --quiet/--verbose/--debug
 # TODO: handle output scope, with options --threshold/--all
@@ -135,16 +138,41 @@ readonly \%DOCFILE;
 my $threshold = USABLE;
 $log->info("acceptance threshold: $MATURITY[$threshold]");
 
+my $graph = Graph::Easy::Parser->from_text('graph { flow: east; }');
+my $root = 'redpill';
+
 my $featureref = path("$BASEDIR")->visit( \&feature );
 
 #use DDP; p $featureref if $log->is_debug;
 
-my @row;
+my ( @row, %node );
+
+$node{$root} = $graph->add_node($root);
+
 for my $feature ( sort keys %$featureref ) {
 	my @target = @{ $featureref->{$feature}{target} };
 
+	next unless $featureref->{$feature}{maturity} >= $threshold;
+
 	push @row, [ $feature, map { join ', ', sort keys %{ $target[$_]{docs} } if $target[$_]{maturity} >= $threshold } EXECUTIVE..EXPERT ]
 		if $featureref->{$feature}{maturity} >= $threshold;
+
+	next if defined $node{$feature};
+
+	$node{$feature} = undef;
+}
+
+for my $feature ( sort keys %node ) {
+
+	next if defined $node{$feature};
+
+	if ( $feature =~ /^([^-]+).*\K-(?=[^-]+$)/ and defined $node{$`} and !defined $node{$feature} ) {
+		( undef, $node{$feature} ) = $graph->add_edge( $node{$`}, $feature );
+		$node{$feature}->set_attribute( 'label',  $' );
+	}
+	else {
+		( undef, $node{$feature} ) = $graph->add_edge( $node{$root}, $feature );
+	}
 }
 
 my $table = Term::Table->new(
@@ -154,6 +182,8 @@ my $table = Term::Table->new(
 
 say $_ for $table->render;
 
+print $graph->as_boxart();
+
 sub feature {
 	my ($path, $state) = @_;
 	my ( $feature, $docs, $maturity );
-- 
cgit v1.2.3