addStaticContentExternal
This commit is contained in:
parent
1dbbfc8d06
commit
632bb4c7ed
43
yesod-default/Yesod/Default/Util.hs
Normal file
43
yesod-default/Yesod/Default/Util.hs
Normal 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
|
||||||
@ -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
|
||||||
|
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user