rename bothHandles -> ioHandles
This commit is contained in:
parent
bc0180da83
commit
1c91024978
6 changed files with 15 additions and 14 deletions
|
@ -16,7 +16,7 @@ import Logs.Location
|
||||||
import Annex.Transfer
|
import Annex.Transfer
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Utility.SimpleProtocol (ioHandles)
|
import Utility.SimpleProtocol (dupIoHandles)
|
||||||
import Git.Types (RemoteName)
|
import Git.Types (RemoteName)
|
||||||
|
|
||||||
data TransferRequest = TransferRequest Direction Remote Key AssociatedFile
|
data TransferRequest = TransferRequest Direction Remote Key AssociatedFile
|
||||||
|
@ -30,7 +30,7 @@ seek = withNothing start
|
||||||
|
|
||||||
start :: CommandStart
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
(readh, writeh) <- liftIO ioHandles
|
(readh, writeh) <- liftIO dupIoHandles
|
||||||
runRequests readh writeh runner
|
runRequests readh writeh runner
|
||||||
stop
|
stop
|
||||||
where
|
where
|
||||||
|
|
|
@ -42,6 +42,7 @@ import Remote.Helper.Chunked as X
|
||||||
import Remote.Helper.Encryptable as X
|
import Remote.Helper.Encryptable as X
|
||||||
import Remote.Helper.Messages
|
import Remote.Helper.Messages
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
|
import Messages.Progress
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Git.Command
|
import qualified Git.Command
|
||||||
import qualified Git.Construct
|
import qualified Git.Construct
|
||||||
|
|
|
@ -28,7 +28,7 @@ import qualified Data.Map as M
|
||||||
|
|
||||||
runForeground :: IO ()
|
runForeground :: IO ()
|
||||||
runForeground = do
|
runForeground = do
|
||||||
(readh, writeh) <- ioHandles
|
(readh, writeh) <- dupIoHandles
|
||||||
ichan <- newTChanIO :: IO (TChan Consumed)
|
ichan <- newTChanIO :: IO (TChan Consumed)
|
||||||
ochan <- newTChanIO :: IO (TChan Emitted)
|
ochan <- newTChanIO :: IO (TChan Emitted)
|
||||||
|
|
||||||
|
|
|
@ -87,7 +87,7 @@ readStrict params = do
|
||||||
pipeStrict :: [CommandParam] -> String -> IO String
|
pipeStrict :: [CommandParam] -> String -> IO String
|
||||||
pipeStrict params input = do
|
pipeStrict params input = do
|
||||||
params' <- stdParams params
|
params' <- stdParams params
|
||||||
withBothHandles createProcessSuccess (proc gpgcmd params') $ \(to, from) -> do
|
withIOHandles createProcessSuccess (proc gpgcmd params') $ \(to, from) -> do
|
||||||
hSetBinaryMode to True
|
hSetBinaryMode to True
|
||||||
hSetBinaryMode from True
|
hSetBinaryMode from True
|
||||||
hPutStr to input
|
hPutStr to input
|
||||||
|
|
|
@ -25,14 +25,14 @@ module Utility.Process (
|
||||||
processTranscript,
|
processTranscript,
|
||||||
processTranscript',
|
processTranscript',
|
||||||
withHandle,
|
withHandle,
|
||||||
withBothHandles,
|
withIOHandles,
|
||||||
withQuietOutput,
|
withQuietOutput,
|
||||||
createProcess,
|
createProcess,
|
||||||
startInteractiveProcess,
|
startInteractiveProcess,
|
||||||
stdinHandle,
|
stdinHandle,
|
||||||
stdoutHandle,
|
stdoutHandle,
|
||||||
stderrHandle,
|
stderrHandle,
|
||||||
bothHandles,
|
ioHandles,
|
||||||
processHandle,
|
processHandle,
|
||||||
devNull,
|
devNull,
|
||||||
) where
|
) where
|
||||||
|
@ -255,12 +255,12 @@ withHandle h creator p a = creator p' $ a . select
|
||||||
(stderrHandle, base { std_err = CreatePipe })
|
(stderrHandle, base { std_err = CreatePipe })
|
||||||
|
|
||||||
{- Like withHandle, but passes (stdin, stdout) handles to the action. -}
|
{- Like withHandle, but passes (stdin, stdout) handles to the action. -}
|
||||||
withBothHandles
|
withIOHandles
|
||||||
:: CreateProcessRunner
|
:: CreateProcessRunner
|
||||||
-> CreateProcess
|
-> CreateProcess
|
||||||
-> ((Handle, Handle) -> IO a)
|
-> ((Handle, Handle) -> IO a)
|
||||||
-> IO a
|
-> IO a
|
||||||
withBothHandles creator p a = creator p' $ a . bothHandles
|
withIOHandles creator p a = creator p' $ a . ioHandles
|
||||||
where
|
where
|
||||||
p' = p
|
p' = p
|
||||||
{ std_in = CreatePipe
|
{ std_in = CreatePipe
|
||||||
|
@ -303,9 +303,9 @@ stdoutHandle _ = error "expected stdoutHandle"
|
||||||
stderrHandle :: HandleExtractor
|
stderrHandle :: HandleExtractor
|
||||||
stderrHandle (_, _, Just h, _) = h
|
stderrHandle (_, _, Just h, _) = h
|
||||||
stderrHandle _ = error "expected stderrHandle"
|
stderrHandle _ = error "expected stderrHandle"
|
||||||
bothHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
|
ioHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
|
||||||
bothHandles (Just hin, Just hout, _, _) = (hin, hout)
|
ioHandles (Just hin, Just hout, _, _) = (hin, hout)
|
||||||
bothHandles _ = error "expected bothHandles"
|
ioHandles _ = error "expected ioHandles"
|
||||||
|
|
||||||
processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
|
processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
|
||||||
processHandle (_, _, _, pid) = pid
|
processHandle (_, _, _, pid) = pid
|
||||||
|
|
|
@ -16,7 +16,7 @@ module Utility.SimpleProtocol (
|
||||||
parse1,
|
parse1,
|
||||||
parse2,
|
parse2,
|
||||||
parse3,
|
parse3,
|
||||||
ioHandles,
|
dupIoHandles,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
|
@ -80,8 +80,8 @@ splitWord = separate isSpace
|
||||||
- will mess up the protocol. To avoid that, close stdin, and
|
- will mess up the protocol. To avoid that, close stdin, and
|
||||||
- and duplicate stderr to stdout. Return two new handles
|
- and duplicate stderr to stdout. Return two new handles
|
||||||
- that are duplicates of the original (stdin, stdout). -}
|
- that are duplicates of the original (stdin, stdout). -}
|
||||||
ioHandles :: IO (Handle, Handle)
|
dupIoHandles :: IO (Handle, Handle)
|
||||||
ioHandles = do
|
duoIoHandles = do
|
||||||
readh <- hDuplicate stdin
|
readh <- hDuplicate stdin
|
||||||
writeh <- hDuplicate stdout
|
writeh <- hDuplicate stdout
|
||||||
nullh <- openFile devNull ReadMode
|
nullh <- openFile devNull ReadMode
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue