retry spurious compile error, fail matrix job on bad compile (#740)

thomashoneyman · web-flow · commit 7add44297a72 · 2026-02-01T21:11:11.000+02:00
diff --git a/app/src/App/API.purs b/app/src/App/API.purs
@@ -713,8 +713,8 @@ publish payload = do
       let installedResolutions = Path.concat [ tmp, ".registry" ]
       buildPlan <- MatrixBuilder.resolutionsToBuildPlan validatedResolutions
       MatrixBuilder.installBuildPlan buildPlan installedResolutions
-      compilationResult <- Run.liftAff $ Purs.callCompiler
-        { command: Purs.Compile { globs: [ "src/**/*.purs", Path.concat [ installedResolutions, "*/src/**/*.purs" ] ] }
+      compilationResult <- Purs.compile
+        { globs: [ "src/**/*.purs", Path.concat [ installedResolutions, "*/src/**/*.purs" ] ]
         , version: Just compiler
         , cwd: Just downloadedPackage
         }
@@ -861,8 +861,8 @@ publish payload = do
         Just { result: Right _ } -> do
           Log.debug "Using cached successful compilation, skipping compilation step"
         _ -> do
-          compilationResult <- Run.liftAff $ Purs.callCompiler
-            { command: Purs.Compile { globs: [ Path.concat [ packageSource, "src/**/*.purs" ], Path.concat [ installedResolutions, "*/src/**/*.purs" ] ] }
+          compilationResult <- Purs.compile
+            { globs: [ Path.concat [ packageSource, "src/**/*.purs" ], Path.concat [ installedResolutions, "*/src/**/*.purs" ] ]
             , version: Just compiler
             , cwd: Just tmp
             }
@@ -1018,8 +1018,8 @@ findAllCompilers { source, manifest, compilers } = do
             FS.Extra.ensureDirectory installed
             buildPlanForCompiler <- MatrixBuilder.resolutionsToBuildPlan resolutions
             MatrixBuilder.installBuildPlan buildPlanForCompiler installed
-            result <- Run.liftAff $ Purs.callCompiler
-              { command: Purs.Compile { globs: [ Path.concat [ source, "src/**/*.purs" ], Path.concat [ installed, "*/src/**/*.purs" ] ] }
+            result <- Purs.compile
+              { globs: [ Path.concat [ source, "src/**/*.purs" ], Path.concat [ installed, "*/src/**/*.purs" ] ]
               , version: Just target
               , cwd: Just workdir
               }
diff --git a/app/src/App/CLI/Purs.purs b/app/src/App/CLI/Purs.purs
@@ -12,7 +12,11 @@ import Data.Foldable (foldMap)
 import Data.String as String
 import Node.ChildProcess.Types (Exit(..))
 import Node.Library.Execa as Execa
+import Registry.App.Effect.Log (LOG)
+import Registry.App.Effect.Log as Log
 import Registry.Version as Version
+import Run (AFF, Run)
+import Run as Run
 
 -- | The minimum compiler version that supports 'purs graph'
 minPursGraph :: Version
@@ -169,3 +173,34 @@ callCompiler compilerArgs = do
             Right ({ errors } :: { errors :: Array CompilerError })
               | Array.null errors -> UnknownError "Non-normal exit code, but no errors reported."
               | otherwise -> CompilationError errors
+
+-- | The error message pattern indicating a race condition in the PureScript
+-- | compiler's parallel compilation. This is a transient error that can be
+-- | resolved by retrying.
+compilerRaceConditionError :: String
+compilerRaceConditionError = "Unexpected end of JSON input"
+
+-- | Check if a compiler failure is due to the known race condition bug.
+isCompilerRaceCondition :: CompilerFailure -> Boolean
+isCompilerRaceCondition = case _ of
+  UnknownError err -> String.contains (String.Pattern compilerRaceConditionError) err
+  _ -> false
+
+-- | Compile PureScript source files with automatic retry for transient errors.
+-- | Retries up to 3 times when the "Unexpected end of JSON input" race condition occurs.
+compile
+  :: forall r
+   . { globs :: Array FilePath, version :: Maybe Version, cwd :: Maybe FilePath }
+  -> Run (LOG + AFF + r) (Either CompilerFailure String)
+compile { globs, version, cwd } = go 1
+  where
+  maxRetries = 3
+
+  go :: Int -> Run (LOG + AFF + r) (Either CompilerFailure String)
+  go attempt = do
+    result <- Run.liftAff $ callCompiler { command: Compile { globs }, version, cwd }
+    case result of
+      Left err | isCompilerRaceCondition err && attempt < maxRetries -> do
+        Log.warn $ "Compiler race condition detected (attempt " <> show attempt <> "/" <> show maxRetries <> "), retrying..."
+        go (attempt + 1)
+      _ -> pure result
diff --git a/app/src/App/Effect/PackageSets.purs b/app/src/App/Effect/PackageSets.purs
@@ -234,8 +234,11 @@ handle env = case _ of
   compileInstalledPackages :: Version -> Run _ (Either CompilerFailure String)
   compileInstalledPackages compiler = do
     Log.debug "Compiling installed packages..."
-    let command = Purs.Compile { globs: [ Path.concat [ Path.basename packagesWorkDir, "**/*.purs" ] ] }
-    Run.liftAff $ Purs.callCompiler { command, version: Just compiler, cwd: Just env.workdir }
+    Purs.compile
+      { globs: [ Path.concat [ Path.basename packagesWorkDir, "**/*.purs" ] ]
+      , version: Just compiler
+      , cwd: Just env.workdir
+      }
 
   attemptChanges :: Version -> PackageSet -> ChangeSet -> Run _ (Either CompilerFailure PackageSet)
   attemptChanges compiler (PackageSet set) changes = do
diff --git a/app/src/App/Server/JobExecutor.purs b/app/src/App/Server/JobExecutor.purs
@@ -115,9 +115,11 @@ findNextAvailableJob = runMaybeT
 executeJob :: DateTime -> Job -> Run ServerEffects Unit
 executeJob _ = case _ of
   PublishJob { payload: payload@{ name } } -> do
+    -- `publish` will throw on error, or return `Nothing` if the pipeline
+    -- exited with a valid status but without publishing a package (for instance,
+    -- the package already existed), or return `Just` if a new version was
+    -- published and we need to queue matrix jobs.
     maybeResult <- API.publish payload
-    -- The above operation will throw if not successful, and return a map of
-    -- dependencies of the package only if it has not been published before.
     for_ maybeResult \{ compiler, dependencies, version } -> do
       -- At this point this package has been verified with one compiler only.
       -- So we need to enqueue compilation jobs for (1) same package, all the other
@@ -127,45 +129,48 @@ executeJob _ = case _ of
       let solverData = { compiler, name, version, dependencies, compilerIndex }
       samePackageAllCompilers <- MatrixBuilder.solveForAllCompilers solverData
       sameCompilerAllDependants <- MatrixBuilder.solveDependantsForCompiler solverData
-      for (Array.fromFoldable $ Set.union samePackageAllCompilers sameCompilerAllDependants)
-        \{ compiler: solvedCompiler, resolutions, name: solvedPackage, version: solvedVersion } -> do
-          Log.info $ "Enqueuing matrix job: compiler "
-            <> Version.print solvedCompiler
-            <> ", package "
-            <> PackageName.print solvedPackage
-            <> "@"
-            <> Version.print solvedVersion
-          Db.insertMatrixJob
-            { payload: resolutions
-            , compilerVersion: solvedCompiler
-            , packageName: solvedPackage
-            , packageVersion: solvedVersion
-            }
+      for (Array.fromFoldable $ Set.union samePackageAllCompilers sameCompilerAllDependants) \{ compiler: solvedCompiler, resolutions, name: solvedPackage, version: solvedVersion } -> do
+        Log.info $ Array.fold
+          [ "Enqueuing matrix job: compiler "
+          , Version.print solvedCompiler
+          , ", package "
+          , PackageName.print solvedPackage
+          , "@"
+          , Version.print solvedVersion
+          ]
+        Db.insertMatrixJob
+          { payload: resolutions
+          , compilerVersion: solvedCompiler
+          , packageName: solvedPackage
+          , packageVersion: solvedVersion
+          }
   UnpublishJob { payload } -> API.authenticated payload
   TransferJob { payload } -> API.authenticated payload
   MatrixJob details@{ packageName, packageVersion } -> do
-    maybeDependencies <- MatrixBuilder.runMatrixJob details
-    -- Unlike the publishing case, after verifying a compilation here we only need
-    -- to followup with trying to compile the packages that depend on this one
-    for_ maybeDependencies \dependencies -> do
-      -- TODO here we are building the compiler index, but we should really cache it
-      compilerIndex <- MatrixBuilder.readCompilerIndex
-      let solverData = { compiler: details.compilerVersion, name: packageName, version: packageVersion, dependencies, compilerIndex }
-      sameCompilerAllDependants <- MatrixBuilder.solveDependantsForCompiler solverData
-      for (Array.fromFoldable sameCompilerAllDependants)
-        \{ compiler: solvedCompiler, resolutions, name: solvedPackage, version: solvedVersion } -> do
-          Log.info $ "Enqueuing matrix job: compiler "
-            <> Version.print solvedCompiler
-            <> ", package "
-            <> PackageName.print solvedPackage
-            <> "@"
-            <> Version.print solvedVersion
-          Db.insertMatrixJob
-            { payload: resolutions
-            , compilerVersion: solvedCompiler
-            , packageName: solvedPackage
-            , packageVersion: solvedVersion
-            }
+    -- After publishing a matrix job, we check if any dependents need to also have
+    -- a job queued (for instance a new compiler version came out, we want to have
+    -- packages trigger jobs for their dependents so it cascades through the registry)
+    dependencies <- MatrixBuilder.runMatrixJob details
+
+    -- TODO here we are building the compiler index, but we should really cache it
+    compilerIndex <- MatrixBuilder.readCompilerIndex
+    let solverData = { compiler: details.compilerVersion, name: packageName, version: packageVersion, dependencies, compilerIndex }
+    sameCompilerAllDependants <- MatrixBuilder.solveDependantsForCompiler solverData
+    for_ (Array.fromFoldable sameCompilerAllDependants) \{ compiler: solvedCompiler, resolutions, name: solvedPackage, version: solvedVersion } -> do
+      Log.info $ Array.fold
+        [ "Enqueuing matrix job: compiler "
+        , Version.print solvedCompiler
+        , ", package "
+        , PackageName.print solvedPackage
+        , "@"
+        , Version.print solvedVersion
+        ]
+      Db.insertMatrixJob
+        { payload: resolutions
+        , compilerVersion: solvedCompiler
+        , packageName: solvedPackage
+        , packageVersion: solvedVersion
+        }
   PackageSetJob payload -> API.packageSetUpdate payload
 
 upgradeRegistryToNewCompiler :: forall r. Version -> Run (DB + LOG + EXCEPT String + REGISTRY + r) Unit
@@ -178,12 +183,14 @@ upgradeRegistryToNewCompiler newCompilerVersion = do
     -- because from them we should be able to reach the whole of the registry,
     -- as they complete new jobs for their dependants will be queued up.
     when (Map.isEmpty manifest.dependencies) do
-      Log.info $ "Enqueuing matrix job for _new_ compiler "
-        <> Version.print newCompilerVersion
-        <> ", package "
-        <> PackageName.print manifest.name
-        <> "@"
-        <> Version.print manifest.version
+      Log.info $ Array.fold
+        [ "Enqueuing matrix job for _new_ compiler "
+        , Version.print newCompilerVersion
+        , ", package "
+        , PackageName.print manifest.name
+        , "@"
+        , Version.print manifest.version
+        ]
       void $ Db.insertMatrixJob
         { payload: Map.empty
         , compilerVersion: newCompilerVersion
diff --git a/app/src/App/Server/MatrixBuilder.purs b/app/src/App/Server/MatrixBuilder.purs
@@ -46,7 +46,7 @@ import Run as Run
 import Run.Except (EXCEPT)
 import Run.Except as Except
 
-runMatrixJob :: forall r. MatrixJobData -> Run (REGISTRY + STORAGE + LOG + AFF + EFFECT + EXCEPT String + r) (Maybe (Map PackageName Range))
+runMatrixJob :: forall r. MatrixJobData -> Run (REGISTRY + STORAGE + LOG + AFF + EFFECT + EXCEPT String + r) (Map PackageName Range)
 runMatrixJob { compilerVersion, packageName, packageVersion, payload: buildPlan } = do
   workdir <- Tmp.mkTmpDir
   let installed = Path.concat [ workdir, ".registry" ]
@@ -57,25 +57,27 @@ runMatrixJob { compilerVersion, packageName, packageVersion, payload: buildPlan
     (Map.insert packageName packageVersion buildPlan)
 
   installBuildPlan buildPlanWithIntegrity installed
-  result <- Run.liftAff $ Purs.callCompiler
-    { command: Purs.Compile { globs: [ Path.concat [ installed, "*/src/**/*.purs" ] ] }
+  result <- Purs.compile
+    { globs: [ Path.concat [ installed, "*/src/**/*.purs" ] ]
     , version: Just compilerVersion
     , cwd: Just workdir
     }
   FS.Extra.remove workdir
   case result of
     Left err -> do
-      Log.info $ "Compilation failed with compiler " <> Version.print compilerVersion
-        <> ":\n"
-        <> printCompilerFailure compilerVersion err
-      pure Nothing
+      Log.info $ Array.fold
+        [ "Compilation failed with compiler " <> Version.print compilerVersion
+        , ":\n"
+        , printCompilerFailure compilerVersion err
+        ]
+      Except.throw $ "Compilation failed with compiler " <> Version.print compilerVersion
     Right _ -> do
       Log.info $ "Compilation succeeded with compiler " <> Version.print compilerVersion
 
       Registry.readMetadata packageName >>= case _ of
         Nothing -> do
           Log.error $ "No existing metadata for " <> PackageName.print packageName
-          pure Nothing
+          Except.throw $ "No metadata found for " <> PackageName.print packageName
         Just (Metadata metadata) -> do
           let
             metadataWithCompilers = metadata
@@ -91,10 +93,10 @@ runMatrixJob { compilerVersion, packageName, packageVersion, payload: buildPlan
 
           Log.info "Wrote completed metadata to the registry!"
           Registry.readManifest packageName packageVersion >>= case _ of
-            Just (Manifest manifest) -> pure (Just manifest.dependencies)
+            Just (Manifest manifest) -> pure manifest.dependencies
             Nothing -> do
               Log.error $ "No existing metadata for " <> PackageName.print packageName <> "@" <> Version.print packageVersion
-              pure Nothing
+              Except.throw $ "No manifest found for " <> PackageName.print packageName <> "@" <> Version.print packageVersion
 
 -- TODO feels like we should be doing this at startup and use the cache instead
 -- of reading files all over again
diff --git a/app/test/App/CLI/Purs.purs b/app/test/App/CLI/Purs.purs
@@ -7,6 +7,7 @@ import Data.Array as Array
 import Data.Codec.JSON as CJ
 import Data.Foldable (traverse_)
 import Data.Map as Map
+import Data.String as String
 import JSON as JSON
 import Node.FS.Aff as FS.Aff
 import Node.Path as Path
@@ -20,6 +21,7 @@ import Registry.Test.Utils (filterAvailableCompilers)
 import Registry.Test.Utils as Utils
 import Registry.Version as Version
 import Test.Spec as Spec
+import Test.Spec.Assertions as Assertions
 
 spec :: Spec.Spec Unit
 spec = do
@@ -35,6 +37,41 @@ spec = do
   traverse_ (testMissingVersion <<< Utils.unsafeVersion) [ "0.13.1", "0.13.7", "0.15.1", "0.12.0", "0.14.12345" ]
   traverse_ testCompilationError (filterMaybeVersions [ Just "0.13.0", Just "0.13.8", Just "0.14.0", Just "0.15.0", Nothing ])
   traverse_ testGraph (filterMaybeVersions [ Just "0.14.0", Just "0.15.0", Nothing ])
+
+  Spec.describe "Compiler Race Condition Detection" do
+    Spec.it "Detects race condition error in UnknownError" do
+      let
+        raceConditionError = UnknownError $ String.joinWith "\n"
+          [ "[ 1 of 226] Compiling Unsafe.Coerce"
+          , "[ 2 of 226] Compiling Type.Row"
+          , "JSON: Unexpected end of JSON input"
+          ]
+      Purs.isCompilerRaceCondition raceConditionError `Assertions.shouldEqual` true
+
+    Spec.it "Detects race condition error with surrounding text" do
+      let err = UnknownError "Some prefix text\nJSON: Unexpected end of JSON input\nSome suffix"
+      Purs.isCompilerRaceCondition err `Assertions.shouldEqual` true
+
+    Spec.it "Does not detect race condition for normal UnknownError" do
+      let err = UnknownError "Some other compiler error message"
+      Purs.isCompilerRaceCondition err `Assertions.shouldEqual` false
+
+    Spec.it "Does not detect race condition for CompilationError" do
+      let
+        err = CompilationError
+          [ { position: { startLine: 1, startColumn: 1, endLine: 1, endColumn: 10 }
+            , message: "Unknown module ModuleB"
+            , errorCode: "UnknownModule"
+            , errorLink: "https://example.com"
+            , filename: "test.purs"
+            , moduleName: Just "ModuleA"
+            }
+          ]
+      Purs.isCompilerRaceCondition err `Assertions.shouldEqual` false
+
+    Spec.it "Does not detect race condition for unrelated JSON error" do
+      let err = UnknownError "JSON parse error: invalid syntax at line 5"
+      Purs.isCompilerRaceCondition err `Assertions.shouldEqual` false
   where
   testVersion version =
     Spec.it ("Calls compiler version " <> Version.print version) do
