micro-opt: replace stmGetEnclosingTRec() with a field access
[ghc-hetmet.git] / darcs-all
index 1e773c9..cdef628 100644 (file)
--- a/darcs-all
+++ b/darcs-all
 
 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
-    $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";
-}
+# Usage:
+#
+# ./darcs-all [-q] [-s] [-i] [-r repo]
+#             [--nofib] [--testsuite] [--checked-out] cmd [darcs flags]
+#
+# Applies the darcs command "cmd" to each repository in the tree.
+#
+# e.g.
+#      ./darcs-all -r http://darcs.haskell.org/ghc get
+#          To get any repos which do not exist in the local tree
+#
+#      ./darcs-all -r ~/ghc-validate push
+#          To push all your repos to the ~/ghc-validate tree
+#
+#      ./darcs-all pull -a
+#          To pull everything from the default repos
+#
+#      ./darc-all push --dry-run
+#          To see what local patches you have relative to the main repos
+#
+#   -q says to be quite, and -s to be silent.
+#
+#   -i says to ignore darcs errors and move on to the next repository
+#
+#   -r repo says to use repo as the location of package repositories
+#
+#   --checked-out says that the remote repo is in checked-out layout, as
+#   opposed to the layout used for the main repo.  By default a repo on
+#   the local filesystem is assumed to be checked-out, and repos accessed
+#   via HTTP or SSH are assumed to be in the main repo layout; use
+#   --checked-out to override the latter.
+#
+#   --nofib, --testsuite also get the nofib and testsuite repos respectively
+#
+#   The darcs get flag you are most likely to want is --complete. By
+#   default we pass darcs the --partial flag.
+#
+
+$| = 1; # autoflush stdout after each print, to avoid output after die
+
+my $defaultrepo;
 
 my $verbose = 2;
 my $ignore_failure = 0;
+my $want_remote_repo = 0;
+my $checked_out_flag = 0;
+
+my %tags;
+
+# Figure out where to get the other repositories from.
+sub getrepo {
+    my $basedir = ".";
+    my $repo = $defaultrepo || `cat $basedir/_darcs/prefs/defaultrepo`;
+    chomp $repo;
 
-# --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;
+    my $repo_base;
+    my $checked_out_tree;
+
+    if ($repo =~ /^...*:/) {
+        # HTTP or SSH
+        # Above regex says "at least two chars before the :", to avoid
+        # catching Win32 drives ("C:\").
+        $repo_base = $repo;
+
+        # --checked-out is needed if you want to use a checked-out repo
+        # over SSH or HTTP
+        if ($checked_out_flag) {
+            $checked_out_tree = 1;
+        } else {
+            $checked_out_tree = 0;
+        }
+
+        # Don't drop the last part of the path if specified with -r, as
+        # it expects repos of the form:
+        #
+        #   http://darcs.haskell.org
+        #
+        # rather than
+        #   
+        #   http://darcs.haskell.org/ghc
+        #
+        if (!$defaultrepo) {
+            $repo_base =~ s#/[^/]+/?$##;
+        }
+    }
+    elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
+        # Local filesystem, either absolute or relative path
+        # (assumes a checked-out tree):
+        $repo_base = $repo;
+        $checked_out_tree = 1;
+    }
+    else {
+        die "Couldn't work out repo";
+    }
+
+    return $repo_base, $checked_out_tree;
+}
 
 sub message {
     if ($verbose >= 2) {
@@ -57,46 +115,67 @@ sub warning {
 sub darcs {
     message "== running darcs @_";
     system ("darcs", @_) == 0
-        or $ignore_failure
-        or die "darcs failed: $?";
+       or $ignore_failure
+       or die "darcs failed: $?";
 }
 
 sub darcsall {
-    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 $pkg (`cat libraries/core-packages libraries/extra-packages`) {
-        chomp $pkg;
-        if (-d "libraries/$pkg") {
-            darcs (@_, "--repodir", "libraries/$pkg");
-        }
-        else {
-            warning("$pkg doesn't exist, use 'darcs-all get' to get it");
-        }
-    }
-}
+    my $localpath;
+    my $remotepath;
+    my $path;
+    my $tag;
+    my @repos;
+
+    my ($repo_base, $checked_out_tree) = getrepo();
 
-sub darcsgetpackage {
-    my ($get_it, $r_flags, $repo_root, $package) = @_;
+    open IN, "< packages" or die "Can't open packages file";
+    @repos = <IN>;
+    close IN;
 
-    if ($get_it) {
-        if (-d $package) {
-            warning("$package already present; omitting");
+    REPO: foreach (@repos) {
+        chomp;
+        if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
+            $localpath = $1;
+            $tag = defined($2) ? $2 : "";
+            $remotepath = $3;
+
+            if ($checked_out_tree) {
+                $path = "$repo_base/$localpath";
+            }
+            else {
+                $path = "$repo_base/$remotepath";
+            }
+
+            if (-d "$localpath/_darcs") {
+                if ($want_remote_repo) {
+                    darcs (@_, "--repodir", $localpath, $path);
+                } else {
+                    darcs (@_, "--repodir", $localpath);
+                }
+            }
+            elsif ($tag eq "") {
+                message "== Required repo $localpath is missing! Skipping";
+            }
+            else {
+                message "== $localpath repo not present; skipping";
+            }
         }
-        else {
-            darcs (@$r_flags, "$repo_root/$package");
+        elsif (! /^(#.*)?$/) {
+            die "Bad line: $_";
         }
     }
 }
 
 sub darcsget {
     my $r_flags;
+    my $localpath;
+    my $remotepath;
+    my $path;
+    my $tag;
+    my @repos;
+
+    my ($repo_base, $checked_out_tree) = getrepo();
+
     if (! grep /(?:--complete|--partial)/, @_) {
         warning("adding --partial, to override use --complete");
         $r_flags = [@_, "--partial"];
@@ -105,27 +184,41 @@ sub darcsget {
         $r_flags = \@_;
     }
 
-    darcsgetpackage($nofib,     $r_flags, $defaultrepo_base, "nofib");
-    darcsgetpackage($testsuite, $r_flags, $defaultrepo_base, "testsuite");
+    open IN, "< packages" or die "Can't open packages file";
+    @repos = <IN>;
+    close IN;
 
-    chdir "libraries";
+    foreach (@repos) {
+        chomp;
+        if (/^([^ ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
+            $localpath = $1;
+            $tag = defined($2) ? $2 : "";
+            $remotepath = $3;
 
-    my @packages;
-    if ($extra) {
-        @packages = `cat core-packages extra-packages`;
-    }
-    else {
-        @packages = `cat core-packages`;
-    }
+            if ($checked_out_tree) {
+                $path = "$repo_base/$localpath";
+            }
+            else {
+                $path = "$repo_base/$remotepath";
+            }
 
-    for my $pkg (@packages) {
-        chomp $pkg;
-        darcsgetpackage(1, $r_flags, $defaultrepo_lib, $pkg);
+            if (($tag eq "") || defined($tags{$tag})) {
+                if (-d $localpath) {
+                    warning("$localpath already present; omitting");
+                }
+                else {
+                    darcs (@$r_flags, $path, $localpath);
+                }
+            }
+        }
+        elsif (! /^(#.*)?$/) {
+            die "Bad line: $_";
+        }
     }
 }
 
 sub main {
-    if (! -d "_darcs" || ! -d "compiler") {
+    if (! -d "compiler") {
         die "error: darcs-all must be run from the top level of the ghc tree."
     }
 
@@ -139,14 +232,24 @@ sub main {
         elsif ($arg eq "-s") {
             $verbose = 0;
         }
-        elsif ($arg eq "--extra") {
-            $extra = 1;
+        elsif ($arg eq "-r") {
+            $defaultrepo = shift;
         }
+        elsif ($arg eq "-i") {
+            $ignore_failure = 1;
+        }
+        # --nofib tells get to also grab the nofib repo.
+        # It has no effect on the other commands.
         elsif ($arg eq "--nofib") {
-            $nofib = 1;
+            $tags{"nofib"} = 1;
         }
+        # --testsuite tells get to also grab the testsuite repo.
+        # It has no effect on the other commands.
         elsif ($arg eq "--testsuite") {
-            $testsuite = 1;
+            $tags{"testsuite"} = 1;
+        }
+        elsif ($arg eq "--checked-out") {
+            $checked_out_flag = 1;
         }
         else {
             unshift @_, $arg;
@@ -169,9 +272,30 @@ sub main {
             # Hack around whatsnew failing if there are no changes
             $ignore_failure = 1;
         }
+        if ($command =~ /^(pul|pus|sen|put)/) {
+            $want_remote_repo = 1;
+        }
         darcsall @_;
     }
 }
 
+END {
+    message "== Checking for old bytestring repo";
+    if (-d "libraries/bytestring/_darcs") {
+        if ((system "darcs annotate --repodir libraries/bytestring --match 'hash 20080118173113-3fd76-d5b74c04372a297b585ebea4e16d524551ce5035' > /dev/null 2> /dev/null") == 0) {
+            print <<EOF;
+============================
+ATTENTION!
+
+You have an old bytestring repository in your GHC tree!
+
+Please remove it (e.g. "rm -r libraries/bytestring"), and the new
+version of bytestring will be used from a tarball instead.
+============================
+EOF
+        }
+    }
+}
+
 main(@ARGV);