Selkie.git | lib/Selkie/Store/ | Schema.rakumod
=begin pod
=head1 NAME
Selkie::Store::Schema - Typed, immutable state tree for Selkie::Store
=head1 SYNOPSIS
=begin code :lang<raku>
use Selkie::Store;
use Selkie::Store::Schema;
# Nested slots are Schema subclasses of their own.
class MyApp::Ui is Selkie::Store::Schema::UI {
has Bool $.sidebar-open = True;
}
# The ROOT schema must declare a `ui` slot holding a
# Selkie::Store::Schema::UI (or subclass) instance — the framework's
# focus machinery lives there. This line belongs in every root schema:
class MyApp::Db is Selkie::Store::Schema {
has MyApp::Ui $.ui .= new;
has Str $.user-name = '';
has @.tasks;
has %.prefs;
}
my $store = Selkie::Store.new(state-class => MyApp::Db);
# Handlers patch state through the same effects as the Hash store —
# now validated against the schema at dispatch time:
$store.register-handler('user/rename', -> $st, %ev {
(db => { user-name => %ev<name> },);
});
# Or transform the whole tree with the db-update effect:
$store.register-handler('tasks/clear', -> $st, %ev {
(db-update => { fn => -> MyApp::Db $s { $s.with(tasks => []) } },);
});
# Reads: typed accessors via .state, or the classic get-in:
say $store.state.user-name;
say $store.get-in('ui', 'sidebar-open');
=end code
=head1 DESCRIPTION
C<Selkie::Store::Schema> is the base class for B<typed store state>.
An app defines its state tree as a class (nested state as nested
Schema subclasses), passes it to
C<Selkie::Store.new(:state-class(...))>, and every write effect —
C<db>, C<db-replace>, C<db-delete>, C<db-update>, and the low-level
C<assoc-in> — is validated against the declared slots at dispatch
time. A typo'd key or a wrong-typed value becomes a loud
C<__effect-error> naming the offending slot instead of a silently
malformed state tree.
The untyped Hash store remains the default and is not deprecated:
apps opt in per store. See "TYPED STORE" in L<Selkie::Store> for the
when-to-use-which discussion.
=head2 Immutability and identity
Schema instances are B<immutable by convention>: every write produces
a new instance via C<with> / C<merge> / C<set-at> / C<deleted-at>,
sharing unchanged sub-structure with the previous instance by
reference. Two consequences the whole design leans on:
=item B<No-op writes keep identity.> Setting a slot to a value that
is already there (C<===>, or both sides undefined) returns C<self>
— the same instance. Subscriptions comparing by identity or by
digest therefore never fire on writes that change nothing.
=item B<Changes are discoverable by identity diff.> After a write,
walking old and new trees comparing slots with C<===> finds exactly
the changed paths in O(changed) time, because unchanged branches
are the I<same object> on both sides. C<Selkie::Store> uses
C<changed-paths> for precise push-subscription dirty marking.
Do not mutate a Schema instance's C<@.>/C<%.>/object slots in place —
in-place mutation is invisible to identity diffing, exactly like the
documented in-place-mutation caveat on C<:identity-check-only> Hash
subscriptions. Replace, don't mutate.
=head2 Collection slots (C<@.> / C<%.>)
Raku's C<clone> gives a clone fresh C<@>/C<%> attribute containers,
so container identity can't distinguish "untouched" from "replaced"
for collection slots. They therefore compare by B<one-level element
identity>: same element count, every element C<===> its counterpart
(with both-undefined counting as equal). Consequences:
=item An untouched collection slot never reads as changed across
clones (the containers differ, the elements don't).
=item Writing a fresh array with identical elements is a B<no-op> —
C<$db.with(tasks => [|$db.tasks])> returns C<self>.
=item The comparison walks the collection once per write to the
owning node. For large collections (thousands of elements),
prefer a C<$.> slot holding a List replaced wholesale — a scalar
slot's value keeps its identity across clones, so it compares in
O(1) and follows the exact replace-wholesale idiom
L<Selkie::Store>'s digest documentation recommends.
=item Elements compare by identity only — no deep recursion. An
element mutated in place is invisible; replace the element.
=head2 Slots
A B<slot> is a public attribute (C<has $.name>, C<has @.name>,
C<has %.name>) on a Schema subclass, addressed by its
attribute name — the path segment for C<'user-name'> is the attribute
C<$.user-name>. Private attributes are not slots and are invisible to
the store. Slots typed as Schema subclasses form the typed tree;
slots holding plain Hashes are "untyped territory" and keep classic
Hash-store semantics (auto-vivified intermediates, C<:delete>) inside
that region, on copied hashes so immutability is preserved.
=head2 The C<ui> slot contract
The framework owns two pieces of store state: the focused widget and
the pending focus action. On a typed store they live in the root
schema's C<ui> slot, which must be a defined
C<Selkie::Store::Schema::UI> (or subclass) instance.
C<Selkie::Store.new> refuses construction otherwise, with the exact
line to add. Apps with their own ui state subclass
C<Selkie::Store::Schema::UI> and type the slot with the subclass, as
in the SYNOPSIS.
(The base Schema class cannot declare the slot itself: nested schemas
are Schema subclasses too, and a C<ui> slot on the base would recurse
— every C<ui> would need its own C<ui>.)
=head2 Deletion semantics
C<db-delete> / C<deleted-at> on a schema slot means B<reset>, not
removal — attributes cannot be removed from an instance. A C<$.>
slot resets to its container default (the type object — note this is
the I<type's> default, not a C<= value> declared default), C<@.> to
empty, C<%.> to empty. A slot whose type constraint rejects the
undefined value (C<Int:D>) throws, and the store routes the throw to
C<__effect-error> — deleting a can't-be-absent slot is a programming
error, and the schema's job is to say so. Inside a plain-Hash region
deletion is classic C<:delete>.
=head1 METHODS
Method-level docs are on each method below; the load-bearing ones:
=item C<with(*%overrides)> — clone with named slots replaced; C<self>
when nothing changes; dies on unknown slots; type constraints
enforced by the clone.
=item C<with-E<lt>slotE<gt>($value)> — per-slot sugar for C<with>,
provided via C<FALLBACK> (so it works for every slot without code
generation): C<$db.with-user-name('Kai')>.
=item C<merge(%updates)> — recursive counterpart of the Hash store's
deep-merge C<db> effect: Hash values merge into Schema/Hash slots,
everything else replaces.
=item C<set-at(@path, $value)> / C<deleted-at(@path)> — path-addressed
write/delete used by the store's C<db-replace> / C<db-delete> /
C<assoc-in>.
=item C<changed-paths($before)> — identity-diff against an older
instance; returns the changed slot paths.
=item C<has-slot($name)> / C<slot-value($name)> / C<slot-names> —
introspection used by the store's C<get-in>.
=head1 EXAMPLES
=head2 Nested patch, three equivalent spellings
=begin code :lang<raku>
# via with (typed, explicit):
$db .= with(ui => $db.ui.with(sidebar-open => False));
# via merge (the shape a `db` effect payload has):
$db .= merge({ ui => { sidebar-open => False } });
# via set-at (the shape db-replace / assoc-in use):
$db .= set-at(('ui', 'sidebar-open'), False);
=end code
All three share every untouched branch with the old instance, and
all three return the I<original> C<$db> unchanged if C<sidebar-open>
was already C<False>.
=head2 Catching a typo at dispatch time
=begin code :lang<raku>
# Hash store: silently creates a 'user-nmae' key, UI never updates.
# Schema store: the db effect dies —
# No such slot 'user-nmae' on MyApp::Db …
# — and the store routes it to __effect-error with the event name.
(db => { user-nmae => 'Kai' },)
=end code
=head1 SEE ALSO
=item L<Selkie::Store> — the store; "TYPED STORE" section for
opt-in, effects, and migration guidance
=item L<Selkie::Test::Store> — C<mock-store> accepts
C<:state-class> / C<:initial-state>
=end pod
#|( Base class for typed store state. Subclass per tree node; public
attributes are the slots. Instances are immutable by convention —
all writes go through with / merge / set-at / deleted-at, which
return new instances sharing unchanged branches. )
class Selkie::Store::Schema {
# Per-class slot map (slot-name → Attribute), computed once per
# class. `.^attributes` includes inherited attributes, so a
# subclass sees the whole chain. Plain `my` hash: store state is
# only ever walked on the tick thread (the same contract %!db
# has), and a first-use race would at worst recompute the Map.
my %slot-cache;
method !slots(--> Map) {
%slot-cache{self.^name} //= do {
my %slots = self.^attributes
.grep(*.has_accessor)
.map({ .name.substr(2) => $_ });
%slots.Map;
}
}
# One-level element-identity comparison for collection values.
# Needed because Mu.clone gives the clone FRESH @/% attribute
# containers — after any clone, every @/% slot's container differs
# by identity even when untouched, so === alone would spuriously
# report every collection slot changed on every write. Elements
# compare by === (plus the undefined==undefined rule); there is
# deliberately no deep recursion — mutating an element in place is
# invisible, same "replace, don't mutate" doctrine as everywhere
# else in this class.
my sub same-collection($a, $b --> Bool) {
if $a ~~ Positional && $b ~~ Positional {
return False unless $a.elems == $b.elems;
for ^$a.elems -> $i {
my $x = $a[$i];
my $y = $b[$i];
next if $x === $y;
next if !$x.defined && !$y.defined;
return False;
}
return True;
}
if $a ~~ Associative && $b ~~ Associative {
return False unless $a.elems == $b.elems;
for $a.kv -> $k, $x {
return False unless $b{$k}:exists;
my $y = $b{$k};
next if $x === $y;
next if !$x.defined && !$y.defined;
return False;
}
return True;
}
False;
}
# The single slot-equality rule every write path and the diff use:
# identity, both-undefined, or one-level collection equality.
my sub slot-unchanged($old, $new --> Bool) {
return True if $old === $new;
return True if !$old.defined && !$new.defined;
return True if ($old ~~ Positional | Associative)
&& same-collection($old, $new);
False;
}
# Deep-merge %source into a copy of %target — the plain-Hash-slot
# counterpart of the store's !merge-into, but pure: modified
# branches are fresh Hashes, untouched branches are shared.
my sub merge-hash(%target, %source --> Hash) {
my %out = %target;
for %source.kv -> $k, $v {
if $v ~~ Associative && %out{$k} ~~ Associative {
%out{$k} = merge-hash(%out{$k}, $v);
} else {
%out{$k} = $v;
}
}
%out;
}
# Path-set inside a plain-Hash region, Hash-store semantics
# (auto-vivify non-Associative intermediates) on copied hashes.
my sub hash-set-at(%h, @path, $value --> Hash) {
my %out = %h;
if @path.elems == 1 {
%out{@path[0]} = $value;
} else {
my $child = %out{@path[0]};
%out{@path[0]} = hash-set-at(
$child ~~ Associative ?? $child !! {},
@path[1..*], $value);
}
%out;
}
# Path-delete inside a plain-Hash region. Returns the ORIGINAL
# hash (same identity) when the path doesn't exist, so callers
# can detect the no-op with === and preserve tree identity.
my sub hash-deleted-at(%h, @path) {
if @path.elems == 1 {
return %h unless %h{@path[0]}:exists;
my %out = %h;
%out{@path[0]}:delete;
return %out;
}
return %h unless %h{@path[0]} ~~ Associative;
my $child = hash-deleted-at(%h{@path[0]}, @path[1..*]);
return %h if $child === %h{@path[0]};
my %out = %h;
%out{@path[0]} = $child;
%out;
}
#|( All slot names on this class, sorted. Introspection for docs,
debugging, and the store's error messages. )
method slot-names(--> List) {
my %slots := self!slots;
%slots.keys.sort.List;
}
#|( True when the class declares a slot of this name (inherited
slots included). )
method has-slot(Str:D $name --> Bool) {
my %slots := self!slots;
%slots{$name}:exists;
}
#|( Read a slot's current value by name. Dies on an unknown slot —
reads through the store's C<get-in> get the Hash-parity Nil
instead; this method is the strict path. )
method slot-value(Str:D $name) {
my %slots := self!slots;
die "No such slot '$name' on {self.^name} (slots: {self.slot-names.join(', ')})"
unless %slots{$name}:exists;
%slots{$name}.get_value(self);
}
#|( Clone with the named slots replaced. The heart of the write
path:
=item Unknown slot names die (the schema's whole point).
=item A value identical to the current one (C<===>, or both
sides undefined) is dropped; if every override is dropped,
C<self> is returned — B<same instance>, so no subscriber
ever fires on a no-op write.
=item Type constraints are enforced by the clone assignment
(C<X::TypeCheck::Assignment> on violation).
my $next = $db.with(user-name => 'Kai', tasks => @new);
)
method with(*%overrides --> Selkie::Store::Schema) {
return self unless %overrides;
my %slots := self!slots;
my %changed;
for %overrides.kv -> $name, $value {
die "No such slot '$name' on {self.^name} (slots: {self.slot-names.join(', ')})"
unless %slots{$name}:exists;
my $current = %slots{$name}.get_value(self);
next if slot-unchanged($current, $value);
%changed{$name} = $value;
}
return self unless %changed;
self.clone(|%changed);
}
#|( Deep-merge a Hash of updates — the typed counterpart of the
C<db> effect's deep-merge:
=item a Hash value merging into a Schema slot recurses with
C<merge> on that slot;
=item a Hash value merging into a plain-Hash slot deep-merges
on copied hashes (classic Hash-store semantics, immutably);
=item anything else replaces the slot via the C<with> rules.
An empty C<%updates> is a no-op returning C<self> — same
contract as the Hash store's documented "empty Hash merge is
a no-op". Unknown keys die. )
method merge(%updates --> Selkie::Store::Schema) {
return self unless %updates;
my %slots := self!slots;
my %changed;
for %updates.kv -> $name, $value {
die "No such slot '$name' on {self.^name} — a db effect's keys must match schema slots (slots: {self.slot-names.join(', ')})"
unless %slots{$name}:exists;
my $current = %slots{$name}.get_value(self);
if $value ~~ Associative && $current ~~ Selkie::Store::Schema {
my $merged = $current.merge($value);
%changed{$name} = $merged unless $merged === $current;
}
elsif $value ~~ Associative && $current ~~ Associative {
%changed{$name} = merge-hash($current, $value);
}
else {
next if slot-unchanged($current, $value);
%changed{$name} = $value;
}
}
return self unless %changed;
self.clone(|%changed);
}
#|( Set the value at a slot path, returning the new tree. The
first segment must name a slot on this class; descent
continues through Schema slots (validated at every level) or
into plain-Hash regions (Hash-store semantics: intermediates
auto-vivify, non-Associative intermediates are replaced —
untyped territory keeps untyped rules). No-op sets keep
identity all the way up. )
method set-at(@path, $value --> Selkie::Store::Schema) {
die "Path must not be empty" unless @path;
my $name = @path[0].Str;
my %slots := self!slots;
die "No such slot '$name' on {self.^name} — schema paths are not auto-created (slots: {self.slot-names.join(', ')})"
unless %slots{$name}:exists;
return self.with(|($name => $value)) if @path.elems == 1;
my $current = %slots{$name}.get_value(self);
if $current ~~ Selkie::Store::Schema {
return self.with(|($name => $current.set-at(@path[1..*], $value)));
}
self.with(|($name => hash-set-at(
$current ~~ Associative ?? $current !! {},
@path[1..*], $value)));
}
#|( Delete at a slot path, returning the new tree. On a schema
slot this means B<reset> (see "Deletion semantics" in the
Pod): C<$.> slots to the container default, C<@.>/C<%.> to
empty. Inside a plain-Hash region it is a classic key delete;
a path that doesn't exist there is a no-op returning C<self>.
The first segment must name a slot — unknown slots die, like
every schema write. )
method deleted-at(@path --> Selkie::Store::Schema) {
die "Path must not be empty" unless @path;
my $name = @path[0].Str;
my %slots := self!slots;
die "No such slot '$name' on {self.^name} (slots: {self.slot-names.join(', ')})"
unless %slots{$name}:exists;
my $attr = %slots{$name};
my $current = $attr.get_value(self);
if @path.elems == 1 {
given $attr.name.substr(0, 1) {
when '@' { return self if $current ~~ Positional && !$current.elems; }
when '%' { return self if $current ~~ Associative && !$current.elems; }
default { return self unless $current.defined; }
}
# A $-slot resets to its container default — the attribute's
# declared type object (Any when untyped). Deliberately not
# Nil: Nil doesn't survive intermediate containers (it reads
# back as Any and fails typed-container assignment).
my $empty = do given $attr.name.substr(0, 1) {
when '@' { [] }
when '%' { {} }
default { $attr.type =:= Mu ?? Any !! $attr.type }
};
return self.clone(|($name => $empty));
}
if $current ~~ Selkie::Store::Schema {
my $child = $current.deleted-at(@path[1..*]);
return self if $child === $current;
return self.with(|($name => $child));
}
if $current ~~ Associative {
my $newh = hash-deleted-at($current, @path[1..*]);
return self if $newh === $current;
return self.with(|($name => $newh));
}
self;
}
#|( Identity-diff this (newer) instance against an older one,
returning the List of changed slot paths (each a List of
segments). Unchanged branches are recognised by C<===> — with
the immutable-clone convention they are the same object, so
the walk costs O(changed paths). A slot whose old and new
values are both Schema instances of the same class recurses
for precision; everything else (plain Hashes included) marks
the slot's whole subtree, which the store's
ancestor/descendant prefix matching plus the digest gate
turns into correct — if blunter — notifications. )
method changed-paths(Selkie::Store::Schema:D $before --> List) {
my @changed;
self!collect-changed($before, (), @changed);
@changed.List;
}
method !collect-changed($before, @prefix, @changed) {
unless $before.WHAT === self.WHAT {
@changed.push: @prefix.List;
return;
}
my %slots := self!slots;
for %slots.keys.sort -> $name {
my $attr = %slots{$name};
my $ov = $attr.get_value($before);
my $nv = $attr.get_value(self);
next if slot-unchanged($ov, $nv);
if $ov ~~ Selkie::Store::Schema && $nv ~~ Selkie::Store::Schema
&& $ov.WHAT === $nv.WHAT {
$nv!collect-changed($ov, (|@prefix, $name), @changed);
} else {
@changed.push: (|@prefix, $name).List;
}
}
}
#|( Provides the per-slot C<with-E<lt>slotE<gt>($value)> sugar
without code generation: any C<with-*> call whose tail names
a slot delegates to C<with>. Anything else dies with a
method-not-found message, so typos stay loud. )
method FALLBACK(Str:D $name, |c) {
if $name.starts-with('with-') {
my $slot = $name.substr(5);
if self.has-slot($slot) {
die "{self.^name}.$name expects exactly one positional argument"
unless c.elems == 1 && !c.hash;
return self.with(|($slot => c[0]));
}
}
die "No such method '$name' for invocant of type {self.^name}"
~ ($name.starts-with('with-')
?? " (no slot '{$name.substr(5)}'; slots: {self.slot-names.join(', ')})"
!! '');
}
}
#|( The framework-owned slot every ROOT schema must carry as its
C<ui> slot (see "The ui slot contract" in the Pod). Subclass it
to add app ui state:
class MyApp::Ui is Selkie::Store::Schema::UI {
has Bool $.sidebar-open = True;
}
C<focused-widget> holds the focused Selkie::Widget (untyped here
so this module stays dependency-free); C<focus-action> holds the
pending 'next' / 'prev' focus request the App consumes. Both are
written by the built-in C<ui/focus*> handlers. )
class Selkie::Store::Schema::UI is Selkie::Store::Schema {
has $.focused-widget;
has $.focus-action;
}