Selkie.git | t/ | 35-table.rakutest
use Test;
use lib 'lib';
use Selkie::Widget::Table;
use Selkie::Sizing;
use Selkie::Style;
use Selkie::Theme;
use Selkie::Event;
use Notcurses::Native::Types;
use Selkie::Test::Keys;
plan 17;
# A theme shaped like a real app palette: the highlight slot owns a
# background of its own (the cursor-row colour), there is a raised
# "surface" background that group-header-ish row styles use, and
# `selection` is the loud accent pair.
sub palette-theme(UInt :$highlight-bg = 0x303040, UInt :$selection-bg = 0x8844CC) {
Selkie::Theme.new(
base => Selkie::Style.new(fg => 0xC0C0C0, bg => 0x101018),
border => Selkie::Style.new(fg => 0x444444),
border-focused => Selkie::Style.new(fg => 0x00FF00, bold => True),
text => Selkie::Style.new(fg => 0xC0C0C0),
text-dim => Selkie::Style.new(fg => 0x808080),
text-highlight => Selkie::Style.new(fg => 0xFFFFFF, bg => $highlight-bg,
bold => True),
input => Selkie::Style.new(fg => 0xC0C0C0, bg => 0x202028),
input-focused => Selkie::Style.new(fg => 0xFFFFFF, bg => 0x202028),
input-placeholder => Selkie::Style.new(fg => 0x666666, italic => True),
scrollbar-track => Selkie::Style.new(fg => 0x333333),
scrollbar-thumb => Selkie::Style.new(fg => 0x00FF00),
divider => Selkie::Style.new(fg => 0x555555),
tab-active => Selkie::Style.new(fg => 0xFFFFFF, bg => 0x00FF00, bold => True),
tab-inactive => Selkie::Style.new(fg => 0x888888),
selection => Selkie::Style.new(fg => 0x101018, bg => $selection-bg),
);
}
subtest "construction defaults" => {
plan 3;
my $t = Selkie::Widget::Table.new;
ok $t.focusable, "focusable by default";
is $t.columns.elems, 0, "no columns initially";
is $t.rows.elems, 0, "no rows initially";
};
subtest "add-column registers columns in order" => {
plan 3;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'a', label => 'A', sizing => Sizing.fixed(4));
$t.add-column(name => 'b', label => 'B', sizing => Sizing.flex);
is $t.columns.elems, 2, "2 columns";
is $t.columns[0].name, 'a', "first is a";
is $t.columns[1].name, 'b', "second is b";
};
subtest "set-rows populates data" => {
plan 2;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'id', label => 'ID');
$t.set-rows([{id => 1}, {id => 2}, {id => 3}]);
is $t.rows.elems, 3, "3 rows";
is $t.row-at(0)<id>, 1, "first row id=1";
};
subtest "cursor starts at 0 and can be moved" => {
plan 3;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'id', label => 'ID');
$t.set-rows([{id => 10}, {id => 20}, {id => 30}]);
is $t.cursor, 0, "starts at 0";
$t.select-index(2);
is $t.cursor, 2, "moved to 2";
is $t.selected-row<id>, 30, "selected row matches cursor";
};
subtest "select-index clamps to bounds" => {
plan 1;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'id', label => 'ID');
$t.set-rows([{id => 1}, {id => 2}]);
$t.select-index(99);
is $t.cursor, 1, "clamped to last row";
};
subtest "on-select emits on cursor move" => {
plan 1;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'id', label => 'ID');
$t.set-rows([{id => 1}, {id => 2}]);
my @emitted;
$t.on-select.tap: -> $i { @emitted.push($i) };
$t.select-index(1);
# First set-rows also emitted 0; we just check the post-move emission
ok @emitted.tail == 1, "last emission is 1";
};
subtest "on-activate emits on Enter" => {
plan 1;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'id', label => 'ID');
$t.set-rows([{id => 1}, {id => 2}]);
my $fired = -1;
$t.on-activate.tap: -> $i { $fired = $i };
$t.handle-event(key-event(id => NCKEY_ENTER));
is $fired, 0, "activated row 0";
};
subtest "arrow keys move cursor" => {
plan 3;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'id', label => 'ID');
$t.set-rows([{id => 1}, {id => 2}, {id => 3}]);
$t.handle-event(key-event(id => NCKEY_DOWN));
is $t.cursor, 1, "down → 1";
$t.handle-event(key-event(id => NCKEY_DOWN));
is $t.cursor, 2, "down → 2";
$t.handle-event(key-event(id => NCKEY_UP));
is $t.cursor, 1, "up → 1";
};
subtest "home / end jump to bounds" => {
plan 2;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'id', label => 'ID');
$t.set-rows([{id => 1}, {id => 2}, {id => 3}, {id => 4}]);
$t.handle-event(key-event(id => NCKEY_END));
is $t.cursor, 3, "end → last";
$t.handle-event(key-event(id => NCKEY_HOME));
is $t.cursor, 0, "home → first";
};
subtest "sort-by ascending then descending" => {
plan 4;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'n', label => 'N', :sortable);
$t.set-rows([{n => 3}, {n => 1}, {n => 2}]);
$t.sort-by('n');
is $t.sort-column, 'n', "column set";
is $t.sort-direction, 'asc', "asc first";
is $t.row-at(0)<n>, 1, "first row is 1 (ascending)";
$t.sort-by('n');
is $t.sort-direction, 'desc', "cycles to desc";
};
subtest "sort-by cycles to unsorted on third call" => {
plan 1;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'n', label => 'N', :sortable);
$t.set-rows([{n => 3}, {n => 1}, {n => 2}]);
$t.sort-by('n');
$t.sort-by('n');
$t.sort-by('n');
nok $t.sort-column.defined, "sort cleared on third call";
};
subtest "sort-by non-sortable column is no-op" => {
plan 1;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'n', label => 'N'); # not sortable
$t.set-rows([{n => 3}, {n => 1}]);
$t.sort-by('n');
nok $t.sort-column.defined, "sort not set for non-sortable column";
};
subtest "custom sort-key applied" => {
plan 1;
my $t = Selkie::Widget::Table.new;
# Sort by integer value even though stored as strings
$t.add-column(
name => 's',
label => 'S',
sortable => True,
sort-key => -> $v { $v.Int },
);
$t.set-rows([{s => '10'}, {s => '2'}, {s => '30'}]);
$t.sort-by('s');
is $t.row-at(0)<s>, '2', "numeric sort: 2 first";
};
subtest "clear-sort restores insertion order" => {
plan 2;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'n', label => 'N', :sortable);
$t.set-rows([{n => 3}, {n => 1}, {n => 2}]);
$t.sort-by('n');
$t.clear-sort;
nok $t.sort-column.defined, "sort cleared";
is $t.row-at(0)<n>, 3, "order is insertion order";
};
subtest "per-row style resolution" => {
plan 12;
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'state', label => 'State');
my $theme = $t.theme;
# No callback: theme defaults, flag-free body rows.
my $plain = $t.effective-row-style({state => 'x'});
is $plain.fg, $theme.text.fg, "no callback: theme text fg";
is $plain.bg, $theme.base.bg, "no callback: theme base bg";
is $plain.styles, 0, "no callback: body rows carry no style flags";
my $cursor = $t.effective-row-style({state => 'x'}, :is-cursor);
is $cursor.fg, $theme.text-highlight.fg, "cursor: highlight fg";
is $cursor.styles, $theme.text-highlight.styles, "cursor: highlight flags";
is $cursor.bg, $theme.base.bg,
"cursor: base bg when the theme's highlight slot has no bg of its own";
# Callback receives the row hash; a defined result overrides.
my %seen;
$t.set-row-style(-> %row {
%seen = %row;
%row<state> eq 'error'
?? Selkie::Style.new(fg => 0xFF0000, bold => True)
!! Nil;
});
my $err = $t.effective-row-style({state => 'error'});
is %seen<state>, 'error', "callback receives the row hash";
is $err.fg, 0xFF0000, "override fg wins on non-cursor rows";
ok $err.bold, "override flags apply";
# Cursor + override: override fg survives, highlight flags OR in.
my $err-cursor = $t.effective-row-style({state => 'error'}, :is-cursor);
is $err-cursor.fg, 0xFF0000, "override fg survives the cursor";
is $err-cursor.styles +& $theme.text-highlight.styles,
$theme.text-highlight.styles, "cursor flags are OR'd in";
# Nil result: back to theme defaults.
is $t.effective-row-style({state => 'fine'}).fg, $theme.text.fg,
"Nil result falls back to theme default";
};
subtest "the cursor row is always visible under a row-style" => {
plan 12;
# Regression: a row style that pinned BOTH colours and was already
# bold (a budget grid's group headers, say) merged over the cursor
# base to exactly the style it merged over the body base — the
# cursor row rendered byte-for-byte like its neighbours and the
# cursor was simply gone. The highlight background is authoritative
# on the cursor row now; fg and flags still come from the row style.
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'name', label => 'Name');
$t.set-theme(palette-theme);
my $theme = $t.theme;
my $header = Selkie::Style.new(fg => 0xFFFFFF, bg => 0x202030, bold => True);
my $red = Selkie::Style.new(fg => 0xFF0000);
$t.set-row-style(-> %row {
given %row<kind> {
when 'header' { $header }
when 'error' { $red }
default { Nil }
}
});
my %hdr = kind => 'header', name => 'Bills';
my $plain-hdr = $t.effective-row-style(%hdr);
my $cursor-hdr = $t.effective-row-style(%hdr, :is-cursor);
is $plain-hdr.bg, 0x202030, "off-cursor: the row style's own bg stands";
isnt $cursor-hdr.bg, $plain-hdr.bg,
"fully-styled bold row differs under the cursor";
is $cursor-hdr.bg, $theme.text-highlight.bg,
"cursor bg is the highlight bg, not the row style's";
is $cursor-hdr.fg, 0xFFFFFF, "cursor keeps the row style's fg";
ok $cursor-hdr.bold, "cursor keeps the row style's flags";
# The documented contract: a red row keeps its red under the cursor.
my %err = kind => 'error', name => 'Overdrawn';
my $cursor-err = $t.effective-row-style(%err, :is-cursor);
is $cursor-err.fg, 0xFF0000, "red row keeps its fg under the cursor";
is $cursor-err.bg, $theme.text-highlight.bg,
"red row still gets the highlight bg";
ok $cursor-err.bold, "red row gains the highlight's bold";
# Unstyled rows on the same table: cursor bg is the highlight bg too,
# so every cursor row in a table wears one colour.
is $t.effective-row-style({kind => 'plain', name => 'x'}, :is-cursor).bg,
$theme.text-highlight.bg, "unstyled cursor row uses the highlight bg";
is $t.effective-row-style({kind => 'plain', name => 'x'}).bg,
$theme.base.bg, "unstyled body row keeps the base bg";
# Last resort: a palette whose highlight bg IS the surface colour
# the header row uses (several real palettes collapse those two into
# one step) would still render identically — `selection` takes over.
my $flat = Selkie::Widget::Table.new;
$flat.add-column(name => 'name', label => 'Name');
$flat.set-theme(palette-theme(highlight-bg => 0x202030,
selection-bg => 0x8844CC));
$flat.set-row-style(-> %row { %row<kind> eq 'header' ?? $header !! Nil });
my $flat-plain = $flat.effective-row-style(%hdr);
my $flat-cursor = $flat.effective-row-style(%hdr, :is-cursor);
is $flat-cursor.bg, 0x8844CC,
"indistinguishable cursor row escalates to the selection bg";
isnt $flat-cursor.bg, $flat-plain.bg,
"…which is, finally, different from the uncursored row";
};
subtest "body-height is the plane's, not the row count's" => {
plan 5;
# Regression: `rows` is overloaded in this class — Table.rows is
# the row DATA, Selkie::Widget.rows is the plane height — and the
# body-height calculation used to read the wrong one. The symptom
# was silent and permanent: a table always rendered one fewer row
# than it held, no matter how tall its plane, so the last row was
# unreachable; the overflow test degenerated to `elems > elems - 1`
# so the scrollbar was always drawn and always stole a column from
# the last flex column; and PageUp/PageDown jumped by the row count
# instead of a screenful.
my $t = Selkie::Widget::Table.new;
$t.add-column(name => 'id', label => 'ID');
$t.set-rows([{id => 1}, {id => 2}, {id => 3}]);
is $t.rows.elems, 3, "three rows of data";
is $t.body-height, 0,
"no plane yet, so no body height — NOT rows - 1";
# With a plane, body-height tracks the plane. `resize` is the
# plane-free half of the geometry path (no notcurses needed).
$t.resize(10, 40);
is $t.body-height, 9, "10-row plane leaves 9 rows under the header";
$t.resize(1, 40);
is $t.body-height, 0, "a 1-row plane is all header, no body";
$t.resize(0, 40);
is $t.body-height, 0, "a 0-row plane clamps at 0 rather than underflowing";
};