UnixFilter improvements

Closes #128

2 files changed, 75 insertions, 21 deletions

diff --git a/src/Hakyll/Core/UnixFilter.hs b/src/Hakyll/Core/UnixFilter.hs
index 261613d..6824bd8 100644
--- a/src/Hakyll/Core/UnixFilter.hs
+++ b/src/Hakyll/Core/UnixFilter.hs
@@ -7,16 +7,24 @@ module Hakyll.Core.UnixFilter
 
 
 --------------------------------------------------------------------------------
-import           Control.Concurrent   (forkIO)
-import           Data.ByteString.Lazy (ByteString)
-import qualified Data.ByteString.Lazy as LB
-import           System.IO            (Handle, hClose, hGetContents, hPutStr,
-                                       hSetEncoding, localeEncoding)
+import           Control.Concurrent            (forkIO)
+import           Control.Concurrent.MVar       (newEmptyMVar, putMVar, takeMVar)
+import           Control.DeepSeq               (NFData, deepseq)
+import           Control.Monad                 (forM_)
+import           Data.ByteString.Lazy          (ByteString)
+import qualified Data.ByteString.Lazy          as LB
+import           Data.IORef                    (newIORef, readIORef, writeIORef)
+import           Data.Monoid                   (Monoid, mempty)
+import           System.Exit                   (ExitCode (..))
+import           System.IO                     (Handle, hClose, hFlush,
+                                                hGetContents, hPutStr,
+                                                hSetEncoding, localeEncoding)
 import           System.Process
 
 
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
+import           Hakyll.Core.Compiler.Internal
 
 
 --------------------------------------------------------------------------------
@@ -67,7 +75,8 @@ unixFilterLBS = unixFilterWith LB.hPutStr LB.hGetContents
 
 --------------------------------------------------------------------------------
 -- | Overloaded compiler
-unixFilterWith :: (Handle -> i -> IO ())  -- ^ Writer
+unixFilterWith :: (Monoid o, NFData o)
+               => (Handle -> i -> IO ())  -- ^ Writer
                -> (Handle -> IO o)        -- ^ Reader
                -> String                  -- ^ Program name
                -> [String]                -- ^ Program args
@@ -75,31 +84,59 @@ unixFilterWith :: (Handle -> i -> IO ())  -- ^ Writer
                -> Compiler o              -- ^ Program output
 unixFilterWith writer reader programName args input = do
     debugCompiler ("Executing external program " ++ programName)
-    unsafeCompiler $ unixFilterIO writer reader programName args input
+    (output, err, exitCode) <- unsafeCompiler $
+        unixFilterIO writer reader programName args input
+    forM_ (lines err) debugCompiler
+    case exitCode of
+        ExitSuccess   -> return output
+        ExitFailure e -> compilerThrow $
+            "Hakyll.Core.UnixFilter.unixFilterWith: " ++
+            unwords (programName : args) ++ " gave exit code " ++ show e
 
 
 --------------------------------------------------------------------------------
 -- | Internally used function
-unixFilterIO :: (Handle -> i -> IO ())
+unixFilterIO :: (Monoid o, NFData o)
+             => (Handle -> i -> IO ())
              -> (Handle -> IO o)
              -> String
              -> [String]
              -> i
-             -> IO o
+             -> IO (o, String, ExitCode)
 unixFilterIO writer reader programName args input = do
-    let process = (proc programName args)
-            { std_in    = CreatePipe
-            , std_out   = CreatePipe
-            , close_fds = True
-            }
+    (Just inh, Just outh, Just errh, pid) <-
+        createProcess (proc programName args)
+                { std_in  = CreatePipe
+                , std_out = CreatePipe
+                , std_err = CreatePipe
+                }
 
-    (Just stdinWriteHandle, Just stdoutReadHandle, _, _) <-
-        createProcess process
+    -- Create boxes
+    lock   <- newEmptyMVar
+    outRef <- newIORef mempty
+    errRef <- newIORef ""
 
     -- Write the input to the child pipe
+    _ <- forkIO $ writer inh input >> hFlush inh >> hClose inh
+
+    -- Read from stdout
+    _ <- forkIO $ do
+        out <- reader outh
+        deepseq out (hClose outh)
+        writeIORef outRef out
+        putMVar lock ()
+
+    -- Read from stderr
     _ <- forkIO $ do
-        writer stdinWriteHandle input
-        hClose stdinWriteHandle
+        err <- hGetContents errh
+        deepseq err (hClose errh)
+        writeIORef errRef err
+        putMVar lock ()
 
-    -- Receive the output from the child
-    reader stdoutReadHandle
+    -- Get exit code & return
+    takeMVar lock
+    takeMVar lock
+    exitCode <- waitForProcess pid
+    out      <- readIORef outRef
+    err      <- readIORef errRef
+    return (out, err, exitCode)
diff --git a/tests/Hakyll/Core/UnixFilter/Tests.hs b/tests/Hakyll/Core/UnixFilter/Tests.hs
index 350c857..04051e3 100644
--- a/tests/Hakyll/Core/UnixFilter/Tests.hs
+++ b/tests/Hakyll/Core/UnixFilter/Tests.hs
@@ -6,6 +6,7 @@ module Hakyll.Core.UnixFilter.Tests
 
 
 --------------------------------------------------------------------------------
+import           Data.List                      (isInfixOf)
 import           Test.Framework                 (Test, testGroup)
 import           Test.Framework.Providers.HUnit (testCase)
 import qualified Test.HUnit                     as H
@@ -13,6 +14,7 @@ import qualified Test.HUnit                     as H
 
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
+import           Hakyll.Core.Compiler.Internal
 import           Hakyll.Core.Item
 import           Hakyll.Core.UnixFilter
 import           TestSuite.Util
@@ -21,7 +23,8 @@ import           TestSuite.Util
 --------------------------------------------------------------------------------
 tests :: Test
 tests = testGroup "Hakyll.Core.UnixFilter.Tests"
-    [ testCase "unixFilter rev" unixFilterRev
+    [ testCase "unixFilter rev"   unixFilterRev
+    , testCase "unixFilter false" unixFilterFalse
     ]
 
 
@@ -37,3 +40,17 @@ unixFilterRev = do
   where
     compiler = getResourceString >>= withItemBody (unixFilter "rev" [])
     rev      = map reverse . lines
+
+
+--------------------------------------------------------------------------------
+unixFilterFalse :: H.Assertion
+unixFilterFalse = do
+    store    <- newTestStore
+    provider <- newTestProvider store
+    result   <- testCompiler store provider "russian.md" compiler
+    H.assert $ case result of
+        CompilerError e -> "exit code" `isInfixOf` e
+        _               -> False
+    cleanTestEnv
+  where
+    compiler = getResourceString >>= withItemBody (unixFilter "false" [])