Skip to content

Commit e0ec0eb

Browse files
MouqMouq
committed
Code clean-up
1 parent c08160a commit e0ec0eb

File tree

2 files changed

+159
-134
lines changed

2 files changed

+159
-134
lines changed

‎htmlify.p6

Lines changed: 47 additions & 134 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ use lib 'lib';
1111
use Perl6::TypeGraph;
1212
use Perl6::TypeGraph::Viz;
1313
use Perl6::Documentable::Registry;
14+
use Pod::Convenience;
1415

1516
my $*DEBUG = False;
1617

@@ -78,36 +79,6 @@ sub p2h($pod, $selection = 'nothing selected') {
7879
pod2html($pod, :url(&url-munge), :$head, :header(header-html $selection), :$footer);
7980
}
8081

81-
sub pod-gist(Pod::Block $pod, $level = 0) {
82-
my $leading = ' ' x $level;
83-
my %confs;
84-
my @chunks;
85-
for <config name level caption type> {
86-
my $thing = $pod.?"$_"();
87-
if $thing {
88-
%confs{$_} = $thing ~~ Iterable ?? $thing.perl !! $thing.Str;
89-
}
90-
}
91-
@chunks = $leading, $pod.^name, (%confs.perl if %confs), "\n";
92-
for $pod.content.list -> $c {
93-
if $c ~~ Pod::Block {
94-
@chunks.push: pod-gist($c, $level + 2);
95-
}
96-
elsif $c ~~ Str {
97-
@chunks.push: $c.indent($level + 2), "\n";
98-
} elsif $c ~~ Positional {
99-
@chunks.push: $c.map: {
100-
if $_ ~~ Pod::Block {
101-
*.&pod-gist
102-
} elsif $_ ~~ Str {
103-
$_
104-
}
105-
}
106-
}
107-
}
108-
@chunks.join;
109-
}
110-
11182
sub recursive-dir($dir) {
11283
my @todo = $dir;
11384
gather while @todo {
@@ -123,13 +94,6 @@ sub recursive-dir($dir) {
12394
}
12495
}
12596

126-
sub first-code-block(@pod) {
127-
if @pod[1] ~~ Pod::Block::Code {
128-
return @pod[1].content.grep(Str).join;
129-
}
130-
'';
131-
}
132-
13397
sub MAIN(Bool :$debug, Bool :$typegraph = False) {
13498
$*DEBUG = $debug;
13599

@@ -182,7 +146,7 @@ sub process-pod-dir($dir, :$dr, :&sorted-by = &[cmp]) {
182146
my $total = +@pod-sources;
183147
my $what = $dir.lc;
184148
for @pod-sources.kv -> $num, (:key($podname), :value($file)) {
185-
printf "% 4d/%d: % -40s => %s\n", $num, $total, $file.path, "$what/$podname";
149+
printf "% 4d/%d: % -40s => %s\n", $num+1, $total, $file.path, "$what/$podname";
186150
my $pod = EVAL(slurp($file.path) ~ "\n\$=pod")[0];
187151
process-pod-source $what, :$dr, :what($what), :$pod, :$podname;
188152
}
@@ -340,73 +304,6 @@ sub find-definitions (:$pod, :$origin, :$dr) {
340304
}
341305
}
342306

343-
sub chunks-grep(:$from!, :&to!, *@elems) {
344-
my @current;
345-
346-
gather {
347-
for @elems -> $c {
348-
if @current && ($c ~~ $from || to(@current[0], $c)) {
349-
take [@current];
350-
@current = ();
351-
@current.push: $c if $c ~~ $from;
352-
}
353-
elsif @current or $c ~~ $from {
354-
@current.push: $c;
355-
}
356-
}
357-
take [@current] if @current;
358-
}
359-
}
360-
361-
sub pod-with-title($title, *@blocks) {
362-
Pod::Block::Named.new(
363-
name => "pod",
364-
content => [
365-
Pod::Block::Named.new(
366-
name => "TITLE",
367-
content => Array.new(
368-
Pod::Block::Para.new(
369-
content => [$title],
370-
)
371-
)
372-
),
373-
@blocks.flat,
374-
]
375-
);
376-
}
377-
378-
sub pod-block(*@content) {
379-
Pod::Block::Para.new(:@content);
380-
}
381-
382-
sub pod-link($text, $url) {
383-
Pod::FormattingCode.new(
384-
type => 'L',
385-
content => [$text],
386-
meta => [$url],
387-
);
388-
}
389-
390-
sub pod-item(*@content, :$level = 1) {
391-
Pod::Item.new(
392-
:$level,
393-
:@content,
394-
);
395-
}
396-
397-
sub pod-heading($name, :$level = 1) {
398-
Pod::Heading.new(
399-
:$level,
400-
:content[pod-block($name)],
401-
);
402-
}
403-
404-
sub pod-table(@content) {
405-
Pod::Block::Table.new(
406-
:@content
407-
)
408-
}
409-
410307
sub write-type-graph-images(:$force) {
411308
unless $force {
412309
my $dest = 'html/images/type-graph-Any.svg'.path;
@@ -564,40 +461,56 @@ sub write-index-files($dr) {
564461
})
565462
), 'language');
566463

567-
sub list-of-all($what) {
568-
pod-block 'This is a list of ', Pod::FormattingCode.new(:type<B>:content['all']),
569-
" built-in {$what}s that are documented here as part of the the Perl 6 language. ",
570-
"Use the above menu to narrow it down topically."
571-
}
464+
write-main-index :$dr :kind<type>;
572465

573-
sub write-main-index($kind) {
574-
say "Writing html/$kind.html ...";
575-
spurt "html/$kind.html", p2h(pod-with-title(
576-
"Perl 6 {$kind.tc}s",
577-
list-of-all($kind),
578-
pod-table($dr.lookup($kind, :by<kind>).categorize(*.name).sort(*.key)>>.value.map({
579-
[set(.map: {.subkinds // Nil}).list.join(', '), pod-link(.[0].name, .[0].url), .[0].summary]
580-
}))
581-
), $kind);
466+
my &summary = {
467+
pod-block("(From ", $_>>.origin.map({
468+
pod-link(.name, .url),", "
469+
}),")")
582470
}
583471

584-
# XXX: Only handles normal routines, not types nor operators
585-
sub write-sub-index($kind, $category) {
586-
say "Writing html/$kind-$category.html ...";
587-
spurt "html/$kind-$category.html", p2h(pod-with-title(
588-
"Perl 6 {$category.tc} {$kind.tc}s",
589-
pod-table($dr.lookup($kind, :by<kind>)\
590-
.grep({$category ⊆ .categories})\ # XXX
591-
.categorize(*.name).sort(*.key)>>.value\
592-
.map({
593-
[set(.map: {.subkinds // Nil}).list.join(', '), pod-link(.[0].name, .[0].url), .[0].summary]
594-
})
595-
)
596-
), $kind);
472+
write-main-index :$dr :kind<routine> :&summary;
473+
474+
for <sub method term operator> -> $category {
475+
write-sub-index :$dr :kind<routine> :$category :&summary;
597476
}
477+
}
478+
479+
sub write-main-index(:$dr, :$kind, :&summary = {Nil}) {
480+
say "Writing html/$kind.html ...";
481+
spurt "html/$kind.html", p2h(pod-with-title(
482+
"Perl 6 {$kind.tc}s",
483+
pod-block(
484+
'This is a list of ', pod-bold('all'), ' built-in ' ~ $kind.tc ~
485+
"s that are documented here as part of the the Perl 6 language. " ~
486+
"Use the above menu to narrow it down topically."
487+
),
488+
pod-table($dr.lookup($kind, :by<kind>)\
489+
.categorize(*.name).sort(*.key)>>.value\
490+
.map({[
491+
set(.map: {.subkinds // Nil}).list.join(', '),
492+
pod-link(.[0].name, .[0].url),
493+
.&summary
494+
]})
495+
)
496+
), $kind);
497+
}
598498

599-
.&write-main-index for <type routine>;
600-
write-sub-index 'routine', $_ for <sub method term operator>;
499+
# XXX: Only handles normal routines, not types nor operators
500+
sub write-sub-index(:$dr, :$kind, :$category, :&summary = {Nil}) {
501+
say "Writing html/$kind-$category.html ...";
502+
spurt "html/$kind-$category.html", p2h(pod-with-title(
503+
"Perl 6 {$category.tc} {$kind.tc}s",
504+
pod-table($dr.lookup($kind, :by<kind>)\
505+
.grep({$category ⊆ .categories})\ # XXX
506+
.categorize(*.name).sort(*.key)>>.value\
507+
.map({[
508+
set(.map: {.subkinds // Nil}).list.join(', '),
509+
pod-link(.[0].name, .[0].url),
510+
.&summary
511+
]})
512+
)
513+
), $kind);
601514
}
602515

603516
sub write-routine-file($dr, $name) {

‎lib/Pod/Convenience.pm6

Lines changed: 112 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,112 @@
1+
module Pod::Convenience;
2+
3+
sub pod-gist(Pod::Block $pod, $level = 0) is export {
4+
my $leading = ' ' x $level;
5+
my %confs;
6+
my @chunks;
7+
for <config name level caption type> {
8+
my $thing = $pod.?"$_"();
9+
if $thing {
10+
%confs{$_} = $thing ~~ Iterable ?? $thing.perl !! $thing.Str;
11+
}
12+
}
13+
@chunks = $leading, $pod.^name, (%confs.perl if %confs), "\n";
14+
for $pod.content.list -> $c {
15+
if $c ~~ Pod::Block {
16+
@chunks.push: pod-gist($c, $level + 2);
17+
}
18+
elsif $c ~~ Str {
19+
@chunks.push: $c.indent($level + 2), "\n";
20+
} elsif $c ~~ Positional {
21+
@chunks.push: $c.map: {
22+
if $_ ~~ Pod::Block {
23+
*.&pod-gist
24+
} elsif $_ ~~ Str {
25+
$_
26+
}
27+
}
28+
}
29+
}
30+
@chunks.join;
31+
}
32+
33+
sub first-code-block(@pod) is export {
34+
if @pod[1] ~~ Pod::Block::Code {
35+
return @pod[1].content.grep(Str).join;
36+
}
37+
'';
38+
}
39+
40+
sub chunks-grep(:$from!, :&to!, *@elems) is export {
41+
my @current;
42+
43+
gather {
44+
for @elems -> $c {
45+
if @current && ($c ~~ $from || to(@current[0], $c)) {
46+
take [@current];
47+
@current = ();
48+
@current.push: $c if $c ~~ $from;
49+
}
50+
elsif @current or $c ~~ $from {
51+
@current.push: $c;
52+
}
53+
}
54+
take [@current] if @current;
55+
}
56+
}
57+
58+
sub pod-with-title($title, *@blocks) is export {
59+
Pod::Block::Named.new(
60+
name => "pod",
61+
content => [
62+
Pod::Block::Named.new(
63+
name => "TITLE",
64+
content => Array.new(
65+
Pod::Block::Para.new(
66+
content => [$title],
67+
)
68+
)
69+
),
70+
@blocks.flat,
71+
]
72+
);
73+
}
74+
75+
sub pod-block(*@content) is export {
76+
Pod::Block::Para.new(:@content);
77+
}
78+
79+
sub pod-link($text, $url) is export {
80+
Pod::FormattingCode.new(
81+
type => 'L',
82+
content => [$text],
83+
meta => [$url],
84+
);
85+
}
86+
87+
sub pod-bold($text) is export {
88+
Pod::FormattingCode.new(
89+
type => 'B',
90+
content => [$text],
91+
);
92+
}
93+
94+
sub pod-item(*@content, :$level = 1) is export {
95+
Pod::Item.new(
96+
:$level,
97+
:@content,
98+
);
99+
}
100+
101+
sub pod-heading($name, :$level = 1) is export {
102+
Pod::Heading.new(
103+
:$level,
104+
:content[pod-block($name)],
105+
);
106+
}
107+
108+
sub pod-table(@content) is export {
109+
Pod::Block::Table.new(
110+
:@content
111+
)
112+
}

0 commit comments

Comments
 (0)