fa8e1ac00f
This is much more consistent than suddenly using a ReaderT for subsites. Thanks to @jprider63 for the inspiration for this, I think it cleans things up a lot!
100 lines
2.6 KiB
Haskell
100 lines
2.6 KiB
Haskell
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
|
|
{-# LANGUAGE FlexibleInstances, ViewPatterns #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE OverloadedStrings #-} -- the module name is a lie!!!
|
|
module YesodCoreTest.NoOverloadedStrings
|
|
( noOverloadedTest
|
|
, Widget
|
|
, resourcesY
|
|
) where
|
|
|
|
import Test.Hspec
|
|
import YesodCoreTest.NoOverloadedStringsSub
|
|
|
|
import Yesod.Core
|
|
import Network.Wai
|
|
import Network.Wai.Test
|
|
import Data.Monoid (mempty)
|
|
import qualified Data.Text as T
|
|
import qualified Data.ByteString.Lazy.Char8 as L8
|
|
|
|
getSubsite :: a -> Subsite
|
|
getSubsite _ = Subsite $(mkYesodSubDispatch resourcesSubsite)
|
|
|
|
getBarR :: MonadHandler m => m T.Text
|
|
getBarR = return $ T.pack "BarR"
|
|
|
|
getBazR :: (MonadHandler m, Yesod (HandlerSite m)) => m Html
|
|
getBazR = liftHandler $ defaultLayout [whamlet|Used Default Layout|]
|
|
|
|
getBinR :: (MonadHandler m, Yesod (HandlerSite m), SubHandlerSite m ~ Subsite) => m Html
|
|
getBinR = do
|
|
routeToParent <- getRouteToParent
|
|
liftHandler $ defaultLayout [whamlet|
|
|
<p>Used defaultLayoutT
|
|
<a href=@{routeToParent BazR}>Baz
|
|
|]
|
|
|
|
getOnePiecesR :: Monad m => Int -> m ()
|
|
getOnePiecesR _ = return ()
|
|
|
|
getTwoPiecesR :: Monad m => Int -> Int -> m ()
|
|
getTwoPiecesR _ _ = return ()
|
|
|
|
getThreePiecesR :: Monad m => Int -> Int -> Int -> m ()
|
|
getThreePiecesR _ _ _ = return ()
|
|
|
|
data Y = Y
|
|
mkYesod "Y" [parseRoutes|
|
|
/ RootR GET
|
|
/foo FooR GET
|
|
/subsite SubsiteR Subsite getSubsite
|
|
|]
|
|
|
|
instance Yesod Y
|
|
|
|
getRootR :: Handler ()
|
|
getRootR = return ()
|
|
|
|
getFooR :: Handler ()
|
|
getFooR = return ()
|
|
|
|
runner :: Session () -> IO ()
|
|
runner f = toWaiApp Y >>= runSession f
|
|
|
|
case_sanity :: IO ()
|
|
case_sanity = runner $ do
|
|
res <- request defaultRequest
|
|
assertBody Data.Monoid.mempty res
|
|
|
|
case_subsite :: IO ()
|
|
case_subsite = runner $ do
|
|
res <- request defaultRequest
|
|
{ pathInfo = map T.pack ["subsite", "bar"]
|
|
}
|
|
assertBody (L8.pack "BarR") res
|
|
assertStatus 200 res
|
|
|
|
case_deflayout :: IO ()
|
|
case_deflayout = runner $ do
|
|
res <- request defaultRequest
|
|
{ pathInfo = map T.pack ["subsite", "baz"]
|
|
}
|
|
assertBodyContains (L8.pack "Used Default Layout") res
|
|
assertStatus 200 res
|
|
|
|
case_deflayoutT :: IO ()
|
|
case_deflayoutT = runner $ do
|
|
res <- request defaultRequest
|
|
{ pathInfo = map T.pack ["subsite", "bin"]
|
|
}
|
|
assertBodyContains (L8.pack "Used defaultLayoutT") res
|
|
assertStatus 200 res
|
|
|
|
noOverloadedTest :: Spec
|
|
noOverloadedTest = describe "Test.NoOverloadedStrings" $ do
|
|
it "sanity" case_sanity
|
|
it "subsite" case_subsite
|
|
it "deflayout" case_deflayout
|
|
it "deflayoutT" case_deflayoutT
|