Selkie.git | lib/Selkie/ | Trace.rakumod

---

unit class Selkie::Trace;

# Lightweight runtime tracing for Selkie applications.
#
# The implementation avoids non-core dependencies so Selkie can emit
# Chrome Trace JSON without adding JSON::Fast to the framework itself.

=begin pod

=head1 NAME

Selkie::Trace - runtime span tracing (Chrome Trace JSON / slow-span JSONL)

=head1 SYNOPSIS

=begin code :lang<raku>

Selkie::Trace.init(mode => 'trace', trace-path => $path);
my $span = Selkie::Trace.enabled
    ?? Selkie::Trace.start('widget.render', cat => 'render',
        args => %(rows => 4))
    !! Nil;
# ... work ...
$span.finish(ok => True) with $span;
Selkie::Trace.shutdown;   # drains + writes the JSON tail

=end code

=head1 DESCRIPTION

Three modes: C<off> (default — C<.enabled> is a state-var check and
C<.start> returns the type object), C<slow> (synchronous JSONL of spans
over their threshold — cheap enough for day-to-day use), and C<trace>
(complete Chrome Trace capture — every span, for deliberate profiling
sessions only).

In C<trace> mode, events are enqueued lock-free on a C<Channel> and a
dedicated writer thread owns all JSON serialization and file I/O, so
span capture on hot paths costs an arg snapshot + a channel send, not
a file write. C<shutdown>/C<reset> close the channel, join the writer,
and only then append the JSON tail — the file is complete and valid
once C<shutdown> returns. Producers racing shutdown lose their events
(sends on the closed channel are swallowed), which is the intended
"capture ends now" semantic.

=head2 Span discipline

Create spans B<after> any cheap early-return guard, never before: a
method whose common case is a no-op (an idempotent destroy, an
already-loaded load) must not emit an event that records nothing —
per-frame no-op spans dominated a real capture at 27 events/frame
before this rule.

=end pod

our class Span {
    has Str $.name is required;
    has Str $.cat = 'app';
    has Num $.ts-us is required;
    has Int $.pid is required;
    has Int $.tid is required;
    has Num $.threshold-ms = 0e0;
    has %.args;

    method finish(*%args) {
        Selkie::Trace.finish-span(self, |%args);
    }
}

my enum Mode <Off Slow Trace>;

my Mode       $active-mode = Off;
my Str        $active-trace-path;
my Str        $active-slow-path;
my IO::Handle $trace-handle;
my IO::Handle $slow-handle;
my Lock       $lock .= new;
my Bool       $trace-first-event = True;
my Int        $trace-events-written = 0;
my Num        $global-slow-ms = 8e0;
my %thresholds;
my Bool       $closed = False;

# Trace-mode writer thread. Producers hand fully-snapshotted event
# Hashes to the channel (safe-args/safe-value run on the caller, so
# mutable values are captured at span time); a single dedicated thread
# owns all JSON serialization + file writes. Before this, every span
# serialized + wrote inside the shared lock ON THE CALLING THREAD —
# at ~27 events/frame (2026-07 capture) that was ~3ms of main-thread
# time per frame while tracing. Slow mode stays synchronous: its
# volume is thresholded and per-line flushing is the point.
my Channel $trace-channel;
my Thread  $trace-writer;

method init(
    ::?CLASS:U:
    Str :$trace-path,
    Str :$slow-path,
    Str :$mode = (%*ENV<CANTINA_TIMINGS> // 'off'),
    Numeric :$slow-ms = (%*ENV<CANTINA_TIMING_SLOW_MS> // 8).Num,
    :%thresholds = %(),
) {
    self.reset;

    $active-mode = parse-mode($mode);
    return if $active-mode == Off;

    $active-trace-path = $trace-path;
    $active-slow-path  = $slow-path;
    $global-slow-ms  = $slow-ms.Num;
    %thresholds      = %thresholds.Hash;
    $trace-first-event = True;
    $trace-events-written = 0;
    $closed          = False;

    if $active-mode == Slow && $active-slow-path.defined && $active-slow-path.chars {
        my $parent = $active-slow-path.IO.parent;
        $parent.mkdir unless $parent.d;
        $slow-handle = $active-slow-path.IO.open(:w, :enc<utf8>);
    }

    if $active-mode == Trace && $active-trace-path.defined && $active-trace-path.chars {
        my $parent = $active-trace-path.IO.parent;
        $parent.mkdir unless $parent.d;
        $trace-handle = $active-trace-path.IO.open(:w, :enc<utf8>);
        $trace-handle.print('{"traceEvents":[');
        # Start the writer BEFORE the first instant so a single thread
        # owns every event write after the header.
        $trace-channel = Channel.new;
        $trace-writer = Thread.start(
            name => 'selkie-trace-writer',
            :app_lifetime,
            sub {
                for $trace-channel.list -> %event {
                    write-trace-event(%event);
                }
            },
        );
        self.instant('trace/start', cat => 'trace', args => {
            mode => 'trace',
            pid  => $*PID,
        });
    }
}

#|( Close the channel and join the writer so every queued event is on
    disk, leaving the handle ready for the JSON tail. Callers hold
    C<$lock>. Idempotent. )
sub drain-trace-writer(--> Nil) {
    with $trace-channel { .close }
    with $trace-writer  { .finish }
    $trace-channel = Channel;
    $trace-writer  = Thread;
}

method reset(::?CLASS:U:) {
    $lock.protect: {
        drain-trace-writer;
        if $trace-handle.defined {
            unless $closed {
                $trace-handle.print('],"displayTimeUnit":"ms"}');
                $trace-handle.flush;
            }
            $trace-handle.close;
            $trace-handle = IO::Handle;
        }
        if $slow-handle.defined {
            $slow-handle.close;
            $slow-handle = IO::Handle;
        }
    }
    $active-mode = Off;
    $active-trace-path = Str;
    $active-slow-path = Str;
    $trace-first-event = True;
    $trace-events-written = 0;
    %thresholds = ();
    $closed = False;
}

method shutdown(::?CLASS:U:) {
    return if $closed;

    # The shutdown marker rides the channel like any other event, so
    # it lands after everything already queued; producers racing this
    # point lose their events to the closed channel (their sends are
    # try-guarded), which is the correct semantic for "capture ends
    # now".
    record-event({
        name => 'trace/shutdown',
        cat  => 'trace',
        ph   => 'i',
        s    => 't',
        ts   => ts-us,
        pid  => $*PID,
        tid  => thread-id,
        args => { pid => $*PID },
    }) if $trace-channel.defined;

    $lock.protect: {
        $closed = True;
        drain-trace-writer;
        if $trace-handle.defined {
            $trace-handle.print('],"displayTimeUnit":"ms"}');
            $trace-handle.flush;
            $trace-handle.close;
            $trace-handle = IO::Handle;
        }

        if $slow-handle.defined {
            $slow-handle.close;
            $slow-handle = IO::Handle;
        }
    }
    $active-mode = Off;
}

method enabled(::?CLASS:U: --> Bool) { $active-mode != Off }
method trace-enabled(::?CLASS:U: --> Bool) { $active-mode == Trace }
method slow-enabled(::?CLASS:U: --> Bool) { $active-mode == Slow }
method mode(::?CLASS:U: --> Str) { $active-mode.Str.lc }
method trace-path(::?CLASS:U: --> Str) { $active-trace-path }
method slow-path(::?CLASS:U: --> Str) { $active-slow-path }

method start(
    ::?CLASS:U:
    Str:D $name,
    Str :$cat = 'app',
    :%args = %(),
    Str :$lane = '',
    Numeric :$slow-ms,
    --> Span
) {
    return Span unless $active-mode != Off;
    my %a = safe-args(%args);
    %a<lane> = $lane if $lane.chars;
    Span.new(
        :$name,
        :$cat,
        ts-us        => ts-us,
        pid          => $*PID,
        tid          => thread-id,
        threshold-ms => ($slow-ms.defined ?? $slow-ms.Num !! threshold-for($cat)),
        args         => %a,
    );
}

method finish-span(::?CLASS:U: Span $span, *%args) {
    return unless $active-mode != Off && $span.defined;
    my Num $end-us = ts-us;
    my Num $dur-us = $end-us - $span.ts-us;
    my Num $dur-ms = $dur-us / 1000e0;
    my %args-out = $span.args.Hash;
    %args-out{$_} = safe-value(%args{$_}) for %args.keys;

    if $active-mode == Trace {
        record-event({
            name => $span.name,
            cat  => $span.cat,
            ph   => 'X',
            ts   => $span.ts-us,
            dur  => $dur-us max 0e0,
            pid  => $span.pid,
            tid  => $span.tid,
            args => %args-out,
        });
    }

    if $active-mode == Slow && $dur-ms >= $span.threshold-ms {
        write-slow({
            ts      => iso-utc(now),
            kind    => 'span',
            name    => $span.name,
            cat     => $span.cat,
            dur_ms  => round-ms($dur-ms),
            pid     => $span.pid,
            tid     => $span.tid,
            args    => %args-out,
        });
    }
}

method instant(
    ::?CLASS:U:
    Str:D $name,
    Str :$cat = 'app',
    :%args = %(),
    Str :$lane = '',
) {
    return unless $active-mode == Trace;
    my %a = safe-args(%args);
    %a<lane> = $lane if $lane.chars;
    record-event({
        :$name,
        :$cat,
        ph   => 'i',
        s    => 't',
        ts   => ts-us,
        pid  => $*PID,
        tid  => thread-id,
        args => %a,
    });
}

method counter(
    ::?CLASS:U:
    Str:D $name,
    Numeric:D $value,
    Str :$cat = 'counter',
    :%args = %(),
    Str :$lane = '',
) {
    return unless $active-mode == Trace;
    my %a = safe-args(%args);
    %a<value> = $value.Num;
    %a<lane> = $lane if $lane.chars;
    record-event({
        :$name,
        :$cat,
        ph   => 'C',
        ts   => ts-us,
        pid  => $*PID,
        tid  => thread-id,
        args => %a,
    });
}

sub parse-mode(Str:D $raw --> Mode) {
    given $raw.lc.trim {
        when 'trace' { Trace }
        when 'slow'  { Slow  }
        default      { Off   }
    }
}

sub threshold-for(Str:D $cat --> Num) {
    with %thresholds{$cat} { return .Num }
    with %thresholds<default> { return .Num }
    $global-slow-ms;
}

sub ts-us(--> Num) { now.Num * 1_000_000e0 }

sub thread-id(--> Int) {
    try { return $*THREAD.id.Int }
    0;
}

sub record-event(%event) {
    # Lock-free enqueue; the writer thread owns serialization + I/O.
    # A send racing shutdown's channel close throws — swallowed, the
    # event is simply outside the capture window.
    return if $closed;
    with $trace-channel {
        try .send(%event.Hash);
    }
}

# Runs ONLY on the writer thread — the header and the JSON tail are
# printed directly by init/reset/shutdown strictly before the writer
# starts / after it is joined, so the handle is single-writer and
# needs no lock here.
sub write-trace-event(%event) {
    return unless $trace-handle.defined;
    my $prefix = $trace-first-event ?? '' !! ',';
    $trace-handle.print($prefix ~ json(%event));
    $trace-first-event = False;
    $trace-events-written++;
    $trace-handle.flush if $trace-events-written %% 256;
}

sub write-slow(%event) {
    return unless $slow-handle.defined;
    $lock.protect: {
        $slow-handle.say(json(%event));
        $slow-handle.flush;
    };
}

sub safe-args(%args --> Hash) {
    %args.map(-> $p { $p.key => safe-value($p.value) }).Hash;
}

sub safe-value($value) {
    return Any unless $value.defined;
    given $value {
        when Bool { $value.Bool }
        when Numeric { $value.Num }
        when Str {
            my $s = $value;
            $s.chars > 180 ?? $s.substr(0, 177) ~ '...' !! $s;
        }
        when Blob { { type => $value.^name, bytes => $value.bytes } }
        when Associative {
            my %out;
            for $value.keys.sort.head(16) -> $k {
                %out{$k.Str} = safe-value($value{$k});
            }
            %out<__truncated> = True if $value.keys.elems > 16;
            %out;
        }
        when Positional {
            my @items = $value.list.head(16).map({ safe-value($_) }).Array;
            @items.push({ __truncated => True, count => $value.elems })
                if $value.elems > 16;
            @items;
        }
        default {
            my $s = $value.gist;
            $s.chars > 180 ?? $s.substr(0, 177) ~ '...' !! $s;
        }
    }
}

sub json($value --> Str) {
    return 'null' unless $value.defined;
    given $value {
        when Bool { $value ?? 'true' !! 'false' }
        when Numeric {
            my Num $n = $value.Num;
            ($n.isNaN || $n == Inf || $n == -Inf) ?? 'null' !! $n.Str;
        }
        when Str { '"' ~ json-escape($value) ~ '"' }
        when Associative {
            '{' ~ $value.keys.sort.map(-> $k {
                json($k.Str) ~ ':' ~ json($value{$k})
            }).join(',') ~ '}';
        }
        when Positional {
            '[' ~ $value.list.map({ json($_) }).join(',') ~ ']';
        }
        default { json($value.gist) }
    }
}

sub json-escape(Str:D $s --> Str) {
    $s.trans(
        ['\\', '"', "\n", "\r", "\t", "\b", "\f"]
        =>
        ['\\\\', '\"', '\n', '\r', '\t', '\b', '\f']
    );
}

sub round-ms(Num:D $ms --> Num) {
    ($ms * 1000e0).round / 1000e0;
}

sub iso-utc(Instant $i --> Str) {
    my $dt = $i.DateTime.utc;
    sprintf '%04d-%02d-%02dT%02d:%02d:%02d.%03dZ',
        $dt.year, $dt.month, $dt.day,
        $dt.hour, $dt.minute, $dt.second.Int,
        (($dt.second - $dt.second.Int) * 1000).Int;
}