{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}

module Yesod.Site.Util
  ( SiteCompatible

  , getSite
  , getWidgetSite

  , withSite
  , withWidgetSite
  ) where

import Data.Coerce
import Yesod.Core.Types

getSite :: HandlerData child site -> site
getSite :: HandlerData child site -> site
getSite = RunHandlerEnv child site -> site
forall child site. RunHandlerEnv child site -> site
rheSite (RunHandlerEnv child site -> site)
-> (HandlerData child site -> RunHandlerEnv child site)
-> HandlerData child site
-> site
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData child site -> RunHandlerEnv child site
forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerEnv

getWidgetSite :: WidgetData site -> site
getWidgetSite :: WidgetData site -> site
getWidgetSite = HandlerData site site -> site
forall child site. HandlerData child site -> site
getSite (HandlerData site site -> site)
-> (WidgetData site -> HandlerData site site)
-> WidgetData site
-> site
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetData site -> HandlerData site site
forall site. WidgetData site -> HandlerData site site
wdHandler

type SiteCompatible site site' = (Coercible (Route site) (Route site'), Coercible (Route site') (Route site))

withWidgetSite
  :: SiteCompatible site site'
  => (site -> site')
  -> WidgetData site
  -> WidgetData site'
withWidgetSite :: (site -> site') -> WidgetData site -> WidgetData site'
withWidgetSite site -> site'
f WidgetData{IORef (GWData (Route site))
HandlerData site site
wdRef :: forall site. WidgetData site -> IORef (GWData (Route site))
wdHandler :: HandlerData site site
wdRef :: IORef (GWData (Route site))
wdHandler :: forall site. WidgetData site -> HandlerData site site
..}
  = WidgetData :: forall site.
IORef (GWData (Route site))
-> HandlerData site site -> WidgetData site
WidgetData
      { wdRef :: IORef (GWData (Route site'))
wdRef = IORef (GWData (Route site)) -> IORef (GWData (Route site'))
coerce IORef (GWData (Route site))
wdRef
      , wdHandler :: HandlerData site' site'
wdHandler = (site -> site') -> HandlerData site site -> HandlerData site' site'
forall site site'.
SiteCompatible site site' =>
(site -> site') -> HandlerData site site -> HandlerData site' site'
withSite site -> site'
f HandlerData site site
wdHandler
      }

withSite
  :: SiteCompatible site site'
  => (site -> site')
  -> HandlerData site site
  -> HandlerData site' site'
withSite :: (site -> site') -> HandlerData site site -> HandlerData site' site'
withSite site -> site'
f = (site -> site')
-> HandlerData site site' -> HandlerData site' site'
forall site site' parent.
SiteCompatible site site' =>
(site -> site')
-> HandlerData site parent -> HandlerData site' parent
withSubSite site -> site'
f (HandlerData site site' -> HandlerData site' site')
-> (HandlerData site site -> HandlerData site site')
-> HandlerData site site
-> HandlerData site' site'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (site -> site') -> HandlerData site site -> HandlerData site site'
forall site site' child.
SiteCompatible site site' =>
(site -> site')
-> HandlerData child site -> HandlerData child site'
withSuperSite site -> site'
f

withSubSite
  :: SiteCompatible site site'
  => (site -> site')
  -> HandlerData site parent
  -> HandlerData site' parent
withSubSite :: (site -> site')
-> HandlerData site parent -> HandlerData site' parent
withSubSite site -> site'
f HandlerData{InternalState
IORef GHState
YesodRequest
RunHandlerEnv site parent
handlerRequest :: forall child site. HandlerData child site -> YesodRequest
handlerState :: forall child site. HandlerData child site -> IORef GHState
handlerResource :: forall child site. HandlerData child site -> InternalState
handlerResource :: InternalState
handlerState :: IORef GHState
handlerEnv :: RunHandlerEnv site parent
handlerRequest :: YesodRequest
handlerEnv :: forall child site.
HandlerData child site -> RunHandlerEnv child site
..}
  = let RunHandlerEnv{site
parent
Maybe (Route site)
Text
Loc -> Text -> LogLevel -> LogStr -> IO ()
RequestBodyLength -> FileUpload
ErrorResponse -> YesodApp
Route site -> Route parent
Route parent -> [(Text, Text)] -> Text
rheRender :: forall child site.
RunHandlerEnv child site -> Route site -> [(Text, Text)] -> Text
rheRoute :: forall child site. RunHandlerEnv child site -> Maybe (Route child)
rheRouteToMaster :: forall child site.
RunHandlerEnv child site -> Route child -> Route site
rheChild :: forall child site. RunHandlerEnv child site -> child
rheUpload :: forall child site.
RunHandlerEnv child site -> RequestBodyLength -> FileUpload
rheLog :: forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheOnError :: forall child site.
RunHandlerEnv child site -> ErrorResponse -> YesodApp
rheMaxExpires :: forall child site. RunHandlerEnv child site -> Text
rheMaxExpires :: Text
rheOnError :: ErrorResponse -> YesodApp
rheLog :: Loc -> Text -> LogLevel -> LogStr -> IO ()
rheUpload :: RequestBodyLength -> FileUpload
rheChild :: site
rheSite :: parent
rheRouteToMaster :: Route site -> Route parent
rheRoute :: Maybe (Route site)
rheRender :: Route parent -> [(Text, Text)] -> Text
rheSite :: forall child site. RunHandlerEnv child site -> site
..} = RunHandlerEnv site parent
handlerEnv
    in
      HandlerData :: forall child site.
YesodRequest
-> RunHandlerEnv child site
-> IORef GHState
-> InternalState
-> HandlerData child site
HandlerData
        { handlerEnv :: RunHandlerEnv site' parent
handlerEnv = RunHandlerEnv :: forall child site.
(Route site -> [(Text, Text)] -> Text)
-> Maybe (Route child)
-> (Route child -> Route site)
-> site
-> child
-> (RequestBodyLength -> FileUpload)
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> (ErrorResponse -> YesodApp)
-> Text
-> RunHandlerEnv child site
RunHandlerEnv
            { rheChild :: site'
rheChild = site -> site'
f site
rheChild
            , rheRoute :: Maybe (Route site')
rheRoute = Maybe (Route site) -> Maybe (Route site')
coerce Maybe (Route site)
rheRoute
            , rheRouteToMaster :: Route site' -> Route parent
rheRouteToMaster = Route site -> Route parent
rheRouteToMaster (Route site -> Route parent)
-> (Route site' -> Route site) -> Route site' -> Route parent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Route site' -> Route site
coerce
            , parent
Text
Loc -> Text -> LogLevel -> LogStr -> IO ()
RequestBodyLength -> FileUpload
ErrorResponse -> YesodApp
Route parent -> [(Text, Text)] -> Text
rheRender :: Route parent -> [(Text, Text)] -> Text
rheUpload :: RequestBodyLength -> FileUpload
rheLog :: Loc -> Text -> LogLevel -> LogStr -> IO ()
rheOnError :: ErrorResponse -> YesodApp
rheMaxExpires :: Text
rheMaxExpires :: Text
rheOnError :: ErrorResponse -> YesodApp
rheLog :: Loc -> Text -> LogLevel -> LogStr -> IO ()
rheUpload :: RequestBodyLength -> FileUpload
rheSite :: parent
rheRender :: Route parent -> [(Text, Text)] -> Text
rheSite :: parent
..
            }
        , InternalState
IORef GHState
YesodRequest
handlerRequest :: YesodRequest
handlerState :: IORef GHState
handlerResource :: InternalState
handlerResource :: InternalState
handlerState :: IORef GHState
handlerRequest :: YesodRequest
..
        }

withSuperSite
  :: SiteCompatible site site'
  => (site -> site')
  -> HandlerData child site
  -> HandlerData child site'
withSuperSite :: (site -> site')
-> HandlerData child site -> HandlerData child site'
withSuperSite site -> site'
f HandlerData{InternalState
IORef GHState
YesodRequest
RunHandlerEnv child site
handlerResource :: InternalState
handlerState :: IORef GHState
handlerEnv :: RunHandlerEnv child site
handlerRequest :: YesodRequest
handlerRequest :: forall child site. HandlerData child site -> YesodRequest
handlerState :: forall child site. HandlerData child site -> IORef GHState
handlerResource :: forall child site. HandlerData child site -> InternalState
handlerEnv :: forall child site.
HandlerData child site -> RunHandlerEnv child site
..}
  = let RunHandlerEnv{site
child
Maybe (Route child)
Text
Loc -> Text -> LogLevel -> LogStr -> IO ()
RequestBodyLength -> FileUpload
ErrorResponse -> YesodApp
Route site -> [(Text, Text)] -> Text
Route child -> Route site
rheMaxExpires :: Text
rheOnError :: ErrorResponse -> YesodApp
rheLog :: Loc -> Text -> LogLevel -> LogStr -> IO ()
rheUpload :: RequestBodyLength -> FileUpload
rheChild :: child
rheSite :: site
rheRouteToMaster :: Route child -> Route site
rheRoute :: Maybe (Route child)
rheRender :: Route site -> [(Text, Text)] -> Text
rheRender :: forall child site.
RunHandlerEnv child site -> Route site -> [(Text, Text)] -> Text
rheRoute :: forall child site. RunHandlerEnv child site -> Maybe (Route child)
rheRouteToMaster :: forall child site.
RunHandlerEnv child site -> Route child -> Route site
rheChild :: forall child site. RunHandlerEnv child site -> child
rheUpload :: forall child site.
RunHandlerEnv child site -> RequestBodyLength -> FileUpload
rheLog :: forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheOnError :: forall child site.
RunHandlerEnv child site -> ErrorResponse -> YesodApp
rheMaxExpires :: forall child site. RunHandlerEnv child site -> Text
rheSite :: forall child site. RunHandlerEnv child site -> site
..} = RunHandlerEnv child site
handlerEnv
    in
      HandlerData :: forall child site.
YesodRequest
-> RunHandlerEnv child site
-> IORef GHState
-> InternalState
-> HandlerData child site
HandlerData
        { handlerEnv :: RunHandlerEnv child site'
handlerEnv = RunHandlerEnv :: forall child site.
(Route site -> [(Text, Text)] -> Text)
-> Maybe (Route child)
-> (Route child -> Route site)
-> site
-> child
-> (RequestBodyLength -> FileUpload)
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> (ErrorResponse -> YesodApp)
-> Text
-> RunHandlerEnv child site
RunHandlerEnv
            { rheSite :: site'
rheSite = site -> site'
f site
rheSite
            , rheRender :: Route site' -> [(Text, Text)] -> Text
rheRender = Route site -> [(Text, Text)] -> Text
rheRender (Route site -> [(Text, Text)] -> Text)
-> (Route site' -> Route site)
-> Route site'
-> [(Text, Text)]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Route site' -> Route site
coerce
            , rheRouteToMaster :: Route child -> Route site'
rheRouteToMaster = Route site -> Route site'
coerce (Route site -> Route site')
-> (Route child -> Route site) -> Route child -> Route site'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Route child -> Route site
rheRouteToMaster
            , child
Maybe (Route child)
Text
Loc -> Text -> LogLevel -> LogStr -> IO ()
RequestBodyLength -> FileUpload
ErrorResponse -> YesodApp
rheMaxExpires :: Text
rheOnError :: ErrorResponse -> YesodApp
rheLog :: Loc -> Text -> LogLevel -> LogStr -> IO ()
rheUpload :: RequestBodyLength -> FileUpload
rheChild :: child
rheRoute :: Maybe (Route child)
rheRoute :: Maybe (Route child)
rheChild :: child
rheUpload :: RequestBodyLength -> FileUpload
rheLog :: Loc -> Text -> LogLevel -> LogStr -> IO ()
rheOnError :: ErrorResponse -> YesodApp
rheMaxExpires :: Text
..
            }
        , InternalState
IORef GHState
YesodRequest
handlerResource :: InternalState
handlerState :: IORef GHState
handlerRequest :: YesodRequest
handlerRequest :: YesodRequest
handlerState :: IORef GHState
handlerResource :: InternalState
..
        }