on master help sign in
UnixFilter improvements
5d7e252Jasper Van der Jeugt
src/Hakyll/Core/UnixFilter.hs+57−20
@@ -7,16 +7,24 @@ module Hakyll.Core.UnixFilter
7
7
8
8
9--------------------------------------------------------------------------------
9--------------------------------------------------------------------------------
10−import Control.Concurrent (forkIO)
10+import Control.Concurrent (forkIO)
11+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
12+import Control.DeepSeq (NFData, deepseq)
13+import Control.Monad (forM_)
11−import Data.ByteString.Lazy (ByteString)
14+import Data.ByteString.Lazy (ByteString)
12−import qualified Data.ByteString.Lazy as LB
15+import qualified Data.ByteString.Lazy as LB
16+import Data.IORef (newIORef, readIORef, writeIORef)
17+import Data.Monoid (Monoid, mempty)
18+import System.Exit (ExitCode (..))
19+import System.IO (Handle, hClose, hFlush,
13−import System.IO (Handle, hClose, hGetContents, hPutStr,
20+ hGetContents, hPutStr,
14− hSetEncoding, localeEncoding)
21+ hSetEncoding, localeEncoding)
15import System.Process
22import System.Process
16
23
17
24
18--------------------------------------------------------------------------------
25--------------------------------------------------------------------------------
19import Hakyll.Core.Compiler
26import Hakyll.Core.Compiler
27+import Hakyll.Core.Compiler.Internal
20
28
21
29
22--------------------------------------------------------------------------------
30--------------------------------------------------------------------------------
@@ -67,7 +75,8 @@ unixFilterLBS = unixFilterWith LB.hPutStr LB.hGetContents
67
75
68--------------------------------------------------------------------------------
76--------------------------------------------------------------------------------
69-- | Overloaded compiler
77-- | Overloaded compiler
78+unixFilterWith :: (Monoid o, NFData o)
70−unixFilterWith :: (Handle -> i -> IO ()) -- ^ Writer
79+ => (Handle -> i -> IO ()) -- ^ Writer
71 -> (Handle -> IO o) -- ^ Reader
80 -> (Handle -> IO o) -- ^ Reader
72 -> String -- ^ Program name
81 -> String -- ^ Program name
73 -> [String] -- ^ Program args
82 -> [String] -- ^ Program args
@@ -75,31 +84,59 @@ unixFilterWith :: (Handle -> i -> IO ()) -- ^ Writer
75 -> Compiler o -- ^ Program output
84 -> Compiler o -- ^ Program output
76unixFilterWith writer reader programName args input = do
85unixFilterWith writer reader programName args input = do
77 debugCompiler ("Executing external program " ++ programName)
86 debugCompiler ("Executing external program " ++ programName)
87+ (output, err, exitCode) <- unsafeCompiler $
78− unsafeCompiler $ unixFilterIO writer reader programName args input
88+ unixFilterIO writer reader programName args input
89+ forM_ (lines err) debugCompiler
90+ case exitCode of
91+ ExitSuccess -> return output
92+ ExitFailure e -> compilerThrow $
93+ "Hakyll.Core.UnixFilter.unixFilterWith: " ++
94+ unwords (programName : args) ++ " gave exit code " ++ show e
79
95
80
96
81--------------------------------------------------------------------------------
97--------------------------------------------------------------------------------
82-- | Internally used function
98-- | Internally used function
99+unixFilterIO :: (Monoid o, NFData o)
83−unixFilterIO :: (Handle -> i -> IO ())
100+ => (Handle -> i -> IO ())
84 -> (Handle -> IO o)
101 -> (Handle -> IO o)
85 -> String
102 -> String
86 -> [String]
103 -> [String]
87 -> i
104 -> i
88− -> IO o
105+ -> IO (o, String, ExitCode)
89unixFilterIO writer reader programName args input = do
106unixFilterIO writer reader programName args input = do
107+ (Just inh, Just outh, Just errh, pid) <-
90− let process = (proc programName args)
108+ createProcess (proc programName args)
91− { std_in = CreatePipe
109+ { std_in = CreatePipe
92− , std_out = CreatePipe
110+ , std_out = CreatePipe
93− , close_fds = True
111+ , std_err = CreatePipe
94− }
112+ }
95
113
96− (Just stdinWriteHandle, Just stdoutReadHandle, _, _) <-
114+ -- Create boxes
97− createProcess process
115+ lock <- newEmptyMVar
116+ outRef <- newIORef mempty
117+ errRef <- newIORef ""
98
118
99 -- Write the input to the child pipe
119 -- Write the input to the child pipe
120+ _ <- forkIO $ writer inh input >> hFlush inh >> hClose inh
121+
122+ -- Read from stdout
123+ _ <- forkIO $ do
124+ out <- reader outh
125+ deepseq out (hClose outh)
126+ writeIORef outRef out
127+ putMVar lock ()
128+
129+ -- Read from stderr
100 _ <- forkIO $ do
130 _ <- forkIO $ do
101− writer stdinWriteHandle input
131+ err <- hGetContents errh
102− hClose stdinWriteHandle
132+ deepseq err (hClose errh)
133+ writeIORef errRef err
134+ putMVar lock ()
103
135
104− -- Receive the output from the child
136+ -- Get exit code & return
105− reader stdoutReadHandle
137+ takeMVar lock
138+ takeMVar lock
139+ exitCode <- waitForProcess pid
140+ out <- readIORef outRef
141+ err <- readIORef errRef
142+ return (out, err, exitCode)
tests/Hakyll/Core/UnixFilter/Tests.hs+18−1
@@ -6,6 +6,7 @@ module Hakyll.Core.UnixFilter.Tests
6
6
7
7
8--------------------------------------------------------------------------------
8--------------------------------------------------------------------------------
9+import Data.List (isInfixOf)
9import Test.Framework (Test, testGroup)
10import Test.Framework (Test, testGroup)
10import Test.Framework.Providers.HUnit (testCase)
11import Test.Framework.Providers.HUnit (testCase)
11import qualified Test.HUnit as H
12import qualified Test.HUnit as H
@@ -13,6 +14,7 @@ import qualified Test.HUnit as H
13
14
14--------------------------------------------------------------------------------
15--------------------------------------------------------------------------------
15import Hakyll.Core.Compiler
16import Hakyll.Core.Compiler
17+import Hakyll.Core.Compiler.Internal
16import Hakyll.Core.Item
18import Hakyll.Core.Item
17import Hakyll.Core.UnixFilter
19import Hakyll.Core.UnixFilter
18import TestSuite.Util
20import TestSuite.Util
@@ -21,7 +23,8 @@ import TestSuite.Util
21--------------------------------------------------------------------------------
23--------------------------------------------------------------------------------
22tests :: Test
24tests :: Test
23tests = testGroup "Hakyll.Core.UnixFilter.Tests"
25tests = testGroup "Hakyll.Core.UnixFilter.Tests"
24− [ testCase "unixFilter rev" unixFilterRev
26+ [ testCase "unixFilter rev" unixFilterRev
27+ , testCase "unixFilter false" unixFilterFalse
25 ]
28 ]
26
29
27
30
@@ -37,3 +40,17 @@ unixFilterRev = do
37 where
40 where
38 compiler = getResourceString >>= withItemBody (unixFilter "rev" [])
41 compiler = getResourceString >>= withItemBody (unixFilter "rev" [])
39 rev = map reverse . lines
42 rev = map reverse . lines
43+
44+
45+--------------------------------------------------------------------------------
46+unixFilterFalse :: H.Assertion
47+unixFilterFalse = do
48+ store <- newTestStore
49+ provider <- newTestProvider store
50+ result <- testCompiler store provider "russian.md" compiler
51+ H.assert $ case result of
52+ CompilerError e -> "exit code" `isInfixOf` e
53+ _ -> False
54+ cleanTestEnv
55+ where
56+ compiler = getResourceString >>= withItemBody (unixFilter "false" [])