module System.Process.QQ (
cmd,
lcmd,
enumCmd,
) where
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.Trans
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Enumerator as E
import Data.Enumerator.Binary as EB
import qualified Data.Text.Lazy as LT
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import System.Exit
import System.IO
import System.Process
import Text.Shakespeare.Text
def :: QuasiQuoter
def = QuasiQuoter {
quoteExp = undefined,
quotePat = undefined,
quoteType = undefined,
quoteDec = undefined
}
cmd :: QuasiQuoter
cmd = def { quoteExp = genCmd }
lcmd :: QuasiQuoter
lcmd = def { quoteExp = genLCmd }
enumCmd :: QuasiQuoter
enumCmd = def { quoteExp = genEnumCmd }
genCmd :: String -> ExpQ
genCmd str =
[| E.run_ $ enumProcess $(quoteExp lt str) $$ do
(B.concat . BL.toChunks <$> EB.consume)
|]
genLCmd :: String -> ExpQ
genLCmd str =
[| E.run_ $ enumProcess $(quoteExp lt str) $$ EB.consume |]
genEnumCmd :: String -> ExpQ
genEnumCmd str =
[| enumProcess $(quoteExp lt str) |]
enumProcess :: MonadIO m => LT.Text -> E.Enumerator B.ByteString m a
enumProcess s step = do
(h, ph) <- liftIO $ openProcess s
r <- EB.enumHandle 65536 h step
r `seq` checkRet ph
return r
openProcess :: LT.Text -> IO (Handle, ProcessHandle)
openProcess s = do
(Just g, Just h, _, ph) <- createProcess (shell $ LT.unpack s)
{ std_in = CreatePipe
, std_out = CreatePipe
, std_err = Inherit }
hClose g
return (h, ph)
checkRet :: MonadIO m => ProcessHandle -> E.Iteratee a m ()
checkRet ph = liftIO $ do
ec <- waitForProcess ph
when (ec /= ExitSuccess) $ do
throwIO ec