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|
-- >Hello
-- >
Check the
-- > compile time
-- >|]
-- >
-- >main :: IO ()
-- >main = warp 3000 $ MyApp eStatic
yesod-static-1.2.2.1/Yesod/EmbeddedStatic/Internal.hs 0000644 0000000 0000000 00000015433 12256301650 020513 0 ustar 00 0000000 0000000 {-# 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-static-1.2.2.1/test/ 0000755 0000000 0000000 00000000000 12256301650 013430 5 ustar 00 0000000 0000000 yesod-static-1.2.2.1/test/GeneratorTestUtil.hs 0000644 0000000 0000000 00000005057 12256301650 017417 0 ustar 00 0000000 0000000 {-# 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"
yesod-static-1.2.2.1/test/EmbedDevelTest.hs 0000644 0000000 0000000 00000005645 12256301650 016632 0 ustar 00 0000000 0000000 {-# 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
yesod-static-1.2.2.1/test/FileGeneratorTests.hs 0000644 0000000 0000000 00000007455 12256301650 017550 0 ustar 00 0000000 0000000 {-# 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
yesod-static-1.2.2.1/test/tests.hs 0000644 0000000 0000000 00000000475 12256301650 015134 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
import Test.Hspec
import YesodStaticTest (specs)
import EmbedProductionTest (embedProductionSpecs)
import EmbedDevelTest (embedDevSpecs)
import FileGeneratorTests (fileGenSpecs)
main :: IO ()
main = hspec $ do
specs
embedProductionSpecs
embedDevSpecs
fileGenSpecs
yesod-static-1.2.2.1/test/YesodStaticTest.hs 0000644 0000000 0000000 00000000401 12256301650 017052 0 ustar 00 0000000 0000000 module YesodStaticTest (specs) where
import Test.Hspec
import Yesod.Static (getFileListPieces)
specs :: Spec
specs = do
describe "get file list" $ do
it "pieces" $ do
getFileListPieces "test/fs" `shouldReturn` [["foo"], ["bar", "baz"]]
yesod-static-1.2.2.1/test/EmbedTestGenerator.hs 0000644 0000000 0000000 00000004045 12256301650 017512 0 ustar 00 0000000 0000000 {-# 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]
yesod-static-1.2.2.1/test/EmbedProductionTest.hs 0000644 0000000 0000000 00000007570 12256301650 017720 0 ustar 00 0000000 0000000 {-# 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|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\");"
yesod-static-1.2.2.1/test/embed-dir/ 0000755 0000000 0000000 00000000000 12256301650 015260 5 ustar 00 0000000 0000000 yesod-static-1.2.2.1/test/embed-dir/foo 0000644 0000000 0000000 00000000004 12256301650 015760 0 ustar 00 0000000 0000000 Bar
yesod-static-1.2.2.1/test/embed-dir/lorem.txt 0000644 0000000 0000000 00000000677 12256301650 017151 0 ustar 00 0000000 0000000 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.
yesod-static-1.2.2.1/test/embed-dir/abc/ 0000755 0000000 0000000 00000000000 12256301650 016005 5 ustar 00 0000000 0000000 yesod-static-1.2.2.1/test/embed-dir/abc/def.txt 0000644 0000000 0000000 00000000014 12256301650 017277 0 ustar 00 0000000 0000000 Yesod Rocks
yesod-static-1.2.2.1/test/fs/ 0000755 0000000 0000000 00000000000 12256301650 014040 5 ustar 00 0000000 0000000 yesod-static-1.2.2.1/test/fs/foo 0000644 0000000 0000000 00000000000 12256301650 014534 0 ustar 00 0000000 0000000 yesod-static-1.2.2.1/test/fs/.ignored 0000644 0000000 0000000 00000000000 12256301650 015456 0 ustar 00 0000000 0000000 yesod-static-1.2.2.1/test/fs/tmp/ 0000755 0000000 0000000 00000000000 12256301650 014640 5 ustar 00 0000000 0000000 yesod-static-1.2.2.1/test/fs/tmp/ignored 0000644 0000000 0000000 00000000000 12256301650 016200 0 ustar 00 0000000 0000000 yesod-static-1.2.2.1/test/fs/bar/ 0000755 0000000 0000000 00000000000 12256301650 014604 5 ustar 00 0000000 0000000 yesod-static-1.2.2.1/test/fs/bar/baz 0000644 0000000 0000000 00000000000 12256301650 015271 0 ustar 00 0000000 0000000