fix: bail if purs exits non-ok

src/Spago/Cmd.purs

@@ -39,6 +39,14 @@ type ExecResult =
   , timedOut :: Boolean
   }
 
+exitedOk :: Either ExecResult ExecResult -> Boolean
+exitedOk = either identity identity >>> case _ of
+  { exit: Normally 0 } -> true
+  _ -> false
+
+exit :: Either ExecResult ExecResult -> Exit
+exit = either identity identity >>> _.exit
+
 printExecResult :: ExecResult -> String
 printExecResult r = Array.intercalate "\n"
   [ "escapedCommand: " <> show r.escapedCommand

src/Spago/Psa.purs

@@ -10,9 +10,12 @@ import Spago.Prelude
 
 import Codec.JSON.DecodeError as CJ.DecodeError
 import Control.Alternative as Alternative
+import Control.Monad.Except.Trans (ExceptT(..), runExceptT)
+import Control.Monad.Trans.Class (lift)
 import Data.Array as Array
 import Data.Array.NonEmpty as NonEmptyArray
 import Data.Codec.JSON as CJ
+import Data.Either (blush)
 import Data.Map as Map
 import Data.Set as Set
 import Data.String as Str
@@ -21,6 +24,7 @@ import Data.Tuple as Tuple
 import Effect.Ref as Ref
 import Foreign.Object as FO
 import JSON as JSON
+import Node.ChildProcess.Types (Exit(..))
 import Node.Encoding as Encoding
 import Node.FS.Aff as FSA
 import Node.Path as Path
@@ -40,35 +44,40 @@ defaultStatVerbosity = Core.CompactStats
 
 psaCompile :: forall a. Set.Set FilePath -> Array String -> PsaArgs -> Spago (Purs.PursEnv a) Boolean
 psaCompile globs pursArgs psaArgs = do
-  result <- Purs.compile globs (Array.snoc pursArgs "--json-errors")
-  let resultStdout = Cmd.getStdout result
-  arrErrorsIsEmpty <- forWithIndex (Str.split (Str.Pattern "\n") resultStdout) \idx err ->
-    case JSON.parse err >>= CJ.decode psaResultCodec >>> lmap CJ.DecodeError.print of
-      Left decodeErrMsg -> do
-        logWarn $ Array.intercalate "\n"
-          [ "Failed to decode PsaResult at index '" <> show idx <> "': " <> decodeErrMsg
-          , "Json was: " <> err
-          ]
-        -- If we can't decode the error, then there's likely a codec issue on Spago's side.
-        -- So, this shouldn't fail the build.
-        pure true
-      Right out -> do
-        files <- liftEffect $ Ref.new FO.empty
-        out' <- buildOutput (loadLines files) psaArgs out
-
-        liftEffect $ if psaArgs.jsonErrors then printJsonOutputToOut out' else printDefaultOutputToErr psaArgs out'
-
-        pure $ FO.isEmpty out'.stats.allErrors
-
-  if Array.all identity arrErrorsIsEmpty then do
-    logSuccess "Build succeeded."
-    pure true
-  else do
-    case result of
-      Left r -> logDebug $ Cmd.printExecResult r
-      _ -> pure unit
-    prepareToDie [ "Failed to build." ]
-    pure false
+  purs <- Purs.compile globs (Array.snoc pursArgs "--json-errors")
+  let
+    resultStdout = Cmd.getStdout purs
+    print' = if psaArgs.jsonErrors then printJsonOutputToOut else printDefaultOutputToErr psaArgs
+
+  errors <- for (Str.split (Str.Pattern "\n") resultStdout) \err -> runExceptT do
+    -- If we can't decode the error, then there's likely a codec issue on Spago's side.
+    -- So, this shouldn't fail the build.
+    out <- ExceptT $ pure $ JSON.parse err >>= CJ.decode psaResultCodec >>> lmap CJ.DecodeError.print
+    files <- liftEffect $ Ref.new FO.empty
+    out' <- lift $ buildOutput (loadLines files) psaArgs out
+    liftEffect (print' out') $> FO.isEmpty out'.stats.allErrors
+
+  let
+    noErrors = Array.all (either (const true) identity) errors
+    failedToDecodeMsg (idx /\ err) =
+      Array.intercalate "\n"
+        [ "Failed to decode PsaResult at index '" <> show idx <> "': " <> err
+        , "Json was: " <> err
+        ]
+    failedToDecode = failedToDecodeMsg <$> Array.catMaybes (Array.mapWithIndex (\idx e -> (idx /\ _) <$> blush e) errors)
+
+  case Cmd.exit purs, noErrors of
+    Normally 0, true ->
+      for failedToDecode logWarn
+        *> logSuccess "Build succeeded."
+        $> true
+    _, true ->
+      prepareToDie [ "purs exited with non-ok status code: " <> show (Cmd.exit purs) ]
+        $> false
+    _, _ ->
+      for (blush purs) (logDebug <<< Cmd.printExecResult)
+        *> prepareToDie [ "Failed to build." ]
+        $> false
 
   where
   isEmptySpan filename pos =

test-fixtures/purs-not-ok.txt

@@ -0,0 +1,11 @@
+Reading Spago workspace configuration...
+
+✓ Selecting package to build: aaa
+
+Downloading dependencies...
+No lockfile found, generating it...
+Lockfile written to spago.lock. Please commit this file.
+Building...
+IF YOURE SEEING THIS IT MEANS THAT THE TEST THAT OVERRIDES purs WAS NOT CLEANED UP PROPERLY!!1
+
+✘ purs exited with non-ok status code: Normally 1

test/Spago/Build.purs

@@ -2,9 +2,11 @@ module Test.Spago.Build where
 
 import Test.Prelude
 
+import Data.Array (intercalate)
 import Data.Foldable (fold)
 import Data.String as String
 import Node.FS.Aff as FSA
+import Node.FS.Perms as FS.Perms
 import Node.Path as Path
 import Node.Platform as Platform
 import Node.Process as Process
@@ -32,6 +34,38 @@ spec = Spec.around withTempDir do
       spago [ "init", "--name", "aaa", "--use-solver" ] >>= shouldBeSuccess
       spago [ "build" ] >>= shouldBeSuccess
 
+    Spec.after (rmRf <<< _.testCwd)
+      $ Spec.it "exits when purs exits non-ok"
+      $ \{ spago, testCwd, fixture } -> do
+          let
+            prependToPath a = testCwd <> ":" <> a
+
+          -- NOTE: this is reset in `Spec.after`
+          -- by removing the tmp dir, rather than
+          -- storing and restoring the PATH variable
+          liftEffect
+            $ Process.lookupEnv "PATH"
+              <#> fromMaybe ""
+              <#> prependToPath
+              >>= Process.setEnv "PATH"
+
+          spago [ "init", "--name", "aaa" ] >>= shouldBeSuccess
+
+          let
+            pursShimPath = testCwd <> "/purs"
+            pursShim =
+              intercalate "\n"
+              [ "#!/bin/bash"
+              , "if [[ $1 = '--version' ]];"
+              , "  then echo '0.15.15';"
+              , "  else echo 'IF YOURE SEEING THIS IT MEANS THAT THE TEST THAT OVERRIDES purs WAS NOT CLEANED UP PROPERLY!!1' 1>&2; exit 1;"
+              , "fi;"
+              ]
+
+          FS.writeTextFile pursShimPath pursShim
+          FS.chmod pursShimPath FS.Perms.permsAll
+          spago [ "build" ] >>= shouldBeFailureErr (fixture "purs-not-ok.txt")
+
     Spec.it "passes options to purs" \{ spago } -> do
       spago [ "init" ] >>= shouldBeSuccess
       spago [ "build", "--purs-args", "--verbose-errors", "--purs-args", "--comments" ] >>= shouldBeSuccess