summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Hakyll/Core/Compiler.hs19
-rw-r--r--src/Hakyll/Core/Resource/Provider.hs10
-rw-r--r--src/Hakyll/Core/UnixFilter.hs61
-rw-r--r--src/Hakyll/Core/Writable.hs4
4 files changed, 73 insertions, 21 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index f8e8e6f..d25af45 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -92,6 +92,7 @@ module Hakyll.Core.Compiler
, getRoute
, getRouteFor
, getResourceString
+ , getResourceLBS
, fromDependency
, require_
, require
@@ -119,6 +120,7 @@ import System.FilePath (takeExtension)
import Data.Binary (Binary)
import Data.Typeable (Typeable)
+import Data.ByteString.Lazy (ByteString)
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
@@ -182,14 +184,25 @@ getRouteFor = fromJob $ \identifier -> CompilerM $ do
-- | Get the resource we are compiling as a string
--
getResourceString :: Compiler Resource String
-getResourceString = fromJob $ \resource -> CompilerM $ do
+getResourceString = getResourceWith resourceString
+
+-- | Get the resource we are compiling as a lazy bytestring
+--
+getResourceLBS :: Compiler Resource ByteString
+getResourceLBS = getResourceWith resourceLBS
+
+-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
+--
+getResourceWith :: (ResourceProvider -> Resource -> IO a)
+ -> Compiler Resource a
+getResourceWith reader = fromJob $ \resource -> CompilerM $ do
let identifier = unResource resource
provider <- compilerResourceProvider <$> ask
if resourceExists provider resource
- then liftIO $ resourceString provider resource
+ then liftIO $ reader provider resource
else throwError $ error' identifier
where
- error' id' = "Hakyll.Core.Compiler.getResourceString: resource "
+ error' id' = "Hakyll.Core.Compiler.getResourceWith: resource "
++ show id' ++ " not found"
-- | Auxiliary: get a dependency
diff --git a/src/Hakyll/Core/Resource/Provider.hs b/src/Hakyll/Core/Resource/Provider.hs
index d7f08e0..944f9c7 100644
--- a/src/Hakyll/Core/Resource/Provider.hs
+++ b/src/Hakyll/Core/Resource/Provider.hs
@@ -36,13 +36,13 @@ import Hakyll.Core.Resource
--
data ResourceProvider = ResourceProvider
{ -- | A list of all resources this provider is able to provide
- resourceList :: [Resource]
+ resourceList :: [Resource]
, -- | Retrieve a certain resource as string
- resourceString :: Resource -> IO String
+ resourceString :: Resource -> IO String
, -- | Retrieve a certain resource as lazy bytestring
- resourceLazyByteString :: Resource -> IO LB.ByteString
+ resourceLBS :: Resource -> IO LB.ByteString
, -- | Cache keeping track of modified items
- resourceModifiedCache :: MVar (Map Resource Bool)
+ resourceModifiedCache :: MVar (Map Resource Bool)
}
-- | Create a resource provider
@@ -61,7 +61,7 @@ resourceExists provider = flip elem $ resourceList provider
-- | Retrieve a digest for a given resource
--
resourceDigest :: ResourceProvider -> Resource -> IO [Word8]
-resourceDigest provider = digest MD5 <=< resourceLazyByteString provider
+resourceDigest provider = digest MD5 <=< resourceLBS provider
-- | Check if a resource was modified
--
diff --git a/src/Hakyll/Core/UnixFilter.hs b/src/Hakyll/Core/UnixFilter.hs
index ee4b6cd..dcbbaaf 100644
--- a/src/Hakyll/Core/UnixFilter.hs
+++ b/src/Hakyll/Core/UnixFilter.hs
@@ -2,14 +2,20 @@
--
module Hakyll.Core.UnixFilter
( unixFilter
+ , unixFilterLBS
) 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 System.IO ( Handle, hPutStr, hClose, hGetContents
+ , hSetEncoding, localeEncoding
+ )
+
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as LB
import Hakyll.Core.Compiler
@@ -26,25 +32,54 @@ import Hakyll.Core.Compiler
--
-- 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
+-- > match "style.scss" $ do
+-- > route $ setExtension "css"
+-- > compile $ getResourceString >>> unixFilter "sass" ["-s", "--scss"]
+-- > >>> arr compressCss
--
unixFilter :: String -- ^ Program name
-> [String] -- ^ Program args
-> Compiler String String -- ^ Resulting compiler
-unixFilter programName args =
+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
+ -> Compiler ByteString ByteString -- ^ Resulting compiler
+unixFilterLBS = unixFilterWith LB.hPutStr LB.hGetContents
+
+-- | Overloaded compiler
+--
+unixFilterWith :: (Handle -> i -> IO ()) -- ^ Writer
+ -> (Handle -> IO o) -- ^ Reader
+ -> String -- ^ Program name
+ -> [String] -- ^ Program args
+ -> Compiler i o -- ^ Resulting compiler
+unixFilterWith writer reader programName args =
timedCompiler ("Executing external program " ++ programName) $
- unsafeCompiler $ \input -> unixFilterIO programName args input
+ unsafeCompiler $ unixFilterIO writer reader programName args
-- | Internally used function
--
-unixFilterIO :: String
- -> [String]
+unixFilterIO :: (Handle -> i -> IO ())
+ -> (Handle -> IO o)
-> String
- -> IO String
-unixFilterIO programName args input = do
+ -> [String]
+ -> i
+ -> IO o
+unixFilterIO writer reader programName args input = do
-- Create pipes
(stdinRead, stdinWrite) <- createPipe
(stdoutRead, stdoutWrite) <- createPipe
@@ -68,9 +103,9 @@ unixFilterIO programName args input = do
-- Write the input to the child pipe
_ <- forkIO $ do
stdinWriteHandle <- fdToHandle stdinWrite
- hPutStr stdinWriteHandle input
+ writer stdinWriteHandle input
hClose stdinWriteHandle
-- Receive the output from the child
stdoutReadHandle <- fdToHandle stdoutRead
- hGetContents stdoutReadHandle
+ reader stdoutReadHandle
diff --git a/src/Hakyll/Core/Writable.hs b/src/Hakyll/Core/Writable.hs
index 8239ce2..280258d 100644
--- a/src/Hakyll/Core/Writable.hs
+++ b/src/Hakyll/Core/Writable.hs
@@ -8,6 +8,7 @@ module Hakyll.Core.Writable
import Data.Word (Word8)
import qualified Data.ByteString as SB
+import qualified Data.ByteString.Lazy as LB
import Text.Blaze (Html)
import Text.Blaze.Renderer.String (renderHtml)
@@ -25,6 +26,9 @@ instance Writable [Char] where
instance Writable SB.ByteString where
write p = SB.writeFile p
+instance Writable LB.ByteString where
+ write p = LB.writeFile p
+
instance Writable [Word8] where
write p = write p . SB.pack
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-27 11:11:31 +0000