Selkie.git | t/ | 101-store-schema-integration.rakutest
use Test;
use lib 'lib';
use Selkie::Store;
use Selkie::Store::Schema;
use Selkie::Widget;
use Selkie::Test::Store;
# Integration of the typed store with Selkie::Store proper: opt-in
# construction, effect validation routed through __effect-error (with
# the offending event named), precise push-subscription firing driven
# by the identity diff, and the framework's focus-state paths working
# unchanged against a schema root. The Hash store's behaviour is
# pinned by the existing suite; here we only check the untyped
# db-update addition.
plan 10;
class I::Ui is Selkie::Store::Schema::UI {
has Bool $.sidebar-open = True;
}
class I::Db is Selkie::Store::Schema {
has I::Ui $.ui .= new;
has Str $.user-name = '';
has Int $.count = 0;
has %.prefs;
}
class I::NoUi is Selkie::Store::Schema {
has Int $.count = 0;
}
# Capture every __effect-error payload the store routes.
my sub capture-effect-errors(Selkie::Store $s, @sink) {
$s.register-handler('__effect-error', -> $st, %payload {
@sink.push: %payload;
();
});
}
subtest "construction — opt-in and validation" => {
plan 6;
my $s = Selkie::Store.new(state-class => I::Db);
ok $s.state ~~ I::Db:D, ":state-class builds a fresh root instance";
my $seed = I::Db.new(user-name => 'Kai');
my $s2 = Selkie::Store.new(initial-state => $seed);
ok $s2.state === $seed, ":initial-state installs the given root";
is $s2.state-class.^name, 'I::Db', "…and back-fills state-class from its type";
throws-like { Selkie::Store.new(state-class => I::NoUi) }, Exception,
message => /"must declare a defined 'ui' slot"/,
"a root schema without the ui slot is refused at construction";
throws-like { Selkie::Store.new(initial-state => 42) }, Exception,
message => /"must be a defined Selkie::Store::Schema instance"/,
"a non-schema initial-state is refused";
throws-like { Selkie::Store.new(state-class => I::Db, initial-state => I::Ui.new) },
Exception,
message => /"not an instance of :state-class"/,
"mismatched state-class and initial-state are refused";
};
subtest "reads — .state, .db, get-in" => {
plan 5;
my $s = Selkie::Store.new(initial-state => I::Db.new(
user-name => 'Kai', prefs => { theme => 'dark' }));
is $s.state.user-name, 'Kai', ".state gives typed accessor reads";
throws-like { $s.db }, Exception,
message => /"read it via .state"/,
".db dies on a typed store, pointing at .state";
is $s.get-in('ui', 'sidebar-open'), True,
"get-in walks schema slots as path segments";
is $s.get-in('prefs', 'theme'), 'dark',
"get-in continues into plain-Hash regions";
ok !$s.get-in('no-such', 'path').defined,
"get-in keeps the missing-step-reads-as-Nil contract";
};
subtest "db effect — validated deep-merge" => {
plan 4;
my $s = Selkie::Store.new(state-class => I::Db);
$s.register-handler('ui/toggle', -> $st, % {
(db => { ui => { sidebar-open => !$st.state.ui.sidebar-open } },);
});
dispatch-and-tick($s, 'ui/toggle');
is $s.state.ui.sidebar-open, False, "nested merge writes through the schema";
my @errors;
capture-effect-errors($s, @errors);
$s.register-handler('user/rename-typo', -> $st, %ev {
(db => { user-nmae => %ev<name> },);
});
dispatch-and-tick($s, 'user/rename-typo', name => 'Kai');
is @errors.elems, 1, "a typo'd key routes to __effect-error";
like @errors[0]<error>, /"No such slot 'user-nmae'"/,
"…whose message names the bad slot";
is @errors[0]<event>, 'user/rename-typo',
"…and whose payload names the offending event";
};
subtest "db effect — slot type constraints enforced" => {
plan 3;
my $s = Selkie::Store.new(state-class => I::Db);
my @errors;
capture-effect-errors($s, @errors);
$s.register-handler('count/corrupt', -> $st, % {
(db => { count => 'not-an-int' },);
});
dispatch-and-tick($s, 'count/corrupt');
is @errors.elems, 1, "a wrong-typed value routes to __effect-error";
ok @errors[0]<exception> ~~ X::TypeCheck,
"…carrying the original type-check exception";
is $s.state.count, 0, "…and the state tree is untouched";
};
subtest "db-replace / db-delete — typed paths" => {
plan 3;
my $s = Selkie::Store.new(initial-state => I::Db.new(
count => 5, prefs => { theme => 'dark', size => 12 }));
$s.register-handler('prefs/reset-theme', -> $st, % {
(db-delete => { path => <prefs theme> },);
});
$s.register-handler('count/set', -> $st, %ev {
(db-replace => { path => ('count',), value => %ev<n> },);
});
dispatch-and-tick($s, 'count/set', n => 9);
is $s.state.count, 9, "db-replace sets a slot through the schema";
dispatch-and-tick($s, 'prefs/reset-theme');
ok $s.state.prefs<theme>:!exists && $s.state.prefs<size> == 12,
"db-delete deletes inside a plain-Hash region";
my @errors;
capture-effect-errors($s, @errors);
$s.register-handler('bad/path', -> $st, % {
(db-replace => { path => <no-such-slot x>, value => 1 },);
});
dispatch-and-tick($s, 'bad/path');
like @errors[0]<error> // '', /"No such slot 'no-such-slot'"/,
"an unknown slot in a path routes to __effect-error";
};
subtest "db-update — the typed workhorse" => {
plan 4;
my $s = Selkie::Store.new(state-class => I::Db);
$s.register-handler('user/rename', -> $st, %ev {
(db-update => { fn => -> I::Db $db { $db.with(user-name => %ev<name>) } },);
});
dispatch-and-tick($s, 'user/rename', name => 'Kai');
is $s.state.user-name, 'Kai', "db-update transforms the root";
my @errors;
capture-effect-errors($s, @errors);
$s.register-handler('bad/return', -> $st, % {
(db-update => { fn => -> $ { 'not a schema' } },);
});
dispatch-and-tick($s, 'bad/return');
like @errors[0]<error> // '', /"must return a I::Db instance"/,
"a wrong-shaped return routes to __effect-error";
$s.register-handler('bad/no-fn', -> $st, % {
(db-update => { },);
});
dispatch-and-tick($s, 'bad/no-fn');
like @errors[1]<error> // '', /"requires :fn"/,
"a missing fn routes to __effect-error";
is $s.state.user-name, 'Kai', "failed updates leave state untouched";
};
subtest "push subscriptions — precise firing from the identity diff" => {
plan 5;
my $s = Selkie::Store.new(state-class => I::Db);
my (@name-fires, @ui-fires, @count-fires, @theme-fires);
$s.subscribe-path-callback('name', ('user-name',), { @name-fires.push($_) }, Selkie::Widget);
$s.subscribe-path-callback('ui', ('ui',), { @ui-fires.push($_) }, Selkie::Widget);
$s.subscribe-path-callback('count', ('count',), { @count-fires.push($_) }, Selkie::Widget);
$s.subscribe-path-callback('theme', ('prefs', 'theme'), { @theme-fires.push($_) }, Selkie::Widget);
# Subscriptions prime synchronously with the current value — drop
# the prime fires so the assertions below see only write-driven ones.
@name-fires = ();
@ui-fires = ();
@count-fires = ();
@theme-fires = ();
$s.register-handler('user/rename', -> $st, %ev { (db => { user-name => %ev<name> },) });
$s.register-handler('ui/toggle', -> $st, % {
(db => { ui => { sidebar-open => !$st.state.ui.sidebar-open } },);
});
$s.register-handler('prefs/replace', -> $st, %ev { (db-replace => { path => ('prefs',), value => %ev<prefs> },) });
dispatch-and-tick($s, 'user/rename', name => 'Kai');
is @name-fires, ['Kai'], "an exact-path sub fires with the new value";
is @count-fires.elems, 0, "an untouched sibling slot's sub does not fire";
dispatch-and-tick($s, 'ui/toggle');
is @ui-fires.elems, 1, "an ancestor sub fires on a nested slot write";
dispatch-and-tick($s, 'prefs/replace', prefs => { theme => 'light' });
is @theme-fires, ['light'], "a descendant sub fires when its ancestor subtree is replaced";
my $before = @name-fires.elems;
dispatch-and-tick($s, 'user/rename', name => 'Kai');
is @name-fires.elems, $before, "a no-op write (identical value) fires nothing";
};
subtest "framework focus paths work against a schema root" => {
plan 4;
my $s = Selkie::Store.new(state-class => I::Db);
# The exact handlers Selkie::App registers, and the exact direct
# assoc-in reset FocusTree performs after consuming an action.
$s.register-handler('ui/focus', -> $st, %ev {
(db => { ui => { focused-widget => %ev<widget> } },);
});
$s.register-handler('ui/focus-next', -> $st, %ev {
(db => { ui => { focus-action => 'next' } },);
});
dispatch-and-tick($s, 'ui/focus-next');
is $s.get-in('ui', 'focus-action'), 'next',
"ui/focus-next lands in the schema's ui slot";
$s.assoc-in('ui', 'focus-action', value => Nil);
nok $s.get-in('ui', 'focus-action').defined,
"FocusTree's direct assoc-in reset works";
my $marker = 'the-focused-widget';
dispatch-and-tick($s, 'ui/focus', widget => $marker);
ok $s.get-in('ui', 'focused-widget') === $marker,
"ui/focus stores the widget in the schema's ui slot";
ok $s.state.ui ~~ I::Ui, "the app's ui subclass survives framework writes";
};
subtest "db-update on the untyped Hash store" => {
plan 3;
my $s = Selkie::Store.new;
$s.assoc-in('count', value => 1);
my @fires;
$s.subscribe-path-callback('count', ('count',), { @fires.push($_) }, Selkie::Widget);
@fires = (); # drop the synchronous prime fire
$s.register-handler('bump', -> $st, % {
(db-update => { fn => -> %db { my %new = %db; %new<count>++; %new } },);
});
dispatch-and-tick($s, 'bump');
is $s.get-in('count'), 2, "fn receives the Hash and its return replaces state";
is @fires, [2], "the root-dirty write notifies path subs (digest-gated)";
my @errors;
capture-effect-errors($s, @errors);
$s.register-handler('bad', -> $st, % { (db-update => { fn => -> % { 42 } },) });
dispatch-and-tick($s, 'bad');
like @errors[0]<error> // '', /"must return an Associative"/,
"a non-Associative return routes to __effect-error";
};
subtest "Test::Store passthrough" => {
plan 3;
my $typed = mock-store(state-class => I::Db, state => { count => 7 });
ok $typed.state ~~ I::Db:D, "mock-store(:state-class) builds a typed store";
is $typed.state.count, 7, ":state seeding works via schema-validated assoc-in";
my $seeded = mock-store(initial-state => I::Db.new(user-name => 'Kai'));
is $seeded.state.user-name, 'Kai', "mock-store(:initial-state) passes through";
};