addStaticContentExternal

This commit is contained in:
Michael Snoyman 2011-09-22 08:44:57 +03:00
parent 1dbbfc8d06
commit 632bb4c7ed
3 changed files with 57 additions and 24 deletions

View File

@ -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

View File

@ -14,15 +14,20 @@ description: Convenient wrappers for your the configuration and
execution of your yesod application execution of your yesod application
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.9 && < 0.10 , yesod-core >= 0.9 && < 0.10
, cmdargs >= 0.8 && < 0.9 , cmdargs >= 0.8 && < 0.9
, warp >= 0.4 && < 0.5 , warp >= 0.4 && < 0.5
, wai >= 0.4 && < 0.5 , wai >= 0.4 && < 0.5
, wai-extra >= 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 exposed-modules: Yesod.Default.Config
, Yesod.Default.Main , Yesod.Default.Main
, Yesod.Default.Util
ghc-options: -Wall ghc-options: -Wall

View File

@ -23,19 +23,18 @@ import Yesod.Auth
import Yesod.Auth.OpenId import Yesod.Auth.OpenId
import Yesod.Auth.Email import Yesod.Auth.Email
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Default.Util (addStaticContentExternal)
import Yesod.Logger (Logger, logLazyText) import Yesod.Logger (Logger, logLazyText)
import qualified Settings import qualified Settings
import System.Directory
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Database.Persist.~importGenericDB~ import Database.Persist.~importGenericDB~
import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile) import Settings (hamletFile, cassiusFile, luciusFile, juliusFile, widgetFile)
import Model import Model
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Control.Monad (join, unless) import Control.Monad (join)
import Network.Mail.Mime import Network.Mail.Mime
import qualified Data.Text.Lazy.Encoding import qualified Data.Text.Lazy.Encoding
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
import qualified Data.Text as T
import Web.ClientSession (getKey) import Web.ClientSession (getKey)
import Text.Blaze.Renderer.Utf8 (renderHtml) import Text.Blaze.Renderer.Utf8 (renderHtml)
import Text.Hamlet (shamlet) import Text.Hamlet (shamlet)
@ -104,21 +103,7 @@ instance Yesod ~sitearg~ where
-- and names them based on a hash of their content. This allows -- and names them based on a hash of their content. This allows
-- expiration dates to be set far in the future without worry of -- expiration dates to be set far in the future without worry of
-- users receiving stale content. -- users receiving stale content.
addStaticContent ext' _ content = do addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])
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] [], [])
-- How to run database actions. -- How to run database actions.
instance YesodPersist ~sitearg~ where instance YesodPersist ~sitearg~ where