From f8a6e26de2ec19a2fd3705914ebae521ed7acde5 Mon Sep 17 00:00:00 2001 From: Changlin Li Date: Tue, 28 Nov 2023 15:42:19 -0800 Subject: [PATCH] Hack around weird reactor build failure --- builder/src/Deps/CustomRepositoryDataIO.hs | 28 ++++++++++--- builder/src/Deps/Solver.hs | 38 ++++++++++++++++- builder/src/Elm/CustomRepositoryData.hs | 9 ++++ builder/src/Elm/Details.hs | 48 ++++++++++++++++++++++ terminal/src/Develop/StaticFiles/Build.hs | 2 +- 5 files changed, 117 insertions(+), 8 deletions(-) diff --git a/builder/src/Deps/CustomRepositoryDataIO.hs b/builder/src/Deps/CustomRepositoryDataIO.hs index 8b19f7351..5690f7f4f 100644 --- a/builder/src/Deps/CustomRepositoryDataIO.hs +++ b/builder/src/Deps/CustomRepositoryDataIO.hs @@ -1,10 +1,11 @@ module Deps.CustomRepositoryDataIO ( loadCustomRepositoriesData , CustomRepositoriesError(..) + , loadCustomRepositoriesDataForReactorTH ) where -import Elm.CustomRepositoryData (CustomRepositoriesData, customRepostoriesDataDecoder, customRepostoriesDataEncoder, defaultCustomRepositoriesData, CustomRepositoryDataParseError) +import Elm.CustomRepositoryData (CustomRepositoriesData, customRepostoriesDataDecoder, customRepostoriesDataEncoder, defaultCustomRepositoriesData, CustomRepositoryDataParseError, defaultCustomRepositoriesDataElmPackageRepoOnly) import qualified File import qualified Json.Decode as D import qualified Json.Encode as E @@ -14,10 +15,15 @@ import Stuff (ZelmCustomRepositoryConfigFilePath (..)) data CustomRepositoriesError = CREJsonDecodeError (D.Error CustomRepositoryDataParseError) deriving Show -createCustomRepositoriesData :: ZelmCustomRepositoryConfigFilePath -> IO (Either e CustomRepositoriesData) -createCustomRepositoriesData (ZelmCustomRepositoryConfigFilePath filePath) = do - E.write filePath (customRepostoriesDataEncoder defaultCustomRepositoriesData) - pure (Right defaultCustomRepositoriesData) +-- FIXME: Boolean argument a hack for now +createCustomRepositoriesData :: ZelmCustomRepositoryConfigFilePath -> Bool -> IO (Either e CustomRepositoriesData) +createCustomRepositoriesData (ZelmCustomRepositoryConfigFilePath filePath) shouldIncludeZelmRepo = + let + defaultData = if shouldIncludeZelmRepo then defaultCustomRepositoriesData else defaultCustomRepositoriesDataElmPackageRepoOnly + in + do + E.write filePath (customRepostoriesDataEncoder defaultData) + pure (Right defaultData) loadCustomRepositoriesData :: ZelmCustomRepositoryConfigFilePath -> IO (Either CustomRepositoriesError CustomRepositoriesData) loadCustomRepositoriesData z@(ZelmCustomRepositoryConfigFilePath filePath) = do @@ -27,4 +33,14 @@ loadCustomRepositoriesData z@(ZelmCustomRepositoryConfigFilePath filePath) = do bytes <- File.readUtf8 filePath pure $ first CREJsonDecodeError (D.fromByteString customRepostoriesDataDecoder bytes) else - createCustomRepositoriesData z \ No newline at end of file + createCustomRepositoriesData z True + +loadCustomRepositoriesDataForReactorTH :: ZelmCustomRepositoryConfigFilePath -> IO (Either CustomRepositoriesError CustomRepositoriesData) +loadCustomRepositoriesDataForReactorTH z@(ZelmCustomRepositoryConfigFilePath filePath) = do + customReposDataDoesExist <- File.exists filePath + if customReposDataDoesExist + then do + bytes <- File.readUtf8 filePath + pure $ first CREJsonDecodeError (D.fromByteString customRepostoriesDataDecoder bytes) + else + createCustomRepositoriesData z False \ No newline at end of file diff --git a/builder/src/Deps/Solver.hs b/builder/src/Deps/Solver.hs index c34faec26..be069fb71 100644 --- a/builder/src/Deps/Solver.hs +++ b/builder/src/Deps/Solver.hs @@ -12,6 +12,7 @@ module Deps.Solver -- , Env(..) , initEnv + , initEnvForReactorTH ) where @@ -36,7 +37,7 @@ import qualified Reporting.Exit as Exit import qualified Stuff import Elm.CustomRepositoryData (CustomRepositoriesData, customRepostoriesDataDecoder) import Data.Maybe (fromJust) -import Deps.CustomRepositoryDataIO (loadCustomRepositoriesData) +import Deps.CustomRepositoryDataIO (loadCustomRepositoriesData, loadCustomRepositoriesDataForReactorTH) import Reporting.Exit (RegistryProblem(..)) import Stuff (ZelmCustomRepositoryConfigFilePath(unZelmCustomRepositoryConfigFilePath)) import qualified Data.Utf8 as Utf8 @@ -429,6 +430,41 @@ initEnv = Left registryProblem -> return $ Right $ Env cache manager (Offline registryProblem) cachedRegistry packageOverridesCache +initEnvForReactorTH :: IO (Either Exit.RegistryProblem Env) +initEnvForReactorTH = + do mvar <- newEmptyMVar + _ <- forkIO $ putMVar mvar =<< Http.getManager + cache <- Stuff.getPackageCache + packageOverridesCache <- Stuff.getPackageOverridesCache + zelmCache <- Stuff.getZelmCache + customRepositoriesConfigLocation <- Stuff.getOrCreateZelmCustomRepositoryConfig + customRepositoriesDataOrErr <- loadCustomRepositoriesDataForReactorTH customRepositoriesConfigLocation + case customRepositoriesDataOrErr of + Left err -> pure $ Left (RP_BadCustomReposData err (unZelmCustomRepositoryConfigFilePath customRepositoriesConfigLocation)) + Right customRepositoriesData -> + Stuff.withRegistryLock cache $ + do maybeRegistry <- Registry.read zelmCache + manager <- readMVar mvar + + case maybeRegistry of + Nothing -> + do eitherRegistry <- Registry.fetch manager zelmCache customRepositoriesData + case eitherRegistry of + Right latestRegistry -> + return $ Right $ Env cache manager (Online manager) latestRegistry packageOverridesCache + + Left problem -> + return $ Left $ problem + + Just cachedRegistry -> + do eitherRegistry <- Registry.update manager zelmCache cachedRegistry + case eitherRegistry of + Right latestRegistry -> + return $ Right $ Env cache manager (Online manager) latestRegistry packageOverridesCache + + Left registryProblem -> + return $ Right $ Env cache manager (Offline registryProblem) cachedRegistry packageOverridesCache + -- INSTANCES diff --git a/builder/src/Elm/CustomRepositoryData.hs b/builder/src/Elm/CustomRepositoryData.hs index b0f5586da..eedf455a7 100644 --- a/builder/src/Elm/CustomRepositoryData.hs +++ b/builder/src/Elm/CustomRepositoryData.hs @@ -12,6 +12,7 @@ module Elm.CustomRepositoryData , customRepostoriesDataDecoder , customRepostoriesDataEncoder , defaultCustomRepositoriesData + , defaultCustomRepositoriesDataElmPackageRepoOnly , CustomRepositoryDataParseError(..) ) where @@ -241,6 +242,14 @@ customRepostoriesDataDecoder = do , _customSinglePackageRepositories=customSinglePackageRepositories } +defaultCustomRepositoriesDataElmPackageRepoOnly :: CustomRepositoriesData +defaultCustomRepositoriesDataElmPackageRepoOnly = CustomRepositoriesData + { _customFullRepositories = + [ standardElmRepository + ] + , _customSinglePackageRepositories = [] + } + defaultCustomRepositoriesData :: CustomRepositoriesData defaultCustomRepositoriesData = CustomRepositoriesData { _customFullRepositories = diff --git a/builder/src/Elm/Details.hs b/builder/src/Elm/Details.hs index 7c6f45dd4..dc0ffeff3 100644 --- a/builder/src/Elm/Details.hs +++ b/builder/src/Elm/Details.hs @@ -7,6 +7,7 @@ module Elm.Details , Local(..) , Foreign(..) , load + , loadForReactorTH , loadObjects , loadInterfaces , verifyInstall @@ -195,6 +196,20 @@ load style scope root = then return (Right details { _buildID = buildID + 1 }) else generate style scope root newTime +-- FIXME: This is a hack to get around a bug somewhere in the build process +loadForReactorTH :: Reporting.Style -> BW.Scope -> FilePath -> IO (Either Exit.Details Details) +loadForReactorTH style scope root = + do newTime <- File.getTime (root "elm.json") + maybeDetails <- File.readBinary (Stuff.details root) + printLog "Made it to LOAD 1" + case maybeDetails of + Nothing -> + generateForReactorTH style scope root newTime + + Just details@(Details oldTime _ buildID _ _ _) -> + if oldTime == newTime + then return (Right details { _buildID = buildID + 1 }) + else generate style scope root newTime -- GENERATE @@ -215,6 +230,21 @@ generate style scope root time = Outline.App app -> Task.run (verifyApp env time app) +-- FIXME +generateForReactorTH :: Reporting.Style -> BW.Scope -> FilePath -> File.Time -> IO (Either Exit.Details Details) +generateForReactorTH style scope root time = + Reporting.trackDetails style $ \key -> + do result <- initEnvForReactorTH key scope root + printLog "Made it to GENERATE 1" + case result of + Left exit -> + return (Left exit) + + Right (env, outline) -> + case outline of + Outline.Pkg pkg -> Task.run (verifyPkg env time pkg) + Outline.App app -> Task.run (verifyApp env time app) + -- ENV @@ -249,6 +279,24 @@ initEnv key scope root = Right (Solver.Env cache manager connection registry packageOverridesCache) -> return $ Right (Env key scope root cache manager connection registry packageOverridesCache, outline) +-- FIXME +initEnvForReactorTH :: Reporting.DKey -> BW.Scope -> FilePath -> IO (Either Exit.Details (Env, Outline.Outline)) +initEnvForReactorTH key scope root = + do mvar <- fork Solver.initEnv + eitherOutline <- Outline.read root + case eitherOutline of + Left problem -> + return $ Left $ Exit.DetailsBadOutline problem + + Right outline -> + do maybeEnv <- readMVar mvar + case maybeEnv of + Left problem -> + return $ Left $ Exit.DetailsCannotGetRegistry problem + + Right (Solver.Env cache manager connection registry packageOverridesCache) -> + return $ Right (Env key scope root cache manager connection registry packageOverridesCache, outline) + -- VERIFY PROJECT diff --git a/terminal/src/Develop/StaticFiles/Build.hs b/terminal/src/Develop/StaticFiles/Build.hs index c61fae579..538994f11 100644 --- a/terminal/src/Develop/StaticFiles/Build.hs +++ b/terminal/src/Develop/StaticFiles/Build.hs @@ -41,7 +41,7 @@ buildReactorFrontEnd = Dir.withCurrentDirectory "reactor" $ do root <- Dir.getCurrentDirectory runTaskUnsafe $ - do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root + do details <- Task.eio Exit.ReactorBadDetails $ Details.loadForReactorTH Reporting.silent scope root artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details paths javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.prod root details artifacts return (LBS.toStrict (B.toLazyByteString javascript))