Multiple threads for communicating with processes

This commit is contained in:
Michael Snoyman 2014-03-26 22:05:06 +02:00
parent bdcb174830
commit 7f1b06ecb3
2 changed files with 26 additions and 11 deletions

View File

@ -30,13 +30,12 @@ module Yesod.EmbeddedStatic.Generators (
-- $example
) where
import Control.Applicative ((<$>))
import Control.Applicative ((<$>), (<*>))
import Control.Exception (try, SomeException)
import Control.Monad (forM, when)
import Control.Monad.Trans.Resource (runResourceT)
import Data.Char (isDigit, isLower)
import Data.Conduit (($$), (=$))
import Data.Conduit.Process (proc, conduitProcess)
import Data.Conduit (($$))
import Data.Default (def)
import Data.Maybe (isNothing)
import Language.Haskell.TH
@ -46,7 +45,12 @@ import System.FilePath ((</>))
import Text.Jasmine (minifym)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Conduit.List as C
import Data.Conduit.Binary (sourceHandle)
import qualified Data.Text as T
import qualified System.Process as Proc
import System.Exit (ExitCode (ExitSuccess))
import Control.Concurrent.Async (Concurrently (..))
import System.IO (hClose)
import Yesod.EmbeddedStatic.Types
@ -197,12 +201,20 @@ compressTool f opts ct = do
mpath <- findExecutable f
when (isNothing mpath) $
fail $ "Unable to find " ++ f
let src = C.sourceList $ BL.toChunks ct
p = proc f opts
sink = C.consume
compressed <- runResourceT (src $$ conduitProcess p =$ sink)
putStrLn $ "Compressed successfully with " ++ f
return $ BL.fromChunks compressed
let p = (Proc.proc f opts)
{ Proc.std_in = Proc.CreatePipe
, Proc.std_out = Proc.CreatePipe
}
(Just hin, Just hout, _, ph) <- Proc.createProcess p
(compressed, (), code) <- runConcurrently $ (,,)
<$> Concurrently (sourceHandle hout $$ C.consume)
<*> Concurrently (BL.hPut hin ct >> hClose hin)
<*> Concurrently (Proc.waitForProcess ph)
if code == ExitSuccess
then do
putStrLn $ "Compressed successfully with " ++ f
return $ BL.fromChunks compressed
else error $ "compressTool: compression failed with " ++ f
-- | Try a list of processing functions (like the compressions above) one by one until

View File

@ -49,10 +49,11 @@ library
, shakespeare-css >= 1.0.3
, mime-types >= 0.1
, hjsmin
, process-conduit >= 1.0 && < 1.1
, filepath >= 1.3
, resourcet >= 0.4
, unordered-containers >= 0.2
, process
, async
exposed-modules: Yesod.Static
Yesod.EmbeddedStatic
@ -104,8 +105,10 @@ test-suite tests
, filepath
, resourcet
, unordered-containers
, async
, process
ghc-options: -Wall
ghc-options: -Wall -threaded
extensions: TemplateHaskell
source-repository head