process-conduit-1.0.0.0/0000755000000000000000000000000012117254720013156 5ustar0000000000000000process-conduit-1.0.0.0/test.hs0000644000000000000000000000176012117254720014475 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} import Data.Conduit.Process import System.Process.QQ import qualified Data.ByteString.Lazy.Char8 as L import Data.Conduit import qualified Data.Conduit.Binary as CB import Test.Hspec main :: IO () main = hspec $ do describe "process conduit" $ do it "get process's output" $ do r <- runResourceT $ sourceCmd "echo abc def" $$ CB.take (10^9) L.words r `shouldBe` ["abc", "def"] it "act as conduit" $ do r <- runResourceT $ sourceProcess (proc "echo" ["zxc\nasd\nqwe"]) $$ conduitCmd "sort" =$ CB.take (10^9) L.words r `shouldBe` ["asd", "qwe", "zxc"] describe "quasiquoter" $ do it "get process's output" $ do r <- [cmd|echo abc def|] L.words r `shouldBe` ["abc", "def"] it "act as conduit" $ do r <- runResourceT $ sourceProcess (proc "echo" ["zxc\nasd\nqwe"]) $$ [ccmd|sort|] =$ CB.take (10^9) L.words r `shouldBe` ["asd", "qwe", "zxc"] process-conduit-1.0.0.0/README.md0000644000000000000000000000300212117254720014430 0ustar0000000000000000process-conduit: Conduit for processes ====================================== # About This package provides [conduit](http://hackage.haskell.org/package/conduit) for processes. Also this provides quasi-quoters for process using it. # Install ~~~ {.bash} $ cabal update $ cabal install process-conduit ~~~ # Document Haddock documents are here: # Quasi Quoters process-conduit has three quasi-quoters, `cmd`, `scmd` and `ccmd`. The result type of `cmd` is Lazy `ByteString`, but execution will perform strictly. The result type of `scmd` and `ccmd` are `GSource m ByteString` and `GConduit ByteString m ByteString` respectively. If a command is failed, an exception is thrown. Commands are executed in ***run-time***, not compile-time. # Examples * Create a Source and a Conduit of process ~~~ {.haskell} import Data.Conduit import qualified Data.Conduit.Binary as CB import Data.Conduit.Process import System.IO main :: IO () main = runResourceT $ do sourceCmd "ls" $= conduitCmd "sort" $$ CB.sinkHandle stdout ~~~ * Invoke a process simply ~~~ {.haskell} {-# LANGUAGE QuasiQuotes #-} import System.Process.QQ main = print =<< [cmd|ls|] ~~~ * Conduit Quasi-Quoters ~~~ {.haskell} main :: IO () main = runResourceT $ do [scmd|ls|] $= [ccmd|sort|] $$ CB.sinkHandle stdout ~~~ * Unquoting (syntax is same as [shakespeare-text](http://hackage.haskell.org/package/shakespeare-text)) ~~~ {.haskell} main = do [url] <- getArgs print =<< [cmd|curl #{url}|] ~~~ process-conduit-1.0.0.0/LICENSE0000644000000000000000000000277412117254720014175 0ustar0000000000000000Copyright (c)2011-2012, Hideyuki Tanaka All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Hideyuki Tanaka nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. process-conduit-1.0.0.0/process-conduit.cabal0000644000000000000000000000316112117254720017264 0ustar0000000000000000name: process-conduit version: 1.0.0.0 synopsis: Conduits for processes description: Conduits for processes. For more details: homepage: http://github.com/tanakh/process-conduit license: BSD3 license-file: LICENSE author: Hideyuki Tanaka maintainer: Hideyuki Tanaka copyright: (c) 2011-2012, Hideyuki Tanaka category: System, Conduit build-type: Simple cabal-version: >=1.8 extra-source-files: README.md source-repository head type: git location: git://github.com/tanakh/process-conduit.git library exposed-modules: Data.Conduit.Process System.Process.QQ build-depends: base == 4.* , template-haskell >= 2.4 && < 2.9 , mtl >= 2.0 , control-monad-loop == 0.1.* , bytestring >= 0.9 , text >= 0.11 , process >= 1.0 , conduit == 1.0.* , shakespeare-text >= 1.0 ghc-options: -Wall test-suite process-conduit-test type: exitcode-stdio-1.0 hs-source-dirs: dist main-is: ../test.hs build-depends: base == 4.* , bytestring , hspec >= 1.3 , conduit , process-conduit process-conduit-1.0.0.0/Setup.hs0000644000000000000000000000005612117254720014613 0ustar0000000000000000import Distribution.Simple main = defaultMain process-conduit-1.0.0.0/System/0000755000000000000000000000000012117254720014442 5ustar0000000000000000process-conduit-1.0.0.0/System/Process/0000755000000000000000000000000012117254720016060 5ustar0000000000000000process-conduit-1.0.0.0/System/Process/QQ.hs0000644000000000000000000000174512117254720016744 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module System.Process.QQ ( -- * Quasi Quoters cmd, scmd, ccmd, ) where import Control.Applicative import qualified Data.ByteString.Lazy as BL import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Text.Lazy as LT import Language.Haskell.TH.Quote import Text.Shakespeare.Text import Data.Conduit.Process def :: QuasiQuoter def = QuasiQuoter { quoteExp = undefined , quotePat = undefined , quoteType = undefined , quoteDec = undefined } -- | Command result of (Lazy) ByteString. cmd :: QuasiQuoter cmd = def { quoteExp = \str -> [| BL.fromChunks <$> C.runResourceT (sourceCmd (LT.unpack $(quoteExp lt str)) C.$$ CL.consume) |] } -- | Source of shell command scmd :: QuasiQuoter scmd = def { quoteExp = \str -> [| sourceCmd (LT.unpack $(quoteExp lt str)) |] } -- | Conduit of shell command ccmd :: QuasiQuoter ccmd = def { quoteExp = \str -> [| conduitCmd (LT.unpack $(quoteExp lt str)) |] } process-conduit-1.0.0.0/Data/0000755000000000000000000000000012117254720014027 5ustar0000000000000000process-conduit-1.0.0.0/Data/Conduit/0000755000000000000000000000000012117254720015434 5ustar0000000000000000process-conduit-1.0.0.0/Data/Conduit/Process.hs0000644000000000000000000000534612117254720017416 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, OverloadedStrings, BangPatterns, RankNTypes #-} module Data.Conduit.Process ( -- * Run process sourceProcess, conduitProcess, -- * Run shell command sourceCmd, conduitCmd, -- * Convenience re-exports shell, proc, CreateProcess(..), CmdSpec(..), StdStream(..), ProcessHandle, ) where import qualified Control.Exception as E import Control.Monad import Control.Monad.Trans import Control.Monad.Trans.Loop import qualified Data.ByteString as S import Data.Conduit import qualified Data.Conduit.List as CL import Data.Maybe import System.Exit (ExitCode(..)) import System.IO import System.Process bufSize :: Int bufSize = 64 * 1024 -- | Conduit of process conduitProcess :: MonadResource m => CreateProcess -> Conduit S.ByteString m S.ByteString conduitProcess cp = bracketP createp closep $ \(Just cin, Just cout, _, ph) -> do end <- repeatLoopT $ do -- if process's outputs are available, then yields them. repeatLoopT $ do b <- liftIO $ hReady' cout when (not b) exit out <- liftIO $ S.hGetSome cout bufSize void $ lift . lift $ yield out -- if process exited, then exit end <- liftIO $ getProcessExitCode ph when (isJust end) $ exitWith end -- if upper stream ended, then exit inp <- lift await when (isNothing inp) $ exitWith Nothing -- put input to process liftIO $ S.hPut cin $ fromJust inp liftIO $ hFlush cin -- uppstream or process is done. -- process rest outputs. liftIO $ hClose cin repeatLoopT $ do out <- liftIO $ S.hGetSome cout bufSize when (S.null out) exit lift $ yield out ec <- liftIO $ maybe (waitForProcess' ph) return end lift $ when (ec /= ExitSuccess) $ monadThrow ec where createp = createProcess cp { std_in = CreatePipe , std_out = CreatePipe } closep (Just cin, Just cout, _, ph) = do hClose cin hClose cout _ <- waitForProcess' ph return () closep _ = error "Data.Conduit.Process.closep: Unhandled case" hReady' h = hReady h `E.catch` \(E.SomeException _) -> return False waitForProcess' ph = waitForProcess ph `E.catch` \(E.SomeException _) -> return ExitSuccess -- | Source of process sourceProcess :: MonadResource m => CreateProcess -> Producer m S.ByteString sourceProcess cp = toProducer $ CL.sourceNull $= conduitProcess cp -- | Conduit of shell command conduitCmd :: MonadResource m => String -> Conduit S.ByteString m S.ByteString conduitCmd = conduitProcess . shell -- | Source of shell command sourceCmd :: MonadResource m => String -> Producer m S.ByteString sourceCmd = sourceProcess . shell process-conduit-1.0.0.0/dist/0000755000000000000000000000000012117254720014121 5ustar0000000000000000