darcs-all

#!/usr/bin/perl -w

use strict;

my @top_dirs = ("nofib", "testsuite");

# Figure out where to get the other repositories from,
# based on where this GHC repo came from.
my $defaultrepo = `cat _darcs/prefs/defaultrepo`;
chomp $defaultrepo;
my $defaultrepo_base;
my $defaultrepo_lib;

if ($defaultrepo =~ /^...*:/) {
    # HTTP or SSH
    # Above regex says "at least two chars before the :", to avoid
    # catching Win32 drives ("C:\").
    $defaultrepo_base = $defaultrepo;
    $defaultrepo_base =~ s#/[^/]+/?$##;
    $defaultrepo_lib = "$defaultrepo_base/packages";
}
elsif ($defaultrepo =~ /^\//) {
    # Local filesystem, absolute path (assumes a checked-out tree):
    $defaultrepo_base = $defaultrepo;
    $defaultrepo_lib = "$defaultrepo/libraries";
}
elsif ($defaultrepo =~ /^..\//) {
    # Local filesystem, relative path (assumes a checked-out tree):
    $defaultrepo_base = $defaultrepo;
    $defaultrepo_lib = "$defaultrepo/libraries";
}
else {
    die "Couldn't work out defaultrepo";
}

my $verbose = 2;
my $ignore_failure = 0;

# --extra says we grab the extra libs with 'get'.  It has no effect on
# the other commands.
my $extra = 0;
# --nofib/--testsuite tell get to also grab the respective repos.
# They have no effect on the other commands.
my $nofib = 0;
my $testsuite = 0;

sub message {
    if ($verbose >= 2) {
        print "@_\n";
    }
}

sub warning {
    if ($verbose >= 1) {
        print "warning: @_\n";
    }
}

sub darcs {
    message "== running darcs @_";
    system ("darcs", @_) == 0
        or $ignore_failure
        or die "darcs failed: $?";
}

sub darcsall {
    my @packages;
    darcs @_;
    for my $dir (@top_dirs) {
        if (-d $dir && -d "$dir/_darcs") {
            darcs (@_, "--repodir", $dir);
        }
        else {
            message "== $dir not present or not a repository; skipping";
        }
    }
    for my $path (<libraries/*/_darcs>) {
        chomp $path;
        if ($path =~ m#/(.*)/#) {
            my $pkg = $1;
            darcs (@_, "--repodir", "libraries/$pkg");
        }
        else {
            die "that pattern can't fail!";
        }
    }
    @packages = `cat libraries/boot-packages`;
    # @packages = `cat libraries/boot-packages libraries/extra-packages`;
    for my $pkg (@packages) {
        chomp $pkg;
        if (! -d "libraries/$pkg") {
            warning("$pkg doesn't exist, use 'darcs-all get' to get it");
        }
    }
}

sub darcsgetpackage {
    my ($get_it, $r_flags, $repo_root, $package) = @_;

    if ($get_it) {
        if (-d $package) {
            warning("$package already present; omitting");
        }
        else {
            darcs (@$r_flags, "$repo_root/$package");
        }
    }
}

sub darcsget {
    my $r_flags;
    if (! grep /(?:--complete|--partial)/, @_) {
        warning("adding --partial, to override use --complete");
        $r_flags = [@_, "--partial"];
    }
    else {
        $r_flags = \@_;
    }

    darcsgetpackage($nofib,     $r_flags, $defaultrepo_base, "nofib");
    darcsgetpackage($testsuite, $r_flags, $defaultrepo_base, "testsuite");

    chdir "libraries";

    my @packages;
    if ($extra) {
        @packages = `cat boot-packages extra-packages`;
    }
    else {
        @packages = `cat boot-packages`;
    }

    for my $pkg (@packages) {
        chomp $pkg;
        darcsgetpackage(1, $r_flags, $defaultrepo_lib, $pkg);
    }
}

sub main {
    if (! -d "_darcs" || ! -d "compiler") {
        die "error: darcs-all must be run from the top level of the ghc tree."
    }

    while ($#_ ne -1) {
        my $arg = shift;
        # We handle -q here as well as lower down as we need to skip over it
        # if it comes before the darcs command
        if ($arg eq "-q") {
            $verbose = 1;
        }
        elsif ($arg eq "-s") {
            $verbose = 0;
        }
        elsif ($arg eq "--extra") {
            $extra = 1;
        }
        elsif ($arg eq "--nofib") {
            $nofib = 1;
        }
        elsif ($arg eq "--testsuite") {
            $testsuite = 1;
        }
        else {
            unshift @_, $arg;
            if (grep /^-q$/, @_) {
                $verbose = 1;
            }
            last;
        }
    }

    if ($#_ eq -1) {
        die "What do you want to do?";
    }
    my $command = $_[0];
    if ($command eq "get") {
        darcsget @_;
    }
    else {
        if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
            # Hack around whatsnew failing if there are no changes
            $ignore_failure = 1;
        }
        darcsall @_;
    }
}

main(@ARGV);