yesod-static 1.2.0.1 → 1.2.1
raw patch · 17 files changed
+1285/−8 lines, 17 filesdep +HUnitdep +filepathdep +hjsmindep ~wai-app-static
Dependencies added: HUnit, filepath, hjsmin, mime-types, process-conduit, resourcet, unordered-containers, wai-test, yesod-test
Dependency ranges changed: wai-app-static
Files
- Yesod/EmbeddedStatic.hs +183/−0
- Yesod/EmbeddedStatic/Generators.hs +317/−0
- Yesod/EmbeddedStatic/Internal.hs +169/−0
- Yesod/EmbeddedStatic/Types.hs +67/−0
- Yesod/Static.hs +7/−3
- sample-embed.hs +42/−0
- sample.hs +25/−0
- test/EmbedDevelTest.hs +95/−0
- test/EmbedProductionTest.hs +118/−0
- test/EmbedTestGenerator.hs +62/−0
- test/FileGeneratorTests.hs +92/−0
- test/GeneratorTestUtil.hs +59/−0
- test/embed-dir/abc/def.txt +1/−0
- test/embed-dir/foo +1/−0
- test/embed-dir/lorem.txt +6/−0
- test/tests.hs +8/−1
- yesod-static.cabal +33/−4
+ Yesod/EmbeddedStatic.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | A subsite which serves static content which is embedded at compile time.+--+-- At compile time, you supply a list of files, directories, processing functions (like javascript+-- minification), and even custom content generators. You can also specify the specific relative+-- locations within the static subsite where these resources should appear. The 'mkEmbeddedStatic'+-- function then computes the resources and embeds them directly into the executable at+-- compile time, so that the original files do not need to be distributed along with+-- the executable. The content is also compressed and hashed at compile time, so that+-- during runtime the compressed content can be sent directly on the wire with the appropriate+-- HTTP header. The precomputed hash is used for an ETag so the client does not redownload+-- the content multiple times. There is also a development mode which does not embed the+-- contents but recomputes it on every request. A simple example using an embedded static+-- subsite is+-- <https://github.com/yesodweb/yesod/blob/master/yesod-static/sample-embed.hs static-embed.hs>.+--+-- To add this to a scaffolded project, replace the code in @Settings/StaticFiles.hs@+-- with a call to 'mkEmbeddedStatic' with the list of all your generators, use the type+-- 'EmbeddedStatic' in your site datatype for @getStatic@, update the route for @/static@ to+-- use the type 'EmbeddedStatic', use 'embedStaticContent' for 'addStaticContent' in+-- @Foundation.hs@, use the routes generated by 'mkEmbeddedStatic' and exported by+-- @Settings/StaticFiles.hs@ to link to your static content, and finally update+-- @Application.hs@ use the variable binding created by 'mkEmbeddedStatic' which+-- contains the created 'EmbeddedStatic'.+--+-- It is recommended that you serve static resources from a separate domain to save time+-- on transmitting cookies. You can use 'urlRenderOverride' to do so, by redirecting+-- routes to this subsite to a different domain (but the same path) and then pointing the+-- alternative domain to this server. In addition, you might consider using a reverse+-- proxy like varnish or squid to cache the static content, but the embedded content in+-- this subsite is cached and served directly from memory so is already quite fast.+module Yesod.EmbeddedStatic (+ -- * Subsite+ EmbeddedStatic+ , embeddedResourceR+ , mkEmbeddedStatic+ , embedStaticContent++ -- * Generators+ , module Yesod.EmbeddedStatic.Generators+) where++import Control.Applicative ((<$>))+import Data.IORef+import Data.Maybe (catMaybes)+import Language.Haskell.TH+import Network.HTTP.Types.Status (status404)+import Network.Wai (responseLBS, pathInfo)+import Network.Wai.Application.Static (staticApp)+import System.IO.Unsafe (unsafePerformIO)+import Yesod.Core+ ( HandlerT+ , Yesod(..)+ , YesodSubDispatch(..)+ )+import Yesod.Core.Types+ ( YesodSubRunnerEnv(..)+ , YesodRunnerEnv(..)+ )+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.HashMap.Strict as M+import qualified WaiAppStatic.Storage.Embedded as Static++import Yesod.EmbeddedStatic.Types+import Yesod.EmbeddedStatic.Internal+import Yesod.EmbeddedStatic.Generators++-- Haddock doesn't support associated types in instances yet so we can't+-- export EmbeddedResourceR directly.++-- | Construct a route to an embedded resource.+embeddedResourceR :: [T.Text] -> [(T.Text, T.Text)] -> Route EmbeddedStatic+embeddedResourceR = EmbeddedResourceR++instance Yesod master => YesodSubDispatch EmbeddedStatic (HandlerT master IO) where+ yesodSubDispatch YesodSubRunnerEnv {..} req = resp+ where+ master = yreSite ysreParentEnv+ site = ysreGetSub master+ resp = case pathInfo req of+ ("res":_) -> stApp site req+ ("widget":_) -> staticApp (widgetSettings site) req+ _ -> return $ responseLBS status404 [] "Not Found"++-- | Create the haskell variable for the link to the entry+mkRoute :: ComputedEntry -> Q [Dec]+mkRoute (ComputedEntry { cHaskellName = Nothing }) = return []+mkRoute (c@ComputedEntry { cHaskellName = Just name }) = do+ routeType <- [t| Route EmbeddedStatic |]+ link <- [| $(cLink c) |]+ return [ SigD name routeType+ , ValD (VarP name) (NormalB link) []+ ]++-- | Creates an 'EmbeddedStatic' by running, at compile time, a list of generators. +-- Each generator produces a list of entries to embed into the executable.+--+-- This template haskell splice creates a variable binding holding the resulting+-- 'EmbeddedStatic' and in addition creates variable bindings for all the routes+-- produced by the generators. For example, if a directory called static has+-- the following contents:+--+-- * js/jquery.js+--+-- * css/bootstrap.css+--+-- * img/logo.png+--+-- then a call to+--+-- > #ifdef DEVELOPMENT+-- > #define DEV_BOOL True+-- > #else+-- > #define DEV_BOOL False+-- > #endif+-- > mkEmbeddedStatic DEV_BOOL "myStatic" [embedDir "static"]+--+-- will produce variables+--+-- > myStatic :: EmbeddedStatic+-- > js_jquery_js :: Route EmbeddedStatic+-- > css_bootstrap_css :: Route EmbeddedStatic+-- > img_logo_png :: Route EmbeddedStatic+mkEmbeddedStatic :: Bool -- ^ development?+ -> String -- ^ variable name for the created 'EmbeddedStatic'+ -> [Generator] -- ^ the generators (see "Yesod.EmbeddedStatic.Generators")+ -> Q [Dec]+mkEmbeddedStatic dev esName gen = do+ entries <- concat <$> sequence gen+ computed <- runIO $ mapM (if dev then devEmbed else prodEmbed) entries++ let settings = Static.mkSettings $ return $ map cStEntry computed+ devExtra = listE $ catMaybes $ map ebDevelExtraFiles entries+ ioRef = [| unsafePerformIO $ newIORef M.empty |]++ -- build the embedded static+ esType <- [t| EmbeddedStatic |]+ esCreate <- if dev+ then [| EmbeddedStatic (develApp $settings $devExtra) $ioRef |]+ else [| EmbeddedStatic (staticApp $! $settings) $ioRef |]+ let es = [ SigD (mkName esName) esType+ , ValD (VarP $ mkName esName) (NormalB esCreate) []+ ]++ routes <- mapM mkRoute computed++ return $ es ++ concat routes++-- | Use this for 'addStaticContent' to have the widget static content be served by+-- the embedded static subsite. For example,+--+-- > import Yesod+-- > import Yesod.EmbeddedStatic+-- > import Text.Jasmine (minifym)+-- >+-- > data MySite = { ..., getStatic :: EmbeddedStatic, ... }+-- >+-- > mkYesod "MySite" [parseRoutes|+-- > ...+-- > /static StaticR EmbeddedStatic getStatic+-- > ...+-- > |]+-- >+-- > instance Yesod MySite where+-- > ...+-- > addStaticContent = embedStaticContent getStatic StaticR mini+-- > where mini = if development then Right else minifym+-- > ...+embedStaticContent :: Yesod site+ => (site -> EmbeddedStatic) -- ^ How to retrieve the embedded static subsite from your site+ -> (Route EmbeddedStatic -> Route site) -- ^ how to convert an embedded static route+ -> (BL.ByteString -> Either a BL.ByteString) -- ^ javascript minifier+ -> AddStaticContent site+embedStaticContent = staticContentHelper
+ Yesod/EmbeddedStatic/Generators.hs view
@@ -0,0 +1,317 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, ScopedTypeVariables #-}+-- | A generator is executed at compile time to load a list of entries+-- to embed into the subsite. This module contains several basic generators,+-- but the design of generators and entries is such that it is straightforward+-- to make custom generators for your own specific purposes, see <#g:4 this section>.+module Yesod.EmbeddedStatic.Generators (+ -- * Generators+ Location+ , embedFile+ , embedFileAt+ , embedDir+ , embedDirAt+ , concatFiles+ , concatFilesWith++ -- * Compression options for 'concatFilesWith'+ , jasmine+ , uglifyJs+ , yuiJavascript+ , yuiCSS+ , closureJs+ , compressTool+ , tryCompressTools++ -- * Util+ , pathToName+ + -- * Custom Generators+ + -- $example+) where++import Control.Applicative ((<$>))+import Control.Exception (try, SomeException)+import Control.Monad (forM, when)+import Control.Monad.Trans.Resource (runResourceT)+import Data.Char (isDigit, isLower)+import Data.Conduit (($$), (=$))+import Data.Conduit.Process (proc, conduitProcess)+import Data.Default (def)+import Data.Maybe (isNothing)+import Language.Haskell.TH+import Network.Mime (defaultMimeLookup)+import System.Directory (doesDirectoryExist, getDirectoryContents, findExecutable)+import System.FilePath ((</>))+import Text.Jasmine (minifym)+import qualified Data.ByteString.Lazy as BL+import qualified Data.Conduit.List as C+import qualified Data.Text as T++import Yesod.EmbeddedStatic.Types++-- | Embed a single file. Equivalent to passing the same string twice to 'embedFileAt'.+embedFile :: FilePath -> Generator+embedFile f = embedFileAt f f++-- | Embed a single file at a given location within the static subsite and generate a+-- route variable based on the location via 'pathToName'. The @FilePath@ must be a relative+-- path to the directory in which you run @cabal build@. During development, the file located+-- at this filepath will be reloaded on every request. When compiling for production, the contents+-- of the file will be embedded into the executable and so the file does not need to be+-- distributed along with the executable.+embedFileAt :: Location -> FilePath -> Generator+embedFileAt loc f = do+ let mime = defaultMimeLookup $ T.pack f+ let entry = def {+ ebHaskellName = Just $ pathToName loc+ , ebLocation = loc+ , ebMimeType = mime+ , ebProductionContent = BL.readFile f+ , ebDevelReload = [| BL.readFile $(litE $ stringL f) |]+ }+ return [entry]++-- | List all files recursively in a directory+getRecursiveContents :: Location -- ^ The directory to search+ -> FilePath -- ^ The prefix to add to the filenames+ -> IO [(Location,FilePath)]+getRecursiveContents prefix topdir = do+ names <- getDirectoryContents topdir+ let properNames = filter (`notElem` [".", ".."]) names+ paths <- forM properNames $ \name -> do+ let path = topdir </> name+ let loc = if null prefix then name else prefix ++ "/" ++ name+ isDirectory <- doesDirectoryExist path+ if isDirectory+ then getRecursiveContents loc path+ else return [(loc, path)]+ return (concat paths)++-- | Embed all files in a directory into the static subsite.+-- +-- Equivalent to passing the empty string as the location to 'embedDirAt',+-- so the directory path itself is not part of the resource locations (and so+-- also not part of the generated route variable names).+embedDir :: FilePath -> Generator+embedDir = embedDirAt ""++-- | Embed all files in a directory to a given location within the static subsite.+--+-- The directory tree rooted at the 'FilePath' (which must be relative to the directory in+-- which you run @cabal build@) is embedded into the static subsite at the given+-- location. Also, route variables will be created based on the final location+-- of each file. For example, if a directory \"static\" contains the files+--+-- * css/bootstrap.css+--+-- * js/jquery.js+--+-- * js/bootstrap.js+-- +-- then @embedDirAt \"somefolder\" \"static\"@ will+--+-- * Make the file @static\/css\/bootstrap.css@ available at the location+-- @somefolder\/css\/bootstrap.css@ within the static subsite and similarly+-- for the other two files.+--+-- * Create variables @somefolder_css_bootstrap_css@, @somefolder_js_jquery_js@,+-- @somefolder_js_bootstrap_js@ all of type @Route EmbeddedStatic@.+--+-- * During development, the files will be reloaded on every request. During+-- production, the contents of all files will be embedded into the executable.+--+-- * During development, files that are added to the directory while the server+-- is running will not be detected. You need to recompile the module which+-- contains the call to @mkEmbeddedStatic@. This will also generate new route+-- variables for the new files.+embedDirAt :: Location -> FilePath -> Generator+embedDirAt loc dir = do+ files <- runIO $ getRecursiveContents loc dir+ concat <$> mapM (uncurry embedFileAt) files++-- | Concatinate a list of files and embed it at the location. Equivalent to passing @return@ to+-- 'concatFilesWith'.+concatFiles :: Location -> [FilePath] -> Generator+concatFiles loc files = concatFilesWith loc return files++-- | Concatinate a list of files into a single 'BL.ByteString', run the resulting content through the given+-- function, embed it at the given location, and create a haskell variable name for the route based on+-- the location.+--+-- The processing function is only run when compiling for production, and the processing function is+-- executed at compile time. During development, on every request the files listed are reloaded,+-- concatenated, and served as a single resource at the given location without being processed.+concatFilesWith :: Location -> (BL.ByteString -> IO BL.ByteString) -> [FilePath] -> Generator+concatFilesWith loc process files = do+ let load = do putStrLn $ "Creating " ++ loc+ BL.concat <$> mapM BL.readFile files >>= process+ expFiles = listE $ map (litE . stringL) files+ expCt = [| BL.concat <$> mapM BL.readFile $expFiles |]+ mime = defaultMimeLookup $ T.pack loc+ return [def { ebHaskellName = Just $ pathToName loc+ , ebLocation = loc+ , ebMimeType = mime+ , ebProductionContent = load+ , ebDevelReload = expCt+ }]++-- | Convienient rexport of 'minifym' with a type signature to work with 'concatFilesWith'.+jasmine :: BL.ByteString -> IO BL.ByteString+jasmine ct = return $ either (const ct) id $ minifym ct++-- | Use <https://github.com/mishoo/UglifyJS2 UglifyJS2> to compress javascript.+-- Assumes @uglifyjs@ is located in the path and uses options @[\"-m\", \"-c\"]@+-- to both mangle and compress and the option \"-\" to cause uglifyjs to read from+-- standard input.+uglifyJs :: BL.ByteString -> IO BL.ByteString+uglifyJs = compressTool "uglifyjs" ["-m", "-c", "-"]++-- | Use <http://yui.github.io/yuicompressor/ YUI Compressor> to compress javascript.+-- Assumes a script @yuicompressor@ is located in the path. If not, you can still+-- use something like+--+-- > compressTool "java" ["-jar", "/path/to/yuicompressor.jar", "--type", "js"]+yuiJavascript :: BL.ByteString -> IO BL.ByteString+yuiJavascript = compressTool "yuicompressor" ["--type", "js"]++-- | Use <http://yui.github.io/yuicompressor/ YUI Compressor> to compress CSS.+-- Assumes a script @yuicompressor@ is located in the path.+yuiCSS :: BL.ByteString -> IO BL.ByteString+yuiCSS = compressTool "yuicompressor" ["--type", "css"]++-- | Use <https://developers.google.com/closure/compiler/ Closure> to compress+-- javascript using the default options. Assumes a script @closure@ is located in+-- the path. If not, you can still run using+--+-- > compressTool "java" ["-jar", "/path/to/compiler.jar"]+closureJs :: BL.ByteString -> IO BL.ByteString+closureJs = compressTool "closure" []++-- | Helper to convert a process into a compression function. The process+-- should be set up to take input from standard input and write to standard output.+compressTool :: FilePath -- ^ program+ -> [String] -- ^ options+ -> BL.ByteString -> IO BL.ByteString+compressTool f opts ct = do+ mpath <- findExecutable f+ when (isNothing mpath) $+ fail $ "Unable to find " ++ f+ let src = C.sourceList $ BL.toChunks ct+ p = proc f opts+ sink = C.consume+ compressed <- runResourceT (src $$ conduitProcess p =$ sink)+ putStrLn $ "Compressed successfully with " ++ f+ return $ BL.fromChunks compressed+++-- | Try a list of processing functions (like the compressions above) one by one until+-- one succeeds (does not raise an exception). Once a processing function succeeds,+-- none of the remaining functions are used. If none succeeds, the input is just+-- returned unprocessed. This is helpful if you are distributing+-- code on hackage and do not know what compressors the user will have installed. You+-- can list several and they will be tried in order until one succeeds.+tryCompressTools :: [BL.ByteString -> IO BL.ByteString] -> BL.ByteString -> IO BL.ByteString+tryCompressTools [] x = return x+tryCompressTools (p:ps) x = do+ mres <- try $ p x+ case mres of+ Left (err :: SomeException) -> do+ putStrLn $ show err+ tryCompressTools ps x+ Right res -> return res++-- | Clean up a path to make it a valid haskell name by replacing all non-letters+-- and non-numbers by underscores. In addition, if the path starts with a capital+-- letter or number add an initial underscore.+pathToName :: FilePath -> Name+pathToName f = routeName+ where+ replace c+ | 'A' <= c && c <= 'Z' = c+ | 'a' <= c && c <= 'z' = c+ | '0' <= c && c <= '9' = c+ | otherwise = '_'+ name = map replace f+ routeName = mkName $+ case () of+ ()+ | null name -> error "null-named file"+ | isDigit (head name) -> '_' : name+ | isLower (head name) -> name+ | otherwise -> '_' : name+++-- $example+-- Here is an example of creating your own custom generator.+-- Because of template haskell stage restrictions, you must define generators in a+-- different module from where you use them. The following generator will embed a+-- JSON document that contains the compile time.+--+-- >{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+-- >module CompileTime where+-- >+-- >import Data.Aeson+-- >import Data.Default+-- >import Data.Time+-- >import Yesod.EmbeddedStatic.Generators+-- >import Yesod.EmbeddedStatic.Types+-- >import qualified Data.ByteString.Lazy as BL+-- >+-- >getTime :: IO BL.ByteString+-- >getTime = do+-- > t <- getCurrentTime+-- > return $ encode $+-- > object [ "compile_time" .= show t ]+-- >+-- >timeGenerator :: Location -> Generator+-- >timeGenerator loc =+-- > return $ [def+-- > { ebHaskellName = Just $ pathToName loc+-- > , ebLocation = loc+-- > , ebMimeType = "application/json"+-- > , ebProductionContent = getTime+-- > , ebDevelReload = [| getTime |]+-- > }]+--+-- Notice how the @getTime@ action is given as both 'ebProductionContent' and+-- 'ebDevelReload'. The result is that during development, the @getTime@ action+-- will be re-executed on every request so the time returned will be different+-- for each reload. When compiling for production, the @getTime@ action will+-- be executed once at compile time to produce the content to embed and never+-- called at runtime.+--+-- Here is a small example yesod program using this generator. Try toggling+-- the development argument to @mkEmbeddedStatic@.+-- +-- >{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies #-}+-- >module Main where+-- >+-- >import Yesod+-- >import Yesod.EmbeddedStatic+-- >import CompileTime (timeGenerator)+-- >+-- >mkEmbeddedStatic True "eStatic" [timeGenerator "compile-time.json"]+-- >+-- >-- The above will generate variables+-- >-- eStatic :: EmbeddedStatic+-- >-- compile_time_json :: Route EmbeddedStatic+-- >+-- >data MyApp = MyApp { getStatic :: EmbeddedStatic }+-- >+-- >mkYesod "MyApp" [parseRoutes|+-- >/ HomeR GET+-- >/static StaticR EmbeddedStatic getStatic+-- >|]+-- >+-- >instance Yesod MyApp+-- >+-- >getHomeR :: Handler Html+-- >getHomeR = defaultLayout $ [whamlet|+-- ><h1>Hello+-- ><p>Check the +-- > <a href=@{StaticR compile_time_json}>compile time+-- >|]+-- >+-- >main :: IO ()+-- >main = warp 3000 $ MyApp eStatic
+ Yesod/EmbeddedStatic/Internal.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+module Yesod.EmbeddedStatic.Internal (+ EmbeddedStatic(..)+ , Route(..)+ , ComputedEntry(..)+ , devEmbed+ , prodEmbed+ , develApp+ , AddStaticContent+ , staticContentHelper+ , widgetSettings+) where++import Control.Applicative ((<$>))+import Data.IORef+import Language.Haskell.TH+import Network.HTTP.Types (Status(..), status404, status200, status304)+import Network.Mime (MimeType)+import Network.Wai+import Network.Wai.Application.Static (defaultWebAppSettings, staticApp)+import WaiAppStatic.Types+import Yesod.Core+ ( HandlerT+ , ParseRoute(..)+ , RenderRoute(..)+ , Yesod(..)+ , getYesod+ , liftIO+ )+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.HashMap.Strict as M+import qualified WaiAppStatic.Storage.Embedded as Static++import Yesod.Static (base64md5)+import Yesod.EmbeddedStatic.Types++#if !MIN_VERSION_base(4,6,0)+-- copied from base+atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b+atomicModifyIORef' ref f = do+ b <- atomicModifyIORef ref+ (\x -> let (a, b) = f x+ in (a, a `seq` b))+ b `seq` return b+#endif++-- | The subsite for the embedded static file server.+data EmbeddedStatic = EmbeddedStatic {+ stApp :: !Application+ , widgetFiles :: !(IORef (M.HashMap T.Text File))+}++instance RenderRoute EmbeddedStatic where+ data Route EmbeddedStatic = EmbeddedResourceR [T.Text] [(T.Text,T.Text)]+ | EmbeddedWidgetR T.Text+ deriving (Eq, Show, Read)+ renderRoute (EmbeddedResourceR x y) = ("res":x, y)+ renderRoute (EmbeddedWidgetR h) = (["widget",h], [])+instance ParseRoute EmbeddedStatic where+ parseRoute (("res":x), y) = Just $ EmbeddedResourceR x y+ parseRoute (["widget",h], _) = Just $ EmbeddedWidgetR h+ parseRoute _ = Nothing++-- | At compile time, one of these is created for every 'Entry' created by+-- the generators. The cLink is a template haskell expression of type @Route EmbeddedStatic@.+data ComputedEntry = ComputedEntry {+ cHaskellName :: Maybe Name -- ^ Optional haskell name to create a variable for the route+ , cStEntry :: Static.EmbeddableEntry -- ^ The entry to be embedded into the executable+ , cLink :: ExpQ -- ^ The route for this entry+}++mkStr :: String -> ExpQ+mkStr = litE . stringL++-- | Create a 'ComputedEntry' for development mode, reloading the content on every request.+devEmbed :: Entry -> IO ComputedEntry+devEmbed e = return computed+ where+ st = Static.EmbeddableEntry {+ Static.eLocation = "res/" `T.append` T.pack (ebLocation e)+ , Static.eMimeType = ebMimeType e+ , Static.eContent = Right [| $(ebDevelReload e) >>= \c ->+ return (T.pack (base64md5 c), c) |]+ }+ link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e)) [] |]+ computed = ComputedEntry (ebHaskellName e) st link++-- | Create a 'ComputedEntry' for production mode, hashing and embedding the content into the executable.+prodEmbed :: Entry -> IO ComputedEntry+prodEmbed e = do+ ct <- ebProductionContent e+ let hash = base64md5 ct+ link = [| EmbeddedResourceR (T.splitOn (T.pack "/") $ T.pack $(mkStr $ ebLocation e))+ [(T.pack "etag", T.pack $(mkStr hash))] |]+ st = Static.EmbeddableEntry {+ Static.eLocation = "res/" `T.append` T.pack (ebLocation e)+ , Static.eMimeType = ebMimeType e+ , Static.eContent = Left (T.pack hash, ct)+ }+ return $ ComputedEntry (ebHaskellName e) st link++tryExtraDevelFiles :: [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application+tryExtraDevelFiles [] _ = return $ responseLBS status404 [] ""+tryExtraDevelFiles (f:fs) r = do+ mct <- liftIO $ f $ drop 1 $ pathInfo r -- drop the initial "res"+ case mct of+ Nothing -> tryExtraDevelFiles fs r+ Just (mime, ct) -> do+ let hash = T.encodeUtf8 $ T.pack $ base64md5 ct+ let headers = [ ("Content-Type", mime)+ , ("ETag", hash)+ ]+ case lookup "If-None-Match" (requestHeaders r) of+ Just h | hash == h -> return $ responseLBS status304 headers ""+ _ -> return $ responseLBS status200 headers ct++-- | Helper to create the development application at runtime+develApp :: StaticSettings -> [[T.Text] -> IO (Maybe (MimeType, BL.ByteString))] -> Application+develApp settings extra req = do+ resp <- staticApp settings {ssMaxAge = NoMaxAge} req+ if statusCode (responseStatus resp) == 404+ then tryExtraDevelFiles extra req+ else return resp++-- | The type of 'addStaticContent'+type AddStaticContent site = T.Text -> T.Text -> BL.ByteString+ -> HandlerT site IO (Maybe (Either T.Text (Route site, [(T.Text, T.Text)])))++-- | Helper for embedStaticContent and embedLicensedStaticContent.+staticContentHelper :: Yesod site+ => (site -> EmbeddedStatic)+ -> (Route EmbeddedStatic -> Route site)+ -> (BL.ByteString -> Either a BL.ByteString)+ -> AddStaticContent site+staticContentHelper getStatic staticR minify ext _ ct = do+ wIORef <- widgetFiles . getStatic <$> getYesod+ let hash = T.pack $ base64md5 ct+ hash' = Just $ T.encodeUtf8 hash+ filename = T.concat [hash, ".", ext]+ content = case ext of+ "js" -> either (const ct) id $ minify ct+ _ -> ct+ file = File+ { fileGetSize = fromIntegral $ BL.length content+ , fileToResponse = \s h -> responseLBS s h content+ , fileName = unsafeToPiece filename+ , fileGetHash = return hash'+ , fileGetModified = Nothing+ }+ liftIO $ atomicModifyIORef' wIORef $ \m ->+ (M.insertWith (\old _ -> old) filename file m, ())++ return $ Just $ Right (staticR $ EmbeddedWidgetR filename, [])++-- | Create a wai-app-static settings based on the IORef inside the EmbeddedStaic site.+widgetSettings :: EmbeddedStatic -> StaticSettings+widgetSettings es = (defaultWebAppSettings "") { ssLookupFile = lookupFile }+ where+ lookupFile [_,p] = do -- The first part of the path is "widget"+ m <- readIORef $ widgetFiles es+ return $ maybe LRNotFound LRFile $ M.lookup (fromPiece p) m+ lookupFile _ = return LRNotFound
+ Yesod/EmbeddedStatic/Types.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+module Yesod.EmbeddedStatic.Types(+ Location+ , Generator+ -- ** Entry+ , Entry+ , ebHaskellName+ , ebLocation+ , ebMimeType+ , ebProductionContent+ , ebDevelReload+ , ebDevelExtraFiles+) where++import Data.Default+import Language.Haskell.TH+import Network.Mime (MimeType)+import qualified Data.ByteString.Lazy as BL++-- | A location is a relative path within the static subsite at which resource(s) are made available.+-- The location can include slashes to simulate directories but must not start or end with a slash.+type Location = String++-- | A single resource embedded into the executable at compile time.+--+-- This data type is a settings type. For more information, see+-- <http://www.yesodweb.com/book/settings-types>.+data Entry = Entry {+ ebHaskellName :: Maybe Name+ -- ^ An optional haskell name. If the name is present, a variable+ -- of type @Route 'Yesod.EmbeddedStatic.EmbeddedStatic'@ with the+ -- given name will be created which points to this resource.+ , ebLocation :: Location -- ^ The location to serve the resource from.+ , ebMimeType :: MimeType -- ^ The mime type of the resource.+ , ebProductionContent :: IO BL.ByteString + -- ^ If the development argument to 'Yesod.EmbeddedStatic.mkEmbeddedStatic' is False,+ -- then at compile time this action will be executed to load the content.+ -- During development, this action will not be executed.+ , ebDevelReload :: ExpQ+ -- ^ This must be a template haskell expression of type @IO 'BL.ByteString'@.+ -- If the development argument to 'Yesod.EmbeddedStatic.mkEmbeddedStatic' is True,+ -- this action is executed on every request to compute the content. Most of the+ -- time, 'ebProductionContent' and 'ebDevelReload' should be the same action but+ -- occasionally you might want additional processing inside the 'ebProductionContent'+ -- function like javascript/css minification to only happen when building for production.+ , ebDevelExtraFiles :: Maybe ExpQ+ -- ^ Occasionally, during development an entry needs extra files/resources available+ -- that are not present during production (for example, image files that are embedded+ -- into the CSS at production but left unembedded during development). If present,+ -- @ebDevelExtraFiles@ must be a template haskell expression of type+ -- @['T.Text'] -> IO (Maybe ('MimeType', 'BL.ByteString'))@. That is, a function+ -- taking as input the list of path pieces and optionally returning a mime type+ -- and content.+}++-- | When using 'def', you must fill in at least 'ebLocation'.+instance Default Entry where+ def = Entry { ebHaskellName = Nothing+ , ebLocation = "xxxx"+ , ebMimeType = "application/octet-stream"+ , ebProductionContent = return BL.empty+ , ebDevelReload = [| return BL.empty |]+ , ebDevelExtraFiles = Nothing+ }++-- | An embedded generator is executed at compile time to produce the entries to embed.+type Generator = Q [Entry]
Yesod/Static.hs view
@@ -35,7 +35,6 @@ -- * Smart constructor , static , staticDevel- , embed -- * Combining CSS/JS -- $combining , combineStylesheets'@@ -54,6 +53,8 @@ , publicFiles -- * Hashing , base64md5+ -- * Embed+ , embed #ifdef TEST_EXPORT , getFileListPieces #endif@@ -134,8 +135,11 @@ hashLookup <- cachedETagLookupDevel dir return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup --- | Produce a 'Static' based on embedding all of the static--- files' contents in the executable at compile time.+-- | Produce a 'Static' based on embedding all of the static files' contents in the+-- executable at compile time.+--+-- You should use "Yesod.EmbeddedStatic" instead, it is much more powerful.+-- -- Nota Bene: if you replace the scaffolded 'static' call in Settings/StaticFiles.hs -- you will need to change the scaffolded addStaticContent. Otherwise, some of your -- assets will be 404'ed. This is because by default yesod will generate compile those
+ sample-embed.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies #-}+-- | This embeds just a single file; it embeds the source code file +-- \"sample-embed.hs\" from the current directory so when you compile,+-- the sample-embed.hs file must be in the current directory.+--+-- Try toggling the development argument to 'mkEmbeddedStatic'. When the+-- development argument is true the file \"sample-embed.hs\" is reloaded+-- from disk on every request (try changing it after you start the server).+-- When development is false, the contents are embedded and the sample-embed.hs+-- file does not even need to be present during runtime.+module Main where++import Yesod.Core+import Yesod.EmbeddedStatic++mkEmbeddedStatic False "eStatic" [embedFile "sample-embed.hs"]++-- The above will generate variables+-- eStatic :: EmbeddedStatic+-- sample_embed_hs :: Route EmbeddedStatic++data MyApp = MyApp { getStatic :: EmbeddedStatic }++mkYesod "MyApp" [parseRoutes|+/ HomeR GET+/static StaticR EmbeddedStatic getStatic+|]++instance Yesod MyApp where+ addStaticContent = embedStaticContent getStatic StaticR Right++getHomeR :: Handler Html+getHomeR = defaultLayout $ do+ toWidget [julius|console.log("Hello World");|]+ [whamlet|+<h1>Hello+<p>Check the+ <a href=@{StaticR sample_embed_hs}>embedded file+|]++main :: IO ()+main = warp 3000 $ MyApp eStatic
+ sample.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+import Yesod.Static+import Yesod.Core+import Network.Wai.Handler.Warp (run)+import Network.Wai.Application.Static++staticFiles "."++data Sample = Sample { getStatic :: Static }++--getStatic _ = Static $ defaultFileServerSettings { ssFolder = fileSystemLookup $ toFilePath "." }+mkYesod "Sample" [parseRoutes|+/ RootR GET+/static StaticR Static getStatic+|]+instance Yesod Sample where++getRootR = do+ redirect "static"+ return ()++main = do+ s <- static "."+ toWaiApp (Sample s) >>= run 3000
+ test/EmbedDevelTest.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies, OverloadedStrings #-}+module EmbedDevelTest where++-- Tests the development mode of the embedded static subsite by+-- using a custom generator testGen.++import Data.Maybe (isNothing)+import EmbedTestGenerator+import EmbedProductionTest (findEtag)+import Network.Wai.Test (SResponse(simpleHeaders))+import Test.HUnit (assertBool)+import Test.Hspec (Spec)+import Yesod.Core+import Yesod.EmbeddedStatic+import Yesod.Test++mkEmbeddedStatic True "eDev" [testGen]++data MyApp = MyApp { getStatic :: EmbeddedStatic }++mkYesod "MyApp" [parseRoutes|+/static StaticR EmbeddedStatic getStatic+|]++instance Yesod MyApp++noCacheControl :: YesodExample site ()+noCacheControl = withResponse $ \r -> do+ liftIO $ assertBool "Cache-Control exists" $+ isNothing $ lookup "Cache-Control" $ simpleHeaders r+ liftIO $ assertBool "Expires exists" $+ isNothing $ lookup "Expires" $ simpleHeaders r++embedDevSpecs :: Spec+embedDevSpecs = yesodSpec (MyApp eDev) $ do+ ydescribe "Embedded Development Entries" $ do+ yit "e1 loads" $ do+ get $ StaticR e1+ statusIs 200+ assertHeader "Content-Type" "text/plain"+ noCacheControl+ bodyEquals "e1 devel"++ tag <- findEtag+ request $ do+ setMethod "GET"+ setUrl $ StaticR e1+ addRequestHeader ("If-None-Match", tag)+ statusIs 304++ yit "e2 with simulated directory" $ do+ get $ StaticR e2+ statusIs 200+ assertHeader "Content-Type" "abcdef"+ noCacheControl+ bodyEquals "e2 devel"++ yit "e3 without haskell name" $ do+ get $ StaticR $ embeddedResourceR ["xxxx", "e3"] []+ statusIs 200+ assertHeader "Content-Type" "yyy"+ noCacheControl+ bodyEquals "e3 devel"++ yit "e4 loads" $ do+ get $ StaticR e4+ statusIs 200+ assertHeader "Content-Type" "text/plain"+ noCacheControl+ bodyEquals "e4 devel"++ yit "e4 extra development dev1" $ do+ get $ StaticR $ embeddedResourceR ["dev1"] []+ statusIs 200+ assertHeader "Content-Type" "mime"+ noCacheControl+ bodyEquals "dev1 content"++ tag <- findEtag+ request $ do+ setMethod "GET"+ setUrl $ StaticR $ embeddedResourceR ["dev1"] []+ addRequestHeader ("If-None-Match", tag)+ statusIs 304++ yit "e4 extra development with path" $ do+ get $ StaticR $ embeddedResourceR ["dir", "dev2"] []+ statusIs 200+ assertHeader "Content-Type" "mime2"+ noCacheControl+ bodyEquals "dev2 content"++ yit "extra development file 404" $ do+ get $ StaticR $ embeddedResourceR ["xxxxxxxxxx"] []+ statusIs 404
+ test/EmbedProductionTest.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies, OverloadedStrings #-}+module EmbedProductionTest where++-- Tests the production mode of the embedded static subsite by+-- using a custom generator testGen. Also tests that the widget+-- content is embedded properly.++import Data.Maybe (isJust)+import EmbedTestGenerator+import Network.Wai.Test (SResponse(simpleHeaders))+import Test.HUnit (assertFailure, assertBool)+import Test.Hspec (Spec)+import Yesod.Core+import Yesod.EmbeddedStatic+import Yesod.Test+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++mkEmbeddedStatic False "eProduction" [testGen]++data MyApp = MyApp { getStatic :: EmbeddedStatic }++mkYesod "MyApp" [parseRoutes|+/ HomeR GET+/static StaticR EmbeddedStatic getStatic+|]++getHomeR :: Handler Html+getHomeR = defaultLayout $ do+ toWidget [julius|console.log("Hello World");|]+ [whamlet|<h1>Hello|]++instance Yesod MyApp where+ addStaticContent = embedStaticContent getStatic StaticR Right++findEtag :: YesodExample site B.ByteString+findEtag = withResponse $ \r ->+ case lookup "ETag" (simpleHeaders r) of+ Nothing -> liftIO (assertFailure "No etag found") >> error ""+ Just e -> return e++hasCacheControl :: YesodExample site ()+hasCacheControl = withResponse $ \r -> do+ liftIO $ assertBool "Cache-Control missing" $+ isJust $ lookup "Cache-Control" $ simpleHeaders r+ liftIO $ assertBool "Expires missing" $+ isJust $ lookup "Expires" $ simpleHeaders r++embedProductionSpecs :: Spec+embedProductionSpecs = yesodSpec (MyApp eProduction) $ do+ ydescribe "Embedded Production Entries" $ do+ yit "e1 loads" $ do+ get $ StaticR e1+ statusIs 200+ assertHeader "Content-Type" "text/plain"+ hasCacheControl+ bodyEquals "e1 production"++ tag <- findEtag+ request $ do+ setMethod "GET"+ setUrl $ StaticR e1+ addRequestHeader ("If-None-Match", tag)+ statusIs 304++ yit "e1 with custom built path" $ do+ get $ StaticR $ embeddedResourceR ["e1"] []+ statusIs 200+ assertHeader "Content-Type" "text/plain"+ hasCacheControl+ bodyEquals "e1 production"++ yit "e2 with simulated directory" $ do+ get $ StaticR e2+ statusIs 200+ assertHeader "Content-Type" "abcdef"+ hasCacheControl+ bodyEquals "e2 production"++ yit "e2 with custom built directory path" $ do+ get $ StaticR $ embeddedResourceR ["dir", "e2"] []+ statusIs 200+ assertHeader "Content-Type" "abcdef"+ hasCacheControl+ bodyEquals "e2 production"++ yit "e3 without haskell name" $ do+ get $ StaticR $ embeddedResourceR ["xxxx", "e3"] []+ statusIs 200+ assertHeader "Content-Type" "yyy"+ hasCacheControl+ bodyEquals "e3 production"++ yit "e4 is embedded" $ do+ get $ StaticR e4+ statusIs 200+ assertHeader "Content-Type" "text/plain"+ hasCacheControl+ bodyEquals "e4 production"++ yit "e4 extra development files are not embedded" $ do+ get $ StaticR $ embeddedResourceR ["dev1"] []+ statusIs 404++ ydescribe "Embedded Widget Content" $+ yit "Embedded Javascript" $ do+ get HomeR+ statusIs 200+ [script] <- htmlQuery "script"+ let src = BL.takeWhile (/= 34) $ BL.drop 1 $ BL.dropWhile (/= 34) script -- 34 is "++ get $ TL.toStrict $ TL.decodeUtf8 src+ statusIs 200+ hasCacheControl+ assertHeader "Content-Type" "application/javascript"+ bodyEquals "console.log(\"Hello World\");"
+ test/EmbedTestGenerator.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+module EmbedTestGenerator (testGen) where++import Data.Default+import Network.Mime (MimeType)+import Yesod.EmbeddedStatic.Types+import Yesod.EmbeddedStatic.Generators (pathToName)++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.ByteString.Lazy as BL++e1, e2, e3, e4 :: Entry++-- Basic entry+e1 = def+ { ebHaskellName = Just $ pathToName "e1"+ , ebLocation = "e1"+ , ebMimeType = "text/plain"+ , ebProductionContent = return $ TL.encodeUtf8 "e1 production"+ , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e1 devel" |]+ , ebDevelExtraFiles = Nothing+ }++-- Test simulated directory in location+e2 = def+ { ebHaskellName = Just $ pathToName "e2"+ , ebLocation = "dir/e2"+ , ebMimeType = "abcdef"+ , ebProductionContent = return $ TL.encodeUtf8 "e2 production"+ , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e2 devel" |]+ , ebDevelExtraFiles = Nothing+ }++-- Test empty haskell name+e3 = def+ { ebHaskellName = Nothing+ , ebLocation = "xxxx/e3"+ , ebMimeType = "yyy"+ , ebProductionContent = return $ TL.encodeUtf8 "e3 production"+ , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e3 devel" |]+ , ebDevelExtraFiles = Nothing+ }++devExtra :: [T.Text] -> IO (Maybe (MimeType, BL.ByteString))+devExtra ["dev1"] = return $ Just ("mime", "dev1 content")+devExtra ["dir", "dev2"] = return $ Just ("mime2", "dev2 content")+devExtra _ = return Nothing++-- Entry with devel extra files+e4 = def+ { ebHaskellName = Just $ pathToName "e4"+ , ebLocation = "e4"+ , ebMimeType = "text/plain"+ , ebProductionContent = return $ TL.encodeUtf8 "e4 production"+ , ebDevelReload = [| return $ TL.encodeUtf8 $ TL.pack "e4 devel" |]+ , ebDevelExtraFiles = Just [| devExtra |]+ }++testGen :: Generator+testGen = return [e1, e2, e3, e4]
+ test/FileGeneratorTests.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+module FileGeneratorTests (fileGenSpecs) where++import Control.Exception+import Control.Monad (forM_)+import GeneratorTestUtil+import Test.Hspec+import Test.HUnit (assertFailure, assertEqual)+import Yesod.EmbeddedStatic.Generators+import qualified Data.ByteString.Lazy as BL++-- | Embeds the LICENSE file+license :: GenTestResult+license = $(embedFile "LICENSE" >>= + testOneEntry (Just "_LICENSE") "LICENSE" (BL.readFile "LICENSE")+ )++licenseAt :: GenTestResult+licenseAt = $(embedFileAt "abc.txt" "LICENSE" >>=+ testOneEntry (Just "abc_txt") "abc.txt" (BL.readFile "LICENSE")+ )++embDir :: [GenTestResult]+embDir = $(embedDir "test/embed-dir" >>=+ testEntries + [ (Just "abc_def_txt", "abc/def.txt", BL.readFile "test/embed-dir/abc/def.txt")+ , (Just "lorem_txt", "lorem.txt", BL.readFile "test/embed-dir/lorem.txt")+ , (Just "foo", "foo", BL.readFile "test/embed-dir/foo")+ ]+ )++embDirAt :: [GenTestResult]+embDirAt = $(embedDirAt "xxx" "test/embed-dir" >>=+ testEntries + [ (Just "xxx_abc_def_txt", "xxx/abc/def.txt", BL.readFile "test/embed-dir/abc/def.txt")+ , (Just "xxx_lorem_txt", "xxx/lorem.txt", BL.readFile "test/embed-dir/lorem.txt")+ , (Just "xxx_foo", "xxx/foo", BL.readFile "test/embed-dir/foo")+ ]+ )++concatR :: GenTestResult+concatR = $(concatFiles "out.txt" [ "test/embed-dir/abc/def.txt", "test/embed-dir/foo"] >>=+ testOneEntry (Just "out_txt") "out.txt" (return "Yesod Rocks\nBar\n")+ )++-- The transform function should only run at compile for the production content+concatWithR :: GenTestResult+concatWithR = $(concatFilesWith "out2.txt"+ (\x -> return $ x `BL.append` "Extra")+ [ "test/embed-dir/abc/def.txt", "test/embed-dir/foo"] >>=+ testOneEntry (Just "out2_txt") "out2.txt" (return "Yesod Rocks\nBar\nExtra")+ )+ +fileGenSpecs :: Spec+fileGenSpecs = do+ describe "Embed File" $ do+ it "embeds a single file" $+ assertGenResult (BL.readFile "LICENSE") license+ it "embeds a single file at a location" $+ assertGenResult (BL.readFile "LICENSE") licenseAt++ describe "Embed Directory" $ do+ it "embeds a directory" $+ forM_ [embDir, embDirAt] $ \d -> case d of+ [GenError e] -> assertFailure e+ [def, foo, lorem] -> do+ assertGenResult (BL.readFile "test/embed-dir/abc/def.txt") def+ assertGenResult (BL.readFile "test/embed-dir/foo") foo+ assertGenResult (BL.readFile "test/embed-dir/lorem.txt") lorem+ _ -> assertFailure "Bad directory list"++ describe "Concat Files" $ do+ it "simple concat" $+ assertGenResult (return "Yesod Rocks\nBar\n") concatR+ it "concat with processing function" $+ assertGenResult (return "Yesod Rocks\nBar\n") concatWithR -- no Extra since this is development++ describe "Compress" $ do+ it "compress tool function" $ do+ out <- compressTool "runhaskell" [] "main = putStrLn \"Hello World\""+ assertEqual "" "Hello World\n" out++ it "tryCompressTools" $ do+ out <- flip tryCompressTools "abcdef" + [ const $ throwIO $ ErrorCall "An expected error"+ , const $ return "foo"+ , const $ return "bar"+ ]+ assertEqual "" "foo" out+ out2 <- flip tryCompressTools "abcdef"+ [ const $ throwIO $ ErrorCall "An expected error"]+ assertEqual "" "abcdef" out2
+ test/GeneratorTestUtil.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+module GeneratorTestUtil where++import Control.Applicative+import Control.Monad (when)+import Data.List (sortBy)+import Language.Haskell.TH+import Test.HUnit+import Yesod.EmbeddedStatic.Types+import qualified Data.ByteString.Lazy as BL++-- We test the generators by executing them at compile time+-- and sticking the result into the GenTestResult. We then+-- test the GenTestResult at runtime. But to test the ebDevelReload+-- we must run the action at runtime so that is also embedded.+-- Because of template haskell stage restrictions, this code+-- needs to be in a separate module.++data GenTestResult = GenError String+ | GenSuccessWithDevel (IO BL.ByteString)++-- | Creates a GenTestResult at compile time by testing the entry.+testEntry :: Maybe String -> Location -> IO BL.ByteString -> Entry -> ExpQ+testEntry name _ _ e | ebHaskellName e /= (mkName <$> name) =+ [| GenError ("haskell name " ++ $(litE $ stringL $ show $ ebHaskellName e)+ ++ " /= "+ ++ $(litE $ stringL $ show name)) |]+testEntry _ loc _ e | ebLocation e /= loc =+ [| GenError ("location " ++ $(litE $ stringL $ show $ ebLocation e)) |]+testEntry _ _ act e = do+ expected <- runIO act+ actual <- runIO $ ebProductionContent e+ if expected == actual+ then [| GenSuccessWithDevel $(ebDevelReload e) |]+ else [| GenError "production content" |]++testOneEntry :: Maybe String -> Location -> IO BL.ByteString -> [Entry] -> ExpQ+testOneEntry name loc ct [e] = testEntry name loc ct e+testOneEntry _ _ _ _ = [| GenError "not exactly one entry" |]++-- | Tests a list of entries +testEntries :: [(Maybe String, Location, IO BL.ByteString)] -> [Entry] -> ExpQ+testEntries a b | length a /= length b = [| [GenError "lengths differ"] |]+testEntries a b = listE $ zipWith f a' b'+ where + a' = sortBy (\(_,l1,_) (_,l2,_) -> compare l1 l2) a+ b' = sortBy (\e1 e2 -> ebLocation e1 `compare` ebLocation e2) b+ f (name, loc, ct) e = testEntry name loc ct e++-- | Use this at runtime to assert the 'GenTestResult' is OK+assertGenResult :: (IO BL.ByteString) -- ^ expected development content+ -> GenTestResult -- ^ test result created at compile time+ -> Assertion+assertGenResult _ (GenError e) = assertFailure ("invalid " ++ e)+assertGenResult mexpected (GenSuccessWithDevel mactual) = do+ expected <- mexpected+ actual <- mactual+ when (expected /= actual) $+ assertFailure "invalid devel content"
+ test/embed-dir/abc/def.txt view
@@ -0,0 +1,1 @@+Yesod Rocks
+ test/embed-dir/foo view
@@ -0,0 +1,1 @@+Bar
+ test/embed-dir/lorem.txt view
@@ -0,0 +1,6 @@+Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor+incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis+nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.+Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu+fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in+culpa qui officia deserunt mollit anim id est laborum.
test/tests.hs view
@@ -2,6 +2,13 @@ import Test.Hspec import YesodStaticTest (specs)+import EmbedProductionTest (embedProductionSpecs)+import EmbedDevelTest (embedDevSpecs)+import FileGeneratorTests (fileGenSpecs) main :: IO ()-main = hspec specs+main = hspec $ do+ specs+ embedProductionSpecs+ embedDevSpecs+ fileGenSpecs
yesod-static.cabal view
@@ -1,5 +1,5 @@ name: yesod-static-version: 1.2.0.1+version: 1.2.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -12,12 +12,16 @@ homepage: http://www.yesodweb.com/ description: Static file serving subsite for Yesod Web Framework. extra-source-files:- test/YesodStaticTest.hs- test/tests.hs+ sample.hs+ sample-embed.hs+ test/*.hs test/fs/bar/baz test/fs/tmp/ignored test/fs/.ignored test/fs/foo+ test/embed-dir/foo+ test/embed-dir/lorem.txt+ test/embed-dir/abc/def.txt library build-depends: base >= 4 && < 5@@ -30,7 +34,7 @@ , template-haskell , directory >= 1.0 , transformers >= 0.2.2- , wai-app-static >= 1.3 && < 1.4+ , wai-app-static >= 1.3.2 && < 1.4 , wai >= 1.3 && < 1.5 , text >= 0.9 , file-embed >= 0.0.4.1 && < 0.5@@ -43,8 +47,22 @@ , system-fileio >= 0.3 , data-default , shakespeare-css >= 1.0.3+ , mime-types >= 0.1+ , hjsmin+ , process-conduit >= 1.0 && < 1.1+ , filepath >= 1.3+ , resourcet >= 0.4+ , unordered-containers >= 0.2+ exposed-modules: Yesod.Static+ Yesod.EmbeddedStatic+ Yesod.EmbeddedStatic.Generators+ Yesod.EmbeddedStatic.Types++ other-modules: Yesod.EmbeddedStatic.Internal+ ghc-options: -Wall+ extensions: TemplateHaskell test-suite tests hs-source-dirs: ., test@@ -53,6 +71,10 @@ cpp-options: -DTEST_EXPORT build-depends: base , hspec >= 1.3+ , yesod-test >= 1.2+ , wai-test+ , HUnit+ -- copy from above , containers , old-time@@ -76,8 +98,15 @@ , system-fileio , data-default , shakespeare-css+ , mime-types+ , hjsmin+ , process-conduit+ , filepath+ , resourcet+ , unordered-containers ghc-options: -Wall+ extensions: TemplateHaskell source-repository head type: git