on master help sign in
Merge branch 'kmicklas-force-update-thunk' into develop
1f9f466Ali Abrar
ChangeLog.md+2
@@ -12,6 +12,8 @@ This project's release branch is `master`. This log is written from the perspect
12* 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.
12* 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.
13* 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`.
13* 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`.
14* 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`.
14* 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+
15
17
16## v0.1.0.0 - 2019-03-29
18## v0.1.0.0 - 2019-03-29
17
19
lib/command/src/Obelisk/Command.hs+7−4
@@ -213,14 +213,17 @@ thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgumen
213data ThunkCommand
213data ThunkCommand
214 = ThunkCommand_Update [FilePath] (Maybe String)
214 = ThunkCommand_Update [FilePath] (Maybe String)
215 | ThunkCommand_Unpack [FilePath]
215 | ThunkCommand_Unpack [FilePath]
216− | ThunkCommand_Pack [FilePath]
216+ | ThunkCommand_Pack [FilePath] Bool
217 deriving Show
217 deriving Show
218
218
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+
219thunkCommand :: Parser ThunkCommand
222thunkCommand :: Parser ThunkCommand
220thunkCommand = hsubparser $ mconcat
223thunkCommand = hsubparser $ mconcat
221 [ command "update" $ info (ThunkCommand_Update <$> some thunkDirectoryParser <*> optional (strOption (long "branch" <> metavar "BRANCH"))) $ progDesc "Update thunk to latest revision available"
224 [ command "update" $ info (ThunkCommand_Update <$> some thunkDirectoryParser <*> optional (strOption (long "branch" <> metavar "BRANCH"))) $ progDesc "Update thunk to latest revision available"
222 , command "unpack" $ info (ThunkCommand_Unpack <$> some thunkDirectoryParser) $ progDesc "Unpack thunk into git checkout of revision it points to"
225 , 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"
224 ]
227 ]
225
228
226data ShellOpts
229data ShellOpts
@@ -342,7 +345,7 @@ ob = \case
342 Right (ThunkData_Packed ptr) -> return ptr
345 Right (ThunkData_Packed ptr) -> return ptr
343 Right (ThunkData_Checkout (Just ptr)) -> return ptr
346 Right (ThunkData_Checkout (Just ptr)) -> return ptr
344 Right (ThunkData_Checkout Nothing) ->
347 Right (ThunkData_Checkout Nothing) ->
345− getThunkPtr' False root
348+ getThunkPtr False root
346 let sshKeyPath = _deployInitOpts_sshKey deployOpts
349 let sshKeyPath = _deployInitOpts_sshKey deployOpts
347 hostname = _deployInitOpts_hostname deployOpts
350 hostname = _deployInitOpts_hostname deployOpts
348 route = _deployInitOpts_route deployOpts
351 route = _deployInitOpts_route deployOpts
@@ -361,7 +364,7 @@ ob = \case
361 ObCommand_Thunk tc -> case tc of
364 ObCommand_Thunk tc -> case tc of
362 ThunkCommand_Update thunks mBranch -> mapM_ ((flip updateThunkToLatest) mBranch) thunks
365 ThunkCommand_Update thunks mBranch -> mapM_ ((flip updateThunkToLatest) mBranch) thunks
363 ThunkCommand_Unpack thunks -> mapM_ unpackThunk thunks
366 ThunkCommand_Unpack thunks -> mapM_ unpackThunk thunks
364− ThunkCommand_Pack thunks -> forM_ thunks packThunk
367+ ThunkCommand_Pack thunks force -> forM_ thunks (packThunk force)
365 ObCommand_Repl -> runRepl
368 ObCommand_Repl -> runRepl
366 ObCommand_Watch -> inNixShell' $ static runWatch
369 ObCommand_Watch -> inNixShell' $ static runWatch
367 ObCommand_Shell so -> withProjectRoot "." $ \root ->
370 ObCommand_Shell so -> withProjectRoot "." $ \root ->
lib/command/src/Obelisk/Command/Deploy.hs+1−1
@@ -108,7 +108,7 @@ deployPush deployPath getNixBuilders = do
108 Right (ThunkData_Packed ptr) -> return ptr
108 Right (ThunkData_Packed ptr) -> return ptr
109 Right (ThunkData_Checkout _) -> do
109 Right (ThunkData_Checkout _) -> do
110 checkGitCleanStatus srcPath True >>= \case
110 checkGitCleanStatus srcPath True >>= \case
111− True -> packThunk srcPath
111+ True -> packThunk False srcPath
112 False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
112 False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
113 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)
113 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)
114 let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr
114 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
26 , readThunk
26 , readThunk
27 , updateThunk
27 , updateThunk
28 , getThunkPtr
28 , getThunkPtr
29− , getThunkPtr'
30 , parseGitUri
29 , parseGitUri
31 , uriThunkPtr
30 , uriThunkPtr
32 ) where
31 ) where
@@ -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]
579
578
@@ -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]
624
623
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
629
627
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
641
639
642−getThunkPtr :: MonadObelisk m => FilePath -> m ThunkPtr
643−getThunkPtr = getThunkPtr' True
644−
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"
649
644