Add simple Pod::Cache, doc dir lookup, and simple display

This Pod::Cache is stripped down almost to a minimum. In the future it
might be possible to use Documentable::Registry or some other module,
but in order to find the fastest method possible for our specific
needs, it is best to use our own.

META6.json

@@ -15,6 +15,7 @@
  "name": "Rakudoc",
  "perl": "6.d",
  "provides": {
+ "Pod::Cache": "lib/Pod/Cache.rakumod",
  "Rakudoc": "lib/Rakudoc.rakumod",
  "Rakudoc::CMD": "lib/Rakudoc/CMD.rakumod"
  },

lib/Pod/Cache.rakumod

@@ -0,0 +1,69 @@
+unit class Pod::Cache;
+
+has %.sources is SetHash;
+
+has IO::Path $!cache-path;
+has $!precomp-repo;
+has %!errors;
+has %!ids;
+
+
+submethod BUILD(
+ :$cache-path = 'rakudoc_cache',
+)
+{
+ $!cache-path = $cache-path.IO.resolve(:completely);
+ $!precomp-repo = CompUnit::PrecompilationRepository::Default.new(
+ :store(CompUnit::PrecompilationStore::File.new(:prefix($!cache-path))),
+ );
+}
+
+method !compunit-handle($pod-file-path) {
+ my $t = $pod-file-path.IO.modified;
+ my $id = CompUnit::PrecompilationId.new-from-string($pod-file-path);
+ %!ids{$pod-file-path} = $id;
+ my ($handle, $) = $!precomp-repo.load( $id, :src($pod-file-path), :since($t) );
+ unless $handle {
+ note "Caching '$pod-file-path' to '$!cache-path'";
+ $handle = $!precomp-repo.try-load(
+ CompUnit::PrecompilationDependency::File.new(
+ :src($pod-file-path),
+ :$id,
+ :spec(CompUnit::DependencySpecification.new(:short-name($pod-file-path))),
+ )
+ );
+ #note " - Survived with handle {$handle // 'NULL'}";
+ }
+
+ ++%!sources{$pod-file-path};
+ return $handle;
+}
+
+#| pod(Str $pod-file-path) returns the pod tree in the pod file
+multi method pod(CompUnit::Handle $handle) {
+ use nqp;
+ nqp::atkey($handle.unit, '$=pod')
+}
+
+multi method pod(IO::Path $pod-file-path) {
+ my $handle;
+ # Canonical form for lookup consistency
+ my $src = $pod-file-path.resolve(:completely).absolute;
+ if %!ids{$src}:exists {
+ $handle = $!precomp-repo.try-load(
+ CompUnit::PrecompilationDependency::File.new(
+ :$src,
+ :id(%!ids{$src})
+ ),
+ );
+ }
+ else {
+ $handle = self!compunit-handle($src);
+ }
+
+ self.pod: $handle;
+}
+
+multi method pod(Str $pod-file-path) {
+ self.pod: $pod-file-path.IO;
+}

lib/Rakudoc.rakumod

@@ -1,12 +1,36 @@
 use Documentable;
 use Documentable::Primary;
+use Pod::Cache;
 use Pod::To::Text;
 
 my class X::Rakudoc is Exception {
  has $.message;
 }
 
 class Rakudoc:auth<github:Raku>:api<1>:ver<0.1.9> {
+ has @.doc-sources;
+ has $.data-dir;
+ has $!cache;
+
+ submethod TWEAK(
+ :$doc-sources is copy,
+ :$no-default-docs,
+ :$data-dir,
+ ) {
+ $doc-sources = grep *.defined, $doc-sources<>;
+ if !$doc-sources and %*ENV<RAKUDOC> {
+ $doc-sources = %*ENV<RAKUDOC>.split(',').map(*.trim);
+ }
+ $doc-sources = [$doc-sources<>] unless $doc-sources ~~ Positional;
+ unless $no-default-docs {
+ $doc-sources.append:
+ $*REPO.repo-chain.map({.?abspath.IO // Empty})».add('doc');
+ }
+ @!doc-sources = map *.resolve, grep *.d, map *.IO, @$doc-sources;
+
+ $!data-dir = self!resolve-data-dir($data-dir // %*ENV<RAKUDOC_DATA>);
+ }
+
  role Request {
  has $.rakudoc;
  has $.section;
@@ -21,7 +45,63 @@ class Rakudoc:auth<github:Raku>:api<1>:ver<0.1.9> {
  Request::Name.new: :rakudoc(self), :name($query);
  }
 
- method search(Request $request) {
+ method search(Request $_) {
+ when Request::Name {
+ # Names can match either a doc file or an installed module
+ flat self.search-doc-sources($_), self.search-compunits($_)
+ given .name;
+ }
+
+ }
+
+ method search-doc-sources($str) {
+ map { pod2text self.cache.pod($_) },
+ grep *.e,
+ map -> $dir, $ext { $dir.add($str).extension(:0parts, $ext) },
+ flat @!doc-sources.map({
+ | .dir(:test(*.starts-with('.').not)).grep(*.d)
+ }) X <pod6 rakudoc>
+ }
+
+ method search-compunits($str) {
  Empty
  }
+
+
+ method cache {
+ return $!cache if $!cache;
+ $!data-dir.mkdir unless $!data-dir.d;
+ $!cache = Pod::Cache.new: :cache-path($!data-dir.add('cache'));
+ }
+
+ method !resolve-data-dir($data-dir) {
+ # A major limitation is that currently there can only be a single
+ # Pod::Cache instance in a program (due to precompilation guts?)
+ # See https://github.com/finanalyst/raku-pod-from-cache/blob/master/t/50-multiple-instance.t
+ #
+ # This precludes having a read-only system-wide cache and a
+ # user-writable fallback. So for now, each user must build & update
+ # their own cache.
+
+ return $data-dir.IO.resolve(:completely) if $data-dir;
+
+ # By default, this will be ~/.cache/raku/rakudoc-data on most Unix
+ # distributions, and ~\.raku\rakudoc-data on Windows and others
+ my IO::Path @candidates = map *.add('rakudoc-data'),
+ # Here is one way to get a system-wide cache: if all raku users are
+ # able to write to the raku installation, then this would probably
+ # work; of course, this will also require file locking to prevent
+ # users racing against each other while updating the cache / indexes
+ #$*REPO.repo-chain.map({.?prefix.?IO // Empty})
+ # .grep({ $_ ~~ :d & :w })
+ # .first(not *.absolute.starts-with($*HOME.absolute)),
+ %*ENV<XDG_CACHE_HOME>.?IO.?add('raku') // Empty,
+ %*ENV<XDG_CACHE_HOME>.?IO // Empty,
+ $*HOME.add('.raku'),
+ $*HOME.add('.perl6'),
+ $*CWD;
+ ;
+
+ @candidates.first(*.f) // @candidates.first;
+ }
 }

lib/Rakudoc/CMD.rakumod

@@ -34,7 +34,7 @@ multi MAIN(
  my $text = @docs.join("\n\n")
  or die X::Rakudoc.new: :message("No results for $request");
 
- print $text;
+ put $text;
 }
 
 multi MAIN(Bool :h(:$help)!, |_) {

t/01-cmd.t

@@ -1,10 +1,12 @@
 use Test;
 
 %*ENV<RAKUDOC_TEST> = '1';
+%*ENV<RAKUDOC> = 't/testdata/mini-doc/test-doc';
 
 my @tests =
  \('test-no-match'), [ False, / ^ $ /, / No .* 'test-no-match' / ],
  \(:help), [ True, / ^ Usage /, / ^ $ /],
+ \('Map'), [ True, / 'class Map' \N+ 'does Associative' / ],
  ;
 
 plan +@tests / 2;
@@ -16,14 +18,14 @@ BEGIN sub MAIN(|) { };
 
 for @tests -> $args, $like {
  subtest "MAIN {$args.gist}" => {
- plan 3;
  my ($result-is, $out-like, $err-like) = @$like;
+ plan $err-like.defined ?? 3 !! 2;
 
  my ($result, $out, $err) = run-test $args;
 
  is $result, $result-is, "returns $result-is";
  like $out, $out-like, "output like {$out-like.gist}";
- like $err, $err-like, "output like {$err-like.gist}";
+ like $err, $_, "output like {.gist}" with $err-like;
  }
 }
 

t/02-cache.t

@@ -0,0 +1,28 @@
+use Test;
+use File::Temp;
+use Pod::Cache;
+
+plan 6;
+
+my $test-doc = 't/testdata/mini-doc/test-doc/Type/Map.pod6';
+
+my $cache-path = tempdir.IO.add('cache');
+my $pc = Pod::Cache.new: :$cache-path;
+
+isa-ok $pc, Pod::Cache,
+ "Create cache object";
+
+is $cache-path.e, False,
+ "Cache dir is not created until needed";
+
+like $pc.pod($test-doc).?first.^name, /^ 'Pod::'/,
+ "pod('relative/path.ext') returns a Pod";
+
+is $cache-path.d, True,
+ "Cache dir is created when needed";
+
+like $pc.pod($test-doc.IO).?first.^name, /^ 'Pod::'/,
+ "pod('relative/path.ext'.IO) returns a Pod";
+
+throws-like { $pc.pod('nonexistent') }, X::Multi::NoMatch,
+ "pod('nonexistent') dies";