[App::Pls] implemented 'build'

All t/subcommands/build.t tests now pass.

lib/App/Pls.pm

@@ -1,14 +1,15 @@
 use v6;
 
-subset State of Str where {
+subset State of Str where
     'gone' | 'fetched' | 'built' | 'tested' | 'installed'
-};
+;
 enum Result <failure success forced-success>;
 
 role App::Pls::ProjectsState {
     method state-of($project --> State) { !!! }
     method set-state-of($project, State $state) { !!! }
     method deps-of($project) { !!! }
+    method reached-state($project, State $state --> Bool) { !!! }
 }
 
 class App::Pls::ProjectsState::Hash does App::Pls::ProjectsState {
@@ -35,13 +36,21 @@ class App::Pls::ProjectsState::Hash does App::Pls::ProjectsState {
         }
         die "No such project: $project";
     }
+
+    method reached-state($project, $goal-state --> Bool) {
+        my $actual-state = self.state-of($project);
+        my @states = <gone fetched built tested installed>;
+        my %state-levels = invert @states;
+        return %state-levels{$actual-state} >= %state-levels{$goal-state};
+    }
 }
 
 role App::Pls::Fetcher {
     method fetch($project) { !!! }
 }
 
 role App::Pls::Builder {
+    method build($project) { !!! }
 }
 
 role App::Pls::Tester {
@@ -76,7 +85,10 @@ class App::Pls::Core {
             return failure
                 if self!fetch-helper($dep) == failure;
         }
-        if $!fetcher.fetch($project) == success {
+        if $!projects.reached-state($project, 'fetched') {
+            return success;
+        }
+        elsif $!fetcher.fetch($project) == success {
             $!projects.set-state-of($project, 'fetched');
             return success;
         }
@@ -86,7 +98,31 @@ class App::Pls::Core {
     }
 
     method build(*@projects) {
-        return;
+        for @projects -> $project {
+            my %*seen-projects;
+            return failure
+                if self!fetch-helper($project) == failure;
+            return failure
+                if self!build-helper($project) == failure;
+        }
+        return success;
+    }
+
+    method !build-helper($project --> Result) {
+        for $!projects.deps-of($project) -> $dep {
+            return failure
+                if self!build-helper($dep) == failure;
+        }
+        if $!projects.reached-state($project, 'built') {
+            return success;
+        }
+        elsif $!builder.build($project) == success {
+            $!projects.set-state-of($project, 'built');
+            return success;
+        }
+        else {
+            return failure;
+        }
     }
 
     method test(*@projects, Bool :$ignore-deps) {

t/subcommands/build.t

@@ -7,25 +7,33 @@ my %projects =
     fetched       => { :state<fetched> },
     unfetched     => {},
     "won't-fetch" => {},
-    "won't-build" => { :state<fetched> },
+    "won't-build" => {},
     # RAKUDO: Need quotes around keys starting with 'has-' [perl #75694]
     'has-deps'   => { :state<fetched>, :deps<A B> },
     A            => { :state<fetched> },
     B            => { :state<fetched>, :deps<C D> },
     C            => {},
-    D            => { :state<fetched> },
+    D            => { :state<built> },
     circ-deps    => { :state<fetched>, :deps<E> },
     E            => { :state<fetched>, :deps<circ-deps> },
-    dirdep-fails => { :state<fetched>, :deps<will-fail> },
+    dirdep-fails => { :state<fetched>, :deps<won't-build> }, #'
     indir-fails  => { :state<fetched>, :deps<dirdep-fails> },
 ;
 
 my @actions;
 
 class Mock::Fetcher does App::Pls::Builder {
+    method fetch($project --> Result) {
+        push @actions, "fetch[$project]";
+        $project eq "won't-fetch" ?? failure !! success;
+    }
 }
 
 class Mock::Builder does App::Pls::Builder {
+    method build($project --> Result) {
+        push @actions, "build[$project]";
+        $project eq "won't-build" ?? failure !! success;
+    }
 }
 
 my $core = App::Pls::Core.new(
@@ -46,7 +54,7 @@ given $core {
     @actions = ();
     is .state-of('unfetched'), 'gone', "State before: 'gone'";
     is .build(<unfetched>), success, "Building unfetched project succeeded";
-    is ~@actions, 'fetch[unfeched] build[unfetched]',
+    is ~@actions, 'fetch[unfetched] build[unfetched]',
         "Fetched the project before building it";
     is .state-of('unfetched'), 'built', "State after of unfetched: 'built'";
 
@@ -60,14 +68,14 @@ given $core {
     # [T] Build a project; a build error occurs: Fail.
     @actions = ();
     is .build(<won't-build>), failure, "Won't build if build fails"; # "
-    is ~@actions, "fetch[won't-build] build[won't build]", "Tried building";
-    is .state-of("won't-build"), 'gone',
-        "State after of won't-build: unchanged";
+    is ~@actions, "fetch[won't-build] build[won't-build]", "Tried building";
+    is .state-of("won't-build"), 'fetched',
+        "State after of won't-build: 'fetched'";
 
     # [T] Build a project with dependencies: Build dependencies first.
     @actions = ();
-    is .build(<has-deps>), 'success', "Building project with deps succeeds";
-    is ~@actions, "fetch[C] build[A] build[C] build[D] build[has-deps]",
+    is .build(<has-deps>), success, "Building project with deps succeeds";
+    is ~@actions, "fetch[C] build[A] build[C] build[B] build[has-deps]",
         "Fetch before build, build with postorder traversal";
     is .state-of('has-deps'), 'built', "State after of has-deps: built";
     for <A B C D> -> $dep {
@@ -79,21 +87,21 @@ given $core {
     is .build(<circ-deps>), failure, "Building project with circ deps fails";
     is ~@actions, "", "Didn't even try to build anything";
     is .state-of('circ-deps'), 'fetched', "State after of circ-deps: unchanged";
-    is .state-of('E'), 'fetched';
+    is .state-of('E'), 'fetched', "State after of E: unchanged";
 
     # [T] Build a project whose direct dependency fails: Fail.
     is .build(<dirdep-fails>), failure, "Fail when direct dep fails to build";
     is .state-of('dirdep-fails'), 'fetched',
         "State after of dirdep-fails: unchanged";
-    is .state-of('will-fail'), 'fetched',
-        "State after of will-fail: unchanged";
+    is .state-of("won't-build"), 'fetched',
+        "State after of won't-build: unchanged";
 
     # [T] Build a project whose indirect dependency fails: Fail.
     is .build(<indir-fails>), failure, "Fail when indirect dep fails to build";
     is .state-of('indir-fails'), 'fetched',
         "State after of indir-fails: unchanged";
     is .state-of('dirdep-fails'), 'fetched',
         "State after of dirdep-fails: unchanged";
-    is .state-of('will-fail'), 'fetched',
-        "State after of will-fail: unchanged";
+    is .state-of("won't-build"), 'fetched',
+        "State after of won't-build: unchanged";
 }