diff --git a/generate-site.p6 b/generate-site.p6 new file mode 100644 index 000000000..20fa8caaf --- /dev/null +++ b/generate-site.p6 @@ -0,0 +1,28 @@ +use v6; + +use lib 'lib', '../Pod-To-HTML/lib/', '../Pod-NodeWalker/lib/'; +use DocSite::Generator; + +sub MAIN ( + Bool :$overwrite-typegraph = False, + Bool :$disambiguation = True, + Bool :$search-file = True, + Bool :$highlight = True, + Bool :$inline-python = True, + Bool :$verbose = True, + Int :$sparse = 0, + Int :$threads = 8, + Str :$root = $*SPEC.catdir( $*CWD ) +) { + DocSite::Generator.new( + :$overwrite-typegraph, + :$disambiguation, + :$search-file, + :$highlight, + :$inline-python, + :$verbose, + :$sparse, + :$threads, + :root( IO::Path.new($root) ), + ).run; +} diff --git a/lib/Perl6/Documentable.pm b/lib/DocSite/Document.pm similarity index 97% rename from lib/Perl6/Documentable.pm rename to lib/DocSite/Document.pm index 28ebd42f7..a3e3fd86c 100644 --- a/lib/Perl6/Documentable.pm +++ b/lib/DocSite/Document.pm @@ -1,5 +1,5 @@ use URI::Escape; -class Perl6::Documentable { +class DocSite::Documentable { has Str $.kind; # type, language doc, routine, module has Str @.subkinds; # class/role/enum, sub/method, prefix/infix/... has Str @.categories; # basic type, exception, operator... diff --git a/lib/Perl6/Documentable/Registry.pm b/lib/DocSite/Document/Registry.pm similarity index 87% rename from lib/Perl6/Documentable/Registry.pm rename to lib/DocSite/Document/Registry.pm index 4ddc734f2..de19aef0c 100644 --- a/lib/Perl6/Documentable/Registry.pm +++ b/lib/DocSite/Document/Registry.pm @@ -1,7 +1,7 @@ use v6; -use Perl6::Documentable; +use DocSite::Document; -class Perl6::Documentable::Registry { +class DocSite::Document::Registry { has @.documentables; has Bool $.composed = False; has %!cache; @@ -9,7 +9,7 @@ class Perl6::Documentable::Registry { has @!kinds; method add-new(*%args) { die "Cannot add something to a composed registry" if $.composed; - @!documentables.append: my $d = Perl6::Documentable.new(|%args); + @!documentables.append: my $d = DocSite::Document.new(|%args); $d; } method compose() { diff --git a/lib/DocSite/Generator.pm b/lib/DocSite/Generator.pm new file mode 100644 index 000000000..936a8ac18 --- /dev/null +++ b/lib/DocSite/Generator.pm @@ -0,0 +1,242 @@ +unit class DocSite::Generator; + +use lib 'lib'; + +use DocSite::Document::Registry; +use DocSite::Pod::To::HTML; +use DocSite::TypeGraph::Viz; +use DocSite::TypeGraph; +use Pod::Convenience; +use Pod::Htmlify; +use Term::ProgressBar; +use URI::Escape; + +has Bool $!overwrite-typegraph; +has Bool $!disambiguation; +has Bool $!search-file; +has Bool $!highlight; +has Bool $!inline-python; +has Bool $!verbose; +has Int $!sparse; +has Int $!threads; +has IO::Path $!root; + +has DocSite::Document::Registry $!registry = DocSite::Document::Registry.new; +has DocSite::TypeGraph $!type-graph; + +my @viz-formats = ( + %( :format ), + %( :format, :size<8,3> ), +); + +method BUILD ( + Bool :$!overwrite-typegraph, + Bool :$!disambiguation, + Bool :$!search-file, + Bool :$!highlight, + Bool :$!inline-python, + Bool :$!verbose, + Int :$!sparse, + Int :$!threads, + IO::Path :$!root, +) { } + +method run { + self!maybe-write-type-graph-images; + self!process-language-pod; + self!process-type-pod; +} + +method !maybe-write-type-graph-images { + my $image-dir = IO::Path.new( $*SPEC.catdir( $!root, 'html', 'images' ) ); + my $any-svg = $*SPEC.catfile( $image-dir, 'type-graph-Any.svg' ).IO; + if $any-svg ~~ :e && !$!overwrite-typegraph { + self!maybe-say( qq:to/END/ ); + Not writing type graph images, it seems to be up-to-date. To forcibly + overwrite the type graph images, supply the --overwrite-typegraph + option at the command line, or delete the file + $any-svg + END + return; + } + + my $tg-file = 'type-graph.txt'; + self!maybe-say: "Reading type graph from $tg-file ..."; + $!type-graph = DocSite::TypeGraph.new-from-file($tg-file); + self!write-type-graph-images($image-dir); + self!write-specialized-type-graph-images($image-dir); +} + +method !write-type-graph-images (IO::Path $image-dir) { + self!maybe-say: "Writing type graph images to $image-dir {$!threads > 1 ?? qq{with $!threads threads } !! q{}}..."; + self!run-with-progress( + $!type-graph.sorted.cache, + sub ($type) { self!write-one-type( $type, $image-dir ) }, + ); +} + +method !write-one-type (DocSite::Type $type, IO::Path $image-dir) { + my $viz = DocSite::TypeGraph::Viz.new-for-type($type); + for @viz-formats -> $args { + my $file = $*SPEC.catfile( $image-dir, "type-graph-{$type}.{$args}" ); + $viz.to-file( $file, |$args ); + } +} + +method !write-specialized-type-graph-images (IO::Path $image-dir) { + self!maybe-say: "Writing specialized visualizations to $image-dir ..."; + my %by-group = $!type-graph.sorted.classify(&viz-group); + %by-group.append: $!type-graph.types< Exception Any Mu >; + %by-group.append: $!type-graph.types< Any Mu >; + + self!run-with-progress( + %by-group.pairs.cache, + sub (Pair $pair) { self!write-one-type-group( $pair.key, $pair.value, $image-dir ) }, + ); +} + +method !write-one-type-group (Str $group, Array $types, IO::Path $image-dir) { + my $viz = DocSite::TypeGraph::Viz.new( + :types($types), + :dot-hints( viz-hints($group) ), + :rank-dir, + ); + for @viz-formats -> $args { + my $file = $*SPEC.catfile( $image-dir, "type-graph-{$group}.{$args}" ); + $viz.to-file($file, |$args); + } +} + +sub viz-group ($type) { + return 'Metamodel' if $type.name ~~ /^ 'Perl6::Metamodel' /; + return 'Exception' if $type.name ~~ /^ 'X::' /; + return 'Any'; +} + +sub viz-hints ($group) { + return q{} unless $group eq 'Any'; + + return Q:to/END/; + subgraph "cluster: Mu children" { + rank=same; + style=invis; + "Any"; + "Junction"; + } + subgraph "cluster: Pod:: top level" { + rank=same; + style=invis; + "Pod::Config"; + "Pod::Block"; + } + subgraph "cluster: Date/time handling" { + rank=same; + style=invis; + "Date"; + "DateTime"; + "DateTime-local-timezone"; + } + subgraph "cluster: Collection roles" { + rank=same; + style=invis; + "Positional"; + "Associative"; + "Baggy"; + } + END +} + +method !process-language-pod { + my $kind = 'Language'; + my @files = self!find-pod-files-in($kind); + if $!sparse { + @files = @files[^(@files / $!sparse).ceiling]; + } + + self!maybe-say("Reading and process $kind pod files ..."); + self!run-with-progress( + @files, + sub ($file) { + self!process-one-pod( $file, $kind ); + } + ) +} + +method !process-type-pod { +} + +method !find-pod-files-in (Str $dir) { + self!maybe-say: "Finding pod sources in $dir ..."; + return gather { + for self!recursive-files-in($dir) -> $file { + take $file if $file.path ~~ / '.pod' $/; + } + } +} + +method !recursive-files-in($dir) { + my @todo = $*SPEC.catdir( $!root, 'doc', $dir ); + return gather { + while @todo { + my $d = @todo.shift; + for dir($d) -> $f { + if $f.f { + self!maybe-say: " ... found $f"; + take $f; + } + else { + self!maybe-say: " ... descending into $f"; + @todo.append( $f.path ); + } + } + } + } +} + +method !process-one-pod (IO::Path $file, Str $kind) { + my $pod = EVAL( $file.slurp ~ "\n\$=pod[0]" ); + my $pth = DocSite::Pod::To::HTML.new; + my $html = $pth.pod-to-html($pod); + + self!spurt-html-file( $file, $kind, $html); +} + +method !spurt-html-file (IO::Path $file, Str $kind, Str $html) { + my $dir = IO::Path.new( $*SPEC.catfile( $!root, 'html', $kind.lc ) ); + unless $dir ~~ :e { +# $dir.mkdir(0o755); + } + + IO::Path.new( $*SPEC.catfile( $dir, $file.basename.subst( / '.pod' $ /, '.html' ) ) ) + .spurt($html); +} + +method !run-with-progress ($items, Routine $sub, Str $msg = q{ done}) { + my $prog = Term::ProgressBar.new( :count( $items.elems ) ) + if $!verbose; + + my $supply = $items.Supply; + + if $!threads > 1 { + my $sched = ThreadPoolScheduler + .new( :max_threads($!threads) ); + $supply.schedule-on($sched); + } + + my $i = 1; + $supply.tap( + sub ($item) { + $sub($item); + $prog.?update($i); + $i++; + } + ); + $prog.?message($msg); +} + +method !maybe-say (*@things) { + return unless $!verbose; + # We chomp in case we were given a multi-line string ending with a + # newline. + .say for @things.map( { .chomp } ); +} diff --git a/lib/DocSite/Pod/To/HTML.pm b/lib/DocSite/Pod/To/HTML.pm new file mode 100644 index 000000000..d0557ba54 --- /dev/null +++ b/lib/DocSite/Pod/To/HTML.pm @@ -0,0 +1,54 @@ +use Pod::To::HTML::Renderer; + +unit class DocSite::Pod::To::HTML is Pod::To::HTML::Renderer; + +use URI::Escape; + +method render-start-tag (Cool:D $tag, Bool :$nl = False, *%attr) { + if $tag eq 'table' { + %attr = [ < table table-striped > ]; + } + + callsame; +} + +method default-prelude { + return Q:to/END/ + + + + ___TITLE___ + + + + + + + + + + + + + ___METADATA___ + + + END +} + +#| Find links like L and L and give them the proper path +method url-and-text-for (Str:D $thing) { + given $thing { + when /^ <[A..Z]>/ { + return ( '/type/' ~ uri_escape($thing), $thing ); + } + when /^ <[a..z]> | ^ <-alpha>* $/ { + return ( '/routine/' ~ uri_escape($thing), $thing ); + } + when / ^ '&'( \w <[[\w'-]>* ) $/ { + return ( '/routine/' ~ uri_escape($0), $0 ); + } + } + + callsame; +} diff --git a/lib/Perl6/Type.pm b/lib/DocSite/Type.pm similarity index 96% rename from lib/Perl6/Type.pm rename to lib/DocSite/Type.pm index b42fa294b..4d65323ae 100644 --- a/lib/Perl6/Type.pm +++ b/lib/DocSite/Type.pm @@ -1,6 +1,6 @@ use v6; -class Perl6::Type { +class DocSite::Type { has Str $.name handles ; has @.super; has @.sub; @@ -10,7 +10,7 @@ class Perl6::Type { has @.categories; has @.mro; - method mro(Perl6::Type:D:) { + method mro(DocSite::Type:D:) { return @!mro if @!mro; if @.super == 1 { @!mro = @.super[0].mro; diff --git a/lib/Perl6/TypeGraph.pm b/lib/DocSite/TypeGraph.pm similarity index 96% rename from lib/Perl6/TypeGraph.pm rename to lib/DocSite/TypeGraph.pm index 69273f1a0..1e57e00cf 100644 --- a/lib/Perl6/TypeGraph.pm +++ b/lib/DocSite/TypeGraph.pm @@ -1,5 +1,6 @@ -use Perl6::Type; -class Perl6::TypeGraph { +use DocSite::Type; + +class DocSite::TypeGraph { has %.types; has @.sorted; my grammar Decl { @@ -34,7 +35,7 @@ class Perl6::TypeGraph { method parse-from-file($fn) { my $f = open $fn; my $get-type = -> Str $name { - %.types{$name} //= Perl6::Type.new(:$name); + %.types{$name} //= DocSite::Type.new(:$name); }; my class Actions { method longname($/) { diff --git a/lib/Perl6/TypeGraph/Viz.pm b/lib/DocSite/TypeGraph/Viz.pm similarity index 95% rename from lib/Perl6/TypeGraph/Viz.pm rename to lib/DocSite/TypeGraph/Viz.pm index 7068c1b15..f1256a5f8 100644 --- a/lib/Perl6/TypeGraph/Viz.pm +++ b/lib/DocSite/TypeGraph/Viz.pm @@ -1,7 +1,9 @@ use v6; -use Perl6::TypeGraph; -class Perl6::TypeGraph::Viz { +class DocSite::TypeGraph::Viz { + use DocSite::TypeGraph; + use File::Temp; + has @.types; has $.dot-hints; has $.url-base = '/type/'; @@ -91,10 +93,9 @@ class Perl6::TypeGraph::Viz { } method to-file ($file, :$format = 'svg', :$size) { - my $tmpfile = $*TMPDIR ~ '/p6-doc-graphviz-' ~ (^100_000).pick; + my ( $tmpfile, $h ) = tempfile( :prefix('p6-doc-graphviz-') ); spurt $tmpfile, self.as-dot(:$size); run 'dot', "-T$format", "-o$file", $tmpfile or die 'dot command failed! (did you install Graphviz?)'; - unlink $tmpfile; } } diff --git a/lib/Pod/Convenience.pm6 b/lib/Pod/Convenience.pm6 index a498ef9dd..8f1e3ebfa 100644 --- a/lib/Pod/Convenience.pm6 +++ b/lib/Pod/Convenience.pm6 @@ -1,35 +1,5 @@ unit module Pod::Convenience; -sub pod-gist(Pod::Block $pod, $level = 0) is export { - my $leading = ' ' x $level; - my %confs; - my @chunks; - for { - my $thing = $pod.?"$_"(); - if $thing { - %confs{$_} = $thing ~~ Iterable ?? $thing.perl !! $thing.Str; - } - } - @chunks = $leading, $pod.^name, (%confs.perl if %confs), "\n"; - for $pod.contents.list -> $c { - if $c ~~ Pod::Block { - @chunks.append: pod-gist($c, $level + 2); - } - elsif $c ~~ Str { - @chunks.append: $c.indent($level + 2), "\n"; - } elsif $c ~~ Positional { - @chunks.append: $c.map: { - if $_ ~~ Pod::Block { - *.&pod-gist - } elsif $_ ~~ Str { - $_ - } - } - } - } - @chunks.join; -} - sub first-code-block(@pod) is export { @pod.first(* ~~ Pod::Block::Code).contents.grep(Str).join; } diff --git a/template/head.html b/template/head.html deleted file mode 100644 index 26c806767..000000000 --- a/template/head.html +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - - - - -