shell-conduit 1.1 → 2.0
raw patch · 4 files changed
+54/−15 lines, 4 filesdep +semigroupsdep +these
Dependencies added: semigroups, these
Files
- shell-conduit.cabal +3/−1
- src/Data/Conduit/Shell/PATH.hs +1/−0
- src/Data/Conduit/Shell/Process.hs +48/−12
- src/Data/Conduit/Shell/TH.hs +2/−2
shell-conduit.cabal view
@@ -1,5 +1,5 @@ name: shell-conduit-version: 1.1+version: 2.0 synopsis: Write shell scripts with Conduit description: Write shell scripts with Conduit. See "Data.Conduit.Shell" for documentation. license: BSD3@@ -36,3 +36,5 @@ , transformers , transformers-base , text+ , semigroups+ , these
src/Data/Conduit/Shell/PATH.hs view
@@ -11,5 +11,6 @@ import Data.Conduit.Shell.Process import Data.Conduit.Shell.TH import Data.List+import Prelude $(generateBinaries)
src/Data/Conduit/Shell/Process.hs view
@@ -23,7 +23,11 @@ import Data.Conduit.Shell.Types import Control.Applicative+import Control.Concurrent (forkIO)+import Control.Concurrent.Chan import qualified Control.Exception as E+import Control.Monad+import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Trans.Resource import Data.ByteString (ByteString)@@ -32,6 +36,8 @@ import Data.Conduit.List (sourceList) import qualified Data.Conduit.List as CL import Data.Conduit.Process+import Data.Semigroup+import Data.These import System.Exit (ExitCode(..)) import System.IO import qualified System.Process@@ -130,8 +136,7 @@ where interleave = do end <- proxyInterleaved liftIO (hClose cin)- remainder cout Right- remainder cerr Left+ remainders cout cerr ec <- liftIO (maybe (waitForProcess' ph) return end) case ec of ExitSuccess -> return ()@@ -156,6 +161,47 @@ proxyInterleaved startProxy _ = error "startProxy: unexpected arguments" +remainders cout cerr =+ do chan <- liftIO newChan+ void (liftIO (forkIO (remainder "stdout" chan cout Right)))+ void (liftIO (forkIO (remainder "stderr" chan cerr Left)))+ fix (\loop done ->+ case done of+ Just (These () ()) -> return ()+ _ ->+ do chunk <- liftIO (readChan chan)+ case chunk of+ Left mchunk ->+ case mchunk of+ Nothing ->+ loop (done <>+ Just (This ()))+ Just chunk ->+ do yield (Left chunk)+ loop done+ Right mchunk ->+ case mchunk of+ Nothing ->+ loop (done <>+ Just (That ()))+ Just chunk ->+ do yield (Right chunk)+ loop done)+ (Nothing :: Maybe (These () ()))++-- | Proxy final results from the handle and yield them.+remainder :: String+ -> Chan (Either (Maybe ByteString) (Maybe ByteString))+ -> Handle+ -> (Maybe ByteString -> Either (Maybe ByteString) (Maybe ByteString))+ -> IO ()+remainder l chan h cons =+ do bytes <- S.hGetSome h bufSize+ if S.null bytes+ then writeChan chan (cons Nothing)+ else do writeChan chan (cons (Just bytes))+ remainder l chan h cons+ -- | Proxy live results from the given handle and yield them. proxy :: MonadIO m => Handle -> (ByteString -> o) -> ConduitM i o m ()@@ -166,16 +212,6 @@ else do bytes <- liftIO (S.hGetSome h bufSize) yield (cons bytes) proxy h cons---- | Proxy final results from the handle and yield them.-remainder :: MonadIO m- => Handle -> (ByteString -> o) -> ConduitM i o m ()-remainder h cons =- do bytes <- liftIO (S.hGetSome h bufSize)- if S.null bytes- then return ()- else do yield (cons bytes)- remainder h cons -- | Is the handle ready? Catches any exceptions. hReady' :: Handle -> IO Bool
src/Data/Conduit/Shell/TH.hs view
@@ -54,9 +54,9 @@ -- | Get a version of the given name available to be bound. getUniqueName :: String -> Q Name getUniqueName candidate =- do inScope <- recover (do void (reify (mkName candidate))+ do inScope <- recover (return False)+ (do void (reify (mkName candidate)) return True)- (return False) if inScope then getUniqueName (candidate ++ "'") else return (mkName candidate)