diff options
author | 2012-11-10 00:13:55 -0400 | |
---|---|---|
committer | 2012-11-10 00:15:00 -0400 | |
commit | f552237297c92b42c647dd7d54ab3d0b7d7030e6 (patch) | |
tree | 8872a45e8105bb7baa32b8edc0dc0c9f5268b9f3 | |
parent | 68c6dcca0b61416db2ffe7a9818fb3b3640da283 (diff) |
refactor
-rw-r--r-- | Assistant/XMPP/Git.hs | 19 |
1 files changed, 8 insertions, 11 deletions
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index d177db8ad..c47e14b22 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -190,33 +190,30 @@ xmppGitRelay = do - its exit status to XMPP. -} xmppReceivePack :: ClientID -> Assistant Bool xmppReceivePack cid = runPush (ReceivePushRunning cid) handleDeferred $ do - feeder <- asIO1 toxmpp - reader <- asIO1 fromxmpp - sendexitcode <- asIO1 $ sendNetMessage . ReceivePackDone cid repodir <- liftAnnex $ fromRepo repoPath let p = (proc "git" ["receive-pack", repodir]) { std_in = CreatePipe , std_out = CreatePipe , std_err = Inherit } + (Just inh, Just outh, _, pid) <- liftIO $ createProcess p + readertid <- forkIO <~> relayfromxmpp inh + relaytoxmpp outh + code <- liftIO $ waitForProcess pid + void $ sendNetMessage $ ReceivePackDone cid code liftIO $ do - (Just inh, Just outh, _, pid) <- createProcess p - readertid <- forkIO $ reader inh - void $ feeder outh - code <- waitForProcess pid - void $ sendexitcode code killThread readertid hClose inh hClose outh return $ code == ExitSuccess where - toxmpp outh = do + relaytoxmpp outh = do b <- liftIO $ B.hGetSome outh chunkSize -- empty is EOF, so exit unless (B.null b) $ do sendNetMessage $ ReceivePackOutput cid b - toxmpp outh - fromxmpp inh = forever $ do + relaytoxmpp outh + relayfromxmpp inh = forever $ do m <- waitNetPushMessage case m of (SendPackOutput _ b) -> liftIO $ do |