bd8d7123ed8bf2002a0663cd20303a2ad6a5ba03
[ghc.git] / 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