SubSub.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

module YesodCoreTest.SubSub where

import Test.Hspec

import Yesod.Core
import Network.Wai.Test
import qualified Data.Text as T
import qualified Data.ByteString.Lazy.Char8 as L8

import YesodCoreTest.SubSubData

data App = App { getOuter :: OuterSubSite }

mkYesod "App" [parseRoutes|
/ OuterSubSiteR OuterSubSite getOuter
|]

instance Yesod App

getSubR :: SubHandlerFor InnerSubSite master T.Text
getSubR = return $ T.pack "sub"

instance YesodSubDispatch OuterSubSite master where
  yesodSubDispatch = $(mkYesodSubDispatch resourcesOuterSubSite)

instance YesodSubDispatch InnerSubSite master where
  yesodSubDispatch = $(mkYesodSubDispatch resourcesInnerSubSite)

app :: App
app = App { getOuter = OuterSubSite { getInner = InnerSubSite }}

runner :: Session () -> IO ()
runner f = toWaiApp app >>= runSession f

case_subSubsite :: IO ()
case_subSubsite = runner $ do
  res <- request defaultRequest
  assertBody (L8.pack "sub") res
  assertStatus 200 res

subSubTest :: Spec
subSubTest = describe "YesodCoreTest.SubSub" $ do
  it "sub_subsite" case_subSubsite