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