mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

refactor

Browse source
This commit is contained in:
Joey Hess 2020-12-10 16:33:52 -04:00
parent 6a11b6fab8
commit cedad7b37d
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 7 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
Command/Transferrer.hs
View file

@ -32,10 +32,7 @@ start :: CommandStart
start = do start = do
enableInteractiveBranchAccess enableInteractiveBranchAccess
(readh, writeh) <- liftIO dupIoHandles (readh, writeh) <- liftIO dupIoHandles
let outputwriter v = do let outputwriter = sendTransferResponse writeh . TransferOutput
hPutStrLn writeh $
unwords $ Proto.formatMessage $ TransferOutput v
hFlush writeh
let outputresponsereader = do let outputresponsereader = do
l <- hGetLine readh l <- hGetLine readh
return $ case Proto.parseMessage l of return $ case Proto.parseMessage l of
@ -114,7 +111,9 @@ runRequests readh writeh a = go Nothing Nothing
Nothing -> transferrerProtocolError l Nothing -> transferrerProtocolError l
Nothing -> transferrerProtocolError l Nothing -> transferrerProtocolError l
sendresult b = liftIO $ do sendresult = liftIO . sendTransferResponse writeh . TransferResult
hPutStrLn writeh $
unwords $ Proto.formatMessage $ TransferResult b sendTransferResponse :: Handle -> TransferResponse -> IO ()
hFlush writeh sendTransferResponse h r = do
hPutStrLn h $ unwords $ Proto.formatMessage r
hFlush h