@@ -26,7 +26,6 @@ module Obelisk.Command.Thunk
26 , readThunk
26 , readThunk
27 , updateThunk
27 , updateThunk
28 , getThunkPtr
28 , getThunkPtr
30 , parseGitUri
29 , parseGitUri
31 , uriThunkPtr
30 , uriThunkPtr
@@ -573,7 +572,7 @@ updateThunk p f = withSystemTempDirectory "obelisk-thunkptr-" $ \tmpDir -> do
573 return tmpThunk
572 return tmpThunk
574 Right _ -> failWith $ "Thunk is not packed"
573 Right _ -> failWith $ "Thunk is not packed"
575 updateThunkFromTmp p' = do
574 updateThunkFromTmp p' = do
576− _ <- packThunk' True p'
575+ _ <- packThunk' True False p'
577 callProcessAndLogOutput (Notice, Error) $
576 callProcessAndLogOutput (Notice, Error) $
578 proc "cp" ["-r", "-T", p', p]
577 proc "cp" ["-r", "-T", p', p]
@@ -622,28 +621,24 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with
622 callProcessAndLogOutput (Notice, Error) $
621 callProcessAndLogOutput (Notice, Error) $
623 proc "mv" ["-T", tmpRepo, thunkDir]
622 proc "mv" ["-T", tmpRepo, thunkDir]
625−--TODO: add force mode to pack even if changes are present
626--TODO: add a rollback mode to pack to the original thunk
624--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
628packThunk = packThunk' False
626packThunk = packThunk' False
630−packThunk' :: MonadObelisk m => Bool -> FilePath -> m ThunkPtr
628+packThunk' :: MonadObelisk m => Bool -> Bool -> FilePath -> m ThunkPtr
631−packThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case
629+packThunk' noTrail force thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case
632 Left err -> failWith $ T.pack $ "thunk pack: " <> show err
630 Left err -> failWith $ T.pack $ "thunk pack: " <> show err
633 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"
631 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"
634 Right (ThunkData_Checkout _) -> do
632 Right (ThunkData_Checkout _) -> do
635 withSpinner' ("Packing thunk " <> T.pack thunkDir)
633 withSpinner' ("Packing thunk " <> T.pack thunkDir)
636 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do
634 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do
637− thunkPtr <- getThunkPtr thunkDir
635+ thunkPtr <- getThunkPtr (not force) thunkDir
638 callProcessAndLogOutput (Debug, Error) $ proc "rm" ["-rf", thunkDir]
636 callProcessAndLogOutput (Debug, Error) $ proc "rm" ["-rf", thunkDir]
639 liftIO $ createThunk thunkDir thunkPtr
637 liftIO $ createThunk thunkDir thunkPtr
640 pure thunkPtr
638 pure thunkPtr
642−getThunkPtr :: MonadObelisk m => FilePath -> m ThunkPtr
643−getThunkPtr = getThunkPtr' True
645−getThunkPtr' :: forall m. MonadObelisk m => Bool -> FilePath -> m ThunkPtr
640+getThunkPtr :: forall m. MonadObelisk m => Bool -> FilePath -> m ThunkPtr
646−getThunkPtr' checkClean thunkDir = do
641+getThunkPtr checkClean thunkDir = do
647 when checkClean $ ensureCleanGitRepo thunkDir True $
642 when checkClean $ ensureCleanGitRepo thunkDir True $
648 "thunk pack: thunk checkout contains unsaved modifications"
643 "thunk pack: thunk checkout contains unsaved modifications"