1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
--------------------------------------------------------------------------------
-- | A Compiler that supports unix filters.
module Hakyll.Core.UnixFilter
( unixFilter
, unixFilterLBS
) where
--------------------------------------------------------------------------------
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 System.Posix.IO (closeFd, createPipe, dupTo, fdToHandle,
stdInput, stdOutput)
import System.Posix.Process (executeFile, forkProcess)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
--------------------------------------------------------------------------------
-- | Use a unix filter as compiler. For example, we could use the 'rev' program
-- as a compiler.
--
-- > rev :: Compiler String
-- > rev = getResourceString >>= itemM (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:
--
-- > match "style.scss" $ do
-- > route $ setExtension "css"
-- > compile $ getResourceString >>=
-- > itemM (unixFilter "sass" ["-s", "--scss"]) >>=
-- > compressCssCompiler
unixFilter :: String -- ^ Program name
-> [String] -- ^ Program args
-> String -- ^ Program input
-> Compiler String -- ^ Program output
unixFilter = unixFilterWith writer reader
where
writer handle input = do
hSetEncoding handle localeEncoding
hPutStr handle input
reader handle = do
hSetEncoding handle localeEncoding
hGetContents handle
--------------------------------------------------------------------------------
-- | Variant of 'unixFilter' that should be used for binary files
--
-- > match "music.wav" $ do
-- > route $ setExtension "ogg"
-- > compile $ getResourceLBS >>= unixFilter "oggenc" ["-"]
unixFilterLBS :: String -- ^ Program name
-> [String] -- ^ Program args
-> ByteString -- ^ Program input
-> Compiler ByteString -- ^ Program output
unixFilterLBS = unixFilterWith LB.hPutStr LB.hGetContents
--------------------------------------------------------------------------------
-- | Overloaded compiler
unixFilterWith :: (Handle -> i -> IO ()) -- ^ Writer
-> (Handle -> IO o) -- ^ Reader
-> String -- ^ Program name
-> [String] -- ^ Program args
-> i -- ^ Program input
-> Compiler o -- ^ Program output
unixFilterWith writer reader programName args input = do
debugCompiler ("Executing external program " ++ programName)
unsafeCompiler $ unixFilterIO writer reader programName args input
--------------------------------------------------------------------------------
-- | Internally used function
unixFilterIO :: (Handle -> i -> IO ())
-> (Handle -> IO o)
-> String
-> [String]
-> i
-> IO o
unixFilterIO writer reader programName args 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
writer stdinWriteHandle input
hClose stdinWriteHandle
-- Receive the output from the child
stdoutReadHandle <- fdToHandle stdoutRead
reader stdoutReadHandle
|
