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