Hack around weird reactor build failure

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
+      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

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

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 =

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

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))