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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
{-# LANGUAGE CPP #-}
--------------------------------------------------------------------------------
-- | A Compiler that supports unix filters.
module Hakyll.Core.UnixFilter
( unixFilter
, unixFilterLBS
) where
--------------------------------------------------------------------------------
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import Control.DeepSeq (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
--------------------------------------------------------------------------------
-- | Use a unix filter as compiler. For example, we could use the 'rev' program
-- as a compiler.
--
-- > rev :: Compiler (Item String)
-- > rev = getResourceString >>= withItemBody (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 >>=
-- > withItemBody (unixFilter "sass" ["-s", "--scss"]) >>=
-- > return . fmap compressCss
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
out <- hGetContents handle
deepseq out (return out)
--------------------------------------------------------------------------------
-- | Variant of 'unixFilter' that should be used for binary files
--
-- > match "music.wav" $ do
-- > route $ setExtension "ogg"
-- > compile $ getResourceLBS >>= withItemBody (unixFilterLBS "oggenc" ["-"])
unixFilterLBS :: String -- ^ Program name
-> [String] -- ^ Program args
-> ByteString -- ^ Program input
-> Compiler ByteString -- ^ Program output
unixFilterLBS = unixFilterWith LB.hPutStr $ \handle -> do
out <- LB.hGetContents handle
LB.length out `seq` return out
--------------------------------------------------------------------------------
-- | Overloaded compiler
unixFilterWith :: Monoid o
=> (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)
(output, err, exitCode) <- unsafeCompiler $
unixFilterIO writer reader programName args input
forM_ (lines err) debugCompiler
case exitCode of
ExitSuccess -> return output
ExitFailure e -> fail $
"Hakyll.Core.UnixFilter.unixFilterWith: " ++
unwords (programName : args) ++ " gave exit code " ++ show e
--------------------------------------------------------------------------------
-- | Internally used function
unixFilterIO :: Monoid o
=> (Handle -> i -> IO ())
-> (Handle -> IO o)
-> String
-> [String]
-> i
-> IO (o, String, ExitCode)
unixFilterIO writer reader programName args input = do
-- The problem on Windows is that `proc` is unable to execute
-- batch stubs (eg. anything created using 'gem install ...') even if its in
-- `$PATH`. A solution to this issue is to execute the batch file explicitly
-- using `cmd /c batchfile` but there is no rational way to know where said
-- batchfile is on the system. Hence, we detect windows using the
-- CPP and instead of using `proc` to create the process, use `shell`
-- which will be able to execute everything `proc` can
-- as well as batch files.
#ifdef mingw32_HOST_OS
let pr = shell $ unwords (programName : args)
#else
let pr = proc programName args
#endif
(Just inh, Just outh, Just errh, pid) <-
createProcess pr
{ std_in = CreatePipe
, std_out = CreatePipe
, std_err = CreatePipe
}
-- 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
hClose outh
writeIORef outRef out
putMVar lock ()
-- Read from stderr
_ <- forkIO $ do
hSetEncoding errh localeEncoding
err <- hGetContents errh
_ <- deepseq err (return err)
hClose errh
writeIORef errRef err
putMVar lock ()
-- Get exit code & return
takeMVar lock
takeMVar lock
exitCode <- waitForProcess pid
out <- readIORef outRef
err <- readIORef errRef
return (out, err, exitCode)
|