### ----------------------------------------------------
### -- PDF::NameTags
### -- Licenses: Artistic-2.0
### -- Authors: Tom Browder
### -- File: bad/rakuast-validate.rakutest
### ----------------------------------------------------
#!/usr/bin/env raku

use experimental :rakuast;

# use various debug numbers

my $debug = 1;

use Test;

use FontFactory::Test-Files;

my @files = FontFactory::Test-Files.pods;

=begin overview

Validate, in a single pass, several characteristics of our
Rakudoc sources using RakuAST.

=head1 C<C>

Verify any C<C<>> tags have no internal trailing whitespace.
To explicitly allow it, prepend the C<C<>> with a
C<Z<ignore-code-ws>> comment, needed in rare cases.

=head1 Links

All URLS should appear inside C<L<>> tags, not in raw text.

=head1 brackets

Authors may forget to add a formatting code when
wrapping something in angle brackets:

    This was supposed to be <bold>.

This is valid pod, but in practice, these dangling <>'s often indicate an error.
Complain whenever we find them, except for infix:<> and prefix:<>

=end overview


if @files {
    plan +@files;
} else {
    plan :skip-all<No rakudoc files specified>
}

my $*TRAILING-C-WHITESPACE-OK = False;
my $*INSIDE-LINK = False;

sub walk($node) {
    if $debug == 1 {
        my $nam = $node.^name;
        say "DEBUG node.^name: {$nam}";
    }
    if $debug == 2 {
        say $node.raku;
    }

    my @children;
    my $check-empty-tags = True;

    if $node ~~ RakuAST::Doc::Paragraph {
        @children = $node.atoms;
    } elsif $node ~~ RakuAST::Doc::Block {
        return if $node.type eq 'code'|'implicit-code'|'comment'|'table';
        @children = $node.paragraphs;
    } elsif $node ~~ RakuAST::Doc::Markup {
        $check-empty-tags = False;

        if $node.letter eq 'L' {
            $*INSIDE-LINK = True;
        }
        if $node.letter eq 'Z' and $node.atoms[0] eq 'ignore-code-ws' {
            $*TRAILING-C-WHITESPACE-OK = True;
        }
        elsif $node.letter eq 'C' {
            my $content = ~$node.atoms;
            if $*TRAILING-C-WHITESPACE-OK {
                pass "Allowed trailing space on $node";
            } else {
                ok $content eq $content.trim-trailing, $node;
            }
            $*TRAILING-C-WHITESPACE-OK = False;
        } else {
            @children = $node.atoms;
        }
    } else {
        # If this hits, need to adapt test
        flunk "new node type: $node.^name";
    }

    for @children -> $child {
        if $child ~~ Str {
            if ! $*INSIDE-LINK {
                if $child ~~ / $<url>=[ 'http' 's'? '://' <-[/]>* '/'? ] / {
                    flunk "URL found: $<url>";
                }
            }
            if $check-empty-tags && $child ~~ / $<bracketed>=['<' .*? '>'] / {
                next if $child.contains("prefix:<" | "infix:<" );
                flunk ~$/<bracketed> ~ " is likely missing a formatting code";
            }
        } else {
            walk($child);
        }
    }
    $*INSIDE-LINK = False;
}

for @files -> $file {
    %*ENV<RAKUDO_RAKUAST>=1;
    subtest $file => {
        for $file.IO.slurp.AST.rakudoc -> $pod {
            walk($pod);
        }
    }
}


