root/lang/perl/Text-Nyarlax/trunk/lib/Text/Nyarlax/Parser/PRD.pm @ 295

Revision 295, 17.6 kB (checked in by nyarla, 6 years ago)

lang/perl/Text-Nyarlax: I deleted grammatical waste about rule Content.

Line 
1package Text::Nyarlax::Parser::PRD;
2
3use strict;
4use warnings;
5
6use Parse::RecDescent;
7use List::MoreUtils qw( uniq );
8use base qw( Text::Nyarlax::Parser );
9
10our $VERSION = '0.1';
11
12__PACKAGE__->mk_classdata( 'engine' );
13
14our %bracket = (
15    Quote           =>  [qw(  " "  )],
16    Citation        =>  [qw( >> << )],
17    Notes           =>  ['(((',')))'],
18    Comparison      =>  [qw( // // )],
19    Emphasis        =>  [qw( ** ** )],
20    Definition      =>  [qw( ?? ?? )],
21    SubScript       =>  [qw( __ __ )],
22    SuperScript     =>  [qw( ~~ ~~ )],
23    Inserted        =>  [qw( ++ ++ )],
24    Deleted         =>  [qw( -- -- )],
25    InputText       =>  [qw( [| |] )],
26    InputCommand    =>  [qw( [$ $] )],
27    Keyboard        =>  [qw( <[ ]> )],
28    Sample          =>  [qw( [! !] )],
29    Code            =>  [qw(  ` `  )],
30    Abbreviation    =>  [  '((','))'],
31    Acronym         =>  [  '((','))'],
32    Ruby            =>  [  '((','))'],
33    Variable        =>  [qw(  { }  )],
34    Embedding       =>  [qw( {{ }} )],
35    HyperLink       =>  [qw( [[ ]] )],
36);
37
38our $exclude_re;
39our $text_re;
40
41{
42    my @exclude = ();
43    for my $def ( values %bracket ) {
44        for ( @{ $def } ) {
45            $_ = quotemeta( $_ );
46            push @exclude, $_;
47        }
48    }
49    $exclude_re = join q{|}, ( @exclude, quotemeta( '\\' ) );
50    $text_re = qr{(?: (?! $exclude_re ) [^\n] )+}x;
51}
52
53our %variable = (
54    '$' => 'string',
55    '#' => 'number',
56    '?' => 'boolean',
57    ':' => 'reference',
58    '*' => 'pointer',
59    '&' => 'function',
60    '@' => 'array',
61    '%' => 'hash',
62    '=' => 'structure',
63    '+' => 'object',
64    '!' => 'class',
65);
66
67our $variable_re;
68{
69    my @symbols = ();
70    for my $symbol ( keys %variable ) {
71        push @symbols, quotemeta( $symbol );
72    }
73    $variable_re = join q{}, @symbols;
74    $variable_re = qr{[$variable_re]};
75}
76
77our $grammer = <<'__GRAMMER__';
78    {
79        use Text::Nyarlax::Element qw( element );
80        use Text::Nyarlax::Util qw( :all );
81        use Regexp::Common qw( URI );
82    }
83    parse               :   <rulevar: local %bracket    = %Text::Nyarlax::Parser::PRD::bracket      >
84                            <rulevar: local $text_re    = $Text::Nyarlax::Parser::PRD::text_re      >
85                            <rulevar: local $exclude_re = $Text::Nyarlax::Parser::PRD::exclude_re   >
86                            <rulevar: local %variable   = %Text::Nyarlax::Parser::PRD::variable     >
87                            <rulevar: local $variable_re= $Text::Nyarlax::Parser::PRD::variable_re  >
88                            <rulevar: local $h_level    = 1                                         >
89
90    parse               :   <skip: ''> Root
91                        { $return = $item{'Root'} }
92
93    Root                :   /\n*/ Content(s)
94                        {
95                            my $tree = $item{'Content(s)'};
96                               $tree = join_node( $tree, element => 'Section' );
97                            $return = $tree;
98                        }
99
100    Content             :   Section
101                        |   List[ marker => quotemeta( '*' ), name => 'UnorderedList', indent => 0 ]
102                        |   List[ marker => quotemeta( '#' ), name => 'OrderedList', indent => 0 ]
103                        |   DefinitionList[ indent => 0 ]
104                        |   BlockQuote
105                        |   BlockNotes
106                        |   Paragraph
107
108    Section             :   Heading Root(?)
109                        {
110                            $h_level--;
111                            my $elm = element( $item[0] );
112                            $elm->push_content( $item{'Heading'}, @{ flatten($item{'Root(?)'}) } );
113                            $return = $elm;
114                        }
115
116    Heading             :   <rulevar: local $text_re = qr{(?: (?! $exclude_re ) [^\n=] )+}x >
117    Heading             :   /[=]{$h_level}/ InlineNode(s) "$item[1]" Blank Identifier(?) Blank /\n*/
118                        {
119                            $h_level++;
120                            my $elm = element( $item[0] );
121
122                            my @text = @{ $item{'InlineNode(s)'} };
123                            $text[0] =~ s{^[ \t]*}{}g       if ( ! ref $text[0] );
124                            $text[$#text] =~ s{[ \t]*$}{}g  if ( ! ref $text[$#text] );
125                            $elm->push_content( @text );
126
127                            $elm->attr->{'id'} = $item{'Identifier(?)'}->[0]
128                                if ( $item{'Identifier(?)'}->[0] );
129
130                            $return = $elm;
131                        }
132
133    List                :   ListItem[ marker => $arg{'marker'}, indent => $arg{'indent'} ](s)
134                        {
135                            my $elm = element( $arg{'name'} );
136                            $elm->push_content( @{ $item{'ListItem(s)'} } );
137                            $return = $elm;
138                        }
139
140    ListItem            :   /[ \t]{$arg{'indent'}} $arg{'marker'} [ \t]*/x ListContent[ indent => $arg{'indent'} ]
141                            {
142                                my $elm = element( $item[0] );
143                                $elm->push_content( @{ $item{'ListContent'} } );
144                                $elm->join_content( text => "\n" );
145                                $return = $elm;
146                            }
147
148    ListContent         :  ListConetntFirst[ indent => $arg{'indent'} ] ListChild[ indent => $arg{'indent'} ](s?)
149                        {
150                            $return = [
151                                @{ $item{'ListConetntFirst'} },
152                                @{ flatten($item{'ListChild(s?)'}) },
153                            ];
154                        }
155
156    ListConetntFirst    :   />>/ parse / [ \t]{$arg{'indent'}} [ \t]{2} << \n /x
157                            { $return = $item{'parse'} }
158                        |   InlineNode(s?) /\n/
159                            { $return = $item{'InlineNode(s?)'} }
160   
161
162    ListChild           :   List[ marker => quotemeta( '*' ), name => 'UnorderedList', indent => $arg{'indent'} + 2 ]
163                        |   List[ marker => quotemeta( '#' ), name => 'OrderedList', indent => $arg{'indent'} + 2 ]
164                        |   DefinitionList[ indent => $arg{'indent'} + 2 ]
165                        |   ListChildText[ indent => $arg{'indent'} ]
166
167    ListChildText       :   /[ \t]{$arg{'indent'}} [ \t]{2,}/x InlineNode(s) /\n/
168                            { $return = [ @{ $item{'InlineNode(s)'} }, "" ] }
169
170    DefinitionList      :   DefinitionItem[ indent => $arg{'indent'} ](s)
171                        {
172                            my $elm = element( $item[0] );
173                            $elm->push_content( @{ $item{'DefinitionItem(s)'} } );
174                            $return = $elm;
175                        }
176
177    DefinitionItem      :   DefinitionTerm[ indent => $arg{'indent'} ] DefinitionDescription[ indent => $arg{'indent'} ](s?)
178                        {
179                            my $elm = element( $item[0] );
180                            $elm->push_content( $item{'DefinitionTerm'}, @{ $item{'DefinitionDescription(s?)'} } );
181                            $return = $elm;
182                        }
183
184    DefinitionTerm      :   /[ \t]{$arg{'indent'}} [?][ \t]*/x InlineNode(s?) /\n/ ListChildText[ indent => $arg{'indent'} ](s?)
185                        {
186                            my $elm = element( $item[0] );
187                            $elm->push_content( @{ $item{'InlineNode(s?)'} }, @{ flatten($item{'ListChildText(s?)'}) } );
188                            $elm->join_content( text => "\n" );
189                            $return = $elm;
190                        }
191
192    DefinitionDescription:  /[ \t]{$arg{'indent'}} [:][ \t]*/x ListContent[ indent => $arg{'indent'} ]
193                        {
194                            my $elm = element( $item[0] );
195                            $elm->push_content( @{ $item{'ListContent'} } );
196                            $elm->join_content( text => "\n" );
197                            $return = $elm;
198                        }
199
200    BlockQuote          :   />>>/ Blank Text(?) Blank /\n/
201                                Root
202                            /<<</ Blank URI(?) Blank /\n/
203                        {
204                            my $elm = element( $item[0] );
205                            $elm->push_content( @{ $item{'Root'} } );
206                            $elm->attr->{'title'} = $item{'Text(?)'}->[0] if ( $item{'Text(?)'}->[0] );
207                            $elm->attr->{'cite'}  = $item{'URI(?)'}->[0]  if ( $item{'URI(?)'}->[0] );
208                            $return = $elm;
209                        }
210
211    BlockNotes          :   /[(]{3}\n/ Root /[)]{3}\n/
212                        {
213                            my $elm = element( $item[0] );
214                            $elm->push_content( @{ $item{'Root'} } );
215                            $return = $elm;
216                        }
217
218    # Paragraph
219    Paragraph           :   Line(s)
220                        {
221                            my $elm = element($item[0]);
222                            $elm->push_content( @{ $item{'Line(s)'} } );
223                            $return = $elm;
224                        }
225
226    Line                :   OneLine(s) /\n*/
227                        {
228                            my $elm = element($item[0]);
229                            $elm->push_content( @{ flatten( $item{'OneLine(s)'} ) } );
230                            $elm->join_content( text => q{} );
231                            $return = $elm;
232                        }
233
234    OneLine             :   ...!/[=]/ InlineNode(s) /\n/
235                        {
236                            $return = [ @{ $item{'InlineNode(s)'} }, "\n" ];
237                        }
238    InlineNode          :   PlainText
239                        |   HyperLink
240                        |   InlineElement[ name => 'Quote' ]
241                        |   InlineElement[ name => 'Citation' ]
242                        |   InlineElement[ name => 'Notes' ]
243                        |   InlineElement[ name => 'Comparison' ]
244                        |   InlineElement[ name => 'Emphasis' ]
245                        |   InlineElement[ name => 'Definition' ]
246                        |   InlineElement[ name => 'SubScript' ]
247                        |   InlineElement[ name => 'SuperScript' ]
248                        |   InlineElement[ name => 'Inserted' ]
249                        |   InlineElement[ name => 'Deleted' ]
250                        |   Abbreviation[ name => 'Acronym', sep => quotemeta( ':=' ) ]
251                        |   Abbreviation[ name => 'Abbreviation', sep => quotemeta( '=' ) ]
252                        |   Ruby
253                        |   InlineElement[ name => 'InputText' ]
254                        |   InlineCodeElement[ name => 'InputCommand' ]
255                        |   InlineCodeElement[ name => 'Keyboard' ]
256                        |   InlineCodeElement[ name => 'Sample' ]
257                        |   InlineCodeElement[ name => 'Code' ]
258                        |   Embedding
259                        |   Variable
260
261    InlineElement       :   <rulevar: local $text_re = $Text::Nyarlax::Parser::PRD::text_re >
262    InlineElement       :   /$bracket{$arg{'name'}}->[0]/ InlineNode(s) /$bracket{$arg{'name'}}->[1]/
263                        {
264                            my $elm = element( $arg{'name'} );
265                            $elm->push_content( @{ $item{'InlineNode(s)'} } );
266                            $return = $elm;
267                        }
268
269    InlineCodeElement   :   m{
270                            $bracket{$arg{'name'}}->[0]
271                                ( (?: (?! $bracket{$arg{'name'}}->[1] ) [^\n] )+ )
272                            $bracket{$arg{'name'}}->[1]
273                            }x
274                        {
275                            my $elm = element( $arg{'name'} );
276                            $elm->push_content( $1 );
277                            $return = $elm;
278                        }
279
280    Abbreviation        :   <rulevar: local $text_re = qr{(?: (?! $exclude_re | $arg{'sep'} ) [^\n] )+}x >
281    Abbreviation        :   /$bracket{$arg{'name'}}->[0]/
282                                InlineNode(s) /$arg{'sep'}/ /(?:(?!$bracket{$arg{'name'}}->[1])[^\n])+/
283                            /$bracket{$arg{'name'}}->[1]/
284                        {
285                            my $elm = element( $arg{'name'} );
286                            $elm->push_content( @{ $item{'InlineNode(s)'} } );
287                            $elm->attribute->{'title'} = $item[4];
288                            $return = $elm;
289                        }
290
291    Ruby                :   /$bracket{$item[0]}->[0]/
292                                RubyItem[ name => 'RubyBase', end => '>' ]
293                                RubyItem[ name => 'RubyText', end => '>' ](s)
294                            /$bracket{$item[0]}->[1]/
295                            {
296                                my $elm = element( $item[0] );
297                                $elm->push_content( $item{'RubyItem'}, @{ $item{'RubyItem(s)'} } );
298                                $return = $elm;
299                            }
300
301    RubyItem            :   <rulevar: local $text_re = qr{(?: (?! $exclude_re | [|] | $arg{'end'} ) [^\n] )+}x >
302    RubyItem            :   /</ <leftop: PlainText(s) '|' PlainText(s) > />/
303                            {
304                                my $elm = element( $arg{'name'} );
305                                $elm->push_content( @{ flatten( $item[2] ) } );
306                                $return = $elm;
307                            }
308
309    Variable            :  m{
310                            $bracket{$item[0]}->[0]
311                                ($variable_re)
312                                    [ \t]+
313                                        ( (?: (?! \1 $bracket{$item[0]}->[1] ) [^\n])+ )
314                                    [ \t]+
315                                \1
316                            $bracket{$item[0]}->[1]
317                            }x
318                        {
319                            my $elm = element( $item[0] );
320                            $elm->attr->{'type'} = $variable{$1};
321                            $elm->push_content( $2 );
322                            $return = $elm;
323                        }
324                        |  m{
325                            $bracket{$item[0]}->[0]
326                                ([^:]+)
327                                    [:]
328                                ( (?: (?! $bracket{$item[0]}->[1] ) [^\n] )+ )
329                            $bracket{$item[0]}->[1]
330                        }x
331                        {
332                            my $elm = element( $item[0] );
333                            $elm->attr->{'type'} = $1;
334                            $elm->push_content( $2 );
335                            $return = $elm;
336                        }
337
338    Embedding           :  m{
339                            $bracket{$item[0]}->[0]
340                                ([a-zA-Z0-9]+)
341                                (?: [:] [\n]?
342                                    ( (?: (?! $bracket{$item[0]}->[1] ) [\s\S])+ )
343                                )?
344                            $bracket{$item[0]}->[1]
345                            }x
346                            {
347                                my $elm = element( $item[0] );
348                                $elm->attr->{'require'} = $1;
349                                $elm->push_content( $2 ) if ( $2 );
350                                $return = $elm;
351                            }
352
353    HyperLink           :   /$bracket{$item[0]}->[0]/
354                                HyperLinkTitle(?) HyperLinkRef
355                            /$bracket{$item[0]}->[1]/
356                            {
357                                my $elm = element($item[0]);
358                                my ( $wikiname, $link ) = @{ $item{'HyperLinkRef'} }{qw( wikiname link )};
359                                my $title = $item{'HyperLinkTitle(?)'}->[0];
360                                   $title ||= ( $wikiname ) ? "$wikiname:$link" : $link;
361                                $elm->push_content( $title );
362                                $elm->attr->{'link'} = $link;
363                                $elm->attr->{'wikiname'} = $wikiname if ( $wikiname );
364                                $return = $elm;
365                            }
366
367    HyperLinkTitle      :  m{ ([^|]+?) [|] }x
368                            { $return = $1 }
369
370    HyperLinkRef        :  m{ ([^\[]+?) \[ ([^\]]+?) \] }x
371                            { $return = { wikiname => $1, link => $2 } }
372                        |  m{
373                                $RE{'URI'}
374                              | (?: (?! $bracket{'HyperLink'}->[1] ) [^\n] )+
375                            }x
376                            { $return = { link => $item[1] } }
377
378    PlainText           :  m{[\\]{3} ( (?:(?![\\]{3}).)+ ) [\\]{3}}x
379                            { $return = $1 }
380                        |  m{[\\](.)}
381                            { $return = $1 }
382                        |  m{$text_re}
383
384    # Token
385    Text                :   /[^\n]+/
386    Blank               :   /[ \t]*/
387    Identifier          :   /[a-zA-Z]+/
388    URI                 :   /$RE{'URI'}/
389__GRAMMER__
390
391__PACKAGE__->engine( Parse::RecDescent->new( $grammer ) );
392
393sub init {
394    my ( $self, $conf ) = @_;
395}
396
397sub parse {
398    my ( $self, $text ) = @_;
399    $text .= "\n" if ( $text !~ m{\n$} );
400    return $self->engine->parse( $text );
401}
402
4031;
404__END__
Note: See TracBrowser for help on using the browser.