@@ -378,19 +378,38 @@ createThunkWithLatest target s = do
378378 , _thunkPtr_rev = rev
379379 }
380380
381−updateThunkToLatest :: MonadObelisk m => FilePath -> m ()
382−updateThunkToLatest target = withSpinner' ("Updating thunk " <> T.pack target <> " to latest") (pure $ const $ "Thunk " <> T.pack target <> " updated to latest") $ do
383− (overwrite, ptr) <- readThunk target >>= \case
384− Left err -> failWith $ T.pack $ "thunk update: " <> show err
385− Right c -> case c of
386− ThunkData_Packed t -> return (target, t)
387− ThunkData_Checkout _ -> failWith "cannot update an unpacked thunk"
388− let src = _thunkPtr_source ptr
389− rev <- getLatestRev src
390− overwriteThunk overwrite $ ThunkPtr
391− { _thunkPtr_source = src
392− , _thunkPtr_rev = rev
393− }
381+updateThunkToLatest :: MonadObelisk m => FilePath -> Maybe String -> m ()
382+updateThunkToLatest target mBranch = withSpinner' ("Updating thunk " <> T.pack target <> " to latest") (pure $ const $ "Thunk " <> T.pack target <> " updated to latest") $ do
383+ checkThunkDirectory "ob thunk update directory cannot be '.'" target
384+ -- check to see if thunk should be updated to a specific branch or just update it's current branch
385+ case mBranch of
386+ Nothing -> do
387+ (overwrite, ptr) <- readThunk target >>= \case
388+ Left err -> failWith $ T.pack $ "thunk update: " <> show err
389+ Right c -> case c of
390+ ThunkData_Packed t -> return (target, t)
391+ ThunkData_Checkout _ -> failWith "cannot update an unpacked thunk"
392+ let src = _thunkPtr_source ptr
393+ rev <- getLatestRev src
394+ overwriteThunk overwrite $ ThunkPtr
395+ { _thunkPtr_source = src
396+ , _thunkPtr_rev = rev
397+ }
398+ Just branch -> readThunk target >>= \case
399+ Left err -> failWith $ T.pack $ "thunk update: " <> show err
400+ Right c -> case c of
401+ ThunkData_Packed t -> case _thunkPtr_source t of
402+ ThunkSource_Git tsg -> setThunk target tsg branch
403+ ThunkSource_GitHub tsgh -> do
404+ let tsg = forgetGithub False tsgh
405+ setThunk target tsg branch
406+ ThunkData_Checkout _ -> failWith $ T.pack $ "thunk located at " <> (show target) <> " is unpacked. Use ob thunk pack on the desired directory and then try ob thunk update again."
407+
408+setThunk :: MonadObelisk m => FilePath -> GitSource -> String -> m ()
409+setThunk target gs branch = do
410+ newThunkPtr <- uriThunkPtr (_gitSource_url gs) (Just $ T.pack branch) Nothing
411+ overwriteThunk target newThunkPtr
412+ updateThunkToLatest target Nothing
394413
395414-- | All recognized github standalone loaders, ordered from newest to oldest.
396415-- This tool will only ever produce the newest one when it writes a thunk.
@@ -565,15 +584,14 @@ unpackThunk :: MonadObelisk m => FilePath -> m ()
565584unpackThunk = unpackThunk' False
566585
567586-- | Check that we are not somewhere inside the thunk directory
568−checkThunkDirectory :: MonadObelisk m => FilePath -> m ()
569−checkThunkDirectory thunkDir = do
587+checkThunkDirectory :: MonadObelisk m => Text -> FilePath -> m ()
588+checkThunkDirectory msg thunkDir = do
570589 currentDir <- liftIO getCurrentDirectory
571590 thunkDir' <- liftIO $ canonicalizePath thunkDir
572− when (thunkDir' `L.isInfixOf` currentDir) $
573− failWith "Can't pack/unpack from within the thunk directory"
591+ when (thunkDir' `L.isInfixOf` currentDir) $ failWith msg
574592
575593unpackThunk' :: MonadObelisk m => Bool -> FilePath -> m ()
576−unpackThunk' noTrail thunkDir = checkThunkDirectory thunkDir >> readThunk thunkDir >>= \case
594+unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case
577595 Left err -> failWith $ "thunk unpack: " <> T.pack (show err)
578596 --TODO: Overwrite option that rechecks out thunk; force option to do so even if working directory is dirty
579597 Right (ThunkData_Checkout _) -> failWith "thunk unpack: thunk is already unpacked"
@@ -610,7 +628,7 @@ packThunk :: MonadObelisk m => FilePath -> m ThunkPtr
610628packThunk = packThunk' False
611629
612630packThunk' :: MonadObelisk m => Bool -> FilePath -> m ThunkPtr
613−packThunk' noTrail thunkDir = checkThunkDirectory thunkDir >> readThunk thunkDir >>= \case
631+packThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case
614632 Left err -> failWith $ T.pack $ "thunk pack: " <> show err
615633 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"
616634 Right (ThunkData_Checkout _) -> do
@@ -639,6 +657,22 @@ getThunkPtr' checkClean thunkDir = do
639657 ] ++ T.lines stashOutput
640658 True -> return ()
641659
660+ -- Get current branch ``
661+ (mCurrentBranch, mCurrentCommit) <- do
662+ b <- listToMaybe
663+ <$> T.lines
664+ <$> readGitProcess thunkDir ["rev-parse", "--abbrev-ref", "HEAD"]
665+ c <- listToMaybe
666+ <$> T.lines
667+ <$> readGitProcess thunkDir ["rev-parse", "HEAD"]
668+ case b of
669+ (Just "HEAD") -> failWith $ T.unlines $
670+ [ "thunk pack: You are in 'detached HEAD' state."
671+ , "If you want to pack at the current ref \
672+ \then please create a new branch with 'git checkout -b <new-branch-name>' and push this upstream."
673+ ]
674+ _ -> return (b, c)
675+
642676 -- Get information on all branches and their (optional) designated upstream
643677 -- correspondents
644678 (headDump :: [Text]) <- T.lines <$> readGitProcess thunkDir
@@ -714,11 +748,6 @@ getThunkPtr' checkClean thunkDir = do
714748 -- We assume it's safe to pack the thunk at this point
715749 putLog Informational $ "All changes safe in git remotes. OK to pack thunk."
716750
717− -- Get current branch ``
718− mCurrentBranch <- listToMaybe
719− <$> T.lines
720− <$> readGitProcess thunkDir ["rev-parse", "--abbrev-ref", "HEAD"]
721−
722751 let remote = maybe "origin" snd $ flip Map.lookup headUpstream =<< mCurrentBranch
723752
724753 [remoteUri'] <- fmap T.lines $ readGitProcess thunkDir
@@ -730,7 +759,7 @@ getThunkPtr' checkClean thunkDir = do
730759 remoteUri <- case parseGitUri remoteUri' of
731760 Nothing -> failWith $ "Could not identify git remote: " <> remoteUri'
732761 Just uri -> pure uri
733− uriThunkPtr remoteUri mCurrentBranch
762+ uriThunkPtr remoteUri mCurrentBranch mCurrentCommit
734763
735764-- | Get the latest revision available from the given source
736765getLatestRev :: MonadObelisk m => ThunkSource -> m ThunkRev
@@ -749,9 +778,11 @@ getLatestRev os = do
749778-- performance. If that doesn't work (e.g. authentication issue), we fall back
750779-- on just doing things the normal way for git repos in general, and save it as
751780-- a regular git thunk.
752−uriThunkPtr :: MonadObelisk m => URI -> Maybe Text -> m ThunkPtr
753−uriThunkPtr uri mbranch = do
754− (_, commit) <- gitGetCommitBranch uri mbranch
781+uriThunkPtr :: MonadObelisk m => URI -> Maybe Text -> Maybe Text -> m ThunkPtr
782+uriThunkPtr uri mbranch mcommit = do
783+ commit <- case mcommit of
784+ Nothing -> gitGetCommitBranch uri mbranch >>= return . snd
785+ (Just c) -> return c
755786 (src, rev) <- case uriToThunkSource uri mbranch of
756787 ThunkSource_GitHub s -> do
757788 rev <- runExceptT $ githubThunkRev s commit
@@ -865,9 +896,10 @@ gitThunkRev s commit = do
865896gitGetCommitBranch
866897 :: MonadObelisk m => URI -> Maybe Text -> m (Text, CommitId)
867898gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote " <> uriMsg) $ do
868− bothMaps <- gitLsRemote
899+ (_, bothMaps) <- gitLsRemote
869900 (T.unpack $ render uri)
870901 (GitRef_Branch <$> mbranch)
902+ Nothing
871903 branch <- case mbranch of
872904 Nothing -> withExitFailMessage "Failed to find default branch" $ do
873905 b <- rethrowE $ gitLookupDefaultBranch bothMaps