From d01d6fa61ae69f538d74eee32dff30c563fa36ae Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 21 Apr 2013 11:14:18 +0300 Subject: [PATCH] Static file combining #517 --- yesod-static/Yesod/Static.hs | 195 +++++++++++++++++++++++++++++++- yesod-static/yesod-static.cabal | 6 + 2 files changed, 199 insertions(+), 2 deletions(-) diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs index fad22367b..78dbd872c 100644 --- a/yesod-static/Yesod/Static.hs +++ b/yesod-static/Yesod/Static.hs @@ -36,6 +36,18 @@ module Yesod.Static , static , staticDevel , embed + -- * Combining CSS/JS + -- $combining + , combineStylesheets' + , combineScripts' + -- ** Settings + , CombineSettings + , csStaticDir + , csCssPostProcess + , csJsPostProcess + , csCssPreProcess + , csJsPreProcess + , csCombinedFolder -- * Template Haskell helpers , staticFiles , staticFilesList @@ -75,10 +87,19 @@ import Data.List (foldl') import qualified Data.ByteString as S import System.PosixCompat.Files (getFileStatus, modificationTime) import System.Posix.Types (EpochTime) -import Data.Conduit (($$)) -import Data.Conduit.List (sourceList) +import Data.Conduit +import Data.Conduit.List (sourceList, consume) +import Data.Conduit.Binary (sourceFile) +import qualified Data.Conduit.Text as CT import Data.Functor.Identity (runIdentity) import qualified Filesystem.Path.CurrentOS as F +import Filesystem.Path.CurrentOS ((), (<.>), FilePath) +import Filesystem (createTree) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE +import Data.Default +import Text.Lucius (luciusRTMinified) import Network.Wai.Application.Static ( StaticSettings (..) @@ -336,3 +357,173 @@ base64 = map tr tr '+' = '-' tr '/' = '_' tr c = c + +-- $combining +-- +-- A common scenario on a site is the desire to include many external CSS and +-- Javascript files on every page. Doing so via the Widget functionality in +-- Yesod will work, but would also mean that the same content will be +-- downloaded many times. A better approach would be to combine all of these +-- files together into a single static file and serve that as a static resource +-- for every page. That resource can be cached on the client, and bandwidth +-- usage reduced. +-- +-- This could be done as a manual process, but that becomes tedious. Instead, +-- you can use some Template Haskell code which will combine these files into a +-- single static file at compile time. + +data CombineType = JS | CSS + +combineStatics' :: CombineType + -> CombineSettings + -> [Route Static] -- ^ files to combine + -> Q Exp +combineStatics' combineType CombineSettings {..} routes = do + texts <- qRunIO $ runResourceT $ mapM_ yield fps $$ awaitForever readUTFFile =$ consume + ltext <- qRunIO $ preProcess $ TL.fromChunks texts + bs <- qRunIO $ postProcess fps $ TLE.encodeUtf8 ltext + let hash' = base64md5 bs + suffix = csCombinedFolder F.decodeString hash' <.> extension + fp = csStaticDir suffix + qRunIO $ do + createTree $ F.directory fp + L.writeFile (F.encodeString fp) bs + let pieces = map T.unpack $ T.splitOn "/" $ either id id $ F.toText suffix + [|StaticRoute (map pack pieces) []|] + where + fps :: [F.FilePath] + fps = map toFP routes + toFP (StaticRoute pieces _) = csStaticDir F.concat (map F.fromText pieces) + readUTFFile fp = sourceFile (F.encodeString fp) =$= CT.decode CT.utf8 + postProcess = + case combineType of + JS -> csJsPostProcess + CSS -> csCssPostProcess + preProcess = + case combineType of + JS -> csJsPreProcess + CSS -> csCssPreProcess + extension = + case combineType of + JS -> "js" + CSS -> "css" + +-- | Data type for holding all settings for combining files. +-- +-- This data type is a settings type. For more information, see: +-- +-- +-- +-- Since 1.2.0 +data CombineSettings = CombineSettings + { csStaticDir :: F.FilePath + -- ^ File path containing static files. + -- + -- Default: static + -- + -- Since 1.2.0 + , csCssPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString + -- ^ Post processing to be performed on CSS files. + -- + -- Default: Use Lucius to minify. + -- + -- Since 1.2.0 + , csJsPostProcess :: [FilePath] -> L.ByteString -> IO L.ByteString + -- ^ Post processing to be performed on Javascript files. + -- + -- Default: Pass-through. + -- + -- Since 1.2.0 + , csCssPreProcess :: TL.Text -> IO TL.Text + -- ^ Pre-processing to be performed on CSS files. + -- + -- Default: convert all occurences of /static/ to ../ + -- + -- Since 1.2.0 + , csJsPreProcess :: TL.Text -> IO TL.Text + -- ^ Pre-processing to be performed on Javascript files. + -- + -- Default: Pass-through. + -- + -- Since 1.2.0 + , csCombinedFolder :: FilePath + -- ^ Subfolder to put combined files into. + -- + -- Default: combined + -- + -- Since 1.2.0 + } + +instance Default CombineSettings where + def = CombineSettings + { csStaticDir = "static" + , csCssPostProcess = \fps -> + either (error . (errorIntro fps)) (return . TLE.encodeUtf8) + . flip luciusRTMinified [] + . TLE.decodeUtf8 + , csJsPostProcess = const return + -- FIXME The following borders on a hack. With combining of files, + -- the final location of the CSS is no longer fixed, so relative + -- references will break. Instead, we switched to using /static/ + -- absolute references. However, when served from a separate domain + -- name, this will break too. The solution is that, during + -- development, we keep /static/, and in the combining phase, we + -- replace /static with a relative reference to the parent folder. + , csCssPreProcess = + return + . TL.replace "'/static/" "'../" + . TL.replace "\"/static/" "\"../" + , csJsPreProcess = return + , csCombinedFolder = "combined" + } + +errorIntro :: [FilePath] -> [Char] -> [Char] +errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s + +liftRoutes :: [Route Static] -> Q Exp +liftRoutes = + fmap ListE . mapM go + where + go :: Route Static -> Q Exp + go (StaticRoute x y) = [|StaticRoute $(liftTexts x) $(liftPairs y)|] + + liftTexts = fmap ListE . mapM liftT + liftT t = [|pack $(TH.lift $ T.unpack t)|] + + liftPairs = fmap ListE . mapM liftPair + liftPair (x, y) = [|($(liftT x), $(liftT y))|] + +-- | Combine multiple CSS files together. Common usage would be: +-- +-- >>> combineStylesheets' development def 'StaticR [style1_css, style2_css] +-- +-- Where @development@ is a variable in your site indicated whether you are in +-- development or production mode. +-- +-- Since 1.2.0 +combineStylesheets' :: Bool -- ^ development? if so, perform no combining + -> CombineSettings + -> Name -- ^ Static route constructor name, e.g. \'StaticR + -> [Route Static] -- ^ files to combine + -> Q Exp +combineStylesheets' development cs con routes + | development = [| mapM_ (addStylesheet . $(return $ ConE con)) $(liftRoutes routes) |] + | otherwise = [| addStylesheet $ $(return $ ConE con) $(combineStatics' CSS cs routes) |] + + +-- | Combine multiple JS files together. Common usage would be: +-- +-- >>> combineScripts' development def 'StaticR [script1_js, script2_js] +-- +-- Where @development@ is a variable in your site indicated whether you are in +-- development or production mode. +-- +-- Since 1.2.0 +combineScripts' :: Bool -- ^ development? if so, perform no combining + -> CombineSettings + -> Name -- ^ Static route constructor name, e.g. \'StaticR + -> [Route Static] -- ^ files to combine + -> Q Exp +combineScripts' development cs con routes + | development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |] + | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |] diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index fcb0cfc17..62e819e98 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -40,6 +40,9 @@ library , crypto-conduit >= 0.4 , cryptohash >= 0.6.1 , system-filepath >= 0.4.6 && < 0.5 + , system-fileio >= 0.3 + , data-default + , shakespeare-css >= 1.0.3 exposed-modules: Yesod.Static ghc-options: -Wall @@ -70,6 +73,9 @@ test-suite tests , crypto-conduit , cryptohash , system-filepath + , system-fileio + , data-default + , shakespeare-css ghc-options: -Wall