diff options
Diffstat (limited to 'src/Hakyll/Core')
-rw-r--r-- | src/Hakyll/Core/UnixFilter.hs | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/src/Hakyll/Core/UnixFilter.hs b/src/Hakyll/Core/UnixFilter.hs new file mode 100644 index 0000000..736acee --- /dev/null +++ b/src/Hakyll/Core/UnixFilter.hs @@ -0,0 +1,66 @@ +-- | A Compiler that supports unix filters. +-- +module Hakyll.Core.UnixFilter + ( unixFilter + ) where + +import Control.Concurrent (forkIO) +import System.IO (hPutStr, hClose, hGetContents) +import System.Posix.Process (executeFile, forkProcess) +import System.Posix.IO ( dupTo, createPipe, stdInput + , stdOutput, closeFd, fdToHandle + ) + +import Hakyll.Core.Compiler + +-- | Use a unix filter as compiler. For example, we could use the 'rev' program +-- as a compiler. +-- +-- > rev :: Compiler Resource String +-- > rev = getResourceString >>> unixFilter "rev" [] +-- +-- A more realistic example: one can use this to call, for example, the sass +-- compiler on CSS files. More information about sass can be found here: +-- +-- <http://sass-lang.com/> +-- +-- The code is fairly straightforward, given that we use @.scss@ for sass: +-- +-- > route "style.scss" $ setExtension "css" +-- > compile "style.scss" $ +-- > getResourceString >>> unixFilter "sass" ["-s", "--scss"] +-- > >>> arr compressCss +-- +unixFilter :: String -- ^ Program name + -> [String] -- ^ Program args + -> Compiler String String -- ^ Resulting compiler +unixFilter programName args = unsafeCompiler $ \input -> do + -- Create pipes + (stdinRead, stdinWrite) <- createPipe + (stdoutRead, stdoutWrite) <- createPipe + + -- Fork the child + _ <- forkProcess $ do + -- Copy our pipes over the regular stdin/stdout + _ <- dupTo stdinRead stdInput + _ <- dupTo stdoutWrite stdOutput + + -- Close the now unneeded file descriptors in the child + mapM_ closeFd [stdinWrite, stdoutRead, stdinRead, stdoutWrite] + + -- Execute the program + _ <- executeFile programName True args Nothing + return () + + -- On the parent side, close the client-side FDs. + mapM_ closeFd [stdinRead, stdoutWrite] + + -- Write the input to the child pipe + _ <- forkIO $ do + stdinWriteHandle <- fdToHandle stdinWrite + hPutStr stdinWriteHandle input + hClose stdinWriteHandle + + -- Receive the output from the child + stdoutReadHandle <- fdToHandle stdoutRead + hGetContents stdoutReadHandle |