{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE GADTs #-}
module Yesod.Core.Types where

import Data.Aeson (ToJSON)
import qualified Data.ByteString.Builder            as BB
import           Control.Arrow                      (first)
import           Control.Exception                  (Exception)
import           Control.Monad                      (ap)
import           Control.Monad.IO.Class             (MonadIO (liftIO))
import           Control.Monad.Logger               (LogLevel, LogSource,
                                                     MonadLogger (..))
import           Control.Monad.Primitive            (PrimMonad (..))
import           Control.Monad.Trans.Resource       (MonadResource (..), InternalState, runInternalState, MonadThrow (..), ResourceT)
import           Data.ByteString                    (ByteString)
import qualified Data.ByteString.Lazy               as L
import           Data.CaseInsensitive               (CI)
import           Data.Conduit                       (Flush, ConduitT)
import           Data.IORef                         (IORef, modifyIORef')
import           Data.Map                           (Map, unionWith)
import qualified Data.Map                           as Map
import           Data.Monoid                        (Endo (..), Last (..))
import           Data.Semigroup                     (Semigroup(..))
import           Data.Serialize                     (Serialize (..),
                                                     putByteString)
import           Data.String                        (IsString (fromString))
import           Data.Text                          (Text)
import qualified Data.Text                          as T
import qualified Data.Text.Lazy.Builder             as TBuilder
import           Data.Time                          (UTCTime)
import           GHC.Generics                       (Generic)
import           Language.Haskell.TH.Syntax         (Loc)
import qualified Network.HTTP.Types                 as H
import           Network.Wai                        (FilePart,
                                                     RequestBodyLength)
import qualified Network.Wai                        as W
import qualified Network.Wai.Parse                  as NWP
import           System.Log.FastLogger              (LogStr, LoggerSet, toLogStr, pushLogStr)
import           Network.Wai.Logger                 (DateCacheGetter)
import           Text.Blaze.Html                    (Html, toHtml)
import           Text.Hamlet                        (HtmlUrl)
import           Text.Julius                        (JavascriptUrl)
import           Web.Cookie                         (SetCookie)
import           Yesod.Core.Internal.Util           (getTime, putTime)
import           Yesod.Routes.Class                 (RenderRoute (..), ParseRoute (..))
import           Control.Monad.Reader               (MonadReader (..))
import Control.DeepSeq (NFData (rnf))
import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
import Control.Monad.Logger (MonadLoggerIO (..))
import UnliftIO (MonadUnliftIO (..))

-- Sessions
type SessionMap = Map Text ByteString

type SaveSession = SessionMap -- ^ The session contents after running the handler
                -> IO [Header]

newtype SessionBackend = SessionBackend
    { SessionBackend -> Request -> IO (SessionMap, SaveSession)
sbLoadSession :: W.Request
                    -> IO (SessionMap, SaveSession) -- ^ Return the session data and a function to save the session
    }

data SessionCookie = SessionCookie !(Either UTCTime ByteString) !ByteString !SessionMap
    deriving (Int -> SessionCookie -> ShowS
[SessionCookie] -> ShowS
SessionCookie -> String
(Int -> SessionCookie -> ShowS)
-> (SessionCookie -> String)
-> ([SessionCookie] -> ShowS)
-> Show SessionCookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionCookie] -> ShowS
$cshowList :: [SessionCookie] -> ShowS
show :: SessionCookie -> String
$cshow :: SessionCookie -> String
showsPrec :: Int -> SessionCookie -> ShowS
$cshowsPrec :: Int -> SessionCookie -> ShowS
Show, ReadPrec [SessionCookie]
ReadPrec SessionCookie
Int -> ReadS SessionCookie
ReadS [SessionCookie]
(Int -> ReadS SessionCookie)
-> ReadS [SessionCookie]
-> ReadPrec SessionCookie
-> ReadPrec [SessionCookie]
-> Read SessionCookie
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SessionCookie]
$creadListPrec :: ReadPrec [SessionCookie]
readPrec :: ReadPrec SessionCookie
$creadPrec :: ReadPrec SessionCookie
readList :: ReadS [SessionCookie]
$creadList :: ReadS [SessionCookie]
readsPrec :: Int -> ReadS SessionCookie
$creadsPrec :: Int -> ReadS SessionCookie
Read)
instance Serialize SessionCookie where
    put :: Putter SessionCookie
put (SessionCookie Either UTCTime ByteString
a ByteString
b SessionMap
c) = do
        (UTCTime -> Put)
-> (ByteString -> Put) -> Either UTCTime ByteString -> Put
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either UTCTime -> Put
putTime ByteString -> Put
putByteString Either UTCTime ByteString
a
        ByteString -> Put
forall t. Serialize t => Putter t
put ByteString
b
        Putter [(String, ByteString)]
forall t. Serialize t => Putter t
put (((Text, ByteString) -> (String, ByteString))
-> [(Text, ByteString)] -> [(String, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> String) -> (Text, ByteString) -> (String, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> String
T.unpack) ([(Text, ByteString)] -> [(String, ByteString)])
-> [(Text, ByteString)] -> [(String, ByteString)]
forall a b. (a -> b) -> a -> b
$ SessionMap -> [(Text, ByteString)]
forall k a. Map k a -> [(k, a)]
Map.toList SessionMap
c)

    get :: Get SessionCookie
get = do
        UTCTime
a <- Get UTCTime
getTime
        ByteString
b <- Get ByteString
forall t. Serialize t => Get t
get
        [(Text, ByteString)]
c <- ((String, ByteString) -> (Text, ByteString))
-> [(String, ByteString)] -> [(Text, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text) -> (String, ByteString) -> (Text, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first String -> Text
T.pack) ([(String, ByteString)] -> [(Text, ByteString)])
-> Get [(String, ByteString)] -> Get [(Text, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [(String, ByteString)]
forall t. Serialize t => Get t
get
        SessionCookie -> Get SessionCookie
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionCookie -> Get SessionCookie)
-> SessionCookie -> Get SessionCookie
forall a b. (a -> b) -> a -> b
$ Either UTCTime ByteString
-> ByteString -> SessionMap -> SessionCookie
SessionCookie (UTCTime -> Either UTCTime ByteString
forall a b. a -> Either a b
Left UTCTime
a) ByteString
b ([(Text, ByteString)] -> SessionMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, ByteString)]
c)

data ClientSessionDateCache =
  ClientSessionDateCache {
    ClientSessionDateCache -> UTCTime
csdcNow               :: !UTCTime
  , ClientSessionDateCache -> UTCTime
csdcExpires           :: !UTCTime
  , ClientSessionDateCache -> ByteString
csdcExpiresSerialized :: !ByteString
  } deriving (ClientSessionDateCache -> ClientSessionDateCache -> Bool
(ClientSessionDateCache -> ClientSessionDateCache -> Bool)
-> (ClientSessionDateCache -> ClientSessionDateCache -> Bool)
-> Eq ClientSessionDateCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientSessionDateCache -> ClientSessionDateCache -> Bool
$c/= :: ClientSessionDateCache -> ClientSessionDateCache -> Bool
== :: ClientSessionDateCache -> ClientSessionDateCache -> Bool
$c== :: ClientSessionDateCache -> ClientSessionDateCache -> Bool
Eq, Int -> ClientSessionDateCache -> ShowS
[ClientSessionDateCache] -> ShowS
ClientSessionDateCache -> String
(Int -> ClientSessionDateCache -> ShowS)
-> (ClientSessionDateCache -> String)
-> ([ClientSessionDateCache] -> ShowS)
-> Show ClientSessionDateCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientSessionDateCache] -> ShowS
$cshowList :: [ClientSessionDateCache] -> ShowS
show :: ClientSessionDateCache -> String
$cshow :: ClientSessionDateCache -> String
showsPrec :: Int -> ClientSessionDateCache -> ShowS
$cshowsPrec :: Int -> ClientSessionDateCache -> ShowS
Show)

-- | The parsed request information. This type augments the standard WAI
-- 'W.Request' with additional information.
data YesodRequest = YesodRequest
    { YesodRequest -> [(Text, Text)]
reqGetParams  :: ![(Text, Text)]
      -- ^ Same as 'W.queryString', but decoded to @Text@.
    , YesodRequest -> [(Text, Text)]
reqCookies    :: ![(Text, Text)]
    , YesodRequest -> Request
reqWaiRequest :: !W.Request
    , YesodRequest -> [Text]
reqLangs      :: ![Text]
      -- ^ Languages which the client supports. This is an ordered list by preference.
    , YesodRequest -> Maybe Text
reqToken      :: !(Maybe Text)
      -- ^ A random, session-specific token used to prevent CSRF attacks.
    , YesodRequest -> SessionMap
reqSession    :: !SessionMap
      -- ^ Initial session sent from the client.
      --
      -- Since 1.2.0
    , YesodRequest -> [ByteString]
reqAccept     :: ![ContentType]
      -- ^ An ordered list of the accepted content types.
      --
      -- Since 1.2.0
    }

-- | An augmented WAI 'W.Response'. This can either be a standard @Response@,
-- or a higher-level data structure which Yesod will turn into a @Response@.
data YesodResponse
    = YRWai !W.Response
    | YRWaiApp !W.Application
    | YRPlain !H.Status ![Header] !ContentType !Content !SessionMap

-- | A tuple containing both the POST parameters and submitted files.
type RequestBodyContents =
    ( [(Text, Text)]
    , [(Text, FileInfo)]
    )

data FileInfo = FileInfo
    { FileInfo -> Text
fileName        :: !Text
    , FileInfo -> Text
fileContentType :: !Text
    , FileInfo -> ConduitT () ByteString (ResourceT IO) ()
fileSourceRaw   :: !(ConduitT () ByteString (ResourceT IO) ())
    , FileInfo -> String -> IO ()
fileMove        :: !(FilePath -> IO ())
    }

data FileUpload = FileUploadMemory !(NWP.BackEnd L.ByteString)
                | FileUploadDisk !(InternalState -> NWP.BackEnd FilePath)
                | FileUploadSource !(NWP.BackEnd (ConduitT () ByteString (ResourceT IO) ()))

-- | How to determine the root of the application for constructing URLs.
--
-- Note that future versions of Yesod may add new constructors without bumping
-- the major version number. As a result, you should /not/ pattern match on
-- @Approot@ values.
data Approot master = ApprootRelative -- ^ No application root.
                    | ApprootStatic !Text
                    | ApprootMaster !(master -> Text)
                    | ApprootRequest !(master -> W.Request -> Text)

type ResolvedApproot = Text

data AuthResult = Authorized | AuthenticationRequired | Unauthorized !Text
    deriving (AuthResult -> AuthResult -> Bool
(AuthResult -> AuthResult -> Bool)
-> (AuthResult -> AuthResult -> Bool) -> Eq AuthResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthResult -> AuthResult -> Bool
$c/= :: AuthResult -> AuthResult -> Bool
== :: AuthResult -> AuthResult -> Bool
$c== :: AuthResult -> AuthResult -> Bool
Eq, Int -> AuthResult -> ShowS
[AuthResult] -> ShowS
AuthResult -> String
(Int -> AuthResult -> ShowS)
-> (AuthResult -> String)
-> ([AuthResult] -> ShowS)
-> Show AuthResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthResult] -> ShowS
$cshowList :: [AuthResult] -> ShowS
show :: AuthResult -> String
$cshow :: AuthResult -> String
showsPrec :: Int -> AuthResult -> ShowS
$cshowsPrec :: Int -> AuthResult -> ShowS
Show, ReadPrec [AuthResult]
ReadPrec AuthResult
Int -> ReadS AuthResult
ReadS [AuthResult]
(Int -> ReadS AuthResult)
-> ReadS [AuthResult]
-> ReadPrec AuthResult
-> ReadPrec [AuthResult]
-> Read AuthResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthResult]
$creadListPrec :: ReadPrec [AuthResult]
readPrec :: ReadPrec AuthResult
$creadPrec :: ReadPrec AuthResult
readList :: ReadS [AuthResult]
$creadList :: ReadS [AuthResult]
readsPrec :: Int -> ReadS AuthResult
$creadsPrec :: Int -> ReadS AuthResult
Read)

data ScriptLoadPosition master
    = BottomOfBody
    | BottomOfHeadBlocking
    | BottomOfHeadAsync !(BottomOfHeadAsync master)

type BottomOfHeadAsync master
       = [Text] -- ^ urls to load asynchronously
      -> Maybe (HtmlUrl (Route master)) -- ^ widget of js to run on async completion
      -> HtmlUrl (Route master) -- ^ widget to insert at the bottom of <head>

type Texts = [Text]

-- | Wrap up a normal WAI application as a Yesod subsite. Ignore parent site's middleware and isAuthorized.
newtype WaiSubsite = WaiSubsite { WaiSubsite -> Application
runWaiSubsite :: W.Application }

-- | Like 'WaiSubsite', but applies parent site's middleware and isAuthorized.
--
-- @since 1.4.34
newtype WaiSubsiteWithAuth = WaiSubsiteWithAuth { WaiSubsiteWithAuth -> Application
runWaiSubsiteWithAuth :: W.Application }

data RunHandlerEnv child site = RunHandlerEnv
    { RunHandlerEnv child site -> Route site -> [(Text, Text)] -> Text
rheRender   :: !(Route site -> [(Text, Text)] -> Text)
    , RunHandlerEnv child site -> Maybe (Route child)
rheRoute    :: !(Maybe (Route child))
    , RunHandlerEnv child site -> Route child -> Route site
rheRouteToMaster :: !(Route child -> Route site)
    , RunHandlerEnv child site -> site
rheSite     :: !site
    , RunHandlerEnv child site -> child
rheChild    :: !child
    , RunHandlerEnv child site -> RequestBodyLength -> FileUpload
rheUpload   :: !(RequestBodyLength -> FileUpload)
    , RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheLog      :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ())
    , RunHandlerEnv child site -> ErrorResponse -> YesodApp
rheOnError  :: !(ErrorResponse -> YesodApp)
      -- ^ How to respond when an error is thrown internally.
      --
      -- Since 1.2.0
    , RunHandlerEnv child site -> Text
rheMaxExpires :: !Text
    }

data HandlerData child site = HandlerData
    { HandlerData child site -> YesodRequest
handlerRequest  :: !YesodRequest
    , HandlerData child site -> RunHandlerEnv child site
handlerEnv      :: !(RunHandlerEnv child site)
    , HandlerData child site -> IORef GHState
handlerState    :: !(IORef GHState)
    , HandlerData child site -> InternalState
handlerResource :: !InternalState
    }

data YesodRunnerEnv site = YesodRunnerEnv
    { YesodRunnerEnv site -> Logger
yreLogger         :: !Logger
    , YesodRunnerEnv site -> site
yreSite           :: !site
    , YesodRunnerEnv site -> Maybe SessionBackend
yreSessionBackend :: !(Maybe SessionBackend)
    , YesodRunnerEnv site -> IO Int
yreGen            :: !(IO Int)
    -- ^ Generate a random number uniformly distributed in the full
    -- range of 'Int'.
    --
    -- Note: Before 1.6.20, the default value generates pseudo-random
    -- number in an unspecified range. The range size may not be a power
    -- of 2. Since 1.6.20, the default value uses a secure entropy source
    -- and generates in the full range of 'Int'.
    , YesodRunnerEnv site -> IO Text
yreGetMaxExpires  :: !(IO Text)
    }

data YesodSubRunnerEnv sub parent = YesodSubRunnerEnv
    { YesodSubRunnerEnv sub parent -> ParentRunner parent
ysreParentRunner  :: !(ParentRunner parent)
    , YesodSubRunnerEnv sub parent -> parent -> sub
ysreGetSub        :: !(parent -> sub)
    , YesodSubRunnerEnv sub parent -> Route sub -> Route parent
ysreToParentRoute :: !(Route sub -> Route parent)
    , YesodSubRunnerEnv sub parent -> YesodRunnerEnv parent
ysreParentEnv     :: !(YesodRunnerEnv parent) -- FIXME maybe get rid of this and remove YesodRunnerEnv in ParentRunner?
    }

type ParentRunner parent
    = HandlerFor parent TypedContent
   -> YesodRunnerEnv parent
   -> Maybe (Route parent)
   -> W.Application

-- | A generic handler monad, which can have a different subsite and master
-- site. We define a newtype for better error message.
newtype HandlerFor site a = HandlerFor
    { HandlerFor site a -> HandlerData site site -> IO a
unHandlerFor :: HandlerData site site -> IO a
    }
    deriving a -> HandlerFor site b -> HandlerFor site a
(a -> b) -> HandlerFor site a -> HandlerFor site b
(forall a b. (a -> b) -> HandlerFor site a -> HandlerFor site b)
-> (forall a b. a -> HandlerFor site b -> HandlerFor site a)
-> Functor (HandlerFor site)
forall a b. a -> HandlerFor site b -> HandlerFor site a
forall a b. (a -> b) -> HandlerFor site a -> HandlerFor site b
forall site a b. a -> HandlerFor site b -> HandlerFor site a
forall site a b. (a -> b) -> HandlerFor site a -> HandlerFor site b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HandlerFor site b -> HandlerFor site a
$c<$ :: forall site a b. a -> HandlerFor site b -> HandlerFor site a
fmap :: (a -> b) -> HandlerFor site a -> HandlerFor site b
$cfmap :: forall site a b. (a -> b) -> HandlerFor site a -> HandlerFor site b
Functor

data GHState = GHState
    { GHState -> SessionMap
ghsSession :: !SessionMap
    , GHState -> Maybe RequestBodyContents
ghsRBC     :: !(Maybe RequestBodyContents)
    , GHState -> Int
ghsIdent   :: !Int
    , GHState -> TypeMap
ghsCache   :: !TypeMap
    , GHState -> KeyedTypeMap
ghsCacheBy :: !KeyedTypeMap
    , GHState -> Endo [Header]
ghsHeaders :: !(Endo [Header])
    }

-- | An extension of the basic WAI 'W.Application' datatype to provide extra
-- features needed by Yesod. Users should never need to use this directly, as
-- the 'HandlerFor' monad and template haskell code should hide it away.
type YesodApp = YesodRequest -> ResourceT IO YesodResponse

-- | A generic widget, allowing specification of both the subsite and master
-- site datatypes. While this is simply a @WriterT@, we define a newtype for
-- better error messages.
newtype WidgetFor site a = WidgetFor
    { WidgetFor site a -> WidgetData site -> IO a
unWidgetFor :: WidgetData site -> IO a
    }
    deriving a -> WidgetFor site b -> WidgetFor site a
(a -> b) -> WidgetFor site a -> WidgetFor site b
(forall a b. (a -> b) -> WidgetFor site a -> WidgetFor site b)
-> (forall a b. a -> WidgetFor site b -> WidgetFor site a)
-> Functor (WidgetFor site)
forall a b. a -> WidgetFor site b -> WidgetFor site a
forall a b. (a -> b) -> WidgetFor site a -> WidgetFor site b
forall site a b. a -> WidgetFor site b -> WidgetFor site a
forall site a b. (a -> b) -> WidgetFor site a -> WidgetFor site b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WidgetFor site b -> WidgetFor site a
$c<$ :: forall site a b. a -> WidgetFor site b -> WidgetFor site a
fmap :: (a -> b) -> WidgetFor site a -> WidgetFor site b
$cfmap :: forall site a b. (a -> b) -> WidgetFor site a -> WidgetFor site b
Functor

data WidgetData site = WidgetData
  { WidgetData site -> IORef (GWData (Route site))
wdRef :: {-# UNPACK #-} !(IORef (GWData (Route site)))
  , WidgetData site -> HandlerData site site
wdHandler :: {-# UNPACK #-} !(HandlerData site site)
  }

instance a ~ () => Monoid (WidgetFor site a) where
    mempty :: WidgetFor site a
mempty = () -> WidgetFor site ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif
instance a ~ () => Semigroup (WidgetFor site a) where
    WidgetFor site a
x <> :: WidgetFor site a -> WidgetFor site a -> WidgetFor site a
<> WidgetFor site a
y = WidgetFor site a
x WidgetFor site a -> WidgetFor site a -> WidgetFor site a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WidgetFor site a
y

-- | A 'String' can be trivially promoted to a widget.
--
-- For example, in a yesod-scaffold site you could use:
--
-- @getHomeR = do defaultLayout "Widget text"@
instance a ~ () => IsString (WidgetFor site a) where
    fromString :: String -> WidgetFor site a
fromString = Html -> WidgetFor site ()
forall site. Html -> WidgetFor site ()
toWidget (Html -> WidgetFor site ())
-> (String -> Html) -> String -> WidgetFor site ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> (String -> Text) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      where toWidget :: Html -> WidgetFor site ()
toWidget Html
x = GWData (Route site) -> WidgetFor site ()
forall site. GWData (Route site) -> WidgetFor site ()
tellWidget GWData (Route site)
forall a. Monoid a => a
mempty { gwdBody :: Body (Route site)
gwdBody = HtmlUrl (Route site) -> Body (Route site)
forall url. HtmlUrl url -> Body url
Body (Html -> HtmlUrl (Route site)
forall a b. a -> b -> a
const Html
x) }

tellWidget :: GWData (Route site) -> WidgetFor site ()
tellWidget :: GWData (Route site) -> WidgetFor site ()
tellWidget GWData (Route site)
d = (WidgetData site -> IO ()) -> WidgetFor site ()
forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor ((WidgetData site -> IO ()) -> WidgetFor site ())
-> (WidgetData site -> IO ()) -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$ \WidgetData site
wd -> IORef (GWData (Route site))
-> (GWData (Route site) -> GWData (Route site)) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (WidgetData site -> IORef (GWData (Route site))
forall site. WidgetData site -> IORef (GWData (Route site))
wdRef WidgetData site
wd) (GWData (Route site) -> GWData (Route site) -> GWData (Route site)
forall a. Semigroup a => a -> a -> a
<> GWData (Route site)
d)

type RY master = Route master -> [(Text, Text)] -> Text

-- | Newtype wrapper allowing injection of arbitrary content into CSS.
--
-- Usage:
--
-- > toWidget $ CssBuilder "p { color: red }"
--
-- Since: 1.1.3
newtype CssBuilder = CssBuilder { CssBuilder -> Builder
unCssBuilder :: TBuilder.Builder }

-- | Content for a web page. By providing this datatype, we can easily create
-- generic site templates, which would have the type signature:
--
-- > PageContent url -> HtmlUrl url
data PageContent url = PageContent
    { PageContent url -> Html
pageTitle :: !Html
    , PageContent url -> HtmlUrl url
pageHead  :: !(HtmlUrl url)
    , PageContent url -> HtmlUrl url
pageBody  :: !(HtmlUrl url)
    }

data Content = ContentBuilder !BB.Builder !(Maybe Int) -- ^ The content and optional content length.
             | ContentSource !(ConduitT () (Flush BB.Builder) (ResourceT IO) ())
             | ContentFile !FilePath !(Maybe FilePart)
             | ContentDontEvaluate !Content

data TypedContent = TypedContent !ContentType !Content

type RepHtml = Html
{-# DEPRECATED RepHtml "Please use Html instead" #-}
newtype RepJson = RepJson Content
newtype RepPlain = RepPlain Content
newtype RepXml = RepXml Content

type ContentType = ByteString -- FIXME Text?

-- | Wrapper around types so that Handlers can return a domain type, even when
-- the data will eventually be encoded as JSON.
-- Example usage in a type signature:
--
-- > postSignupR :: Handler (JSONResponse CreateUserResponse)
--
-- And in the implementation:
--
-- > return $ JSONResponse $ CreateUserResponse userId
--
-- @since 1.6.14
data JSONResponse a where
    JSONResponse :: ToJSON a => a -> JSONResponse a

-- | Prevents a response body from being fully evaluated before sending the
-- request.
--
-- Since 1.1.0
newtype DontFullyEvaluate a = DontFullyEvaluate { DontFullyEvaluate a -> a
unDontFullyEvaluate :: a }

-- | Responses to indicate some form of an error occurred.
data ErrorResponse =
      NotFound
        -- ^ The requested resource was not found.
        -- Examples of when this occurs include when an incorrect URL is used, or @yesod-persistent@'s 'get404' doesn't find a value.
        -- HTTP status: 404.
    | InternalError !Text
        -- ^ Some sort of unexpected exception.
        -- If your application uses `throwIO` or `error` to throw an exception, this is the form it would take.
        -- HTTP status: 500.
    | InvalidArgs ![Text]
        -- ^ Indicates some sort of invalid or missing argument, like a missing query parameter or malformed JSON body.
        -- Examples Yesod functions that send this include 'requireCheckJsonBody' and @Yesod.Auth.GoogleEmail2@.
        -- HTTP status: 400.
    | NotAuthenticated
        -- ^ Indicates the user is not logged in.
        -- This is thrown when 'isAuthorized' returns 'AuthenticationRequired'.
        -- HTTP code: 401.
    | PermissionDenied !Text
        -- ^ Indicates the user doesn't have permission to access the requested resource.
        -- This is thrown when 'isAuthorized' returns 'Unauthorized'.
        -- HTTP code: 403.
    | BadMethod !H.Method
        -- ^ Indicates the URL would have been valid if used with a different HTTP method (e.g. a GET was used, but only POST is handled.)
        -- HTTP code: 405.
    deriving (Int -> ErrorResponse -> ShowS
[ErrorResponse] -> ShowS
ErrorResponse -> String
(Int -> ErrorResponse -> ShowS)
-> (ErrorResponse -> String)
-> ([ErrorResponse] -> ShowS)
-> Show ErrorResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorResponse] -> ShowS
$cshowList :: [ErrorResponse] -> ShowS
show :: ErrorResponse -> String
$cshow :: ErrorResponse -> String
showsPrec :: Int -> ErrorResponse -> ShowS
$cshowsPrec :: Int -> ErrorResponse -> ShowS
Show, ErrorResponse -> ErrorResponse -> Bool
(ErrorResponse -> ErrorResponse -> Bool)
-> (ErrorResponse -> ErrorResponse -> Bool) -> Eq ErrorResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorResponse -> ErrorResponse -> Bool
$c/= :: ErrorResponse -> ErrorResponse -> Bool
== :: ErrorResponse -> ErrorResponse -> Bool
$c== :: ErrorResponse -> ErrorResponse -> Bool
Eq, (forall x. ErrorResponse -> Rep ErrorResponse x)
-> (forall x. Rep ErrorResponse x -> ErrorResponse)
-> Generic ErrorResponse
forall x. Rep ErrorResponse x -> ErrorResponse
forall x. ErrorResponse -> Rep ErrorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorResponse x -> ErrorResponse
$cfrom :: forall x. ErrorResponse -> Rep ErrorResponse x
Generic)
instance NFData ErrorResponse

----- header stuff
-- | Headers to be added to a 'Result'.
data Header =
      AddCookie !SetCookie
    | DeleteCookie !ByteString !ByteString
    -- ^ name and path
    | Header !(CI ByteString) !ByteString
    -- ^ key and value
    deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq, Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show)

-- FIXME In the next major version bump, let's just add strictness annotations
-- to Header (and probably everywhere else). We can also add strictness
-- annotations to SetCookie in the cookie package.
instance NFData Header where
    rnf :: Header -> ()
rnf (AddCookie SetCookie
x) = SetCookie -> ()
forall a. NFData a => a -> ()
rnf SetCookie
x
    rnf (DeleteCookie ByteString
x ByteString
y) = ByteString
x ByteString -> () -> ()
`seq` ByteString
y ByteString -> () -> ()
`seq` ()
    rnf (Header CI ByteString
x ByteString
y) = CI ByteString
x CI ByteString -> () -> ()
`seq` ByteString
y ByteString -> () -> ()
`seq` ()

data Location url = Local !url | Remote !Text
    deriving (Int -> Location url -> ShowS
[Location url] -> ShowS
Location url -> String
(Int -> Location url -> ShowS)
-> (Location url -> String)
-> ([Location url] -> ShowS)
-> Show (Location url)
forall url. Show url => Int -> Location url -> ShowS
forall url. Show url => [Location url] -> ShowS
forall url. Show url => Location url -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location url] -> ShowS
$cshowList :: forall url. Show url => [Location url] -> ShowS
show :: Location url -> String
$cshow :: forall url. Show url => Location url -> String
showsPrec :: Int -> Location url -> ShowS
$cshowsPrec :: forall url. Show url => Int -> Location url -> ShowS
Show, Location url -> Location url -> Bool
(Location url -> Location url -> Bool)
-> (Location url -> Location url -> Bool) -> Eq (Location url)
forall url. Eq url => Location url -> Location url -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location url -> Location url -> Bool
$c/= :: forall url. Eq url => Location url -> Location url -> Bool
== :: Location url -> Location url -> Bool
$c== :: forall url. Eq url => Location url -> Location url -> Bool
Eq)

-- | A diff list that does not directly enforce uniqueness.
-- When creating a widget Yesod will use nub to make it unique.
newtype UniqueList x = UniqueList ([x] -> [x])

data Script url = Script { Script url -> Location url
scriptLocation :: !(Location url), Script url -> [(Text, Text)]
scriptAttributes :: ![(Text, Text)] }
    deriving (Int -> Script url -> ShowS
[Script url] -> ShowS
Script url -> String
(Int -> Script url -> ShowS)
-> (Script url -> String)
-> ([Script url] -> ShowS)
-> Show (Script url)
forall url. Show url => Int -> Script url -> ShowS
forall url. Show url => [Script url] -> ShowS
forall url. Show url => Script url -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Script url] -> ShowS
$cshowList :: forall url. Show url => [Script url] -> ShowS
show :: Script url -> String
$cshow :: forall url. Show url => Script url -> String
showsPrec :: Int -> Script url -> ShowS
$cshowsPrec :: forall url. Show url => Int -> Script url -> ShowS
Show, Script url -> Script url -> Bool
(Script url -> Script url -> Bool)
-> (Script url -> Script url -> Bool) -> Eq (Script url)
forall url. Eq url => Script url -> Script url -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Script url -> Script url -> Bool
$c/= :: forall url. Eq url => Script url -> Script url -> Bool
== :: Script url -> Script url -> Bool
$c== :: forall url. Eq url => Script url -> Script url -> Bool
Eq)
data Stylesheet url = Stylesheet { Stylesheet url -> Location url
styleLocation :: !(Location url), Stylesheet url -> [(Text, Text)]
styleAttributes :: ![(Text, Text)] }
    deriving (Int -> Stylesheet url -> ShowS
[Stylesheet url] -> ShowS
Stylesheet url -> String
(Int -> Stylesheet url -> ShowS)
-> (Stylesheet url -> String)
-> ([Stylesheet url] -> ShowS)
-> Show (Stylesheet url)
forall url. Show url => Int -> Stylesheet url -> ShowS
forall url. Show url => [Stylesheet url] -> ShowS
forall url. Show url => Stylesheet url -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stylesheet url] -> ShowS
$cshowList :: forall url. Show url => [Stylesheet url] -> ShowS
show :: Stylesheet url -> String
$cshow :: forall url. Show url => Stylesheet url -> String
showsPrec :: Int -> Stylesheet url -> ShowS
$cshowsPrec :: forall url. Show url => Int -> Stylesheet url -> ShowS
Show, Stylesheet url -> Stylesheet url -> Bool
(Stylesheet url -> Stylesheet url -> Bool)
-> (Stylesheet url -> Stylesheet url -> Bool)
-> Eq (Stylesheet url)
forall url. Eq url => Stylesheet url -> Stylesheet url -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stylesheet url -> Stylesheet url -> Bool
$c/= :: forall url. Eq url => Stylesheet url -> Stylesheet url -> Bool
== :: Stylesheet url -> Stylesheet url -> Bool
$c== :: forall url. Eq url => Stylesheet url -> Stylesheet url -> Bool
Eq)
newtype Title = Title { Title -> Html
unTitle :: Html }

newtype Head url = Head (HtmlUrl url)
    deriving Semigroup (Head url)
Head url
Semigroup (Head url)
-> Head url
-> (Head url -> Head url -> Head url)
-> ([Head url] -> Head url)
-> Monoid (Head url)
[Head url] -> Head url
Head url -> Head url -> Head url
forall url. Semigroup (Head url)
forall url. Head url
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall url. [Head url] -> Head url
forall url. Head url -> Head url -> Head url
mconcat :: [Head url] -> Head url
$cmconcat :: forall url. [Head url] -> Head url
mappend :: Head url -> Head url -> Head url
$cmappend :: forall url. Head url -> Head url -> Head url
mempty :: Head url
$cmempty :: forall url. Head url
$cp1Monoid :: forall url. Semigroup (Head url)
Monoid
instance Semigroup (Head url) where
  <> :: Head url -> Head url -> Head url
(<>) = Head url -> Head url -> Head url
forall a. Monoid a => a -> a -> a
mappend
newtype Body url = Body (HtmlUrl url)
    deriving Semigroup (Body url)
Body url
Semigroup (Body url)
-> Body url
-> (Body url -> Body url -> Body url)
-> ([Body url] -> Body url)
-> Monoid (Body url)
[Body url] -> Body url
Body url -> Body url -> Body url
forall url. Semigroup (Body url)
forall url. Body url
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall url. [Body url] -> Body url
forall url. Body url -> Body url -> Body url
mconcat :: [Body url] -> Body url
$cmconcat :: forall url. [Body url] -> Body url
mappend :: Body url -> Body url -> Body url
$cmappend :: forall url. Body url -> Body url -> Body url
mempty :: Body url
$cmempty :: forall url. Body url
$cp1Monoid :: forall url. Semigroup (Body url)
Monoid
instance Semigroup (Body url) where
  <> :: Body url -> Body url -> Body url
(<>) = Body url -> Body url -> Body url
forall a. Monoid a => a -> a -> a
mappend

type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> TBuilder.Builder

data GWData a = GWData
    { GWData a -> Body a
gwdBody        :: !(Body a)
    , GWData a -> Last Title
gwdTitle       :: !(Last Title)
    , GWData a -> UniqueList (Script a)
gwdScripts     :: !(UniqueList (Script a))
    , GWData a -> UniqueList (Stylesheet a)
gwdStylesheets :: !(UniqueList (Stylesheet a))
    , GWData a -> Map (Maybe Text) (CssBuilderUrl a)
gwdCss         :: !(Map (Maybe Text) (CssBuilderUrl a)) -- media type
    , GWData a -> Maybe (JavascriptUrl a)
gwdJavascript  :: !(Maybe (JavascriptUrl a))
    , GWData a -> Head a
gwdHead        :: !(Head a)
    }
instance Monoid (GWData a) where
    mempty :: GWData a
mempty = Body a
-> Last Title
-> UniqueList (Script a)
-> UniqueList (Stylesheet a)
-> Map (Maybe Text) (CssBuilderUrl a)
-> Maybe (JavascriptUrl a)
-> Head a
-> GWData a
forall a.
Body a
-> Last Title
-> UniqueList (Script a)
-> UniqueList (Stylesheet a)
-> Map (Maybe Text) (CssBuilderUrl a)
-> Maybe (JavascriptUrl a)
-> Head a
-> GWData a
GWData Body a
forall a. Monoid a => a
mempty Last Title
forall a. Monoid a => a
mempty UniqueList (Script a)
forall a. Monoid a => a
mempty UniqueList (Stylesheet a)
forall a. Monoid a => a
mempty Map (Maybe Text) (CssBuilderUrl a)
forall a. Monoid a => a
mempty Maybe (JavascriptUrl a)
forall a. Monoid a => a
mempty Head a
forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif
instance Semigroup (GWData a) where
    GWData Body a
a1 Last Title
a2 UniqueList (Script a)
a3 UniqueList (Stylesheet a)
a4 Map (Maybe Text) (CssBuilderUrl a)
a5 Maybe (JavascriptUrl a)
a6 Head a
a7 <> :: GWData a -> GWData a -> GWData a
<>
      GWData Body a
b1 Last Title
b2 UniqueList (Script a)
b3 UniqueList (Stylesheet a)
b4 Map (Maybe Text) (CssBuilderUrl a)
b5 Maybe (JavascriptUrl a)
b6 Head a
b7 = Body a
-> Last Title
-> UniqueList (Script a)
-> UniqueList (Stylesheet a)
-> Map (Maybe Text) (CssBuilderUrl a)
-> Maybe (JavascriptUrl a)
-> Head a
-> GWData a
forall a.
Body a
-> Last Title
-> UniqueList (Script a)
-> UniqueList (Stylesheet a)
-> Map (Maybe Text) (CssBuilderUrl a)
-> Maybe (JavascriptUrl a)
-> Head a
-> GWData a
GWData
        (Body a -> Body a -> Body a
forall a. Monoid a => a -> a -> a
mappend Body a
a1 Body a
b1)
        (Last Title -> Last Title -> Last Title
forall a. Monoid a => a -> a -> a
mappend Last Title
a2 Last Title
b2)
        (UniqueList (Script a)
-> UniqueList (Script a) -> UniqueList (Script a)
forall a. Monoid a => a -> a -> a
mappend UniqueList (Script a)
a3 UniqueList (Script a)
b3)
        (UniqueList (Stylesheet a)
-> UniqueList (Stylesheet a) -> UniqueList (Stylesheet a)
forall a. Monoid a => a -> a -> a
mappend UniqueList (Stylesheet a)
a4 UniqueList (Stylesheet a)
b4)
        ((CssBuilderUrl a -> CssBuilderUrl a -> CssBuilderUrl a)
-> Map (Maybe Text) (CssBuilderUrl a)
-> Map (Maybe Text) (CssBuilderUrl a)
-> Map (Maybe Text) (CssBuilderUrl a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith CssBuilderUrl a -> CssBuilderUrl a -> CssBuilderUrl a
forall a. Monoid a => a -> a -> a
mappend Map (Maybe Text) (CssBuilderUrl a)
a5 Map (Maybe Text) (CssBuilderUrl a)
b5)
        (Maybe (JavascriptUrl a)
-> Maybe (JavascriptUrl a) -> Maybe (JavascriptUrl a)
forall a. Monoid a => a -> a -> a
mappend Maybe (JavascriptUrl a)
a6 Maybe (JavascriptUrl a)
b6)
        (Head a -> Head a -> Head a
forall a. Monoid a => a -> a -> a
mappend Head a
a7 Head a
b7)

data HandlerContents =
      HCContent !H.Status !TypedContent
    | HCError !ErrorResponse
    | HCSendFile !ContentType !FilePath !(Maybe FilePart)
    | HCRedirect !H.Status !Text
    | HCCreated !Text
    | HCWai !W.Response
    | HCWaiApp !W.Application

instance Show HandlerContents where
    show :: HandlerContents -> String
show (HCContent Status
status (TypedContent ByteString
t Content
_)) = String
"HCContent " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Status, ByteString) -> String
forall a. Show a => a -> String
show (Status
status, ByteString
t)
    show (HCError ErrorResponse
e) = String
"HCError " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ErrorResponse -> String
forall a. Show a => a -> String
show ErrorResponse
e
    show (HCSendFile ByteString
ct String
fp Maybe FilePart
mfp) = String
"HCSendFile " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ByteString, String, Maybe FilePart) -> String
forall a. Show a => a -> String
show (ByteString
ct, String
fp, Maybe FilePart
mfp)
    show (HCRedirect Status
s Text
t) = String
"HCRedirect " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Status, Text) -> String
forall a. Show a => a -> String
show (Status
s, Text
t)
    show (HCCreated Text
t) = String
"HCCreated " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t
    show (HCWai Response
_) = String
"HCWai"
    show (HCWaiApp Application
_) = String
"HCWaiApp"
instance Exception HandlerContents

-- Instances for WidgetFor
instance Applicative (WidgetFor site) where
    pure :: a -> WidgetFor site a
pure = (WidgetData site -> IO a) -> WidgetFor site a
forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor ((WidgetData site -> IO a) -> WidgetFor site a)
-> (a -> WidgetData site -> IO a) -> a -> WidgetFor site a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> WidgetData site -> IO a
forall a b. a -> b -> a
const (IO a -> WidgetData site -> IO a)
-> (a -> IO a) -> a -> WidgetData site -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    <*> :: WidgetFor site (a -> b) -> WidgetFor site a -> WidgetFor site b
(<*>) = WidgetFor site (a -> b) -> WidgetFor site a -> WidgetFor site b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (WidgetFor site) where
    return :: a -> WidgetFor site a
return = a -> WidgetFor site a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    WidgetFor WidgetData site -> IO a
x >>= :: WidgetFor site a -> (a -> WidgetFor site b) -> WidgetFor site b
>>= a -> WidgetFor site b
f = (WidgetData site -> IO b) -> WidgetFor site b
forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor ((WidgetData site -> IO b) -> WidgetFor site b)
-> (WidgetData site -> IO b) -> WidgetFor site b
forall a b. (a -> b) -> a -> b
$ \WidgetData site
wd -> do
        a
a <- WidgetData site -> IO a
x WidgetData site
wd
        WidgetFor site b -> WidgetData site -> IO b
forall site a. WidgetFor site a -> WidgetData site -> IO a
unWidgetFor (a -> WidgetFor site b
f a
a) WidgetData site
wd
instance MonadIO (WidgetFor site) where
    liftIO :: IO a -> WidgetFor site a
liftIO = (WidgetData site -> IO a) -> WidgetFor site a
forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor ((WidgetData site -> IO a) -> WidgetFor site a)
-> (IO a -> WidgetData site -> IO a) -> IO a -> WidgetFor site a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> WidgetData site -> IO a
forall a b. a -> b -> a
const
-- | @since 1.6.7
instance PrimMonad (WidgetFor site) where
    type PrimState (WidgetFor site) = PrimState IO
    primitive :: (State# (PrimState (WidgetFor site))
 -> (# State# (PrimState (WidgetFor site)), a #))
-> WidgetFor site a
primitive = IO a -> WidgetFor site a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> WidgetFor site a)
-> ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #))
-> WidgetFor site a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
-- | @since 1.4.38
instance MonadUnliftIO (WidgetFor site) where
  {-# INLINE withRunInIO #-}
  withRunInIO :: ((forall a. WidgetFor site a -> IO a) -> IO b) -> WidgetFor site b
withRunInIO (forall a. WidgetFor site a -> IO a) -> IO b
inner = (WidgetData site -> IO b) -> WidgetFor site b
forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor ((WidgetData site -> IO b) -> WidgetFor site b)
-> (WidgetData site -> IO b) -> WidgetFor site b
forall a b. (a -> b) -> a -> b
$ \WidgetData site
x -> (forall a. WidgetFor site a -> IO a) -> IO b
inner ((forall a. WidgetFor site a -> IO a) -> IO b)
-> (forall a. WidgetFor site a -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ (WidgetFor site a -> WidgetData site -> IO a)
-> WidgetData site -> WidgetFor site a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip WidgetFor site a -> WidgetData site -> IO a
forall site a. WidgetFor site a -> WidgetData site -> IO a
unWidgetFor WidgetData site
x
instance MonadReader (WidgetData site) (WidgetFor site) where
    ask :: WidgetFor site (WidgetData site)
ask = (WidgetData site -> IO (WidgetData site))
-> WidgetFor site (WidgetData site)
forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor WidgetData site -> IO (WidgetData site)
forall (m :: * -> *) a. Monad m => a -> m a
return
    local :: (WidgetData site -> WidgetData site)
-> WidgetFor site a -> WidgetFor site a
local WidgetData site -> WidgetData site
f (WidgetFor WidgetData site -> IO a
g) = (WidgetData site -> IO a) -> WidgetFor site a
forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor ((WidgetData site -> IO a) -> WidgetFor site a)
-> (WidgetData site -> IO a) -> WidgetFor site a
forall a b. (a -> b) -> a -> b
$ WidgetData site -> IO a
g (WidgetData site -> IO a)
-> (WidgetData site -> WidgetData site) -> WidgetData site -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetData site -> WidgetData site
f

instance MonadThrow (WidgetFor site) where
    throwM :: e -> WidgetFor site a
throwM = IO a -> WidgetFor site a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> WidgetFor site a) -> (e -> IO a) -> e -> WidgetFor site a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadResource (WidgetFor site) where
    liftResourceT :: ResourceT IO a -> WidgetFor site a
liftResourceT ResourceT IO a
f = (WidgetData site -> IO a) -> WidgetFor site a
forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor ((WidgetData site -> IO a) -> WidgetFor site a)
-> (WidgetData site -> IO a) -> WidgetFor site a
forall a b. (a -> b) -> a -> b
$ ResourceT IO a -> InternalState -> IO a
forall (m :: * -> *) a. ResourceT m a -> InternalState -> m a
runInternalState ResourceT IO a
f (InternalState -> IO a)
-> (WidgetData site -> InternalState) -> WidgetData site -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData site site -> InternalState
forall child site. HandlerData child site -> InternalState
handlerResource (HandlerData site site -> InternalState)
-> (WidgetData site -> HandlerData site site)
-> WidgetData site
-> InternalState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetData site -> HandlerData site site
forall site. WidgetData site -> HandlerData site site
wdHandler

instance MonadLogger (WidgetFor site) where
    monadLoggerLog :: Loc -> Text -> LogLevel -> msg -> WidgetFor site ()
monadLoggerLog Loc
a Text
b LogLevel
c msg
d = (WidgetData site -> IO ()) -> WidgetFor site ()
forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor ((WidgetData site -> IO ()) -> WidgetFor site ())
-> (WidgetData site -> IO ()) -> WidgetFor site ()
forall a b. (a -> b) -> a -> b
$ \WidgetData site
wd ->
        RunHandlerEnv site site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheLog (HandlerData site site -> RunHandlerEnv site site
forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerEnv (HandlerData site site -> RunHandlerEnv site site)
-> HandlerData site site -> RunHandlerEnv site site
forall a b. (a -> b) -> a -> b
$ WidgetData site -> HandlerData site site
forall site. WidgetData site -> HandlerData site site
wdHandler WidgetData site
wd) Loc
a Text
b LogLevel
c (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
d)

instance MonadLoggerIO (WidgetFor site) where
    askLoggerIO :: WidgetFor site (Loc -> Text -> LogLevel -> LogStr -> IO ())
askLoggerIO = (WidgetData site
 -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> WidgetFor site (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor ((WidgetData site
  -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
 -> WidgetFor site (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> (WidgetData site
    -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> WidgetFor site (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall a b. (a -> b) -> a -> b
$ (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> IO (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Loc -> Text -> LogLevel -> LogStr -> IO ())
 -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> (WidgetData site -> Loc -> Text -> LogLevel -> LogStr -> IO ())
-> WidgetData site
-> IO (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunHandlerEnv site site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheLog (RunHandlerEnv site site
 -> Loc -> Text -> LogLevel -> LogStr -> IO ())
-> (WidgetData site -> RunHandlerEnv site site)
-> WidgetData site
-> Loc
-> Text
-> LogLevel
-> LogStr
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData site site -> RunHandlerEnv site site
forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerEnv (HandlerData site site -> RunHandlerEnv site site)
-> (WidgetData site -> HandlerData site site)
-> WidgetData site
-> RunHandlerEnv 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

-- Instances for HandlerFor
instance Applicative (HandlerFor site) where
    pure :: a -> HandlerFor site a
pure = (HandlerData site site -> IO a) -> HandlerFor site a
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData site site -> IO a) -> HandlerFor site a)
-> (a -> HandlerData site site -> IO a) -> a -> HandlerFor site a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> HandlerData site site -> IO a
forall a b. a -> b -> a
const (IO a -> HandlerData site site -> IO a)
-> (a -> IO a) -> a -> HandlerData site site -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: HandlerFor site (a -> b) -> HandlerFor site a -> HandlerFor site b
(<*>) = HandlerFor site (a -> b) -> HandlerFor site a -> HandlerFor site b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (HandlerFor site) where
    return :: a -> HandlerFor site a
return = a -> HandlerFor site a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    HandlerFor HandlerData site site -> IO a
x >>= :: HandlerFor site a -> (a -> HandlerFor site b) -> HandlerFor site b
>>= a -> HandlerFor site b
f = (HandlerData site site -> IO b) -> HandlerFor site b
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData site site -> IO b) -> HandlerFor site b)
-> (HandlerData site site -> IO b) -> HandlerFor site b
forall a b. (a -> b) -> a -> b
$ \HandlerData site site
r -> HandlerData site site -> IO a
x HandlerData site site
r IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x' -> HandlerFor site b -> HandlerData site site -> IO b
forall site a. HandlerFor site a -> HandlerData site site -> IO a
unHandlerFor (a -> HandlerFor site b
f a
x') HandlerData site site
r
instance MonadIO (HandlerFor site) where
    liftIO :: IO a -> HandlerFor site a
liftIO = (HandlerData site site -> IO a) -> HandlerFor site a
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData site site -> IO a) -> HandlerFor site a)
-> (IO a -> HandlerData site site -> IO a)
-> IO a
-> HandlerFor site a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> HandlerData site site -> IO a
forall a b. a -> b -> a
const
-- | @since 1.6.7
instance PrimMonad (HandlerFor site) where
    type PrimState (HandlerFor site) = PrimState IO
    primitive :: (State# (PrimState (HandlerFor site))
 -> (# State# (PrimState (HandlerFor site)), a #))
-> HandlerFor site a
primitive = IO a -> HandlerFor site a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> HandlerFor site a)
-> ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, a #))
-> HandlerFor site a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
instance MonadReader (HandlerData site site) (HandlerFor site) where
    ask :: HandlerFor site (HandlerData site site)
ask = (HandlerData site site -> IO (HandlerData site site))
-> HandlerFor site (HandlerData site site)
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor HandlerData site site -> IO (HandlerData site site)
forall (m :: * -> *) a. Monad m => a -> m a
return
    local :: (HandlerData site site -> HandlerData site site)
-> HandlerFor site a -> HandlerFor site a
local HandlerData site site -> HandlerData site site
f (HandlerFor HandlerData site site -> IO a
g) = (HandlerData site site -> IO a) -> HandlerFor site a
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData site site -> IO a) -> HandlerFor site a)
-> (HandlerData site site -> IO a) -> HandlerFor site a
forall a b. (a -> b) -> a -> b
$ HandlerData site site -> IO a
g (HandlerData site site -> IO a)
-> (HandlerData site site -> HandlerData site site)
-> HandlerData site site
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData site site -> HandlerData site site
f

-- | @since 1.4.38
instance MonadUnliftIO (HandlerFor site) where
  {-# INLINE withRunInIO #-}
  withRunInIO :: ((forall a. HandlerFor site a -> IO a) -> IO b)
-> HandlerFor site b
withRunInIO (forall a. HandlerFor site a -> IO a) -> IO b
inner = (HandlerData site site -> IO b) -> HandlerFor site b
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData site site -> IO b) -> HandlerFor site b)
-> (HandlerData site site -> IO b) -> HandlerFor site b
forall a b. (a -> b) -> a -> b
$ \HandlerData site site
x -> (forall a. HandlerFor site a -> IO a) -> IO b
inner ((forall a. HandlerFor site a -> IO a) -> IO b)
-> (forall a. HandlerFor site a -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ (HandlerFor site a -> HandlerData site site -> IO a)
-> HandlerData site site -> HandlerFor site a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip HandlerFor site a -> HandlerData site site -> IO a
forall site a. HandlerFor site a -> HandlerData site site -> IO a
unHandlerFor HandlerData site site
x

instance MonadThrow (HandlerFor site) where
    throwM :: e -> HandlerFor site a
throwM = IO a -> HandlerFor site a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> HandlerFor site a)
-> (e -> IO a) -> e -> HandlerFor site a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadResource (HandlerFor site) where
    liftResourceT :: ResourceT IO a -> HandlerFor site a
liftResourceT ResourceT IO a
f = (HandlerData site site -> IO a) -> HandlerFor site a
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData site site -> IO a) -> HandlerFor site a)
-> (HandlerData site site -> IO a) -> HandlerFor site a
forall a b. (a -> b) -> a -> b
$ ResourceT IO a -> InternalState -> IO a
forall (m :: * -> *) a. ResourceT m a -> InternalState -> m a
runInternalState ResourceT IO a
f (InternalState -> IO a)
-> (HandlerData site site -> InternalState)
-> HandlerData site site
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData site site -> InternalState
forall child site. HandlerData child site -> InternalState
handlerResource

instance MonadLogger (HandlerFor site) where
    monadLoggerLog :: Loc -> Text -> LogLevel -> msg -> HandlerFor site ()
monadLoggerLog Loc
a Text
b LogLevel
c msg
d = (HandlerData site site -> IO ()) -> HandlerFor site ()
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData site site -> IO ()) -> HandlerFor site ())
-> (HandlerData site site -> IO ()) -> HandlerFor site ()
forall a b. (a -> b) -> a -> b
$ \HandlerData site site
hd ->
        RunHandlerEnv site site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheLog (HandlerData site site -> RunHandlerEnv site site
forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerEnv HandlerData site site
hd) Loc
a Text
b LogLevel
c (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
d)

instance MonadLoggerIO (HandlerFor site) where
    askLoggerIO :: HandlerFor site (Loc -> Text -> LogLevel -> LogStr -> IO ())
askLoggerIO = (HandlerData site site
 -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> HandlerFor site (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall site a. (HandlerData site site -> IO a) -> HandlerFor site a
HandlerFor ((HandlerData site site
  -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
 -> HandlerFor site (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> (HandlerData site site
    -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> HandlerFor site (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall a b. (a -> b) -> a -> b
$ \HandlerData site site
hd -> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> IO (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (RunHandlerEnv site site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheLog (HandlerData site site -> RunHandlerEnv site site
forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerEnv HandlerData site site
hd))

instance Monoid (UniqueList x) where
    mempty :: UniqueList x
mempty = ([x] -> [x]) -> UniqueList x
forall x. ([x] -> [x]) -> UniqueList x
UniqueList [x] -> [x]
forall a. a -> a
id
#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif
instance Semigroup (UniqueList x) where
    UniqueList [x] -> [x]
x <> :: UniqueList x -> UniqueList x -> UniqueList x
<> UniqueList [x] -> [x]
y = ([x] -> [x]) -> UniqueList x
forall x. ([x] -> [x]) -> UniqueList x
UniqueList (([x] -> [x]) -> UniqueList x) -> ([x] -> [x]) -> UniqueList x
forall a b. (a -> b) -> a -> b
$ [x] -> [x]
x ([x] -> [x]) -> ([x] -> [x]) -> [x] -> [x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [x] -> [x]
y

instance IsString Content where
    fromString :: String -> Content
fromString = (Builder -> Maybe Int -> Content)
-> Maybe Int -> Builder -> Content
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> Maybe Int -> Content
ContentBuilder Maybe Int
forall a. Maybe a
Nothing (Builder -> Content) -> (String -> Builder) -> String -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
BB.stringUtf8

instance RenderRoute WaiSubsite where
    data Route WaiSubsite = WaiSubsiteRoute [Text] [(Text, Text)]
        deriving (Int -> Route WaiSubsite -> ShowS
[Route WaiSubsite] -> ShowS
Route WaiSubsite -> String
(Int -> Route WaiSubsite -> ShowS)
-> (Route WaiSubsite -> String)
-> ([Route WaiSubsite] -> ShowS)
-> Show (Route WaiSubsite)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Route WaiSubsite] -> ShowS
$cshowList :: [Route WaiSubsite] -> ShowS
show :: Route WaiSubsite -> String
$cshow :: Route WaiSubsite -> String
showsPrec :: Int -> Route WaiSubsite -> ShowS
$cshowsPrec :: Int -> Route WaiSubsite -> ShowS
Show, Route WaiSubsite -> Route WaiSubsite -> Bool
(Route WaiSubsite -> Route WaiSubsite -> Bool)
-> (Route WaiSubsite -> Route WaiSubsite -> Bool)
-> Eq (Route WaiSubsite)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Route WaiSubsite -> Route WaiSubsite -> Bool
$c/= :: Route WaiSubsite -> Route WaiSubsite -> Bool
== :: Route WaiSubsite -> Route WaiSubsite -> Bool
$c== :: Route WaiSubsite -> Route WaiSubsite -> Bool
Eq, ReadPrec [Route WaiSubsite]
ReadPrec (Route WaiSubsite)
Int -> ReadS (Route WaiSubsite)
ReadS [Route WaiSubsite]
(Int -> ReadS (Route WaiSubsite))
-> ReadS [Route WaiSubsite]
-> ReadPrec (Route WaiSubsite)
-> ReadPrec [Route WaiSubsite]
-> Read (Route WaiSubsite)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Route WaiSubsite]
$creadListPrec :: ReadPrec [Route WaiSubsite]
readPrec :: ReadPrec (Route WaiSubsite)
$creadPrec :: ReadPrec (Route WaiSubsite)
readList :: ReadS [Route WaiSubsite]
$creadList :: ReadS [Route WaiSubsite]
readsPrec :: Int -> ReadS (Route WaiSubsite)
$creadsPrec :: Int -> ReadS (Route WaiSubsite)
Read, Eq (Route WaiSubsite)
Eq (Route WaiSubsite)
-> (Route WaiSubsite -> Route WaiSubsite -> Ordering)
-> (Route WaiSubsite -> Route WaiSubsite -> Bool)
-> (Route WaiSubsite -> Route WaiSubsite -> Bool)
-> (Route WaiSubsite -> Route WaiSubsite -> Bool)
-> (Route WaiSubsite -> Route WaiSubsite -> Bool)
-> (Route WaiSubsite -> Route WaiSubsite -> Route WaiSubsite)
-> (Route WaiSubsite -> Route WaiSubsite -> Route WaiSubsite)
-> Ord (Route WaiSubsite)
Route WaiSubsite -> Route WaiSubsite -> Bool
Route WaiSubsite -> Route WaiSubsite -> Ordering
Route WaiSubsite -> Route WaiSubsite -> Route WaiSubsite
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Route WaiSubsite -> Route WaiSubsite -> Route WaiSubsite
$cmin :: Route WaiSubsite -> Route WaiSubsite -> Route WaiSubsite
max :: Route WaiSubsite -> Route WaiSubsite -> Route WaiSubsite
$cmax :: Route WaiSubsite -> Route WaiSubsite -> Route WaiSubsite
>= :: Route WaiSubsite -> Route WaiSubsite -> Bool
$c>= :: Route WaiSubsite -> Route WaiSubsite -> Bool
> :: Route WaiSubsite -> Route WaiSubsite -> Bool
$c> :: Route WaiSubsite -> Route WaiSubsite -> Bool
<= :: Route WaiSubsite -> Route WaiSubsite -> Bool
$c<= :: Route WaiSubsite -> Route WaiSubsite -> Bool
< :: Route WaiSubsite -> Route WaiSubsite -> Bool
$c< :: Route WaiSubsite -> Route WaiSubsite -> Bool
compare :: Route WaiSubsite -> Route WaiSubsite -> Ordering
$ccompare :: Route WaiSubsite -> Route WaiSubsite -> Ordering
$cp1Ord :: Eq (Route WaiSubsite)
Ord)
    renderRoute :: Route WaiSubsite -> ([Text], [(Text, Text)])
renderRoute (WaiSubsiteRoute ps qs) = ([Text]
ps, [(Text, Text)]
qs)
instance ParseRoute WaiSubsite where
    parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route WaiSubsite)
parseRoute ([Text]
x, [(Text, Text)]
y) = Route WaiSubsite -> Maybe (Route WaiSubsite)
forall a. a -> Maybe a
Just (Route WaiSubsite -> Maybe (Route WaiSubsite))
-> Route WaiSubsite -> Maybe (Route WaiSubsite)
forall a b. (a -> b) -> a -> b
$ [Text] -> [(Text, Text)] -> Route WaiSubsite
WaiSubsiteRoute [Text]
x [(Text, Text)]
y

instance RenderRoute WaiSubsiteWithAuth where
  data Route WaiSubsiteWithAuth = WaiSubsiteWithAuthRoute [Text] [(Text,Text)]
       deriving (Int -> Route WaiSubsiteWithAuth -> ShowS
[Route WaiSubsiteWithAuth] -> ShowS
Route WaiSubsiteWithAuth -> String
(Int -> Route WaiSubsiteWithAuth -> ShowS)
-> (Route WaiSubsiteWithAuth -> String)
-> ([Route WaiSubsiteWithAuth] -> ShowS)
-> Show (Route WaiSubsiteWithAuth)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Route WaiSubsiteWithAuth] -> ShowS
$cshowList :: [Route WaiSubsiteWithAuth] -> ShowS
show :: Route WaiSubsiteWithAuth -> String
$cshow :: Route WaiSubsiteWithAuth -> String
showsPrec :: Int -> Route WaiSubsiteWithAuth -> ShowS
$cshowsPrec :: Int -> Route WaiSubsiteWithAuth -> ShowS
Show, Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
(Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool)
-> (Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool)
-> Eq (Route WaiSubsiteWithAuth)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
$c/= :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
== :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
$c== :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
Eq, ReadPrec [Route WaiSubsiteWithAuth]
ReadPrec (Route WaiSubsiteWithAuth)
Int -> ReadS (Route WaiSubsiteWithAuth)
ReadS [Route WaiSubsiteWithAuth]
(Int -> ReadS (Route WaiSubsiteWithAuth))
-> ReadS [Route WaiSubsiteWithAuth]
-> ReadPrec (Route WaiSubsiteWithAuth)
-> ReadPrec [Route WaiSubsiteWithAuth]
-> Read (Route WaiSubsiteWithAuth)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Route WaiSubsiteWithAuth]
$creadListPrec :: ReadPrec [Route WaiSubsiteWithAuth]
readPrec :: ReadPrec (Route WaiSubsiteWithAuth)
$creadPrec :: ReadPrec (Route WaiSubsiteWithAuth)
readList :: ReadS [Route WaiSubsiteWithAuth]
$creadList :: ReadS [Route WaiSubsiteWithAuth]
readsPrec :: Int -> ReadS (Route WaiSubsiteWithAuth)
$creadsPrec :: Int -> ReadS (Route WaiSubsiteWithAuth)
Read, Eq (Route WaiSubsiteWithAuth)
Eq (Route WaiSubsiteWithAuth)
-> (Route WaiSubsiteWithAuth
    -> Route WaiSubsiteWithAuth -> Ordering)
-> (Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool)
-> (Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool)
-> (Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool)
-> (Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool)
-> (Route WaiSubsiteWithAuth
    -> Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth)
-> (Route WaiSubsiteWithAuth
    -> Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth)
-> Ord (Route WaiSubsiteWithAuth)
Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Ordering
Route WaiSubsiteWithAuth
-> Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Route WaiSubsiteWithAuth
-> Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth
$cmin :: Route WaiSubsiteWithAuth
-> Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth
max :: Route WaiSubsiteWithAuth
-> Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth
$cmax :: Route WaiSubsiteWithAuth
-> Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth
>= :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
$c>= :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
> :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
$c> :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
<= :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
$c<= :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
< :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
$c< :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Bool
compare :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Ordering
$ccompare :: Route WaiSubsiteWithAuth -> Route WaiSubsiteWithAuth -> Ordering
$cp1Ord :: Eq (Route WaiSubsiteWithAuth)
Ord)
  renderRoute :: Route WaiSubsiteWithAuth -> ([Text], [(Text, Text)])
renderRoute (WaiSubsiteWithAuthRoute ps qs) = ([Text]
ps,[(Text, Text)]
qs)

instance ParseRoute WaiSubsiteWithAuth where
  parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route WaiSubsiteWithAuth)
parseRoute ([Text]
x, [(Text, Text)]
y) = Route WaiSubsiteWithAuth -> Maybe (Route WaiSubsiteWithAuth)
forall a. a -> Maybe a
Just (Route WaiSubsiteWithAuth -> Maybe (Route WaiSubsiteWithAuth))
-> Route WaiSubsiteWithAuth -> Maybe (Route WaiSubsiteWithAuth)
forall a b. (a -> b) -> a -> b
$ [Text] -> [(Text, Text)] -> Route WaiSubsiteWithAuth
WaiSubsiteWithAuthRoute [Text]
x [(Text, Text)]
y

data Logger = Logger
    { Logger -> LoggerSet
loggerSet :: !LoggerSet
    , Logger -> DateCacheGetter
loggerDate :: !DateCacheGetter
    }

loggerPutStr :: Logger -> LogStr -> IO ()
loggerPutStr :: Logger -> LogStr -> IO ()
loggerPutStr (Logger LoggerSet
ls DateCacheGetter
_) = LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
ls

-- | A handler monad for subsite
--
-- @since 1.6.0
newtype SubHandlerFor sub master a = SubHandlerFor
    { SubHandlerFor sub master a -> HandlerData sub master -> IO a
unSubHandlerFor :: HandlerData sub master -> IO a
    }
    deriving a -> SubHandlerFor sub master b -> SubHandlerFor sub master a
(a -> b)
-> SubHandlerFor sub master a -> SubHandlerFor sub master b
(forall a b.
 (a -> b)
 -> SubHandlerFor sub master a -> SubHandlerFor sub master b)
-> (forall a b.
    a -> SubHandlerFor sub master b -> SubHandlerFor sub master a)
-> Functor (SubHandlerFor sub master)
forall a b.
a -> SubHandlerFor sub master b -> SubHandlerFor sub master a
forall a b.
(a -> b)
-> SubHandlerFor sub master a -> SubHandlerFor sub master b
forall sub master a b.
a -> SubHandlerFor sub master b -> SubHandlerFor sub master a
forall sub master a b.
(a -> b)
-> SubHandlerFor sub master a -> SubHandlerFor sub master b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SubHandlerFor sub master b -> SubHandlerFor sub master a
$c<$ :: forall sub master a b.
a -> SubHandlerFor sub master b -> SubHandlerFor sub master a
fmap :: (a -> b)
-> SubHandlerFor sub master a -> SubHandlerFor sub master b
$cfmap :: forall sub master a b.
(a -> b)
-> SubHandlerFor sub master a -> SubHandlerFor sub master b
Functor

instance Applicative (SubHandlerFor child master) where
    pure :: a -> SubHandlerFor child master a
pure = (HandlerData child master -> IO a) -> SubHandlerFor child master a
forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor ((HandlerData child master -> IO a)
 -> SubHandlerFor child master a)
-> (a -> HandlerData child master -> IO a)
-> a
-> SubHandlerFor child master a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> HandlerData child master -> IO a
forall a b. a -> b -> a
const (IO a -> HandlerData child master -> IO a)
-> (a -> IO a) -> a -> HandlerData child master -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: SubHandlerFor child master (a -> b)
-> SubHandlerFor child master a -> SubHandlerFor child master b
(<*>) = SubHandlerFor child master (a -> b)
-> SubHandlerFor child master a -> SubHandlerFor child master b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (SubHandlerFor child master) where
    return :: a -> SubHandlerFor child master a
return = a -> SubHandlerFor child master a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    SubHandlerFor HandlerData child master -> IO a
x >>= :: SubHandlerFor child master a
-> (a -> SubHandlerFor child master b)
-> SubHandlerFor child master b
>>= a -> SubHandlerFor child master b
f = (HandlerData child master -> IO b) -> SubHandlerFor child master b
forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor ((HandlerData child master -> IO b)
 -> SubHandlerFor child master b)
-> (HandlerData child master -> IO b)
-> SubHandlerFor child master b
forall a b. (a -> b) -> a -> b
$ \HandlerData child master
r -> HandlerData child master -> IO a
x HandlerData child master
r IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x' -> SubHandlerFor child master b -> HandlerData child master -> IO b
forall sub master a.
SubHandlerFor sub master a -> HandlerData sub master -> IO a
unSubHandlerFor (a -> SubHandlerFor child master b
f a
x') HandlerData child master
r
instance MonadIO (SubHandlerFor child master) where
    liftIO :: IO a -> SubHandlerFor child master a
liftIO = (HandlerData child master -> IO a) -> SubHandlerFor child master a
forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor ((HandlerData child master -> IO a)
 -> SubHandlerFor child master a)
-> (IO a -> HandlerData child master -> IO a)
-> IO a
-> SubHandlerFor child master a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> HandlerData child master -> IO a
forall a b. a -> b -> a
const
instance MonadReader (HandlerData child master) (SubHandlerFor child master) where
    ask :: SubHandlerFor child master (HandlerData child master)
ask = (HandlerData child master -> IO (HandlerData child master))
-> SubHandlerFor child master (HandlerData child master)
forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor HandlerData child master -> IO (HandlerData child master)
forall (m :: * -> *) a. Monad m => a -> m a
return
    local :: (HandlerData child master -> HandlerData child master)
-> SubHandlerFor child master a -> SubHandlerFor child master a
local HandlerData child master -> HandlerData child master
f (SubHandlerFor HandlerData child master -> IO a
g) = (HandlerData child master -> IO a) -> SubHandlerFor child master a
forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor ((HandlerData child master -> IO a)
 -> SubHandlerFor child master a)
-> (HandlerData child master -> IO a)
-> SubHandlerFor child master a
forall a b. (a -> b) -> a -> b
$ HandlerData child master -> IO a
g (HandlerData child master -> IO a)
-> (HandlerData child master -> HandlerData child master)
-> HandlerData child master
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData child master -> HandlerData child master
f

-- | @since 1.4.38
instance MonadUnliftIO (SubHandlerFor child master) where
  {-# INLINE withRunInIO #-}
  withRunInIO :: ((forall a. SubHandlerFor child master a -> IO a) -> IO b)
-> SubHandlerFor child master b
withRunInIO (forall a. SubHandlerFor child master a -> IO a) -> IO b
inner = (HandlerData child master -> IO b) -> SubHandlerFor child master b
forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor ((HandlerData child master -> IO b)
 -> SubHandlerFor child master b)
-> (HandlerData child master -> IO b)
-> SubHandlerFor child master b
forall a b. (a -> b) -> a -> b
$ \HandlerData child master
x -> (forall a. SubHandlerFor child master a -> IO a) -> IO b
inner ((forall a. SubHandlerFor child master a -> IO a) -> IO b)
-> (forall a. SubHandlerFor child master a -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ (SubHandlerFor child master a -> HandlerData child master -> IO a)
-> HandlerData child master -> SubHandlerFor child master a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip SubHandlerFor child master a -> HandlerData child master -> IO a
forall sub master a.
SubHandlerFor sub master a -> HandlerData sub master -> IO a
unSubHandlerFor HandlerData child master
x

instance MonadThrow (SubHandlerFor child master) where
    throwM :: e -> SubHandlerFor child master a
throwM = IO a -> SubHandlerFor child master a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> SubHandlerFor child master a)
-> (e -> IO a) -> e -> SubHandlerFor child master a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadResource (SubHandlerFor child master) where
    liftResourceT :: ResourceT IO a -> SubHandlerFor child master a
liftResourceT ResourceT IO a
f = (HandlerData child master -> IO a) -> SubHandlerFor child master a
forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor ((HandlerData child master -> IO a)
 -> SubHandlerFor child master a)
-> (HandlerData child master -> IO a)
-> SubHandlerFor child master a
forall a b. (a -> b) -> a -> b
$ ResourceT IO a -> InternalState -> IO a
forall (m :: * -> *) a. ResourceT m a -> InternalState -> m a
runInternalState ResourceT IO a
f (InternalState -> IO a)
-> (HandlerData child master -> InternalState)
-> HandlerData child master
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData child master -> InternalState
forall child site. HandlerData child site -> InternalState
handlerResource

instance MonadLogger (SubHandlerFor child master) where
    monadLoggerLog :: Loc -> Text -> LogLevel -> msg -> SubHandlerFor child master ()
monadLoggerLog Loc
a Text
b LogLevel
c msg
d = (HandlerData child master -> IO ())
-> SubHandlerFor child master ()
forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor ((HandlerData child master -> IO ())
 -> SubHandlerFor child master ())
-> (HandlerData child master -> IO ())
-> SubHandlerFor child master ()
forall a b. (a -> b) -> a -> b
$ \HandlerData child master
sd ->
        RunHandlerEnv child master
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheLog (HandlerData child master -> RunHandlerEnv child master
forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerEnv HandlerData child master
sd) Loc
a Text
b LogLevel
c (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
d)

instance MonadLoggerIO (SubHandlerFor child master) where
    askLoggerIO :: SubHandlerFor
  child master (Loc -> Text -> LogLevel -> LogStr -> IO ())
askLoggerIO = (HandlerData child master
 -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> SubHandlerFor
     child master (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor ((HandlerData child master
  -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
 -> SubHandlerFor
      child master (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> (HandlerData child master
    -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> SubHandlerFor
     child master (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall a b. (a -> b) -> a -> b
$ (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> IO (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Loc -> Text -> LogLevel -> LogStr -> IO ())
 -> IO (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> (HandlerData child master
    -> Loc -> Text -> LogLevel -> LogStr -> IO ())
-> HandlerData child master
-> IO (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunHandlerEnv child master
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheLog (RunHandlerEnv child master
 -> Loc -> Text -> LogLevel -> LogStr -> IO ())
-> (HandlerData child master -> RunHandlerEnv child master)
-> HandlerData child master
-> Loc
-> Text
-> LogLevel
-> LogStr
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerData child master -> RunHandlerEnv child master
forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerEnv