1a5aa23f13
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.
119 lines
3.9 KiB
Haskell
119 lines
3.9 KiB
Haskell
{-# 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\");"
|