Selkie.git | t/ | 78-subscription-digest.rakutest

---

use Test;
use lib 'lib';

use Selkie::Store;
use Selkie::Widget;

# Change detection is digest-based (see Store !value-digest / !sub-changed):
# Hashes / Arrays are folded structurally and every leaf — value type OR
# object — is keyed by its .WHICH. For value types .WHICH is content-
# derived (two equal Strs share it); for references it is identity (a
# wholesale-replaced record reads as changed, the same instance as
# unchanged). Object attributes are NOT folded: the store holds things
# like the focused Selkie widget, whose attribute graph has native plane
# handles (which read back as the NQP null) and parent<->child cycles —
# folding those crashed / exploded the walk. Identity is the right (and
# for Cantina's immutable, replace-wholesale records, exact) comparison.
#
# This file pins that contract.

class TestWidget does Selkie::Widget {
    has Int $.fires = 0;
    method render() { self.clear-dirty }
    method mark-dirty() { $!fires++; nextsame; }
}

class Inner { has Str $.note; has Int $.n; }
class Heavy { has Int $.id; has Str $.body; has Inner $.inner; }
sub heavy(Int $id, Str $body, Str $note, Int $n) {
    Heavy.new(:$id, :$body, inner => Inner.new(:$note, :$n));
}

# A cyclic, native-attr-laden graph like a focused widget subtree.
class Node { has Node $.parent is rw; has @.children; has Str $.name; }

plan 7;

subtest 'value-typed leaves compare by content, not identity' => {
    plan 3;
    # The fingerprint-Str pattern: a computed sub returns a FRESH Str each
    # tick and must fire only when the string content changes.
    my $s = Selkie::Store.new;
    my $w = TestWidget.new;
    $s.register-handler('set', -> $st, %ev { (db => { n => %ev<v> },); });
    $s.dispatch('set', v => 1); $s.tick;
    $s.subscribe-with-callback('fp',
        -> $st { "v={$st.get-in('n')}" },   # fresh Str instance each call
        -> $ { }, $w);
    $s.tick;
    my $base = $w.fires;

    $s.dispatch('set', v => 1); $s.tick;
    is $w.fires, $base, 'identical fingerprint string does not fire (content compare)';
    $s.dispatch('set', v => 2); $s.tick;
    is $w.fires, $base + 1, 'changed fingerprint string fires';
    $s.dispatch('set', v => 2); $s.tick;
    is $w.fires, $base + 1, 'no spurious fire when content is unchanged';
};

subtest 'object leaves compare by identity (replace fires, same is silent)' => {
    plan 2;
    my $s = Selkie::Store.new;
    my $w = TestWidget.new;
    $s.register-handler('put', -> $st, %ev { (db => { slot => %ev<v> },); });
    my $h = heavy(1, 'hello', 'calm', 0);
    $s.dispatch('put', v => $h); $s.tick;
    $s.subscribe('slot-sub', ['slot'], $w);
    my $base = $w.fires;

    # Same instance again → identity unchanged → silent.
    $s.dispatch('put', v => $h); $s.tick;
    is $w.fires, $base, 'writing the same record instance does not fire';

    # A fresh record (Cantina replaces wholesale on any real change) →
    # identity changed → fires.
    $s.dispatch('put', v => heavy(1, 'hello', 'EDITED', 0)); $s.tick;
    is $w.fires, $base + 1, 'a replaced record fires';
};

subtest 'in-place assoc-in on a nested scalar leaf fires (structural)' => {
    plan 2;
    my $s = Selkie::Store.new;
    my $w = TestWidget.new;
    $s.assoc-in('prefs', 'theme', value => 'dark');
    $s.subscribe('prefs-sub', ['prefs'], $w);   # default structural sub
    $s.tick;
    my $base = $w.fires;

    # assoc-in mutates the leaf inside the live prefs Hash; the Hash's
    # identity is unchanged but the leaf's .WHICH moves, so it's caught.
    $s.assoc-in('prefs', 'theme', value => 'light');
    $s.tick;
    is $w.fires, $base + 1, 'deep assoc-in mutation is detected';

    $s.assoc-in('prefs', 'theme', value => 'light');   # no-op
    $s.tick;
    is $w.fires, $base + 1, 'a no-op write does not fire';
};

subtest 'unrelated sibling write with undefined leaf does not fire' => {
    plan 1;
    # Regression: get-in returns Nil when an intermediate is missing but
    # the Any leaf when only the final key is absent. Both are "no value"
    # and must digest identically, or a write to user.age spuriously
    # fires a subscription on user.name.
    my $s = Selkie::Store.new;
    my $w = TestWidget.new;
    $s.subscribe('name-sub', ('user', 'name'), $w);
    $s.tick;
    my $base = $w.fires;
    $s.register-handler('age', -> $st, %ev { (db => { user => { age => 30 } },); });
    $s.dispatch('age'); $s.tick;
    is $w.fires, $base, 'sibling user.age write leaves user.name subscription silent';
};

subtest 'cyclic / native-attr object graph: no crash, compares by identity' => {
    plan 2;
    # Regression for the launch crash: the digest used to fold object
    # attributes, which recursed into a focused widget's native plane
    # handles (NQPMu) and parent<->child cycles. Identity sidesteps both.
    my $a = Node.new(name => 'a');
    my $b = Node.new(name => 'b');
    $a.children.push($b);
    $b.parent = $a;        # cycle

    my $s = Selkie::Store.new;
    my $w = TestWidget.new;
    $s.register-handler('focus',
        -> $st, %ev { (db => { ui => { focused => %ev<v> } },); });
    $s.dispatch('focus', v => $a); $s.tick;

    lives-ok {
        $s.subscribe-path-callback('foc', ['ui', 'focused'], -> $ { }, $w);
        $s.tick;
        $s.dispatch('focus', v => $a); $s.tick;   # same instance
        $s.dispatch('focus', v => $b); $s.tick;   # different instance
    }, 'digesting a cyclic widget-like object never crashes or hangs';
    pass 'cyclic-graph subscription handled by identity';
};

subtest 'regression guard: comparison stays cheap on large structures' => {
    plan 1;
    # 30 records (~2 KB body each), 100 reload ticks. Identity-keyed leaves
    # do this in single-digit ms; the old per-field eqv took multiple
    # seconds (~2.5 ms × 30 × 100 ≈ 7.5 s). A 3 s ceiling has wide margin
    # over the digest path while still tripping on an eqv regression.
    my $s = Selkie::Store.new;
    my $w = TestWidget.new;
    $s.register-handler('put', -> $st, %ev { (db => { big => %ev<v> },); });
    my $body = 'x' x 2000;
    sub batch(Int $salt) { (^30).map({ heavy($_, $body, "n-{$_}-$salt", $_) }).Array }
    $s.dispatch('put', v => batch(0)); $s.tick;
    $s.subscribe('big-sub', ['big'], $w);

    my $start = now;
    for ^100 -> $i { $s.dispatch('put', v => batch($i + 1)); $s.tick; }
    my $elapsed = (now - $start).Num;
    ok $elapsed < 3, "100 reload ticks over 30 records in {$elapsed.fmt('%.3f')}s (< 3 s)";
};

subtest 'Blob and Buf leaves are compact digest tokens' => {
    plan 2;
    my $s = Selkie::Store.new;
    my $w = TestWidget.new;
    my $buf = Buf[uint8].allocate(4 * 1024 * 1024);
    $s.register-handler('put-upload', -> $st, %ev {
        (db => { upload => { blob => %ev<blob>, sha => %ev<sha> } },);
    });
    $s.dispatch('put-upload', blob => $buf, sha => 'same'); $s.tick;
    $s.subscribe('upload-sub', ['upload'], $w);
    $s.tick;
    my $base = $w.fires;

    my $start = now;
    for ^25 {
        $s.dispatch('put-upload', blob => $buf, sha => 'same');
        $s.tick;
    }
    my $elapsed = (now - $start).Num;
    is $w.fires, $base, 'same Buf leaf under a parent hash stays silent';
    ok $elapsed < 2,
        "25 parent digests with a 4 MB Buf in {$elapsed.fmt('%.3f')}s (< 2 s)";
};

done-testing;