Skip to content

Commit ca73df5

Browse files
autarchautarch
committed
Work in progress on rewriting site generation to use my new Pod::To::HTML
1 parent 440fa4c commit ca73df5

File tree

10 files changed

+339
-53
lines changed

10 files changed

+339
-53
lines changed

‎generate-site.p6‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
use v6;
2+
3+
use lib 'lib', '../Pod-To-HTML/lib/', '../Pod-NodeWalker/lib/';
4+
use DocSite::Generator;
5+
6+
sub MAIN (
7+
Bool :$overwrite-typegraph = False,
8+
Bool :$disambiguation = True,
9+
Bool :$search-file = True,
10+
Bool :$highlight = True,
11+
Bool :$inline-python = True,
12+
Bool :$verbose = True,
13+
Int :$sparse = 0,
14+
Int :$threads = 8,
15+
Str :$root = $*SPEC.catdir( $*CWD )
16+
) {
17+
DocSite::Generator.new(
18+
:$overwrite-typegraph,
19+
:$disambiguation,
20+
:$search-file,
21+
:$highlight,
22+
:$inline-python,
23+
:$verbose,
24+
:$sparse,
25+
:$threads,
26+
:root( IO::Path.new($root) ),
27+
).run;
28+
}

‎lib/Perl6/Documentable.pm‎ renamed to ‎lib/DocSite/Document.pm‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
use URI::Escape;
2-
class Perl6::Documentable {
2+
class DocSite::Documentable {
33
has Str $.kind; # type, language doc, routine, module
44
has Str @.subkinds; # class/role/enum, sub/method, prefix/infix/...
55
has Str @.categories; # basic type, exception, operator...

‎lib/Perl6/Documentable/Registry.pm‎ renamed to ‎lib/DocSite/Document/Registry.pm‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,15 @@
11
use v6;
2-
use Perl6::Documentable;
2+
use DocSite::Document;
33

4-
class Perl6::Documentable::Registry {
4+
class DocSite::Document::Registry {
55
has @.documentables;
66
has Bool $.composed = False;
77
has %!cache;
88
has %!grouped-by;
99
has @!kinds;
1010
method add-new(*%args) {
1111
die "Cannot add something to a composed registry" if $.composed;
12-
@!documentables.append: my $d = Perl6::Documentable.new(|%args);
12+
@!documentables.append: my $d = DocSite::Document.new(|%args);
1313
$d;
1414
}
1515
method compose() {

‎lib/DocSite/Generator.pm‎

Lines changed: 242 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,242 @@
1+
unit class DocSite::Generator;
2+
3+
use lib 'lib';
4+
5+
use DocSite::Document::Registry;
6+
use DocSite::Pod::To::HTML;
7+
use DocSite::TypeGraph::Viz;
8+
use DocSite::TypeGraph;
9+
use Pod::Convenience;
10+
use Pod::Htmlify;
11+
use Term::ProgressBar;
12+
use URI::Escape;
13+
14+
has Bool $!overwrite-typegraph;
15+
has Bool $!disambiguation;
16+
has Bool $!search-file;
17+
has Bool $!highlight;
18+
has Bool $!inline-python;
19+
has Bool $!verbose;
20+
has Int $!sparse;
21+
has Int $!threads;
22+
has IO::Path $!root;
23+
24+
has DocSite::Document::Registry $!registry = DocSite::Document::Registry.new;
25+
has DocSite::TypeGraph $!type-graph;
26+
27+
my @viz-formats = (
28+
%( :format<svg> ),
29+
%( :format<png>, :size<8,3> ),
30+
);
31+
32+
method BUILD (
33+
Bool :$!overwrite-typegraph,
34+
Bool :$!disambiguation,
35+
Bool :$!search-file,
36+
Bool :$!highlight,
37+
Bool :$!inline-python,
38+
Bool :$!verbose,
39+
Int :$!sparse,
40+
Int :$!threads,
41+
IO::Path :$!root,
42+
) { }
43+
44+
method run {
45+
self!maybe-write-type-graph-images;
46+
self!process-language-pod;
47+
self!process-type-pod;
48+
}
49+
50+
method !maybe-write-type-graph-images {
51+
my $image-dir = IO::Path.new( $*SPEC.catdir( $!root, 'html', 'images' ) );
52+
my $any-svg = $*SPEC.catfile( $image-dir, 'type-graph-Any.svg' ).IO;
53+
if $any-svg ~~ :e && !$!overwrite-typegraph {
54+
self!maybe-say( qq:to/END/ );
55+
Not writing type graph images, it seems to be up-to-date. To forcibly
56+
overwrite the type graph images, supply the --overwrite-typegraph
57+
option at the command line, or delete the file
58+
$any-svg
59+
END
60+
return;
61+
}
62+
63+
my $tg-file = 'type-graph.txt';
64+
self!maybe-say: "Reading type graph from $tg-file ...";
65+
$!type-graph = DocSite::TypeGraph.new-from-file($tg-file);
66+
self!write-type-graph-images($image-dir);
67+
self!write-specialized-type-graph-images($image-dir);
68+
}
69+
70+
method !write-type-graph-images (IO::Path $image-dir) {
71+
self!maybe-say: "Writing type graph images to $image-dir {$!threads > 1 ?? qq{with $!threads threads } !! q{}}...";
72+
self!run-with-progress(
73+
$!type-graph.sorted.cache,
74+
sub ($type) { self!write-one-type( $type, $image-dir ) },
75+
);
76+
}
77+
78+
method !write-one-type (DocSite::Type $type, IO::Path $image-dir) {
79+
my $viz = DocSite::TypeGraph::Viz.new-for-type($type);
80+
for @viz-formats -> $args {
81+
my $file = $*SPEC.catfile( $image-dir, "type-graph-{$type}.{$args<format>}" );
82+
$viz.to-file( $file, |$args );
83+
}
84+
}
85+
86+
method !write-specialized-type-graph-images (IO::Path $image-dir) {
87+
self!maybe-say: "Writing specialized visualizations to $image-dir ...";
88+
my %by-group = $!type-graph.sorted.classify(&viz-group);
89+
%by-group<Exception>.append: $!type-graph.types< Exception Any Mu >;
90+
%by-group<Metamodel>.append: $!type-graph.types< Any Mu >;
91+
92+
self!run-with-progress(
93+
%by-group.pairs.cache,
94+
sub (Pair $pair) { self!write-one-type-group( $pair.key, $pair.value, $image-dir ) },
95+
);
96+
}
97+
98+
method !write-one-type-group (Str $group, Array $types, IO::Path $image-dir) {
99+
my $viz = DocSite::TypeGraph::Viz.new(
100+
:types($types),
101+
:dot-hints( viz-hints($group) ),
102+
:rank-dir<LR>,
103+
);
104+
for @viz-formats -> $args {
105+
my $file = $*SPEC.catfile( $image-dir, "type-graph-{$group}.{$args<format>}" );
106+
$viz.to-file($file, |$args);
107+
}
108+
}
109+
110+
sub viz-group ($type) {
111+
return 'Metamodel' if $type.name ~~ /^ 'Perl6::Metamodel' /;
112+
return 'Exception' if $type.name ~~ /^ 'X::' /;
113+
return 'Any';
114+
}
115+
116+
sub viz-hints ($group) {
117+
return q{} unless $group eq 'Any';
118+
119+
return Q:to/END/;
120+
subgraph "cluster: Mu children" {
121+
rank=same;
122+
style=invis;
123+
"Any";
124+
"Junction";
125+
}
126+
subgraph "cluster: Pod:: top level" {
127+
rank=same;
128+
style=invis;
129+
"Pod::Config";
130+
"Pod::Block";
131+
}
132+
subgraph "cluster: Date/time handling" {
133+
rank=same;
134+
style=invis;
135+
"Date";
136+
"DateTime";
137+
"DateTime-local-timezone";
138+
}
139+
subgraph "cluster: Collection roles" {
140+
rank=same;
141+
style=invis;
142+
"Positional";
143+
"Associative";
144+
"Baggy";
145+
}
146+
END
147+
}
148+
149+
method !process-language-pod {
150+
my $kind = 'Language';
151+
my @files = self!find-pod-files-in($kind);
152+
if $!sparse {
153+
@files = @files[^(@files / $!sparse).ceiling];
154+
}
155+
156+
self!maybe-say("Reading and process $kind pod files ...");
157+
self!run-with-progress(
158+
@files,
159+
sub ($file) {
160+
self!process-one-pod( $file, $kind );
161+
}
162+
)
163+
}
164+
165+
method !process-type-pod {
166+
}
167+
168+
method !find-pod-files-in (Str $dir) {
169+
self!maybe-say: "Finding pod sources in $dir ...";
170+
return gather {
171+
for self!recursive-files-in($dir) -> $file {
172+
take $file if $file.path ~~ / '.pod' $/;
173+
}
174+
}
175+
}
176+
177+
method !recursive-files-in($dir) {
178+
my @todo = $*SPEC.catdir( $!root, 'doc', $dir );
179+
return gather {
180+
while @todo {
181+
my $d = @todo.shift;
182+
for dir($d) -> $f {
183+
if $f.f {
184+
self!maybe-say: " ... found $f";
185+
take $f;
186+
}
187+
else {
188+
self!maybe-say: " ... descending into $f";
189+
@todo.append( $f.path );
190+
}
191+
}
192+
}
193+
}
194+
}
195+
196+
method !process-one-pod (IO::Path $file, Str $kind) {
197+
my $pod = EVAL( $file.slurp ~ "\n\$=pod[0]" );
198+
my $pth = DocSite::Pod::To::HTML.new;
199+
my $html = $pth.pod-to-html($pod);
200+
201+
self!spurt-html-file( $file, $kind, $html);
202+
}
203+
204+
method !spurt-html-file (IO::Path $file, Str $kind, Str $html) {
205+
my $dir = IO::Path.new( $*SPEC.catfile( $!root, 'html', $kind.lc ) );
206+
unless $dir ~~ :e {
207+
# $dir.mkdir(0o755);
208+
}
209+
210+
IO::Path.new( $*SPEC.catfile( $dir, $file.basename.subst( / '.pod' $ /, '.html' ) ) )
211+
.spurt($html);
212+
}
213+
214+
method !run-with-progress ($items, Routine $sub, Str $msg = q{ done}) {
215+
my $prog = Term::ProgressBar.new( :count( $items.elems ) )
216+
if $!verbose;
217+
218+
my $supply = $items.Supply;
219+
220+
if $!threads > 1 {
221+
my $sched = ThreadPoolScheduler
222+
.new( :max_threads($!threads) );
223+
$supply.schedule-on($sched);
224+
}
225+
226+
my $i = 1;
227+
$supply.tap(
228+
sub ($item) {
229+
$sub($item);
230+
$prog.?update($i);
231+
$i++;
232+
}
233+
);
234+
$prog.?message($msg);
235+
}
236+
237+
method !maybe-say (*@things) {
238+
return unless $!verbose;
239+
# We chomp in case we were given a multi-line string ending with a
240+
# newline.
241+
.say for @things.map( { .chomp } );
242+
}

‎lib/DocSite/Pod/To/HTML.pm‎

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
use Pod::To::HTML::Renderer;
2+
3+
unit class DocSite::Pod::To::HTML is Pod::To::HTML::Renderer;
4+
5+
use URI::Escape;
6+
7+
method render-start-tag (Cool:D $tag, Bool :$nl = False, *%attr) {
8+
if $tag eq 'table' {
9+
%attr<class> = [ < table table-striped > ];
10+
}
11+
12+
callsame;
13+
}
14+
15+
method default-prelude {
16+
return Q:to/END/
17+
<!doctype html>
18+
<html>
19+
<head>
20+
<title>___TITLE___</title>
21+
<meta charset="UTF-8">
22+
<meta name="viewport" content="width=device-width, initial-scale=1">
23+
<link rel="icon" href="/favicon.ico" type="image/x-icon">
24+
25+
<link rel="stylesheet" type="text/css" href="http://perl6.org/bootstrap/css/bootstrap.min.css">
26+
<link rel="stylesheet" type="text/css" href="http://perl6.org/bootstrap/css/bootstrap-theme.min.css">
27+
<link rel="stylesheet" type="text/css" href="http://perl6.org/style.css">
28+
29+
<link rel="stylesheet" type="text/css" href="/css/custom-theme/jquery-ui.css">
30+
<link rel="stylesheet" type="text/css" href="/css/pygments.css">
31+
<noscript> <style> #search { visibility: hidden; } </style> </noscript>
32+
33+
___METADATA___
34+
</head>
35+
<body class="bg" id="___top">
36+
END
37+
}
38+
39+
#| Find links like L<die> and L<Str> and give them the proper path
40+
method url-and-text-for (Str:D $thing) {
41+
given $thing {
42+
when /^ <[A..Z]>/ {
43+
return ( '/type/' ~ uri_escape($thing), $thing );
44+
}
45+
when /^ <[a..z]> | ^ <-alpha>* $/ {
46+
return ( '/routine/' ~ uri_escape($thing), $thing );
47+
}
48+
when / ^ '&'( \w <[[\w'-]>* ) $/ {
49+
return ( '/routine/' ~ uri_escape($0), $0 );
50+
}
51+
}
52+
53+
callsame;
54+
}

‎lib/Perl6/Type.pm‎ renamed to ‎lib/DocSite/Type.pm‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
use v6;
22

3-
class Perl6::Type {
3+
class DocSite::Type {
44
has Str $.name handles <Str>;
55
has @.super;
66
has @.sub;
@@ -10,7 +10,7 @@ class Perl6::Type {
1010
has @.categories;
1111

1212
has @.mro;
13-
method mro(Perl6::Type:D:) {
13+
method mro(DocSite::Type:D:) {
1414
return @!mro if @!mro;
1515
if @.super == 1 {
1616
@!mro = @.super[0].mro;

‎lib/Perl6/TypeGraph.pm‎ renamed to ‎lib/DocSite/TypeGraph.pm‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
1-
use Perl6::Type;
2-
class Perl6::TypeGraph {
1+
use DocSite::Type;
2+
3+
class DocSite::TypeGraph {
34
has %.types;
45
has @.sorted;
56
my grammar Decl {
@@ -34,7 +35,7 @@ class Perl6::TypeGraph {
3435
method parse-from-file($fn) {
3536
my $f = open $fn;
3637
my $get-type = -> Str $name {
37-
%.types{$name} //= Perl6::Type.new(:$name);
38+
%.types{$name} //= DocSite::Type.new(:$name);
3839
};
3940
my class Actions {
4041
method longname($/) {

0 commit comments

Comments
 (0)