view release on metacpan or  search on metacpan

lib/MarpaX/Hoonlint/Policy/Test/Whitespace.pm  view on Meta::CPAN

        my $expectedBodyColumn = $anchorColumn + 4;
        push @mistakes,
          @{
            $policy->checkOneLineGap(
                $gap,
                {
                    mainColumn => $expectedBodyColumn,
                    subpolicy  => [ $runeName, 'hint' ],
                    runeName        => $runeName,
                    subpolicy  => [$runeName],
                }
            )
          };

        if ( $bodyColumn != $expectedBodyColumn ) {
            my $msg =
              sprintf 'SIGGAL/SIGGAR hint body %s; %s',
              describeLC( $bodyLine, $bodyColumn ),
              describeMisindent2( $bodyColumn, $expectedBodyColumn );
            push @mistakes,
              {
                desc         => $msg,
                subpolicy    => [ $runeName, 'hint-body-indent' ],
                parentLine   => $parentLine,
                parentColumn => $parentColumn,
                line         => $bodyLine,
                column       => $bodyColumn,
                reportLine   => $bodyLine,
                reportColumn => $bodyColumn,
              };
        }
    }

    return \@mistakes;
}

# bonz5d ::= (- TIS TIS GAP -) optBonzElements (- GAP TIS TIS -)
# bonz5d ::= wideBonz5d
sub checkBonz5d {
    my ( $policy, $node ) = @_;
    my $instance = $policy->{lint};

    my ($initialTis1, undef, $gap, $bonzElements, $tistisGap, $finalTistis) = @{$node->{children}};
    return [] if not defined $gap;
    my $runeName = 'sigcen';
    my ( $parentLine, $parentColumn ) = $instance->nodeLC($node);
    my ( $elementsLine, $elementsColumn ) = $instance->nodeLC($bonzElements);
    my ( $tistisLine, $tistisColumn ) = $instance->nodeLC($finalTistis);
    my $anchorColumn = $parentColumn;
    my $expectedElementsColumn = $anchorColumn + 2;

    my @mistakes = ();
    push @mistakes,
      @{
        $policy->checkOneLineGap(
            $gap,
            {
                mainColumn => $anchorColumn,
                preColumn => $elementsColumn,
                runeName        => $runeName,
                subpolicy => [ $runeName, 'formulas-initial-vgap' ],
            }
        )
      };

    if ( $expectedElementsColumn != $elementsColumn ) {

        my $msg = sprintf 'formula %s; %s',
          describeLC( $elementsLine, $elementsColumn ),
          describeMisindent2( $elementsColumn, $expectedElementsColumn );
        push @mistakes,
          {
            desc         => $msg,
            subpolicy    => [ $runeName, 'formula-body-indent' ],
            parentLine   => $parentLine,
            parentColumn => $parentColumn,
            line         => $elementsLine,
            column       => $elementsColumn,
            reportLine   => $elementsLine,
            reportColumn => $elementsColumn,
          };
    }

    push @mistakes,
      @{
        $policy->checkOneLineGap(
            $tistisGap,
            {
                mainColumn => $anchorColumn,
                preColumn => $elementsColumn,
                runeName        => $runeName,
                subpolicy => [ $runeName, 'formulas-final-gap' ],
                topicLines => [$tistisLine],
            }
        )
      };

    push @mistakes,
      @{
        $policy->checkTistis(
            $finalTistis,
            {
                expectedColumn => $anchorColumn,
                tag            => $runeName,
                subpolicy => [ $runeName, 'formulas-final-tistis' ],
            }
        )
      };

  return \@mistakes;

}

# optBonzElements ::= bonzElement* separator=>GAP proper=>1
# bonzElement ::= CEN SYM4K (- GAP -) tall5d
sub checkBonzElements {
    my ( $policy, $node ) = @_;
    my $children = $node->{children};
    my @nodesToAlign = ();
    for (my $childIX = 0; $childIX <= $#$children; $childIX += 2) {
        my $element = $children->[$childIX];
        my ($cen, $sym, $gap, $body) = @{ $element->{children} };
        push @nodesToAlign, $gap, $body;
    }
    my $alignmentData = $policy->findAlignment( \@nodesToAlign );
    $policy->setInheritedAttribute($node, 'formulaAlignmentData', $alignmentData);
    return $policy->checkSeq( $node, 'sigcen-formula' );
}

sub checkBonzElement {
    my ( $policy, $node ) = @_;
    my $instance = $policy->{lint};

    # bonzElement ::= CEN SYM4K (- GAP -) tall5d
    my ( $bodyGap, $body ) = @{ $policy->gapSeq0($node) };

    my ( $parentLine, $parentColumn ) = $instance->nodeLC($node);
    my ( $bodyLine,   $bodyColumn )   = $instance->nodeLC($body);

    my $alignmentData = $policy->getInheritedAttribute($node, 'formulaAlignmentData');
    my $bodyAlignmentColumn = @{$alignmentData};

    my @mistakes = ();
    my $runeName      = 'sigcen';

  BODY_ISSUES: {
        if ( $parentLine != $bodyLine ) {
            my $msg = sprintf 'formula body %s; must be on rune line',
              describeLC( $bodyLine, $bodyColumn );
            push @mistakes,
              {
                desc         => $msg,
                subpolicy => [ $runeName, 'formula-split' ],
                parentLine   => $parentLine,
                parentColumn => $parentColumn,
                line         => $bodyLine,
                column       => $bodyColumn,
                reportLine   => $bodyLine,
                reportColumn => $bodyColumn,
              };
            last BODY_ISSUES;
        }

        # If here, bodyLine == parentLine
        last BODY_ISSUES if $bodyColumn = $bodyAlignmentColumn;
        my $gapLiteral = $instance->literalNode($bodyGap);
        my $gapLength  = $bodyGap->{length};
        last BODY_ISSUES if $gapLength == 2;
        my ( undef, $bodyGapColumn ) = $instance->nodeLC($bodyGap);

        my $msg = sprintf 'formula body %s; %s',
          describeLC( $bodyLine, $bodyColumn ),
          describeMisindent2( $gapLength, 2 );
        push @mistakes,
          {
            desc         => $msg,
            subpolicy => [ $runeName, 'formula-body-indent' ],
            parentLine   => $parentLine,
            parentColumn => $parentColumn,
            line         => $bodyLine,
            column       => $bodyColumn,
            reportLine   => $bodyLine,
            reportColumn => $bodyColumn,
          };
    }

    return \@mistakes;
}

# assumes this is a <tallAttributes> node
sub sailAttributeBodyAlignment {
    my ( $policy, $node ) = @_;
    my $instance = $policy->{lint};
    my $children = $node->{children};
    my $firstBodyColumn;
    my %firstLine       = ();
    my %bodyColumnCount = ();
    my @nodesToAlign = ();

    # Traverse first to last to make it easy to record
    # first line of occurrence of each body column
  CHILD:
    for ( my $childIX = $#$children ; $childIX >= 0 ; $childIX-- ) {
        my $attribute = $children->[$childIX];
        my ( undef, $head, $gap, $body ) = @{ $policy->gapSeq0($attribute) };
        my ( $headLine, $headColumn ) = $instance->nodeLC($head);
        my ( $bodyLine, $bodyColumn ) = $instance->nodeLC($body);
        next CHILD if $headLine != $bodyLine;
        push @nodesToAlign, $gap, $body;
    }
    return $policy->findAlignment( \@nodesToAlign );
}

sub checkSailAttribute {
    my ( $policy, $node ) = @_;
    my $instance = $policy->{lint};

    my ( $headGap, $head, $bodyGap, $body ) = @{ $policy->gapSeq0($node) };

    my ( $headLine, $headColumn ) = $instance->nodeLC($head);
    my ( $bodyLine, $bodyColumn ) = $instance->nodeLC($body);

    my $sailApex = $instance->ancestorByLHS( $node, { sailApex5d => 1 } );
    my ( $sailApexLine, $sailApexColumn ) = $instance->nodeLC($sailApex);
    my $attributes = $instance->ancestorByLHS( $node, { tallAttributes => 1 } );
    my $expectedHeadColumn = $sailApexColumn + 4;
    my ($expectedBodyColumn, $expectBodyColumnDetails) = @{$policy->sailAttributeBodyAlignment($attributes)};

    my @mistakes = ();

    # Not really a rune name
    my $runeName      = 'sail';

    # We deal with the elements list in its own node

    push @mistakes,
      @{