Branch type and push function

1 files changed, 24 insertions, 0 deletions

diff --git a/src/Repo.hs b/src/Repo.hs
index 2093a9a..c6fc275 100644
--- a/src/Repo.hs
+++ b/src/Repo.hs
@@ -8,6 +8,7 @@ module Repo (
     TreeId, textTreeId, showTreeId,
     Tag(..),
     TagId, textTagId, showTagId,
+    Branch(..),
 
     openRepo,
     readCommit, readCommitId, tryReadCommit,
@@ -27,6 +28,7 @@ module Repo (
     checkoutAt,
     createWipCommit,
     readCommittedFile,
+    pushToBranch,
 
     watchBranch,
     watchTags,
@@ -115,6 +117,11 @@ data Tag a = Tag
     , tagMessage :: Text
     }
 
+data Branch = Branch
+    { branchRepo :: Repo
+    , branchName :: Text
+    }
+
 instance Eq Repo where
     (==) = (==) `on` gitLock
 
@@ -428,6 +435,23 @@ readCommittedFile Tree {..} path = do
                         return (Just content)
             | otherwise -> error "createProcess must return stdout handle"
 
+pushToBranch :: (MonadIO m, MonadFail m) => Branch -> Commit -> m ()
+pushToBranch Branch {..} Commit {..} = do
+    liftIO $
+        withMVar (gitLock branchRepo) $ \_ ->
+        withMVar (gitLock commitRepo) $ \_ -> do
+            let cmd = (proc "git" [ "--git-dir=" <> gitDir commitRepo, "push", "--quiet", "--porcelain", gitDir branchRepo, showCommitId commitId_ <> ":refs/heads/" <> T.unpack branchName ])
+                    { std_in = NoStream
+                    , std_out = CreatePipe
+                    , std_err = NoStream
+                    }
+            createProcess cmd >>= \( _, mbstdout, _, ph ) -> if
+                | Just _ <- mbstdout -> do
+                    waitForProcess ph >>= \case
+                        ExitSuccess -> return ()
+                        code -> fail $ "git push exited with error: " <> show code
+                | otherwise -> error "createProcess must return stdout handle"
+
 
 repoInotify :: Repo -> IO ( INotify, TChan (Tag Commit) )
 repoInotify repo@GitRepo {..} = modifyMVar gitInotify $ \case