{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Test.Media (mediaTest) where
import Yesod.Core hiding (Request)
import Test.Framework (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
import Network.Wai
import Network.Wai.Test
import Network.HTTP.Types (status200, decodePathSegments)
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.Text as TS
import Text.Lucius
data Y = Y
mkYesod "Y" [$parseRoutes|
/ RootR GET
/static StaticR GET
|]
instance Yesod Y where
approot _ = ""
addStaticContent _ _ content = do
tm <- getRouteToMaster
route <- getCurrentRoute
case fmap tm route of
Just StaticR -> return $ Just $ Left $
if content == "foo2{bar:baz}"
then "screen.css"
else "all.css"
_ -> return Nothing
getRootR = defaultLayout $ do
addCassius [$lucius|foo1{bar:baz}|]
addCassiusMedia "screen" [$lucius|foo2{bar:baz}|]
addCassius [$lucius|foo3{bar:baz}|]
getStaticR = getRootR
runner f = toWaiApp Y >>= runSession f
defaultRequest = Request
{ pathInfo = []
, requestHeaders = []
, queryString = []
, requestMethod = "GET"
}
caseMedia = runner $ do
res <- request defaultRequest
assertStatus 200 res
flip assertBody res "\n"
caseMediaLink = runner $ do
res <- request defaultRequest { pathInfo = ["static"] }
assertStatus 200 res
flip assertBody res "\n"
mediaTest = testGroup "Test.Media"
[ testCase "media" caseMedia
, testCase "media link" caseMediaLink
]