Thanks, that helped a lot. Below is a reference for anyone else who tries
to do this:
Images was fairly trivial, I added the below based on the example from
jaspervdj:
assetHashRoute :: FileHashes -> Routes
assetHashRoute fileHashes =
customRoute $ \identifier ->
fromMaybe (toFilePath identifier) (Map.lookup identifier fileHashes)
rewriteAssetUrls :: FileHashes -> Item String -> Compiler (Item String)
rewriteAssetUrls hashes item = do
route <- getRoute $ itemIdentifier item
return $ case route of
Nothing -> item
Just r -> fmap rewrite item
where
rewrite = withUrls $ \url ->
maybe url (\hashUrl -> "/" <> hashUrl) (Map.lookup (fromFilePath url)
hashes)
Which lets me do the below rewriting image urls in the html from say
"images/myimage.jpg" to "images/[hash].jpg":
main = hakyll $ do
imageHashes <- preprocess (mkFileHashes "images")
match "images/*" $ do
route $ assetHashRoute imageHashes
compile copyFileCompiler
match "pages/*" $ do
route $ gsubRoute "pages/" (const "") `composeRoutes`
setExtension "html"
compile $ do
pandocCompiler
Post by Jasper Van der Jeugt= loadAndApplyTemplate "templates/page.html"
defaultContext
Post by Jasper Van der Jeugt= loadAndApplyTemplate "templates/default.html"
defaultContext
Post by Jasper Van der Jeugt= rewriteAssetUrls imageHashes
= relativizeUrls
Sass was a little harder as I wanted the hash to be the hash of the final
compiled file. I ended up with the below which stores the compiled sass in
memory for writing out:
loadSass :: String -> IO (Map Identifier (String, String))
loadSass dir = do
files <- getRecursiveContents (\_ -> return False) dir
toCompile <- return $ files >>=
\file -> maybe [] (\opts -> [(dir </> file, opts)]) (sassOpts file)
compileResults <- forM toCompile $
\(file, opt) -> fmap (\result -> (file, result)) $ compileFile file opt
successfullFiles <- return $ compileResults >>=
\result -> case result of
(file, Left _) -> []
(file, Right css) -> [(fromFilePath file, (replaceFileName
file (hash css <> ".css"), css))]
return $ Map.fromList successfullFiles
where
sassOpts filepath =
case takeExtensions filepath of
".sass" -> Just def { sassIsIndentedSyntax = True
, sassOutputStyle = SassStyleCompressed
}
".scss" -> Just def { sassIsIndentedSyntax = False
, sassOutputStyle = SassStyleCompressed
}
_ -> Nothing
hash =
BS8.unpack. Base16.encode . SHA256.hash . BS8.pack
writeHashedContent :: Map Identifier (String, String) -> Rules ()
writeHashedContent =
sequence_ . fmap f . Map.toList
where
f (identifier, (hashedPath, css)) =
create [identifier] $ do
route $ customRoute (\identifier -> hashedPath)
compile $ makeItem css
Similarly used:
main = hakyll $ do
imageHashes <- preprocess (mkFileHashes "images")
sass <- preprocess (loadSass "css")
match "pages/*" $ do
route $ gsubRoute "pages/" (const "") `composeRoutes`
setExtension "html"
compile $ do
pandocCompiler
Post by Jasper Van der Jeugt= loadAndApplyTemplate "templates/page.html"
defaultContext
Post by Jasper Van der Jeugt= loadAndApplyTemplate "templates/default.html"
defaultContext
Post by Jasper Van der Jeugt= rewriteAssetUrls imageHashes
= rewriteAssetUrls (fmap fst sass)
= relativizeUrls
All I need to do is write a parser for the compiled CSS to update any image
urls as I can't use the existing withUrls.
Post by Jasper Van der JeugtHey,
I think the best approach would be to do this as a preprocessing step.
In this example, I'm using the libraries cryptohash-sha256 [1] and
base16-bytestring [2]. The `getRecursiveContents` function is in
Hakyll.
{-# LANGUAGE BangPatterns #-}
import Control.Monad (forM)
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BSL
import Data.Map (Map)
import qualified Data.Map as Map
import Hakyll
import System.FilePath ((</>))
type FileHashes = Map Identifier String
mkFileHashes :: FilePath -> IO FileHashes
mkFileHashes dir = do
allFiles <- getRecursiveContents (\_ -> return False) dir
fmap Map.fromList $ forM allFiles $ \path0 -> do
let path1 = dir </> path0
!h <- hash path1
return (fromFilePath path1, h)
where
hash :: FilePath -> IO String
hash fp = do
!h <- SHA256.hashlazy <$> BSL.readFile fp
return $! BS8.unpack $! Base16.encode h
main :: IO ()
main = hakyll $ do
fileHashes <- preprocess (mkFileHashes "images")
-- Now, you can just use `Map.lookup` in your routes...
...
Hope this helps!
[1]: https://hackage.haskell.org/package/cryptohash-sha256
[2]: https://hackage.haskell.org/package/base16-bytestring
Cheers
Jasper
Has anyone configured asset hashing with Hakyll?
I want to take the result of `Compiler (Item String)` generate a sha256
hash from it then update the route to use the sha256 as the filename.
IE: I want the below to generate [hash].css files
match "css/*.scss" $ do
route $ setExtension "css"
compile $ sassCompilerWith scssopts
I can create a hash from a `Item String`, I can't see how I can update
the
route from `Compiler (Item String)`.
I would also need to create a list of `[(Identifier, Hash)]' for each
asset
so I can modify the template asset paths to use the hashed filename.
Similarly I'd want to use the same pattern and update `copyFileCompiler`
to
rename images based on the hash.
Is this possible to create?
--
You received this message because you are subscribed to the Google
Groups "hakyll" group.
To unsubscribe from this group and stop receiving emails from it, send
For more options, visit https://groups.google.com/d/optout.
--
You received this message because you are subscribed to the Google Groups "hakyll" group.
To unsubscribe from this group and stop receiving emails from it, send an email to hakyll+***@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.