44 lines
1.9 KiB
Haskell
44 lines
1.9 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
-- | Various utilities used in the scaffolded site.
|
|
module Yesod.Default.Util
|
|
( addStaticContentExternal
|
|
) where
|
|
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import qualified Data.ByteString.Lazy as L
|
|
import Data.Text (Text, pack, unpack)
|
|
import Yesod.Core -- purposely using complete import so that Haddock will see addStaticContent
|
|
import Control.Monad (unless)
|
|
import System.Directory (doesFileExist, createDirectoryIfMissing)
|
|
|
|
-- | An implementation of 'addStaticContent' which stores the contents in an
|
|
-- external file. Files are created in the given static folder with names based
|
|
-- on a hash of their content. This allows expiration dates to be set far in
|
|
-- the future without worry of users receiving stale content.
|
|
addStaticContentExternal
|
|
:: (L.ByteString -> Either a L.ByteString) -- ^ javascript minifier
|
|
-> (L.ByteString -> String) -- ^ hash function to determine file name
|
|
-> FilePath -- ^ location of static directory. files will be placed within a "tmp" subfolder
|
|
-> ([Text] -> Route master) -- ^ route constructor, taking a list of pieces
|
|
-> Text -- ^ filename extension
|
|
-> Text -- ^ mime type
|
|
-> L.ByteString -- ^ file contents
|
|
-> GHandler sub master (Maybe (Either Text (Route master, [(Text, Text)])))
|
|
addStaticContentExternal minify hash staticDir toRoute ext' _ content = do
|
|
liftIO $ createDirectoryIfMissing True statictmp
|
|
exists <- liftIO $ doesFileExist fn'
|
|
unless exists $ liftIO $ L.writeFile fn' content'
|
|
return $ Just $ Right (toRoute ["tmp", pack fn], [])
|
|
where
|
|
fn, statictmp, fn' :: FilePath
|
|
-- by basing the hash off of the un-minified content, we avoid a costly
|
|
-- minification if the file already exists
|
|
fn = hash content ++ '.' : unpack ext'
|
|
statictmp = staticDir ++ "/tmp/"
|
|
fn' = statictmp ++ fn
|
|
|
|
content' :: L.ByteString
|
|
content'
|
|
| ext' == "js" = either (const content) id $ minify content
|
|
| otherwise = content
|