{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts  #-}
module Yesod.Core.Class.Dispatch where

import Yesod.Routes.Class
import qualified Network.Wai as W
import Yesod.Core.Types
import Yesod.Core.Content
import Yesod.Core.Class.Yesod
import Yesod.Core.Class.Handler
import Yesod.Core.Internal.Request (textQueryString)
import Yesod.Core.Internal.Run
import           Control.Monad.Trans.Control  (MonadBaseControl)

-- | This class is automatically instantiated when you use the template haskell
-- mkYesod function. You should never need to deal with it directly.
class Yesod site => YesodDispatch site where
    yesodDispatch :: YesodRunnerEnv site -> W.Application

class YesodSubDispatch sub m where
    yesodSubDispatch
        :: (MonadHandler m, master ~ HandlerMaster m, Yesod master)
        => (m TypedContent
                -> YesodRunnerEnv master
                -> Maybe (Route master)
                -> W.Application)
        -> (master -> sub)
        -> (Route sub -> Route master)
        -> YesodRunnerEnv master
        -> W.Application

instance YesodSubDispatch WaiSubsite master where
    yesodSubDispatch _ toSub _ YesodRunnerEnv { yreSite = site } req =
        app req
      where
        WaiSubsite app = toSub site

subHelper :: (HandlerSite m ~ master, MonadHandler m)
          => (m TypedContent
                -> YesodRunnerEnv master
                -> Maybe (Route master)
                -> W.Application)
          -> (master -> sub)
          -> (Route sub -> Route master)
          -> HandlerT sub m TypedContent
          -> YesodRunnerEnv master
          -> Maybe (Route sub)
          -> W.Application
subHelper parentRunner getSub toMaster handlert env route =
    parentRunner base env (fmap toMaster route)
  where
    base = stripHandlerT (fmap toTypedContent handlert) getSub toMaster route