{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
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 (..), SomeException)

-- 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
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]
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 Method
a Method
b SessionMap
c) = do
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either UTCTime -> Put
putTime Putter Method
putByteString Either UTCTime Method
a
        forall t. Serialize t => Putter t
put Method
b
        forall t. Serialize t => Putter t
put (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> String
T.unpack) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList SessionMap
c)

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

data ClientSessionDateCache =
  ClientSessionDateCache {
    ClientSessionDateCache -> UTCTime
csdcNow               :: !UTCTime
  , ClientSessionDateCache -> UTCTime
csdcExpires           :: !UTCTime
  , ClientSessionDateCache -> Method
csdcExpiresSerialized :: !ByteString
  } deriving (ClientSessionDateCache -> ClientSessionDateCache -> Bool
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
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 -> [Method]
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 () Method (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
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
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]
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
    { forall child site.
RunHandlerEnv child site -> Route site -> [(Text, Text)] -> Text
rheRender   :: !(Route site -> [(Text, Text)] -> Text)
    , forall child site. RunHandlerEnv child site -> Maybe (Route child)
rheRoute    :: !(Maybe (Route child))
    , forall child site.
RunHandlerEnv child site -> Route child -> Route site
rheRouteToMaster :: !(Route child -> Route site)
    , forall child site. RunHandlerEnv child site -> site
rheSite     :: !site
    , forall child site. RunHandlerEnv child site -> child
rheChild    :: !child
    , forall child site.
RunHandlerEnv child site -> RequestBodyLength -> FileUpload
rheUpload   :: !(RequestBodyLength -> FileUpload)
    , forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheLog      :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ())
    , forall child site.
RunHandlerEnv child site -> ErrorResponse -> YesodApp
rheOnError  :: !(ErrorResponse -> YesodApp)
      -- ^ How to respond when an error is thrown internally.
      --
      -- Since 1.2.0
    , forall child site. RunHandlerEnv child site -> Text
rheMaxExpires :: !Text

      -- | @since 1.6.24.0
      --   catch function for rendering 500 pages on exceptions.
      --   by default this is catch from unliftio (rethrows all async exceptions).
    , forall child site.
RunHandlerEnv child site
-> forall a (m :: * -> *).
   MonadUnliftIO m =>
   m a -> (SomeException -> m a) -> m a
rheCatchHandlerExceptions :: !(forall a m . MonadUnliftIO m =>  m a -> (SomeException -> m a) -> m a)
    }

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

data YesodRunnerEnv site = YesodRunnerEnv
    { forall site. YesodRunnerEnv site -> Logger
yreLogger         :: !Logger
    , forall site. YesodRunnerEnv site -> site
yreSite           :: !site
    , forall site. YesodRunnerEnv site -> Maybe SessionBackend
yreSessionBackend :: !(Maybe SessionBackend)
    , forall site. 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'.
    , forall site. YesodRunnerEnv site -> IO Text
yreGetMaxExpires  :: !(IO Text)
    }

data YesodSubRunnerEnv sub parent = YesodSubRunnerEnv
    { forall sub parent.
YesodSubRunnerEnv sub parent -> ParentRunner parent
ysreParentRunner  :: !(ParentRunner parent)
    , forall sub parent. YesodSubRunnerEnv sub parent -> parent -> sub
ysreGetSub        :: !(parent -> sub)
    , forall sub parent.
YesodSubRunnerEnv sub parent -> Route sub -> Route parent
ysreToParentRoute :: !(Route sub -> Route parent)
    , forall sub 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
    { forall site a. HandlerFor site a -> HandlerData site site -> IO a
unHandlerFor :: HandlerData site site -> IO a
    }
    deriving 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
<$ :: forall a b. a -> HandlerFor site b -> HandlerFor site a
$c<$ :: forall site a b. a -> HandlerFor site b -> HandlerFor site a
fmap :: forall a b. (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
    { forall site a. WidgetFor site a -> WidgetData site -> IO a
unWidgetFor :: WidgetData site -> IO a
    }
    deriving 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
<$ :: forall a b. a -> WidgetFor site b -> WidgetFor site a
$c<$ :: forall site a b. a -> WidgetFor site b -> WidgetFor site a
fmap :: forall a b. (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
  { forall site. WidgetData site -> IORef (GWData (Route site))
wdRef :: {-# UNPACK #-} !(IORef (GWData (Route site)))
  , forall site. WidgetData site -> HandlerData site site
wdHandler :: {-# UNPACK #-} !(HandlerData site site)
  }

instance a ~ () => Monoid (WidgetFor site a) where
    mempty :: WidgetFor site a
mempty = 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 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 = forall {site}. Html -> WidgetFor site ()
toWidget forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMarkup a => a -> Html
toHtml forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      where toWidget :: Html -> WidgetFor site ()
toWidget Html
x = forall site. GWData (Route site) -> WidgetFor site ()
tellWidget forall a. Monoid a => a
mempty { gwdBody :: Body (Route site)
gwdBody = forall url. HtmlUrl url -> Body url
Body (forall a b. a -> b -> a
const Html
x) }

tellWidget :: GWData (Route site) -> WidgetFor site ()
tellWidget :: forall site. GWData (Route site) -> WidgetFor site ()
tellWidget GWData (Route site)
d = forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor forall a b. (a -> b) -> a -> b
$ \WidgetData site
wd -> forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (forall site. WidgetData site -> IORef (GWData (Route site))
wdRef WidgetData site
wd) (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
    { forall url. PageContent url -> Html
pageTitle       :: !Html
    , forall url. PageContent url -> Maybe Text
pageDescription :: !(Maybe Text)
    , forall url. PageContent url -> HtmlUrl url
pageHead        :: !(HtmlUrl url)
    , forall 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 { forall a. 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
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
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. 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
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
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) = forall a. NFData a => a -> ()
rnf SetCookie
x
    rnf (DeleteCookie Method
x Method
y) = Method
x seq :: forall a b. a -> b -> b
`seq` Method
y seq :: forall a b. a -> b -> b
`seq` ()
    rnf (Header CI Method
x Method
y) = CI Method
x seq :: forall a b. a -> b -> b
`seq` Method
y seq :: forall a b. a -> b -> b
`seq` ()

data Location url = Local !url | Remote !Text
    deriving (Int -> Location url -> ShowS
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
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 { forall url. Script url -> Location url
scriptLocation :: !(Location url), forall url. Script url -> [(Text, Text)]
scriptAttributes :: ![(Text, Text)] }
    deriving (Int -> Script url -> ShowS
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
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 { forall url. Stylesheet url -> Location url
styleLocation :: !(Location url), forall url. Stylesheet url -> [(Text, Text)]
styleAttributes :: ![(Text, Text)] }
    deriving (Int -> Stylesheet url -> ShowS
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
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 Description = Description { Description -> Text
unDescription :: Text }

newtype Head url = Head (HtmlUrl url)
    deriving 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
Monoid
instance Semigroup (Head url) where
  <> :: Head url -> Head url -> Head url
(<>) = forall a. Monoid a => a -> a -> a
mappend
newtype Body url = Body (HtmlUrl url)
    deriving 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
Monoid
instance Semigroup (Body url) where
  <> :: 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
    { forall a. GWData a -> Body a
gwdBody        :: !(Body a)
    , forall a. GWData a -> Last Title
gwdTitle       :: !(Last Title)
    , forall a. GWData a -> Last Description
gwdDescription :: !(Last Description)
    , forall a. GWData a -> UniqueList (Script a)
gwdScripts     :: !(UniqueList (Script a))
    , forall a. GWData a -> UniqueList (Stylesheet a)
gwdStylesheets :: !(UniqueList (Stylesheet a))
    , forall a. GWData a -> Map (Maybe Text) (CssBuilderUrl a)
gwdCss         :: !(Map (Maybe Text) (CssBuilderUrl a)) -- media type
    , forall a. GWData a -> Maybe (JavascriptUrl a)
gwdJavascript  :: !(Maybe (JavascriptUrl a))
    , forall a. GWData a -> Head a
gwdHead        :: !(Head a)
    }
instance Monoid (GWData a) where
    mempty :: GWData a
mempty = forall a.
Body a
-> Last Title
-> Last Description
-> UniqueList (Script a)
-> UniqueList (Stylesheet a)
-> Map (Maybe Text) (CssBuilderUrl a)
-> Maybe (JavascriptUrl a)
-> Head a
-> GWData a
GWData forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty 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 Last Description
a3 UniqueList (Script a)
a4 UniqueList (Stylesheet a)
a5 Map (Maybe Text) (CssBuilderUrl a)
a6 Maybe (JavascriptUrl a)
a7 Head a
a8 <> :: GWData a -> GWData a -> GWData a
<>
      GWData Body a
b1 Last Title
b2 Last Description
b3 UniqueList (Script a)
b4 UniqueList (Stylesheet a)
b5 Map (Maybe Text) (CssBuilderUrl a)
b6 Maybe (JavascriptUrl a)
b7 Head a
b8 = forall a.
Body a
-> Last Title
-> Last Description
-> UniqueList (Script a)
-> UniqueList (Stylesheet a)
-> Map (Maybe Text) (CssBuilderUrl a)
-> Maybe (JavascriptUrl a)
-> Head a
-> GWData a
GWData
        (forall a. Monoid a => a -> a -> a
mappend Body a
a1 Body a
b1)
        (forall a. Monoid a => a -> a -> a
mappend Last Title
a2 Last Title
b2)
        (forall a. Monoid a => a -> a -> a
mappend Last Description
a3 Last Description
b3)
        (forall a. Monoid a => a -> a -> a
mappend UniqueList (Script a)
a4 UniqueList (Script a)
b4)
        (forall a. Monoid a => a -> a -> a
mappend UniqueList (Stylesheet a)
a5 UniqueList (Stylesheet a)
b5)
        (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith forall a. Monoid a => a -> a -> a
mappend Map (Maybe Text) (CssBuilderUrl a)
a6 Map (Maybe Text) (CssBuilderUrl a)
b6)
        (forall a. Monoid a => a -> a -> a
mappend Maybe (JavascriptUrl a)
a7 Maybe (JavascriptUrl a)
b7)
        (forall a. Monoid a => a -> a -> a
mappend Head a
a8 Head a
b8)

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 Method
t Content
_)) = String
"HCContent " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Status
status, Method
t)
    show (HCError ErrorResponse
e) = String
"HCError " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ErrorResponse
e
    show (HCSendFile Method
ct String
fp Maybe FilePart
mfp) = String
"HCSendFile " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Method
ct, String
fp, Maybe FilePart
mfp)
    show (HCRedirect Status
s Text
t) = String
"HCRedirect " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Status
s, Text
t)
    show (HCCreated Text
t) = String
"HCCreated " forall a. [a] -> [a] -> [a]
++ 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 :: forall a. a -> WidgetFor site a
pure = forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    <*> :: forall a 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 :: forall a. a -> WidgetFor site a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    WidgetFor WidgetData site -> IO a
x >>= :: forall a b.
WidgetFor site a -> (a -> WidgetFor site b) -> WidgetFor site b
>>= a -> WidgetFor site b
f = forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor forall a b. (a -> b) -> a -> b
$ \WidgetData site
wd -> do
        a
a <- WidgetData site -> IO a
x WidgetData site
wd
        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 :: forall a. IO a -> WidgetFor site a
liftIO = forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
-- | @since 1.6.7
instance PrimMonad (WidgetFor site) where
    type PrimState (WidgetFor site) = PrimState IO
    primitive :: forall a.
(State# (PrimState (WidgetFor site))
 -> (# State# (PrimState (WidgetFor site)), a #))
-> WidgetFor site a
primitive = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 b.
((forall a. WidgetFor site a -> IO a) -> IO b) -> WidgetFor site b
withRunInIO (forall a. WidgetFor site a -> IO a) -> IO b
inner = forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor forall a b. (a -> b) -> a -> b
$ \WidgetData site
x -> (forall a. WidgetFor site a -> IO a) -> IO b
inner forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor forall (m :: * -> *) a. Monad m => a -> m a
return
    local :: forall a.
(WidgetData site -> WidgetData site)
-> WidgetFor site a -> WidgetFor site a
local WidgetData site -> WidgetData site
f (WidgetFor WidgetData site -> IO a
g) = forall site a. (WidgetData site -> IO a) -> WidgetFor site a
WidgetFor forall a b. (a -> b) -> a -> b
$ WidgetData site -> IO a
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. WidgetData site -> WidgetData site
f

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

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

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

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

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

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

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

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

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

instance Monoid (UniqueList x) where
    mempty :: UniqueList x
mempty = forall x. ([x] -> [x]) -> UniqueList x
UniqueList 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 = forall x. ([x] -> [x]) -> UniqueList x
UniqueList forall a b. (a -> b) -> a -> b
$ [x] -> [x]
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. [x] -> [x]
y

instance IsString Content where
    fromString :: String -> Content
fromString = forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> Maybe Int -> Content
ContentBuilder forall a. Maybe a
Nothing 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
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
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]
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)
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
Ord)
    renderRoute :: Route WaiSubsite -> ([Text], [(Text, Text)])
renderRoute (WaiSubsiteRoute [Text]
ps [(Text, Text)]
qs) = ([Text]
ps, [(Text, Text)]
qs)
instance ParseRoute WaiSubsite where
    parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route WaiSubsite)
parseRoute ([Text]
x, [(Text, Text)]
y) = forall a. a -> Maybe a
Just 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
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
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]
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)
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
Ord)
  renderRoute :: Route WaiSubsiteWithAuth -> ([Text], [(Text, Text)])
renderRoute (WaiSubsiteWithAuthRoute [Text]
ps [(Text, Text)]
qs) = ([Text]
ps,[(Text, Text)]
qs)

instance ParseRoute WaiSubsiteWithAuth where
  parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route WaiSubsiteWithAuth)
parseRoute ([Text]
x, [(Text, Text)]
y) = forall a. a -> Maybe a
Just 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
    { forall sub master a.
SubHandlerFor sub master a -> HandlerData sub master -> IO a
unSubHandlerFor :: HandlerData sub master -> IO a
    }
    deriving 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
<$ :: forall a b.
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 :: forall a b.
(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 :: forall a. a -> SubHandlerFor child master a
pure = forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: forall a 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 :: forall a. a -> SubHandlerFor child master a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    SubHandlerFor HandlerData child master -> IO a
x >>= :: forall a b.
SubHandlerFor child master a
-> (a -> SubHandlerFor child master b)
-> SubHandlerFor child master b
>>= a -> SubHandlerFor child master b
f = forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor forall a b. (a -> b) -> a -> b
$ \HandlerData child master
r -> HandlerData child master -> IO a
x HandlerData child master
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x' -> 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 :: forall a. IO a -> SubHandlerFor child master a
liftIO = forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
instance MonadReader (HandlerData child master) (SubHandlerFor child master) where
    ask :: SubHandlerFor child master (HandlerData child master)
ask = forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor forall (m :: * -> *) a. Monad m => a -> m a
return
    local :: forall a.
(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) = forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor forall a b. (a -> b) -> a -> b
$ HandlerData child master -> IO a
g 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 b.
((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 = forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor forall a b. (a -> b) -> a -> b
$ \HandlerData child master
x -> (forall a. SubHandlerFor child master a -> IO a) -> IO b
inner forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 :: forall e a. Exception e => e -> SubHandlerFor child master a
throwM = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

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

instance MonadLogger (SubHandlerFor child master) where
    monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> SubHandlerFor child master ()
monadLoggerLog Loc
a Text
b LogLevel
c msg
d = forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor forall a b. (a -> b) -> a -> b
$ \HandlerData child master
sd ->
        forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheLog (forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerEnv HandlerData child master
sd) Loc
a Text
b LogLevel
c (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 = forall sub master a.
(HandlerData sub master -> IO a) -> SubHandlerFor sub master a
SubHandlerFor forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall child site.
RunHandlerEnv child site
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
rheLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall child site.
HandlerData child site -> RunHandlerEnv child site
handlerEnv