module Git.Commit.Push where
import Control.Failure
import Control.Monad
import Control.Monad.Trans.Class
import Data.Function
import qualified Data.HashSet as HashSet
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Tagged
import Data.Text (Text)
import Data.Traversable (for)
import Git.Commit
import Git.Object
import Git.Reference
import Git.Types
import Prelude hiding (FilePath)
pushCommit :: (Repository m, Repository (t m), MonadTrans t)
=> CommitOid m -> Text -> t m (CommitOid (t m))
pushCommit coid remoteRefName = do
commits <- mapM copyCommitOid =<< lift (listCommits Nothing coid)
mrref <- fmap Tagged `liftM` resolveReference remoteRefName
mrref' <- for mrref $ \rref ->
if rref `elem` commits
then lift $ copyCommitOid rref
else failure $ PushNotFastForward
$ "SHA " <> renderObjOid rref
<> " not found in remote"
objs <- lift $ listAllObjects mrref' coid
let shas = HashSet.fromList $ map (renderOid . untagObjOid) objs
(cref,_) <- copyCommit coid Nothing shas
unless (renderObjOid coid == renderObjOid cref) $
failure $ BackendError $ "Error copying commit: "
<> renderObjOid coid <> " /= " <> renderObjOid cref
return cref