git.iko.soy/obelisk
on master help sign in
Merge branch 'force-update-thunk' of github.com:kmicklas/obelisk into kmicklas-force-update-thunk

* 'force-update-thunk' of github.com:kmicklas/obelisk: Add option to force pack thunks

commitbf5ca6ce38aa890ad8d55de65f0b1c170696fd10 authorAli Abrar <aliabrar@gmail.com> dateFri 17 May 2019, 23:14 (7 years ago) parent62a192d71528e2
3 files changed+15−17
compare with master
unifiedsplit
lib/command/src/Obelisk/Command.hs+7−4 lib/command/src/Obelisk/Command/Deploy.hs+1−1 lib/command/src/Obelisk/Command/Thunk.hs+7−12
lib/command/src/Obelisk/Command.hs+7−4
@@ -213,14 +213,17 @@ thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgumen
213213data ThunkCommand
214214 = ThunkCommand_Update [FilePath] (Maybe String)
215215 | ThunkCommand_Unpack [FilePath]
216− | ThunkCommand_Pack [FilePath]
216+ | ThunkCommand_Pack [FilePath] Bool
217217 deriving Show
218218
219+forceFlag :: Parser Bool
220+forceFlag = switch $ long "force" <> short 'f' <> help "Force packing thunks even if there are branches not pushed upstream, uncommitted changes, stashes, etc."
221+
219222thunkCommand :: Parser ThunkCommand
220223thunkCommand = hsubparser $ mconcat
221224 [ command "update" $ info (ThunkCommand_Update <$> some thunkDirectoryParser <*> optional (strOption (long "branch" <> metavar "BRANCH"))) $ progDesc "Update thunk to latest revision available"
222225 , command "unpack" $ info (ThunkCommand_Unpack <$> some thunkDirectoryParser) $ progDesc "Unpack thunk into git checkout of revision it points to"
223− , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"
226+ , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser <*> forceFlag) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"
224227 ]
225228
226229data ShellOpts
@@ -342,7 +345,7 @@ ob = \case
342345 Right (ThunkData_Packed ptr) -> return ptr
343346 Right (ThunkData_Checkout (Just ptr)) -> return ptr
344347 Right (ThunkData_Checkout Nothing) ->
345− getThunkPtr' False root
348+ getThunkPtr False root
346349 let sshKeyPath = _deployInitOpts_sshKey deployOpts
347350 hostname = _deployInitOpts_hostname deployOpts
348351 route = _deployInitOpts_route deployOpts
@@ -361,7 +364,7 @@ ob = \case
361364 ObCommand_Thunk tc -> case tc of
362365 ThunkCommand_Update thunks mBranch -> mapM_ ((flip updateThunkToLatest) mBranch) thunks
363366 ThunkCommand_Unpack thunks -> mapM_ unpackThunk thunks
364− ThunkCommand_Pack thunks -> forM_ thunks packThunk
367+ ThunkCommand_Pack thunks force -> forM_ thunks (packThunk force)
365368 ObCommand_Repl -> runRepl
366369 ObCommand_Watch -> inNixShell' $ static runWatch
367370 ObCommand_Shell so -> withProjectRoot "." $ \root ->
lib/command/src/Obelisk/Command/Deploy.hs+1−1
@@ -108,7 +108,7 @@ deployPush deployPath getNixBuilders = do
108108 Right (ThunkData_Packed ptr) -> return ptr
109109 Right (ThunkData_Checkout _) -> do
110110 checkGitCleanStatus srcPath True >>= \case
111− True -> packThunk srcPath
111+ True -> packThunk False srcPath
112112 False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
113113 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)
114114 let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr
lib/command/src/Obelisk/Command/Thunk.hs+7−12
@@ -26,7 +26,6 @@ module Obelisk.Command.Thunk
2626 , readThunk
2727 , updateThunk
2828 , getThunkPtr
29− , getThunkPtr'
3029 , parseGitUri
3130 , uriThunkPtr
3231 ) where
@@ -573,7 +572,7 @@ updateThunk p f = withSystemTempDirectory "obelisk-thunkptr-" $ \tmpDir -> do
573572 return tmpThunk
574573 Right _ -> failWith $ "Thunk is not packed"
575574 updateThunkFromTmp p' = do
576− _ <- packThunk' True p'
575+ _ <- packThunk' True False p'
577576 callProcessAndLogOutput (Notice, Error) $
578577 proc "cp" ["-r", "-T", p', p]
579578
@@ -622,28 +621,24 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with
622621 callProcessAndLogOutput (Notice, Error) $
623622 proc "mv" ["-T", tmpRepo, thunkDir]
624623
625−--TODO: add force mode to pack even if changes are present
626624--TODO: add a rollback mode to pack to the original thunk
627−packThunk :: MonadObelisk m => FilePath -> m ThunkPtr
625+packThunk :: MonadObelisk m => Bool -> FilePath -> m ThunkPtr
628626packThunk = packThunk' False
629627
630−packThunk' :: MonadObelisk m => Bool -> FilePath -> m ThunkPtr
631−packThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case
628+packThunk' :: MonadObelisk m => Bool -> Bool -> FilePath -> m ThunkPtr
629+packThunk' noTrail force thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case
632630 Left err -> failWith $ T.pack $ "thunk pack: " <> show err
633631 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"
634632 Right (ThunkData_Checkout _) -> do
635633 withSpinner' ("Packing thunk " <> T.pack thunkDir)
636634 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do
637− thunkPtr <- getThunkPtr thunkDir
635+ thunkPtr <- getThunkPtr (not force) thunkDir
638636 callProcessAndLogOutput (Debug, Error) $ proc "rm" ["-rf", thunkDir]
639637 liftIO $ createThunk thunkDir thunkPtr
640638 pure thunkPtr
641639
642−getThunkPtr :: MonadObelisk m => FilePath -> m ThunkPtr
643−getThunkPtr = getThunkPtr' True
644−
645−getThunkPtr' :: forall m. MonadObelisk m => Bool -> FilePath -> m ThunkPtr
646−getThunkPtr' checkClean thunkDir = do
640+getThunkPtr :: forall m. MonadObelisk m => Bool -> FilePath -> m ThunkPtr
641+getThunkPtr checkClean thunkDir = do
647642 when checkClean $ ensureCleanGitRepo thunkDir True $
648643 "thunk pack: thunk checkout contains unsaved modifications"
649644