From 632bb4c7ed5cfce844d7b7de6c1f0099b27bfe6f Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 22 Sep 2011 08:44:57 +0300 Subject: [PATCH] addStaticContentExternal --- yesod-default/Yesod/Default/Util.hs | 43 +++++++++++++++++++++++++++++ yesod-default/yesod-default.cabal | 17 ++++++++---- yesod/scaffold/Foundation.hs.cg | 21 ++------------ 3 files changed, 57 insertions(+), 24 deletions(-) create mode 100644 yesod-default/Yesod/Default/Util.hs diff --git a/yesod-default/Yesod/Default/Util.hs b/yesod-default/Yesod/Default/Util.hs new file mode 100644 index 00000000..ba36cb14 --- /dev/null +++ b/yesod-default/Yesod/Default/Util.hs @@ -0,0 +1,43 @@ +{-# 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 diff --git a/yesod-default/yesod-default.cabal b/yesod-default/yesod-default.cabal index 306b6fb1..8eea3d63 100644 --- a/yesod-default/yesod-default.cabal +++ b/yesod-default/yesod-default.cabal @@ -14,15 +14,20 @@ description: Convenient wrappers for your the configuration and execution of your yesod application library - build-depends: base >= 4 && < 5 - , yesod-core >= 0.9 && < 0.10 - , cmdargs >= 0.8 && < 0.9 - , warp >= 0.4 && < 0.5 - , wai >= 0.4 && < 0.5 - , wai-extra >= 0.4 && < 0.5 + build-depends: base >= 4 && < 5 + , yesod-core >= 0.9 && < 0.10 + , cmdargs >= 0.8 && < 0.9 + , warp >= 0.4 && < 0.5 + , wai >= 0.4 && < 0.5 + , wai-extra >= 0.4 && < 0.5 + , bytestring >= 0.9 && < 0.10 + , transformers >= 0.2 && < 0.3 + , text >= 0.9 && < 1.0 + , directory >= 1.0 && < 1.2 exposed-modules: Yesod.Default.Config , Yesod.Default.Main + , Yesod.Default.Util ghc-options: -Wall diff --git a/yesod/scaffold/Foundation.hs.cg b/yesod/scaffold/Foundation.hs.cg index 6910cd26..1aa391c1 100644 --- a/yesod/scaffold/Foundation.hs.cg +++ b/yesod/scaffold/Foundation.hs.cg @@ -23,19 +23,18 @@ import Yesod.Auth import Yesod.Auth.OpenId import Yesod.Auth.Email import Yesod.Default.Config +import Yesod.Default.Util (addStaticContentExternal) import Yesod.Logger (Logger, logLazyText) import qualified Settings -import System.Directory import qualified Data.ByteString.Lazy as L import Database.Persist.~importGenericDB~ import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile) import Model import Data.Maybe (isJust) -import Control.Monad (join, unless) +import Control.Monad (join) import Network.Mail.Mime import qualified Data.Text.Lazy.Encoding import Text.Jasmine (minifym) -import qualified Data.Text as T import Web.ClientSession (getKey) import Text.Blaze.Renderer.Utf8 (renderHtml) import Text.Hamlet (shamlet) @@ -104,21 +103,7 @@ instance Yesod ~sitearg~ where -- and names them 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. - addStaticContent ext' _ content = do - let fn = base64md5 content ++ '.' : T.unpack ext' - let content' = - if ext' == "js" - then case minifym content of - Left _ -> content - Right y -> y - else content - let statictmp = Settings.staticDir ++ "/tmp/" - liftIO $ createDirectoryIfMissing True statictmp - let fn' = statictmp ++ fn - exists <- liftIO $ doesFileExist fn' - unless exists $ liftIO $ L.writeFile fn' content' - return $ Just $ Right (StaticR $ StaticRoute ["tmp", T.pack fn] [], []) - + addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute []) -- How to run database actions. instance YesodPersist ~sitearg~ where