A custom script to build local hoogle databases

HoogleHelper.pl

#!/usr/bin/perl
use strict;
use warnings;

use Getopt::Std;
use Cwd;
use File::Spec;
use File::HomeDir;
use File::Path qw(remove_tree make_path);

my %opts;

my $cabal_dev = "";
my $ghc_pkg;
my @packages;

getopts("d", \%opts);
if (exists($opts{d}))
{
  $cabal_dev = "cabal-dev";
}
$ghc_pkg = "$cabal_dev ghc-pkg";
@packages = split " ", `$ghc_pkg list --simple-output --names-only`;

my %htmlroots;
for (@packages)
{
  my ($version, $haddock_html) = split "\n", `$ghc_pkg field $_ version,haddock-html`;
  my $hpos = index($haddock_html, ': ');
  $version = substr($version, index($version, ': ')+2);
  if ($hpos >= 0)
  {
    my $html = substr($haddock_html, $hpos+2);
    my @path = File::Spec->splitdir($html);
    my $last = pop @path;
    if (!$last) # remove empty path component
    {
      $last = pop @path;
    }
    if ($last eq 'html')
    {
      $last = pop @path;
    }
    # when checking --local directories, hoogle recognizes only package-version names
    if ($last eq "$_-$version")
    {
      $htmlroots{File::Spec->catdir(@path)} = "";
    }
    else
    {
      # non-standard name, need an alias for it
      push @path, $last;
      $htmlroots{File::Spec->catdir(@path)} = "$_-$version";
    }
  }
  else
  {
    print STDERR "No HTML documentation found for $_-$version\n";
  }
}

my $HOOGLEDIR = '.hoogle';
my $hbase = File::Spec->catdir(File::HomeDir->my_home(), $HOOGLEDIR);
my $dbdir = File::Spec->catdir($hbase, 'db'); # store intermediate databases in user home
# directory to store combined database and links to documents in locations not expected by hoogle
my $hlocal = $hbase;
if ($cabal_dev)
{
  $hlocal = File::Spec->catdir(getcwd(), $HOOGLEDIR);
}

my $doclinks = File::Spec->catdir($hlocal, 'doclinks');
remove_tree($doclinks, {error => \my $err});
make_path($doclinks);
make_path($dbdir);
my @docdirs = ($doclinks);
for (keys %htmlroots)
{
  my $pkg = $htmlroots{$_};
  if ($pkg)
  {
    # create links for non-standard locations
    symlink $_, File::Spec->catdir("$doclinks", $pkg);
    # TODO use something on Windows
  }
  else
  {
    push @docdirs, $_;
  }
}

map {unlink;} glob(File::Spec->catfile($dbdir, '*.{hoo,txt}'));
my $locals = '--local=' . join(' --local=', @docdirs);
my $allpackages = join ' ', @packages;
system("hoogle data --datadir=$dbdir $locals $allpackages");
my $databases = join(' ', glob(File::Spec->catfile($dbdir, '*.hoo')));
my $defaultdb = File::Spec->catfile($hlocal, 'default.hoo');
system("hoogle combine --outfile=$defaultdb $databases");
# ?add keyword,platform,packages?

# vim: set ts=8 sts=2 sw=2: