darcs-all 4.34 KB
Newer Older
Ian Lynagh's avatar
Ian Lynagh committed
1
#!/usr/bin/perl -w
2

Ian Lynagh's avatar
Ian Lynagh committed
3
use strict;
4

Ian Lynagh's avatar
Ian Lynagh committed
5
my @top_dirs = ("nofib", "testsuite");
6

7 8
# Figure out where to get the other repositories from,
# based on where this GHC repo came from.
Ian Lynagh's avatar
Ian Lynagh committed
9 10 11 12 13
my $defaultrepo = `cat _darcs/prefs/defaultrepo`;
chomp $defaultrepo;
my $defaultrepo_base;
my $defaultrepo_lib;

Simon Marlow's avatar
Simon Marlow committed
14
if ($defaultrepo =~ /^...*:/) {
Ian Lynagh's avatar
Ian Lynagh committed
15
    # HTTP or SSH
Simon Marlow's avatar
Simon Marlow committed
16 17
    # Above regex says "at least two chars before the :", to avoid
    # catching Win32 drives ("C:\").
Ian Lynagh's avatar
Ian Lynagh committed
18
    $defaultrepo_base = $defaultrepo;
19
    $defaultrepo_base =~ s#/[^/]+/?$##;
Ian Lynagh's avatar
Ian Lynagh committed
20
    $defaultrepo_lib = "$defaultrepo_base/packages";
21
}
22 23 24
elsif ($defaultrepo =~ /^(\.\.)?\//) {
    # Local filesystem, either absolute or relative path
    # (assumes a checked-out tree):
Ian Lynagh's avatar
Ian Lynagh committed
25 26
    $defaultrepo_base = $defaultrepo;
    $defaultrepo_lib = "$defaultrepo/libraries";
27
}
Ian Lynagh's avatar
Ian Lynagh committed
28 29
else {
    die "Couldn't work out defaultrepo";
30 31
}

Ian Lynagh's avatar
Ian Lynagh committed
32
my $verbose = 2;
Ian Lynagh's avatar
Ian Lynagh committed
33
my $ignore_failure = 0;
34

35 36
# --extra says we grab the extra libs with 'get'.  It has no effect on
# the other commands.
Ian Lynagh's avatar
Ian Lynagh committed
37
my $extra = 0;
38 39
# --nofib/--testsuite tell get to also grab the respective repos.
# They have no effect on the other commands.
Ian Lynagh's avatar
Ian Lynagh committed
40 41 42 43
my $nofib = 0;
my $testsuite = 0;

sub message {
Ian Lynagh's avatar
Ian Lynagh committed
44
    if ($verbose >= 2) {
Ian Lynagh's avatar
Ian Lynagh committed
45 46 47 48 49
        print "@_\n";
    }
}

sub warning {
Ian Lynagh's avatar
Ian Lynagh committed
50 51 52
    if ($verbose >= 1) {
        print "warning: @_\n";
    }
Ian Lynagh's avatar
Ian Lynagh committed
53 54 55 56 57 58 59 60 61 62
}

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

sub darcsall {
63
    my @packages;
Ian Lynagh's avatar
Ian Lynagh committed
64 65 66 67 68 69 70 71 72
    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";
        }
    }
73 74 75 76
    for my $path (<libraries/*/_darcs>) {
        chomp $path;
        if ($path =~ m#/(.*)/#) {
            my $pkg = $1;
77
            darcs (@_, "--repodir", "libraries/$pkg");
Ian Lynagh's avatar
Ian Lynagh committed
78 79
        }
        else {
80 81 82 83 84 85 86 87
            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") {
Ian Lynagh's avatar
Ian Lynagh committed
88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
            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;
108
    if (! grep /(?:--complete|--partial)/, @_) {
Ian Lynagh's avatar
Ian Lynagh committed
109 110 111 112 113 114 115 116 117 118 119 120 121 122
        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) {
123
        @packages = `cat boot-packages extra-packages`;
Ian Lynagh's avatar
Ian Lynagh committed
124 125
    }
    else {
126
        @packages = `cat boot-packages`;
Ian Lynagh's avatar
Ian Lynagh committed
127 128 129 130 131 132 133 134 135 136 137 138 139
    }

    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."
    }

140 141
    while ($#_ ne -1) {
        my $arg = shift;
142 143
        # We handle -q here as well as lower down as we need to skip over it
        # if it comes before the darcs command
144
        if ($arg eq "-q") {
Ian Lynagh's avatar
Ian Lynagh committed
145 146 147
            $verbose = 1;
        }
        elsif ($arg eq "-s") {
148 149 150 151 152 153 154 155 156 157 158 159 160
            $verbose = 0;
        }
        elsif ($arg eq "--extra") {
            $extra = 1;
        }
        elsif ($arg eq "--nofib") {
            $nofib = 1;
        }
        elsif ($arg eq "--testsuite") {
            $testsuite = 1;
        }
        else {
            unshift @_, $arg;
161
            if (grep /^-q$/, @_) {
Ian Lynagh's avatar
Ian Lynagh committed
162
                $verbose = 1;
163
            }
164 165 166 167
            last;
        }
    }

Ian Lynagh's avatar
Ian Lynagh committed
168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185
    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);