implements qq

tanakh · Feb 6, 2012 · 95e82e2 · 95e82e2
1 parent df5df90
commit 95e82e2
Show file tree

Hide file tree

Showing 4 changed files with 37 additions and 59 deletions.
diff --git a/Data/Conduit/Process.hs b/Data/Conduit/Process.hs
@@ -2,9 +2,11 @@ module Data.Conduit.Process (
   -- * run process
   sourceProcess,
   conduitProcess,
+
   -- * run command
   sourceCmd,
   conduitCmd,
+
   -- * Convenience re-exports
   shell,
   proc,
@@ -20,7 +22,6 @@ import Control.Monad.Trans
 import qualified Data.ByteString as B
 import qualified Data.Conduit as C
 import qualified Data.Conduit.List as CL
-import Data.Monoid
 import System.Exit
 import System.IO
 import System.Process

diff --git a/System/Process/QQ.hs b/System/Process/QQ.hs
@@ -3,74 +3,45 @@
 module System.Process.QQ (
   cmd,
   lcmd,
-  enumCmd,
+  scmd,
+  ccmd,
   ) 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.Conduit as C
+import qualified Data.Conduit.Lazy as CL
+import qualified Data.Conduit.List as CL
 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
 
+import Data.Conduit.Process
+
 def :: QuasiQuoter
-def = QuasiQuoter {
-  quoteExp = undefined,
-  quotePat = undefined,
-  quoteType = undefined,
-  quoteDec = undefined
+def = QuasiQuoter
+  { quoteExp  = undefined
+  , quotePat  = undefined
+  , quoteType = undefined
+  , quoteDec  = undefined
   }
 
 cmd :: QuasiQuoter
-cmd = def { quoteExp = genCmd }
+cmd = def { quoteExp = \str -> [|
+  BL.fromChunks <$> C.runResourceT (sourceCmd (LT.unpack $(quoteExp lt str)) C.$$ CL.consume)
+|] }
 
 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
+lcmd = def { quoteExp = \str -> [|
+  BL.fromChunks <$> (CL.lazyConsume $ sourceCmd $ LT.unpack $(quoteExp lt str))
+|] }
 
-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)
+scmd :: QuasiQuoter
+scmd = def { quoteExp = \str -> [| sourceCmd $(quoteExp lt str) |] }
 
-checkRet :: MonadIO m => ProcessHandle -> E.Iteratee a m ()
-checkRet ph = liftIO $ do
-  ec <- waitForProcess ph
-  when (ec /= ExitSuccess) $ do
-    throwIO ec
+ccmd :: QuasiQuoter
+ccmd = def { quoteExp = \str -> [| conduitCmd $(quoteExp lt str) |] }
diff --git a/Test.hs → examples/TestQQ.hs b/Test.hs → examples/TestQQ.hs
diff --git a/process-qq.cabal b/process-qq.cabal
@@ -8,20 +8,23 @@ License-file:        LICENSE
 Author:              Hideyuki Tanaka
 Maintainer:          Hideyuki Tanaka <tanaka.hideyuki@gmail.com>
 Copyright:           (c) 2011-2012, Hideyuki Tanaka
-Category:            System
+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-qq.git
+
 Flag examples
   Description:         Build examples
   Default:             False
 
 Library
   Exposed-modules:     Data.Conduit.Process
-                       -- System.Process.QQ
+                       System.Process.QQ
 
   Build-depends:       base             == 4.*
                      , template-haskell >= 2.4 && < 2.8
@@ -38,10 +41,13 @@ Executable process-conduit
   Build-depends:       base            == 4.*
                      , conduit         == 0.2.*
                      , process-conduit
-
   if !flag(examples)
     Buildable:         False
 
-Source-repository head
-  Type:                git
-  Location:            git://github.com/tanakh/process-qq.git
+Executable process-qq
+  Hs-source-dirs:      examples
+  Main-is:             TestQQ.hs
+  Build-depends:       base            == 4.*
+                     , process-conduit
+  if !flag(examples)
+    Buildable:         False