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

* kmicklas-force-update-thunk: Add changelog for forced-packing of thunks; update warning message Add option to force pack thunks

commit1f9f466fc38a37a72afb316cee4f3317af204220 authorAli Abrar <aliabrar@gmail.com> dateFri 17 May 2019, 23:19 (7 years ago) parent62a192db1e4c40
4 files changed+17−17
compare with master
unifiedsplit
ChangeLog.md+2 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
ChangeLog.md+2
@@ -12,6 +12,8 @@ This project's release branch is `master`. This log is written from the perspect
1212* Allow skeleton's obelisk to be overridden. This changes the skeleton's default.nix interface: the arguments that it used to take are now part of the new "obelisk" argument.
1313* Removed `MonadIO` from `ObeliskWidget` to prevent accidental IO during prerendering. If you need to do IO in a widget it should be on the right hand side of a `prerender`.
1414* Significantly changed the interface to the "executable config" packages. `obelisk-executable-config-lookup` is a new internal package which looks up all configs in a platform-specific way. `obelisk-executable-frontend` and `obelisk-executable-backend` provide MTL-style monad classes (`HasFrontendConfigs` and `HasBackendConfigs`) which the frontend and backend, respectively, can use to look up configs. This replaces the old `get` function which ran in `IO`.
15+* Add a flag to force thunk packing even if there are unpushed changes in the unpacked thunk.
16+
1517
1618## v0.1.0.0 - 2019-03-29
1719
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. This will cause changes that have not been pushed upstream to be lost; use with care."
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