From f8a35ce0a0cdf99d984570addf2a6bcb0ad5df39 Mon Sep 17 00:00:00 2001 From: John Lenz Date: Thu, 12 Sep 2013 12:21:33 -0500 Subject: [PATCH 1/4] static: Add an embedded static subsite This commit adds just the subsite itself. The subsite works by running a list of generaters at compile time. The entries produced by the generators are converted into wai-app-static.WaiAppStatic.Storage.Embedded entries. Also, addStaticContent is supported via an IORef. When a widget produces static content (css, javascript), it is stuck into the IORef inside the embedded static subsite. The embedded static subsite will then serve it from the IORef, properly using a 304 response if the client already has the content. --- yesod-static/Yesod/EmbeddedStatic.hs | 183 ++++++++++++++++++ .../Yesod/EmbeddedStatic/Generators.hs | 116 +++++++++++ yesod-static/Yesod/EmbeddedStatic/Internal.hs | 158 +++++++++++++++ yesod-static/Yesod/EmbeddedStatic/Types.hs | 45 +++++ yesod-static/test/EmbedDevelTest.hs | 95 +++++++++ yesod-static/test/EmbedProductionTest.hs | 117 +++++++++++ yesod-static/test/EmbedTestGenerator.hs | 61 ++++++ yesod-static/test/tests.hs | 7 +- yesod-static/yesod-static.cabal | 18 +- 9 files changed, 796 insertions(+), 4 deletions(-) create mode 100644 yesod-static/Yesod/EmbeddedStatic.hs create mode 100644 yesod-static/Yesod/EmbeddedStatic/Generators.hs create mode 100644 yesod-static/Yesod/EmbeddedStatic/Internal.hs create mode 100644 yesod-static/Yesod/EmbeddedStatic/Types.hs create mode 100644 yesod-static/test/EmbedDevelTest.hs create mode 100644 yesod-static/test/EmbedProductionTest.hs create mode 100644 yesod-static/test/EmbedTestGenerator.hs diff --git a/yesod-static/Yesod/EmbeddedStatic.hs b/yesod-static/Yesod/EmbeddedStatic.hs new file mode 100644 index 00000000..40345a10 --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic.hs @@ -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 +-- . +-- +-- 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.Map 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 diff --git a/yesod-static/Yesod/EmbeddedStatic/Generators.hs b/yesod-static/Yesod/EmbeddedStatic/Generators.hs new file mode 100644 index 00000000..c6388865 --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic/Generators.hs @@ -0,0 +1,116 @@ +{-# 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 + + -- * Util + , pathToName + + -- * Custom Generators + + -- $example +) where + +import Data.Char (isDigit, isLower) +import Language.Haskell.TH + +import Yesod.EmbeddedStatic.Types + +-- | 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.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 $ [Entry +-- > { ebHaskellName = Just $ pathToName loc +-- > , ebLocation = loc +-- > , ebMimeType = "application/json" +-- > , ebProductionContent = getTime +-- > , ebDevelReload = [| getTime |] +-- > , ebDevelExtraFiles = Nothing +-- > }] +-- +-- 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| +-- >

Hello +-- >

Check the +-- > compile time +-- >|] +-- > +-- >main :: IO () +-- >main = warp 3000 $ MyApp eStatic diff --git a/yesod-static/Yesod/EmbeddedStatic/Internal.hs b/yesod-static/Yesod/EmbeddedStatic/Internal.hs new file mode 100644 index 00000000..8f8ad8ff --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic/Internal.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +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.Map as M +import qualified WaiAppStatic.Storage.Embedded as Static + +import Yesod.Static (base64md5) +import Yesod.EmbeddedStatic.Types + +-- | The subsite for the embedded static file server. +data EmbeddedStatic = EmbeddedStatic { + stApp :: !Application + , widgetFiles :: !(IORef (M.Map 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 diff --git a/yesod-static/Yesod/EmbeddedStatic/Types.hs b/yesod-static/Yesod/EmbeddedStatic/Types.hs new file mode 100644 index 00000000..8d757237 --- /dev/null +++ b/yesod-static/Yesod/EmbeddedStatic/Types.hs @@ -0,0 +1,45 @@ +module Yesod.EmbeddedStatic.Types( + Location + , Entry(..) + , Generator +) where + +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. +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. +} + +-- | An embedded generator is executed at compile time to produce the entries to embed. +type Generator = Q [Entry] diff --git a/yesod-static/test/EmbedDevelTest.hs b/yesod-static/test/EmbedDevelTest.hs new file mode 100644 index 00000000..f1436614 --- /dev/null +++ b/yesod-static/test/EmbedDevelTest.hs @@ -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 diff --git a/yesod-static/test/EmbedProductionTest.hs b/yesod-static/test/EmbedProductionTest.hs new file mode 100644 index 00000000..8fd407a3 --- /dev/null +++ b/yesod-static/test/EmbedProductionTest.hs @@ -0,0 +1,117 @@ +{-# 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.Encoding as T + +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|

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 $ T.decodeUtf8 $ BL.toStrict src + statusIs 200 + hasCacheControl + assertHeader "Content-Type" "application/javascript" + bodyEquals "console.log(\"Hello World\");" diff --git a/yesod-static/test/EmbedTestGenerator.hs b/yesod-static/test/EmbedTestGenerator.hs new file mode 100644 index 00000000..82268f4e --- /dev/null +++ b/yesod-static/test/EmbedTestGenerator.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} +module EmbedTestGenerator (testGen) where + +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 = Entry + { 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 = Entry + { 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 = Entry + { 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 = Entry + { 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] diff --git a/yesod-static/test/tests.hs b/yesod-static/test/tests.hs index 00553511..e9a8625f 100644 --- a/yesod-static/test/tests.hs +++ b/yesod-static/test/tests.hs @@ -2,6 +2,11 @@ import Test.Hspec import YesodStaticTest (specs) +import EmbedProductionTest (embedProductionSpecs) +import EmbedDevelTest (embedDevSpecs) main :: IO () -main = hspec specs +main = hspec $ do + specs + embedProductionSpecs + embedDevSpecs diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index f0d4db22..e555d7d4 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -12,8 +12,7 @@ build-type: Simple homepage: http://www.yesodweb.com/ description: Static file serving subsite for Yesod Web Framework. extra-source-files: - test/YesodStaticTest.hs - test/tests.hs + test/*.hs test/fs/bar/baz test/fs/tmp/ignored test/fs/.ignored @@ -30,7 +29,7 @@ library , 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,7 +42,15 @@ library , system-fileio >= 0.3 , data-default , shakespeare-css >= 1.0.3 + , mime-types >= 0.1 + exposed-modules: Yesod.Static + Yesod.EmbeddedStatic + Yesod.EmbeddedStatic.Generators + Yesod.EmbeddedStatic.Types + + other-modules: Yesod.EmbeddedStatic.Internal + ghc-options: -Wall test-suite tests @@ -53,6 +60,10 @@ test-suite tests cpp-options: -DTEST_EXPORT build-depends: base , hspec >= 1.3 + , yesod-test >= 1.2 + , wai-test + , HUnit + -- copy from above , containers , old-time @@ -76,6 +87,7 @@ test-suite tests , system-fileio , data-default , shakespeare-css + , mime-types ghc-options: -Wall From 2ad3977712242b60988488f97090c10e00825be4 Mon Sep 17 00:00:00 2001 From: John Lenz Date: Thu, 12 Sep 2013 12:21:47 -0500 Subject: [PATCH 2/4] static: add several embedded generators This constains the generators to embed files, directories, and javascript compression --- .../Yesod/EmbeddedStatic/Generators.hs | 191 ++++++++++++++++++ yesod-static/test/FileGeneratorTests.hs | 92 +++++++++ yesod-static/test/GeneratorTestUtil.hs | 59 ++++++ yesod-static/test/embed-dir/abc/def.txt | 1 + yesod-static/test/embed-dir/foo | 1 + yesod-static/test/embed-dir/lorem.txt | 6 + yesod-static/test/tests.hs | 2 + yesod-static/yesod-static.cabal | 11 + 8 files changed, 363 insertions(+) create mode 100644 yesod-static/test/FileGeneratorTests.hs create mode 100644 yesod-static/test/GeneratorTestUtil.hs create mode 100644 yesod-static/test/embed-dir/abc/def.txt create mode 100644 yesod-static/test/embed-dir/foo create mode 100644 yesod-static/test/embed-dir/lorem.txt diff --git a/yesod-static/Yesod/EmbeddedStatic/Generators.hs b/yesod-static/Yesod/EmbeddedStatic/Generators.hs index c6388865..94e6e03c 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Generators.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Generators.hs @@ -6,6 +6,21 @@ 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 @@ -15,11 +30,187 @@ module Yesod.EmbeddedStatic.Generators ( -- $example ) where +import Control.Applicative ((<$>)) +import Control.Exception (try, SomeException) +import Control.Monad (forM) +import Control.Monad.Trans.Resource (runResourceT) import Data.Char (isDigit, isLower) +import Data.Conduit (($$), (=$)) +import Data.Conduit.Process (proc, conduitProcess) import Language.Haskell.TH +import Network.Mime (defaultMimeLookup) +import System.Directory (doesDirectoryExist, getDirectoryContents) +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 = Entry { + ebHaskellName = Just $ pathToName loc + , ebLocation = loc + , ebMimeType = mime + , ebProductionContent = BL.readFile f + , ebDevelReload = [| BL.readFile $(litE $ stringL f) |] + , ebDevelExtraFiles = Nothing + } + 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 [Entry (Just $ pathToName loc) loc mime load expCt Nothing] + +-- | 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 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 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 to compress CSS. +-- Assumes a script @yuicompressor@ is located in the path. +yuiCSS :: BL.ByteString -> IO BL.ByteString +yuiCSS = compressTool "yuicompressor" ["--type", "css"] + +-- | Use 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 + let src = C.sourceList $ BL.toChunks ct + p = proc f opts + sink = C.consume + compressed <- runResourceT (src $$ conduitProcess p =$ sink) + 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. diff --git a/yesod-static/test/FileGeneratorTests.hs b/yesod-static/test/FileGeneratorTests.hs new file mode 100644 index 00000000..d1bffa34 --- /dev/null +++ b/yesod-static/test/FileGeneratorTests.hs @@ -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 diff --git a/yesod-static/test/GeneratorTestUtil.hs b/yesod-static/test/GeneratorTestUtil.hs new file mode 100644 index 00000000..87f744ad --- /dev/null +++ b/yesod-static/test/GeneratorTestUtil.hs @@ -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" diff --git a/yesod-static/test/embed-dir/abc/def.txt b/yesod-static/test/embed-dir/abc/def.txt new file mode 100644 index 00000000..89f4668d --- /dev/null +++ b/yesod-static/test/embed-dir/abc/def.txt @@ -0,0 +1 @@ +Yesod Rocks diff --git a/yesod-static/test/embed-dir/foo b/yesod-static/test/embed-dir/foo new file mode 100644 index 00000000..ebd7525b --- /dev/null +++ b/yesod-static/test/embed-dir/foo @@ -0,0 +1 @@ +Bar diff --git a/yesod-static/test/embed-dir/lorem.txt b/yesod-static/test/embed-dir/lorem.txt new file mode 100644 index 00000000..1bb51996 --- /dev/null +++ b/yesod-static/test/embed-dir/lorem.txt @@ -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. diff --git a/yesod-static/test/tests.hs b/yesod-static/test/tests.hs index e9a8625f..11a124c6 100644 --- a/yesod-static/test/tests.hs +++ b/yesod-static/test/tests.hs @@ -4,9 +4,11 @@ import Test.Hspec import YesodStaticTest (specs) import EmbedProductionTest (embedProductionSpecs) import EmbedDevelTest (embedDevSpecs) +import FileGeneratorTests (fileGenSpecs) main :: IO () main = hspec $ do specs embedProductionSpecs embedDevSpecs + fileGenSpecs diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index e555d7d4..7e0d0ede 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -17,6 +17,9 @@ extra-source-files: 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 @@ -43,6 +46,10 @@ library , data-default , shakespeare-css >= 1.0.3 , mime-types >= 0.1 + , hjsmin + , process-conduit >= 1.0 && < 1.1 + , filepath >= 1.3 + , resourcet >= 0.4 exposed-modules: Yesod.Static Yesod.EmbeddedStatic @@ -88,6 +95,10 @@ test-suite tests , data-default , shakespeare-css , mime-types + , hjsmin + , process-conduit + , filepath + , resourcet ghc-options: -Wall From 8e16fd222727bb960b1ea58d8ce5e9ec99d614df Mon Sep 17 00:00:00 2001 From: John Lenz Date: Thu, 12 Sep 2013 12:21:47 -0500 Subject: [PATCH 3/4] static: update sample-embed.hs and point the old embedded static to the new one --- yesod-static/Yesod/Static.hs | 10 +++++-- yesod-static/sample-embed.hs | 53 ++++++++++++++++++++++----------- yesod-static/yesod-static.cabal | 2 ++ 3 files changed, 45 insertions(+), 20 deletions(-) diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs index c8949f17..85e95e87 100644 --- a/yesod-static/Yesod/Static.hs +++ b/yesod-static/Yesod/Static.hs @@ -35,7 +35,6 @@ module Yesod.Static -- * Smart constructor , static , staticDevel - , embed -- * Combining CSS/JS -- $combining , combineStylesheets' @@ -54,6 +53,8 @@ module Yesod.Static , publicFiles -- * Hashing , base64md5 + -- * Embed + , embed #ifdef TEST_EXPORT , getFileListPieces #endif @@ -134,8 +135,11 @@ staticDevel dir = do 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 diff --git a/yesod-static/sample-embed.hs b/yesod-static/sample-embed.hs index b8a53b3b..cb1cc4d5 100644 --- a/yesod-static/sample-embed.hs +++ b/yesod-static/sample-embed.hs @@ -1,23 +1,42 @@ -{-# LANGUAGE QuasiQuotes, TypeFamilies, MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -import Yesod.Static -import Yesod.Dispatch +{-# 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 Network.Wai.Handler.Warp (run) +import Yesod.EmbeddedStatic -staticFiles "." +mkEmbeddedStatic False "eStatic" [embedFile "sample-embed.hs"] -data Sample = Sample -getStatic _ = $(embed "tests") -mkYesod "Sample" [parseRoutes| -/ RootR GET -/static StaticR Static getStatic +-- 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 Sample where approot _ = "" -getRootR = do - redirectText RedirectPermanent "static" - return () +instance Yesod MyApp where + addStaticContent = embedStaticContent getStatic StaticR Right -main = toWaiApp Sample >>= run 3000 +getHomeR :: Handler Html +getHomeR = defaultLayout $ do + toWidget [julius|console.log("Hello World");|] + [whamlet| +

Hello +

Check the + embedded file +|] + +main :: IO () +main = warp 3000 $ MyApp eStatic diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index 7e0d0ede..a5ccc0d7 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -12,6 +12,8 @@ build-type: Simple homepage: http://www.yesodweb.com/ description: Static file serving subsite for Yesod Web Framework. extra-source-files: + sample.hs + sample-embed.hs test/*.hs test/fs/bar/baz test/fs/tmp/ignored From 1a5aa23f13285ac116443f22f0a7bd6523cb54e0 Mon Sep 17 00:00:00 2001 From: John Lenz Date: Thu, 12 Sep 2013 17:52:15 -0500 Subject: [PATCH 4/4] static: fix the build on GHC 7.4 There were two build issues on GHC 7.4: using atomicModifyIORef' and ByteString.Lazy.toStrict, both of which were missing. These are now fixed. In addition, looking at the IORef code more closely, we want the quite a bit of strictness in the IORef. The common case is that the widget content already exists in the map (every reload of a page will call embedStaticContent), but until we force the map the thunks holding the duplicated generated content will be kept around, leaking memory. This will be the common situation since the vast majority of the time the content already exists. Since the containers module does not have a strict map until 0.5, use unordered containers which does have a strict map. --- yesod-static/Yesod/EmbeddedStatic.hs | 2 +- yesod-static/Yesod/EmbeddedStatic/Internal.hs | 15 +++++++++++++-- yesod-static/test/EmbedProductionTest.hs | 5 +++-- yesod-static/yesod-static.cabal | 2 ++ 4 files changed, 19 insertions(+), 5 deletions(-) diff --git a/yesod-static/Yesod/EmbeddedStatic.hs b/yesod-static/Yesod/EmbeddedStatic.hs index 40345a10..e8196302 100644 --- a/yesod-static/Yesod/EmbeddedStatic.hs +++ b/yesod-static/Yesod/EmbeddedStatic.hs @@ -67,7 +67,7 @@ import Yesod.Core.Types ) import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T -import qualified Data.Map as M +import qualified Data.HashMap.Strict as M import qualified WaiAppStatic.Storage.Embedded as Static import Yesod.EmbeddedStatic.Types diff --git a/yesod-static/Yesod/EmbeddedStatic/Internal.hs b/yesod-static/Yesod/EmbeddedStatic/Internal.hs index 8f8ad8ff..0882c16d 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Internal.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Internal.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} module Yesod.EmbeddedStatic.Internal ( EmbeddedStatic(..) , Route(..) @@ -34,16 +35,26 @@ import Yesod.Core import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Encoding as T -import qualified Data.Map as M +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.Map T.Text File)) + , widgetFiles :: !(IORef (M.HashMap T.Text File)) } instance RenderRoute EmbeddedStatic where diff --git a/yesod-static/test/EmbedProductionTest.hs b/yesod-static/test/EmbedProductionTest.hs index 8fd407a3..d7fcbc1d 100644 --- a/yesod-static/test/EmbedProductionTest.hs +++ b/yesod-static/test/EmbedProductionTest.hs @@ -15,7 +15,8 @@ import Yesod.EmbeddedStatic import Yesod.Test import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL -import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL mkEmbeddedStatic False "eProduction" [testGen] @@ -110,7 +111,7 @@ embedProductionSpecs = yesodSpec (MyApp eProduction) $ do [script] <- htmlQuery "script" let src = BL.takeWhile (/= 34) $ BL.drop 1 $ BL.dropWhile (/= 34) script -- 34 is " - get $ T.decodeUtf8 $ BL.toStrict src + get $ TL.toStrict $ TL.decodeUtf8 src statusIs 200 hasCacheControl assertHeader "Content-Type" "application/javascript" diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index a5ccc0d7..9db09b9c 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -52,6 +52,7 @@ library , process-conduit >= 1.0 && < 1.1 , filepath >= 1.3 , resourcet >= 0.4 + , unordered-containers >= 0.2 exposed-modules: Yesod.Static Yesod.EmbeddedStatic @@ -101,6 +102,7 @@ test-suite tests , process-conduit , filepath , resourcet + , unordered-containers ghc-options: -Wall