summaryrefslogtreecommitdiff
path: root/src/Hakyll/Core
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Core')
-rw-r--r--src/Hakyll/Core/UnixFilter.hs66
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