Commit eb545119 authored by Johan Ouwerkerk's avatar Johan Ouwerkerk

Reimplement dependency tree output formatting in the TTY client UI.

parent a245faba
......@@ -673,76 +673,6 @@ sub resolveToModuleGraph
}
}
sub _descendModuleGraph
{
my ($moduleGraph, $callback, $nodeInfo, $context) = @_;
my $depth = $nodeInfo->{depth};
my $index = $nodeInfo->{idx};
my $count = $nodeInfo->{count};
my $currentItem = $nodeInfo->{currentItem};
my $currentBranch = $nodeInfo->{currentBranch};
my $parentItem = $nodeInfo->{parentItem};
my $parentBranch = $nodeInfo->{parentBranch};
my $subGraph = $moduleGraph->{$currentItem};
&$callback($nodeInfo, $subGraph->{module}, $context);
++$depth;
my @items = keys(%{$subGraph->{deps}});
my $itemCount = scalar(@items);
my $itemIndex = 1;
for my $item (@items)
{
$subGraph = $moduleGraph->{$item};
my $branch = $subGraph->{branch} // '';
my $itemInfo = {
build => $subGraph->{build},
depth => $depth,
idx => $itemIndex,
count => $itemCount,
currentItem => $item,
currentBranch => $branch,
parentItem => $currentItem,
parentBranch => $currentBranch
};
_descendModuleGraph($moduleGraph, $callback, $itemInfo, $context);
++$itemIndex;
}
}
sub walkModuleDependencyTrees
{
my $moduleGraph = shift;
my $callback = shift;
my $context = shift;
my @modules = @_;
my $itemCount = scalar(@modules);
my $itemIndex = 1;
for my $module (@modules) {
assert_isa($module, 'ksb::Module');
my $item = $module->name();
my $subGraph = $moduleGraph->{$item};
my $branch = $subGraph->{branch} // '';
my $info = {
build => $subGraph->{build},
depth => 0,
idx => $itemIndex,
count => $itemCount,
currentItem => $item,
currentBranch => $branch,
parentItem => '',
parentBranch => ''
};
_descendModuleGraph($moduleGraph, $callback, $info, $context);
++$itemIndex;
}
}
sub hasErrors
{
my $info = shift;
......
package ksb::UserInterface::DependencyGraph;
use strict;
use warnings;
use 5.014;
sub _descendModuleGraph
{
my ($moduleGraph, $callback, $nodeInfo, $context) = @_;
my $depth = $nodeInfo->{depth};
my $index = $nodeInfo->{idx};
my $count = $nodeInfo->{count};
my $currentItem = $nodeInfo->{currentItem};
my $currentBranch = $nodeInfo->{currentBranch};
my $parentItem = $nodeInfo->{parentItem};
my $parentBranch = $nodeInfo->{parentBranch};
my $subGraph = $moduleGraph->{$currentItem};
&$callback($nodeInfo, $subGraph->{module}, $context);
++$depth;
my @items = @{$subGraph->{deps}};
my $itemCount = scalar(@items);
my $itemIndex = 1;
for my $item (@items)
{
$subGraph = $moduleGraph->{$item};
my $branch = $subGraph->{branch} // '';
my $itemInfo = {
build => $subGraph->{build},
depth => $depth,
idx => $itemIndex,
count => $itemCount,
currentItem => $item,
currentBranch => $branch,
parentItem => $currentItem,
parentBranch => $currentBranch
};
_descendModuleGraph($moduleGraph, $callback, $itemInfo, $context);
++$itemIndex;
}
}
sub _walkModuleDependencyTrees
{
my $moduleGraph = shift;
my $callback = shift;
my $context = shift;
my @modules = @_;
my $itemCount = scalar(@modules);
my $itemIndex = 1;
for my $item (@modules) {
my $subGraph = $moduleGraph->{$item};
my $branch = $subGraph->{branch} // '';
my $info = {
build => $subGraph->{build},
depth => 0,
idx => $itemIndex,
count => $itemCount,
currentItem => $item,
currentBranch => $branch,
parentItem => '',
parentBranch => ''
};
_descendModuleGraph($moduleGraph, $callback, $info, $context);
++$itemIndex;
}
}
sub _treeOutputConnectors
{
my ($depth, $index, $count) = @_;
my $blankPadding = (' ' x 4);
return (' ── ', $blankPadding) if ($depth == 0);
return ('└── ', $blankPadding) if ($index == $count);
return ('├── ', '');
}
sub _yieldModuleDependencyTreeEntry
{
my ($nodeInfo, $module, $context) = @_;
my $depth = $nodeInfo->{depth};
my $index = $nodeInfo->{idx};
my $count = $nodeInfo->{count};
my $build = $nodeInfo->{build};
my $currentItem = $nodeInfo->{currentItem};
my $currentBranch = $nodeInfo->{currentBranch};
my $parentItem = $nodeInfo->{parentItem};
my $parentBranch = $nodeInfo->{parentBranch};
my $buildStatus = $build ? 'built' : 'not built';
my $statusInfo = $currentBranch ? "($buildStatus: $currentBranch)" : "($buildStatus)";
my $connectorStack = $context->{stack};
my $prefix = pop(@$connectorStack);
while($context->{depth} > $depth) {
$prefix = pop(@$connectorStack);
--($context->{depth});
}
push(@$connectorStack, $prefix);
my ($connector, $padding) = _treeOutputConnectors($depth, $index, $count);
push(@$connectorStack, $prefix . $padding);
$context->{depth} = $depth + 1;
my $line = $prefix . $connector . $currentItem . ' ' . $statusInfo;
$context->{report}($line);
}
sub printTrees
{
my $tree = shift;
my @modules = @_;
#
# Hack: reopen STDOUT to get rid of ... "does not map to ascii" noise
# Yes: the code points do not map to ASCII, that is sort of the point
#
my $ok = open my $fh, '>&', STDOUT;
return 1 unless $ok;
my $depTreeCtx = {
stack => [''],
depth => 0,
report => sub {
my $line = shift;
print $fh $line, "\n";
}
};
_walkModuleDependencyTrees(
$tree,
\&_yieldModuleDependencyTreeEntry,
$depTreeCtx,
@modules
);
close $fh;
return 0;
}
1;
......@@ -41,6 +41,8 @@ use ksb::BuildException;
use ksb::StatusView;
use ksb::Util;
use ksb::Debug;
use ksb::UserInterface::DependencyGraph;
use Mojo::Promise;
use IO::Handle; # For methods on event_stream file
use List::Util qw(max);
......@@ -76,6 +78,57 @@ sub _check_error {
die $err;
};
sub _fetchModuleList
{
my ($ua, $list) = @_;
return $ua->get_p($list)->then(sub {
my $tx = _check_error(shift);
return $tx->result->json;
});
}
sub dumpDependencyTree
{
my ($ua, $tree) = @_;
#
# TODO: this could fail, how to properly promisify?
#
my $errors = $tree->{errors} // {};
my $errorCount = $errors->{errors} // 0;
if ($errorCount != 0) {
say "Unable to resolve dependencies, number of errors encountered is: $errorCount";
my $p = Mojo::Promise->new();
return $p->resolve(1);
}
my $data = $tree->{data};
if (!defined($data)) {
say "Unable to resolve dependencies, did not obtain (valid) results";
my $p = Mojo::Promise->new();
return $p->resolve(1);
}
else {
#
# TODO: this is *not* how we should await things in general.
# Fix using Mojo::AsyncAwait?
#
return _fetchModuleList($ua, '/modulesFromCommand')->then(sub {
my $list = shift;
my @names = map { $_->{name} } (@$list);
return @names;
})->then(sub {
my @modules = @_;
my $err = ksb::UserInterface::DependencyGraph::printTrees(
$data,
@modules
);
return $err ? 1 : 0;
});
}
}
# Returns a promise chain to handle the "debug and show some output but don't
# actually build anything" use case.
sub _runModeDebug
......@@ -90,8 +143,10 @@ sub _runModeDebug
$app->log->debug("Dumping dependency tree (in a later release...)");
return $ua->get_p('/moduleGraph')->then(sub {
my $tx = _check_error(shift);
say $tx->result->text;
return 0;
return $tx->result->json;
})->then(sub {
my $tree = shift;
return dumpDependencyTree($ua, $tree);
});
}
elsif ($debugFlags{'list-build'}) {
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment