diff --git a/yesod-core/test/YesodCoreTest.hs b/yesod-core/test/YesodCoreTest.hs index 80f61c2d..e9f42851 100644 --- a/yesod-core/test/YesodCoreTest.hs +++ b/yesod-core/test/YesodCoreTest.hs @@ -11,6 +11,7 @@ import YesodCoreTest.NoOverloadedStrings import YesodCoreTest.InternalRequest import YesodCoreTest.ErrorHandling import YesodCoreTest.Cache +import YesodCoreTest.ParameterizedSite import qualified YesodCoreTest.WaiSubsite as WaiSubsite import qualified YesodCoreTest.Redirect as Redirect import qualified YesodCoreTest.JsLoader as JsLoader @@ -43,6 +44,7 @@ specs = do internalRequestTest errorHandlingTest cacheTest + parameterizedSiteTest WaiSubsite.specs Redirect.specs JsLoader.specs diff --git a/yesod-core/test/YesodCoreTest/ParameterizedSite.hs b/yesod-core/test/YesodCoreTest/ParameterizedSite.hs new file mode 100644 index 00000000..e8544fe7 --- /dev/null +++ b/yesod-core/test/YesodCoreTest/ParameterizedSite.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +module YesodCoreTest.ParameterizedSite + ( parameterizedSiteTest + ) where + +import Data.ByteString.Lazy (ByteString) +import Network.Wai.Test (runSession, request, defaultRequest, assertBodyContains) +import Test.Hspec (Spec, describe, it) +import Yesod.Core (YesodDispatch) +import Yesod.Core.Dispatch (toWaiApp) + +import YesodCoreTest.ParameterizedSite.PolyAny (PolyAny (..)) +import YesodCoreTest.ParameterizedSite.PolyShow (PolyShow (..)) + +-- These are actually tests for template haskell. So if it compiles, it works +parameterizedSiteTest :: Spec +parameterizedSiteTest = describe "Polymorphic Yesod sites" $ do + it "Polymorphic unconstrained stub" $ runStub (PolyAny ()) + it "Polymorphic stub with Show" $ runStub' "1337" (PolyShow 1337) + +runStub :: YesodDispatch a => a -> IO () +runStub stub = + let actions = do + res <- request defaultRequest + assertBodyContains "Stub" res + in toWaiApp stub >>= runSession actions + + +runStub' :: YesodDispatch a => ByteString -> a -> IO () +runStub' body stub = + let actions = do + res <- request defaultRequest + assertBodyContains "Stub" res + assertBodyContains body res + in toWaiApp stub >>= runSession actions diff --git a/yesod-core/test/YesodCoreTest/ParameterizedSite/PolyAny.hs b/yesod-core/test/YesodCoreTest/ParameterizedSite/PolyAny.hs new file mode 100644 index 00000000..93f67e1d --- /dev/null +++ b/yesod-core/test/YesodCoreTest/ParameterizedSite/PolyAny.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE + TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses + , OverloadedStrings, StandaloneDeriving, FlexibleInstances + #-} +module YesodCoreTest.ParameterizedSite.PolyAny + ( PolyAny (..) + ) where + +import Yesod.Core + +-- | Parameterized without constraints +data PolyAny a = PolyAny a + +mkYesod "PolyAny a" [parseRoutes| +/ HomeR GET +|] + +instance Yesod (PolyAny a) + +getHomeR :: Handler a Html +getHomeR = defaultLayout + [whamlet| +
+ Stub + |] + diff --git a/yesod-core/test/YesodCoreTest/ParameterizedSite/PolyShow.hs b/yesod-core/test/YesodCoreTest/ParameterizedSite/PolyShow.hs new file mode 100644 index 00000000..4fa942eb --- /dev/null +++ b/yesod-core/test/YesodCoreTest/ParameterizedSite/PolyShow.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE + TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses + , OverloadedStrings, StandaloneDeriving, FlexibleInstances + #-} +module YesodCoreTest.ParameterizedSite.PolyShow + ( PolyShow (..) + ) where + +import Yesod.Core + +-- | Parameterized with 'Show' constraint +data PolyShow a = PolyShow a + +mkYesod "(Show a) => PolyShow a" [parseRoutes| +/ HomeR GET +|] + +instance Show a => Yesod (PolyShow a) + +getHomeR :: Show a => Handler a Html +getHomeR = do + PolyShow x <- getYesod + defaultLayout + [whamlet| +
+ Stub #{show x} + |] + diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index ce9c902c..8441db8b 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -156,6 +156,9 @@ test-suite tests YesodCoreTest.MediaData YesodCoreTest.NoOverloadedStrings YesodCoreTest.NoOverloadedStringsSub + YesodCoreTest.ParameterizedSite + YesodCoreTest.ParameterizedSite.PolyAny + YesodCoreTest.ParameterizedSite.PolyShow YesodCoreTest.RawResponse YesodCoreTest.Redirect YesodCoreTest.Reps