Files
devops/perl/Examples/Chap8/outline-parser
2025-09-17 16:08:16 +08:00

73 lines
1.7 KiB
Plaintext

###
### outline-parser
###
## Chapter 8 section 6
use Lexer ':all';
use Stream 'node';
my ($tree, $subtree);
sub outline_to_array {
my @input = @_;
my $input = sub { shift @input };
my $lexer = iterator_to_stream(
make_lexer($input,
['ITEM', qr/^.*$/m ],
['NEWLINE', qr/\n+/ , sub { "" } ],
)
);
my ($result) = $tree->($lexer);
return $result;
}
## Chapter 8 section 6
use Parser ':all';
use Stream 'head';
my $Tree = parser { $tree->(@_) };
my $Subtree = parser { $subtree->(@_) };
my $LEVEL = 0;
$tree = concatenate(lookfor('ITEM', sub { trim($_[0][1]) }),
action(sub { $LEVEL++ }),
star($Subtree),
action(sub { $LEVEL-- }));
my $BULLET = '[#*ox.+-]\s+';
sub trim {
my $s = shift;
$s =~ s/^ *//;
$s =~ s/^$BULLET//o;
return $s;
}
## Chapter 8 section 6
$tree = T(concatenate(lookfor('ITEM', sub { trim($_[0][1]) }),
action(sub { $LEVEL++; return 1; }),
star($Subtree),
action(sub { $LEVEL--; return 1; })),
sub { [ $_[0], @{$_[2]} ] });
$subtree = T(concatenate(test(sub {
my $input = shift;
return unless $input;
my $next = head($input);
return unless $next->[0] eq 'ITEM';
return level_of($next->[1]) >= $LEVEL;
}),
$Tree,
),
sub { $_[1] });
sub level_of {
my ($space) = $_[0] =~ /^( *)/;
return length($space)/2;
}