darcs-all

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 my @top_dirs = ("nofib", "testsuite", "utils/hsc2hs");
   6
   7 # Figure out where to get the other repositories from,
   8 # based on where this GHC repo came from.
   9 my $defaultrepo = `cat _darcs/prefs/defaultrepo`;
  10 chomp $defaultrepo;
  11 my $defaultrepo_base;
  12 my $defaultrepo_lib;
  13 my $hsc2hs_repo_loc;
  14
  15 if ($defaultrepo =~ /^...*:/) {
  16     # HTTP or SSH
  17     # Above regex says "at least two chars before the :", to avoid
  18     # catching Win32 drives ("C:\").
  19     $defaultrepo_base = $defaultrepo;
  20     $defaultrepo_base =~ s#/[^/]+/?$##;
  21     $defaultrepo_lib = "$defaultrepo_base/packages";
  22     $hsc2hs_repo_loc = $defaultrepo_base;
  23 }
  24 elsif ($defaultrepo =~ /^(\.\.)?\//) {
  25     # Local filesystem, either absolute or relative path
  26     # (assumes a checked-out tree):
  27     $defaultrepo_base = $defaultrepo;
  28     $defaultrepo_lib = "$defaultrepo/libraries";
  29     $hsc2hs_repo_loc = "$defaultrepo_base/utils";
  30 }
  31 else {
  32     die "Couldn't work out defaultrepo";
  33 }
  34
  35 my $verbose = 2;
  36 my $ignore_failure = 0;
  37
  38 # --extra says we grab the extra libs with 'get'.  It has no effect on
  39 # the other commands.
  40 my $extra = 0;
  41 # --nofib/--testsuite tell get to also grab the respective repos.
  42 # They have no effect on the other commands.
  43 my $nofib = 0;
  44 my $testsuite = 0;
  45
  46 sub message {
  47     if ($verbose >= 2) {
  48         print "@_\n";
  49     }
  50 }
  51
  52 sub warning {
  53     if ($verbose >= 1) {
  54         print "warning: @_\n";
  55     }
  56 }
  57
  58 sub darcs {
  59     message "== running darcs @_";
  60     system ("darcs", @_) == 0
  61         or $ignore_failure
  62         or die "darcs failed: $?";
  63 }
  64
  65 sub darcsall {
  66     my @packages;
  67     darcs @_;
  68     for my $dir (@top_dirs) {
  69         if (-d $dir && -d "$dir/_darcs") {
  70             darcs (@_, "--repodir", $dir);
  71         }
  72         else {
  73             message "== $dir not present or not a repository; skipping";
  74         }
  75     }
  76     for my $path (<libraries/*/_darcs>) {
  77         chomp $path;
  78         if ($path =~ m#/(.*)/#) {
  79             my $pkg = $1;
  80             darcs (@_, "--repodir", "libraries/$pkg");
  81         }
  82         else {
  83             die "that pattern can't fail!";
  84         }
  85     }
  86     @packages = `cat libraries/boot-packages`;
  87     # @packages = `cat libraries/boot-packages libraries/extra-packages`;
  88     for my $pkg (@packages) {
  89         chomp $pkg;
  90         if (! -d "libraries/$pkg") {
  91             warning("$pkg doesn't exist, use 'darcs-all get' to get it");
  92         }
  93     }
  94 }
  95
  96 sub darcsgetpackage {
  97     my ($get_it, $r_flags, $repo_root, $package) = @_;
  98
  99     if ($get_it) {
 100         if (-d $package) {
 101             warning("$package already present; omitting");
 102         }
 103         else {
 104             darcs (@$r_flags, "$repo_root/$package");
 105         }
 106     }
 107 }
 108
 109 sub darcsget {
 110     my $r_flags;
 111     if (! grep /(?:--complete|--partial)/, @_) {
 112         warning("adding --partial, to override use --complete");
 113         $r_flags = [@_, "--partial"];
 114     }
 115     else {
 116         $r_flags = \@_;
 117     }
 118
 119     darcsgetpackage($nofib,     $r_flags, $defaultrepo_base, "nofib");
 120     darcsgetpackage($testsuite, $r_flags, $defaultrepo_base, "testsuite");
 121
 122     chdir "utils";
 123     darcsgetpackage(1         , $r_flags, $hsc2hs_repo_loc,  "hsc2hs");
 124     chdir "..";
 125
 126     chdir "libraries";
 127
 128     my @packages;
 129     if ($extra) {
 130         @packages = `cat boot-packages extra-packages`;
 131     }
 132     else {
 133         @packages = `cat boot-packages`;
 134     }
 135
 136     for my $pkg (@packages) {
 137         chomp $pkg;
 138         darcsgetpackage(1, $r_flags, $defaultrepo_lib, $pkg);
 139     }
 140 }
 141
 142 sub main {
 143     if (! -d "_darcs" || ! -d "compiler") {
 144         die "error: darcs-all must be run from the top level of the ghc tree."
 145     }
 146
 147     while ($#_ ne -1) {
 148         my $arg = shift;
 149         # We handle -q here as well as lower down as we need to skip over it
 150         # if it comes before the darcs command
 151         if ($arg eq "-q") {
 152             $verbose = 1;
 153         }
 154         elsif ($arg eq "-s") {
 155             $verbose = 0;
 156         }
 157         elsif ($arg eq "--extra") {
 158             $extra = 1;
 159         }
 160         elsif ($arg eq "--nofib") {
 161             $nofib = 1;
 162         }
 163         elsif ($arg eq "--testsuite") {
 164             $testsuite = 1;
 165         }
 166         else {
 167             unshift @_, $arg;
 168             if (grep /^-q$/, @_) {
 169                 $verbose = 1;
 170             }
 171             last;
 172         }
 173     }
 174
 175     if ($#_ eq -1) {
 176         die "What do you want to do?";
 177     }
 178     my $command = $_[0];
 179     if ($command eq "get") {
 180         darcsget @_;
 181     }
 182     else {
 183         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
 184             # Hack around whatsnew failing if there are no changes
 185             $ignore_failure = 1;
 186         }
 187         darcsall @_;
 188     }
 189 }
 190
 191 main(@ARGV);
 192