on master help sign in
Allow deployments with unpacked/dirty thunks
commit199798bffac36e6f63f0300f2cfd09f26362a956 author3noch <eacameron@gmail.com> dateThu 9 Jul 2020, 15:05 (6 years ago) parenta8c4822
1 file changed+16−13
lib/command/src/Obelisk/Command/Deploy.hs+16−13
lib/command/src/Obelisk/Command/Deploy.hs+16−13
@@ -17,6 +17,7 @@ import Data.Bits
1717import qualified Data.ByteString.Lazy as BSL
1818import Data.Default
1919import qualified Data.Map as Map
20+import Data.Maybe (isJust)
2021import qualified Data.Set as Set
2122import Data.String.Here.Interpolated (i)
2223import qualified Data.Text as T
@@ -125,14 +126,15 @@ deployPush deployPath getNixBuilders = do
125126 route <- readDeployConfig deployPath $ "config" </> "common" </> "route"
126127 routeHost <- getHostFromRoute enableHttps route
127128 let srcPath = deployPath </> "src"
128− thunkPtr <- readThunk srcPath >>= \case
129− Right (ThunkData_Packed _ ptr) -> return ptr
129+ thunkPtr' <- readThunk srcPath >>= \case
130+ Right (ThunkData_Packed _ ptr) -> return $ Just ptr
130131 Right ThunkData_Checkout -> do
131132 checkGitCleanStatus srcPath True >>= \case
132− True -> packThunk (ThunkPackConfig False (ThunkConfig Nothing)) srcPath
133− False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
133+ True -> Just <$> packThunk (ThunkPackConfig False (ThunkConfig Nothing)) srcPath
134+ False -> Nothing <$ putLog Warning "Skipping packing of src thunk; won't be able to automatically commit this deployment"
135+ -- failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
134136 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)
135− let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr
137+ let version' = show . _thunkRev_commit . _thunkPtr_rev <$> thunkPtr'
136138 builders <- getNixBuilders
137139 let moduleFile = deployPath </> "module.nix"
138140 moduleFileExists <- liftIO $ doesFileExist moduleFile
@@ -149,7 +151,7 @@ deployPush deployPath getNixBuilders = do
149151 [ strArg "hostName" host
150152 , strArg "adminEmail" adminEmail
151153 , strArg "routeHost" routeHost
152− , strArg "version" version
154+ , strArg "version" $ maybe "Deployment was done with a dirty source tree" id version'
153155 , boolArg "enableHttps" enableHttps
154156 ] <> [rawArg "module" ("import " <> toNixPath moduleFile) | moduleFileExists ])
155157 & nixCmdConfig_builders .~ builders
@@ -179,13 +181,14 @@ deployPush deployPath getNixBuilders = do
179181 , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
180182 ]
181183 ]
182− isClean <- checkGitCleanStatus deployPath True
183− when (not isClean) $ do
184− withSpinner "Committing changes to Git" $ do
185− callProcessAndLogOutput (Debug, Error) $ proc "git"
186− ["-C", deployPath, "add", "."]
187− callProcessAndLogOutput (Debug, Error) $ proc "git"
188− ["-C", deployPath, "commit", "-m", "New deployment"]
184+ when (isJust version') $ do
185+ isClean <- checkGitCleanStatus deployPath True
186+ when (not isClean) $ do
187+ withSpinner "Committing changes to Git" $ do
188+ callProcessAndLogOutput (Debug, Error) $ proc "git"
189+ ["-C", deployPath, "add", "."]
190+ callProcessAndLogOutput (Debug, Error) $ proc "git"
191+ ["-C", deployPath, "commit", "-m", "New deployment"]
189192 putLog Notice $ "Deployed => " <> T.pack route
190193 where
191194 callProcess' envMap cmd args = do