on master help sign in
ob thunk issue fix: pack on branch A always packs into the tip
2e3cb46Divam
lib/command/src/Obelisk/Command/Thunk.hs+11−6
@@ -640,17 +640,20 @@ getThunkPtr' checkClean thunkDir = do
640 True -> return ()
640 True -> return ()
641
641
642 -- Get current branch ``
642 -- Get current branch ``
643− mCurrentBranch <- do
643+ (mCurrentBranch, mCurrentCommit) <- do
644 b <- listToMaybe
644 b <- listToMaybe
645 <$> T.lines
645 <$> T.lines
646 <$> readGitProcess thunkDir ["rev-parse", "--abbrev-ref", "HEAD"]
646 <$> readGitProcess thunkDir ["rev-parse", "--abbrev-ref", "HEAD"]
647+ c <- listToMaybe
648+ <$> T.lines
649+ <$> readGitProcess thunkDir ["rev-parse", "HEAD"]
647 case b of
650 case b of
648 (Just "HEAD") -> failWith $ T.unlines $
651 (Just "HEAD") -> failWith $ T.unlines $
649 [ "thunk pack: You are in 'detached HEAD' state."
652 [ "thunk pack: You are in 'detached HEAD' state."
650 , "If you want to pack at the current ref \
653 , "If you want to pack at the current ref \
651 \then please create a new branch with 'git checkout -b <new-branch-name>' and push this upstream."
654 \then please create a new branch with 'git checkout -b <new-branch-name>' and push this upstream."
652 ]
655 ]
653− _ -> return b
656+ _ -> return (b, c)
654
657
655 -- Get information on all branches and their (optional) designated upstream
658 -- Get information on all branches and their (optional) designated upstream
656 -- correspondents
659 -- correspondents
@@ -738,7 +741,7 @@ getThunkPtr' checkClean thunkDir = do
738 remoteUri <- case parseGitUri remoteUri' of
741 remoteUri <- case parseGitUri remoteUri' of
739 Nothing -> failWith $ "Could not identify git remote: " <> remoteUri'
742 Nothing -> failWith $ "Could not identify git remote: " <> remoteUri'
740 Just uri -> pure uri
743 Just uri -> pure uri
741− uriThunkPtr remoteUri mCurrentBranch
744+ uriThunkPtr remoteUri mCurrentBranch mCurrentCommit
742
745
743-- | Get the latest revision available from the given source
746-- | Get the latest revision available from the given source
744getLatestRev :: MonadObelisk m => ThunkSource -> m ThunkRev
747getLatestRev :: MonadObelisk m => ThunkSource -> m ThunkRev
@@ -757,9 +760,11 @@ getLatestRev os = do
757-- performance. If that doesn't work (e.g. authentication issue), we fall back
760-- performance. If that doesn't work (e.g. authentication issue), we fall back
758-- on just doing things the normal way for git repos in general, and save it as
761-- on just doing things the normal way for git repos in general, and save it as
759-- a regular git thunk.
762-- a regular git thunk.
760−uriThunkPtr :: MonadObelisk m => URI -> Maybe Text -> m ThunkPtr
763+uriThunkPtr :: MonadObelisk m => URI -> Maybe Text -> Maybe Text -> m ThunkPtr
761−uriThunkPtr uri mbranch = do
764+uriThunkPtr uri mbranch mcommit = do
765+ commit <- case mcommit of
762− (_, commit) <- gitGetCommitBranch uri mbranch
766+ Nothing -> gitGetCommitBranch uri mbranch >>= return . snd
767+ (Just c) -> return c
763 (src, rev) <- case uriToThunkSource uri mbranch of
768 (src, rev) <- case uriToThunkSource uri mbranch of
764 ThunkSource_GitHub s -> do
769 ThunkSource_GitHub s -> do
765 rev <- runExceptT $ githubThunkRev s commit
770 rev <- runExceptT $ githubThunkRev s commit