WIP Move over to RIO (CC @chrisdone)

2018-01-17 13:34:12 +02:00
7 changed files with 320 additions and 546 deletions
--- a/yesod-core/Yesod/Core/Class/Handler.hs
+++ b/yesod-core/Yesod/Core/Class/Handler.hs
@ -1,99 +0,0 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableInstances #-}
 module Yesod.Core.Class.Handler
    ( MonadHandler (..)
    , MonadWidget (..)
    , liftHandlerT
    , liftWidgetT
    ) where
 import Yesod.Core.Types
 import Control.Monad.Logger (MonadLogger)
 import Control.Monad.Trans.Resource (MonadResource)
 import Control.Monad.Trans.Class (lift)
 #if __GLASGOW_HASKELL__ < 710
 import Data.Monoid (Monoid)
 #endif
 import Data.Conduit.Internal (Pipe, ConduitM)
 import Control.Monad.Trans.Identity ( IdentityT)
 import Control.Monad.Trans.List     ( ListT    )
 import Control.Monad.Trans.Maybe    ( MaybeT   )
 import Control.Monad.Trans.Except   ( ExceptT  )
 import Control.Monad.Trans.Reader   ( ReaderT  )
 import Control.Monad.Trans.State    ( StateT   )
 import Control.Monad.Trans.Writer   ( WriterT  )
 import Control.Monad.Trans.RWS      ( RWST     )
 import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST   )
 import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT )
 import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
 -- FIXME should we just use MonadReader instances instead?
 class (MonadResource m, MonadLogger m) => MonadHandler m where
    type HandlerSite m
    liftHandler :: HandlerFor (HandlerSite m) a -> m a
 liftHandlerT :: MonadHandler m => HandlerFor (HandlerSite m) a -> m a
 liftHandlerT = liftHandler
 {-# DEPRECATED liftHandlerT "Use liftHandler instead" #-}
 instance MonadHandler (HandlerFor site) where
    type HandlerSite (HandlerFor site) = site
    liftHandler = id
    {-# INLINE liftHandler #-}
 instance MonadHandler (WidgetFor site) where
    type HandlerSite (WidgetFor site) = site
    liftHandler (HandlerFor f) = WidgetFor $ f . wdHandler
    {-# INLINE liftHandler #-}
 #define GO(T) instance MonadHandler m => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandler = lift . liftHandler
 #define GOX(X, T) instance (X, MonadHandler m) => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandler = lift . liftHandler
 GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
 GO(ExceptT e)
 GO(ReaderT r)
 GO(StateT s)
 GOX(Monoid w, WriterT w)
 GOX(Monoid w, RWST r w s)
 GOX(Monoid w, Strict.RWST r w s)
 GO(Strict.StateT s)
 GOX(Monoid w, Strict.WriterT w)
 GO(Pipe l i o u)
 GO(ConduitM i o)
 #undef GO
 #undef GOX
 class MonadHandler m => MonadWidget m where
    liftWidget :: WidgetFor (HandlerSite m) a -> m a
 instance MonadWidget (WidgetFor site) where
    liftWidget = id
    {-# INLINE liftWidget #-}
 liftWidgetT :: MonadWidget m => WidgetFor (HandlerSite m) a -> m a
 liftWidgetT = liftWidget
 {-# DEPRECATED liftWidgetT "Use liftWidget instead" #-}
 #define GO(T) instance MonadWidget m => MonadWidget (T m) where liftWidget = lift . liftWidget
 #define GOX(X, T) instance (X, MonadWidget m) => MonadWidget (T m) where liftWidget = lift . liftWidget
 GO(IdentityT)
 GO(ListT)
 GO(MaybeT)
 GO(ExceptT e)
 GO(ReaderT r)
 GO(StateT s)
 GOX(Monoid w, WriterT w)
 GOX(Monoid w, RWST r w s)
 GOX(Monoid w, Strict.RWST r w s)
 GO(Strict.StateT s)
 GOX(Monoid w, Strict.WriterT w)
 GO(Pipe l i o u)
 GO(ConduitM i o)
 #undef GO
 #undef GOX
--- a/yesod-core/Yesod/Core/Class/Yesod.hs
+++ b/yesod-core/Yesod/Core/Class/Yesod.hs
@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE GADTs             #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE TemplateHaskell   #-}
@ -13,14 +14,8 @@ import           Yesod.Routes.Class
 import           Data.ByteString.Builder            (Builder)
 import           Data.Text.Encoding                 (encodeUtf8Builder)
 import           Control.Arrow                      ((***), second)
 import           Control.Exception                  (bracket)
 #if __GLASGOW_HASKELL__ < 710
 import           Control.Applicative                ((<$>))
 #endif
 import           Control.Monad                      (forM, when, void)
 import           Control.Monad.IO.Class             (MonadIO (liftIO))
 import           Control.Monad.Logger               (LogLevel (LevelInfo, LevelOther),
                                                     LogSource, logErrorS)
 import           Control.Monad.Trans.Resource       (InternalState, createInternalState, closeInternalState)
 import qualified Data.ByteString.Char8              as S8
 import qualified Data.ByteString.Lazy               as L
@ -35,13 +30,10 @@ import qualified Data.Text.Encoding.Error           as TEE
 import           Data.Text.Lazy.Builder             (toLazyText)
 import           Data.Text.Lazy.Encoding            (encodeUtf8)
 import           Data.Word                          (Word64)
 import           Language.Haskell.TH.Syntax         (Loc (..))
 import           Network.HTTP.Types                 (encodePath)
 import qualified Network.Wai                        as W
 import           Network.Wai.Parse                  (lbsBackEnd,
                                                     tempFileBackEnd)
 import           Network.Wai.Logger                 (ZonedDate, clockDateCacher)
 import           System.Log.FastLogger
 import           Text.Blaze                         (customAttribute, textTag,
                                                     toValue, (!),
                                                     preEscapedToMarkup)
@ -56,7 +48,7 @@ import           Yesod.Core.Internal.Session
 import           Yesod.Core.Widget
 import Data.CaseInsensitive (CI)
 import qualified Network.Wai.Request
-import Data.IORef
+import RIO hiding (encodeUtf8)
 -- | Define settings for a Yesod applications. All methods have intelligent
 -- defaults, and therefore no implementation is required.
@ -80,7 +72,7 @@ class RenderRoute site => Yesod site where
    errorHandler = defaultErrorHandler
    -- | Applies some form of layout to the contents of a page.
-    defaultLayout :: WidgetFor site () -> HandlerFor site Html
+    defaultLayout :: (HasHandler env, HandlerSite env ~ site) => WidgetFor site () -> RIO env Html
    defaultLayout w = do
        p <- widgetToPageContent w
        msgs <- getMessages
@ -116,9 +108,10 @@ class RenderRoute site => Yesod site where
    -- Return 'Authorized' if the request is authorized,
    -- 'Unauthorized' a message if unauthorized.
    -- If authentication is required, return 'AuthenticationRequired'.
-    isAuthorized :: Route site
+    isAuthorized :: (HasHandler env, HandlerSite env ~ site)
                 => Route site
                 -> Bool -- ^ is this a write request?
-                 -> HandlerFor site AuthResult
+                 -> RIO env AuthResult
    isAuthorized _ _ = return Authorized
    -- | Determines whether the current request is a write request. By default,
@ -128,7 +121,7 @@ class RenderRoute site => Yesod site where
    --
    -- This function is used to determine if a request is authorized; see
    -- 'isAuthorized'.
-    isWriteRequest :: Route site -> HandlerFor site Bool
+    isWriteRequest :: (HasHandler env, HandlerSite env ~ site) => Route site -> RIO env Bool
    isWriteRequest _ = do
        wai <- waiRequest
        return $ W.requestMethod wai `notElem`
@ -191,10 +184,11 @@ class RenderRoute site => Yesod site where
    -- file, whereas a 'Just' 'Right' gives the type-safe URL. The former is
    -- necessary when you are serving the content outside the context of a
    -- Yesod application, such as via memcached.
-    addStaticContent :: Text -- ^ filename extension
+    addStaticContent :: (HasHandler env, HandlerSite env ~ site)
                     => Text -- ^ filename extension
                     -> Text -- ^ mime-type
                     -> L.ByteString -- ^ content
-                     -> HandlerFor site (Maybe (Either Text (Route site, [(Text, Text)])))
+                     -> RIO env (Maybe (Either Text (Route site, [(Text, Text)])))
    addStaticContent _ _ _ = return Nothing
    -- | Maximum allowed length of the request body, in bytes.
@ -205,29 +199,12 @@ class RenderRoute site => Yesod site where
    maximumContentLength :: site -> Maybe (Route site) -> Maybe Word64
    maximumContentLength _ _ = Just $ 2 * 1024 * 1024 -- 2 megabytes
-    -- | Creates a @Logger@ to use for log messages.
+    -- | Create a logging function.
    --
-    -- Note that a common technique (endorsed by the scaffolding) is to create
+    -- Default: the 'defaultMakeLogFunc" function, using
    -- a @Logger@ value and place it in your foundation datatype, and have this
    -- method return that already created value. That way, you can use that
    -- same @Logger@ for printing messages during app initialization.
    --
    -- Default: the 'defaultMakeLogger' function.
    makeLogger :: site -> IO Logger
    makeLogger _ = defaultMakeLogger
    -- | Send a message to the @Logger@ provided by @getLogger@.
    --
    -- Default: the 'defaultMessageLoggerSource' function, using
    -- 'shouldLogIO' to check whether we should log.
-    messageLoggerSource :: site
+    makeLogFunc :: site -> IO LogFunc
-                        -> Logger
+    makeLogFunc = defaultMakeLogFunc . shouldLogIO
                        -> Loc -- ^ position in source code
                        -> LogSource
                        -> LogLevel
                        -> LogStr -- ^ message
                        -> IO ()
    messageLoggerSource site = defaultMessageLoggerSource $ shouldLogIO site
    -- | Where to Load sripts from. We recommend the default value,
    -- 'BottomOfBody'.
@ -302,36 +279,23 @@ class RenderRoute site => Yesod site where
                ^{body}
            |]
-- | Default implementation of 'makeLogger'. Sends to stdout and
+-- | Default implementation of 'makeLogFunc'. Checks if the
 -- automatically flushes on each write.
 --
 -- Since 1.4.10
 defaultMakeLogger :: IO Logger
 defaultMakeLogger = do
    loggerSet' <- newStdoutLoggerSet defaultBufSize
    (getter, _) <- clockDateCacher
    return $! Logger loggerSet' getter
 -- | Default implementation of 'messageLoggerSource'. Checks if the
 -- message should be logged using the provided function, and if so,
 -- formats using 'formatLogMessage'. You can use 'defaultShouldLogIO'
 -- as the provided function.
 --
 -- Since 1.4.10
-defaultMessageLoggerSource ::
+defaultMakeLogFunc
-       (LogSource -> LogLevel -> IO Bool) -- ^ Check whether we should
+    :: (LogSource -> LogLevel -> IO Bool) -- ^ Check whether we should
                                          -- log this
-    -> Logger
+    -> IO LogFunc
-    -> Loc -- ^ position in source code
+defaultMakeLogFunc ckLoggable = do
-    -> LogSource
+  getZonedDate <- makeZonedDateGetter
-    -> LogLevel
+  return $ \loc source level msg -> do
    -> LogStr -- ^ message
    -> IO ()
 defaultMessageLoggerSource ckLoggable logger loc source level msg = do
    loggable <- ckLoggable source level
-    when loggable $
+    when loggable $ do
-        formatLogMessage (loggerDate logger) loc source level msg >>=
+      zonedDate <- getZonedDate
-        loggerPutStr logger
+      hPutBuilder stdout $ getUtf8Builder $ formatLogMessage zonedDate loc source level msg
 -- | Default implementation of 'shouldLog'. Logs everything at or
 -- above 'LevelInfo'.
@ -406,10 +370,10 @@ sameSiteSession s = (fmap . fmap) secureSessionCookies
 sslOnlyMiddleware :: Int -- ^ minutes
                  -> HandlerFor site res
                  -> HandlerFor site res
-sslOnlyMiddleware timeout handler = do
+sslOnlyMiddleware timeout' handler = do
    addHeader "Strict-Transport-Security"
              $ T.pack $ concat [ "max-age="
-                                , show $ timeout * 60
+                                , show $ timeout' * 60
                                , "; includeSubDomains"
                                ]
    handler
@ -505,22 +469,23 @@ defaultCsrfMiddleware :: Yesod site => HandlerFor site res -> HandlerFor site re
 defaultCsrfMiddleware = defaultCsrfSetCookieMiddleware . defaultCsrfCheckMiddleware
 -- | Convert a widget to a 'PageContent'.
-widgetToPageContent :: Yesod site
+widgetToPageContent
-                    => WidgetFor site ()
+  :: (HasHandler env, Yesod (HandlerSite env))
-                    -> HandlerFor site (PageContent (Route site))
+  => WidgetFor (HandlerSite env) ()
-widgetToPageContent w = HandlerFor $ \hd -> do
+  -> RIO env (PageContent (Route (HandlerSite env)))
-  master <- unHandlerFor getYesod hd
+widgetToPageContent w = do
-  ref <- newIORef mempty
+    master <- getYesod
-  unWidgetFor w WidgetData
+    hd <- view handlerL
-    { wdRef = ref
+    ref <- newIORef mempty
-    , wdHandler = hd
+    runRIO WidgetData
-    }
+      { wdRef = ref
-  GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head') <- readIORef ref
+      , wdHandler = hd
-  let title = maybe mempty unTitle mTitle
+      } w
-      scripts = runUniqueList scripts'
+    GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head') <- readIORef ref
-      stylesheets = runUniqueList stylesheets'
+    let title = maybe mempty unTitle mTitle
        scripts = runUniqueList scripts'
        stylesheets = runUniqueList stylesheets'
  flip unHandlerFor hd $ do
    render <- getUrlRenderParams
    let renderLoc x =
            case x of
@ -656,7 +621,7 @@ defaultErrorHandler (InvalidArgs ia) = selectRep $ do
        |]
    provideRep $ return $ object ["message" .= ("Invalid Arguments" :: Text), "errors" .= ia]
 defaultErrorHandler (InternalError e) = do
-    $logErrorS "yesod-core" e
+    logErrorS "yesod-core" $ display e
    selectRep $ do
        provideRep $ defaultLayout $ defaultMessageWidget
            "Internal Server Error"
@ -691,6 +656,11 @@ asyncHelper render scripts jscript jsLoc =
                    Nothing -> Nothing
                    Just j -> Just $ jelper j
 type ZonedDate = DisplayBuilder
 makeZonedDateGetter :: IO (IO ZonedDate)
 makeZonedDateGetter = error "makeZonedDateGetter"
 -- | Default formatting for log messages. When you use
 -- the template haskell logging functions for to log with information
 -- about the source location, that information will be appended to
@ -701,32 +671,27 @@ asyncHelper render scripts jscript jsLoc =
 -- but it removes some of the visual clutter from non-TH logs.
 --
 -- Since 1.4.10
-formatLogMessage :: IO ZonedDate
+formatLogMessage :: ZonedDate
-                 -> Loc
+                 -> CallStack
                 -> LogSource
                 -> LogLevel
                 -> LogStr -- ^ message
-                 -> IO LogStr
+                 -> DisplayBuilder
-formatLogMessage getdate loc src level msg = do
+formatLogMessage now loc src level msg =
-    now <- getdate
+  now <>
-    return $ mempty
+  " [" <>
-        `mappend` toLogStr now
+  displayLevel level <>
-        `mappend` " ["
+  (if T.null src then mempty else "#" <> display src) <>
-        `mappend` (case level of
+  "] " <>
-            LevelOther t -> toLogStr t
+  msg <>
-            _ -> toLogStr $ drop 5 $ show level)
+  displayCallStack loc <>
-        `mappend` (if T.null src
+  "\n"
-            then mempty
+  where
-            else "#" `mappend` toLogStr src)
+    displayLevel LevelDebug = "DEBUG"
-        `mappend` "] "
+    displayLevel LevelInfo = "INFO"
-        `mappend` msg
+    displayLevel LevelWarn = "WARN"
-        `mappend` sourceSuffix
+    displayLevel LevelError = "ERROR"
-        `mappend` "\n"
+    displayLevel (LevelOther x) = display x
    where
    sourceSuffix = if loc_package loc == "<unknown>" then "" else mempty
        `mappend` " @("
        `mappend` toLogStr (fileLocationToString loc)
        `mappend` ")"
 -- | Customize the cookies used by the session backend.  You may
 -- use this function on your definition of 'makeSessionBackend'.
@ -843,22 +808,6 @@ loadClientSession key getCachedDate sessionName req = load
        where
          host = "" -- fixme, properly lock sessions to client address
 -- taken from file-location package
 -- turn the TH Loc loaction information into a human readable string
 -- leaving out the loc_end parameter
 fileLocationToString :: Loc -> String
 fileLocationToString loc =
    concat
      [ loc_package loc
      , ':' : loc_module loc
      , ' ' : loc_filename loc
      , ':' : line loc
      , ':' : char loc
      ]
  where
    line = show . fst . loc_start
    char = show . snd . loc_start
 -- | Guess the approot based on request headers. For more information, see
 -- "Network.Wai.Middleware.Approot"
 --
--- a/yesod-core/Yesod/Core/Handler.hs
+++ b/yesod-core/Yesod/Core/Handler.hs
@ -188,19 +188,13 @@ import           Yesod.Core.Internal.Request   (langKey, mkFileInfoFile,
                                                mkFileInfoLBS, mkFileInfoSource)
 #if __GLASGOW_HASKELL__ < 710
 import           Control.Applicative           ((<$>))
 import           Data.Monoid                   (mempty, mappend)
 #endif
 import           Control.Applicative           ((<|>))
 import qualified Data.CaseInsensitive          as CI
 import           Control.Exception             (evaluate, SomeException, throwIO)
 import           Control.Exception             (handle)
 import           Control.Monad                 (void, liftM, unless)
 import qualified Control.Monad.Trans.Writer    as Writer
-import           UnliftIO                      (MonadIO, liftIO, MonadUnliftIO, withRunInIO)
+import           UnliftIO                      (MonadIO, liftIO, withRunInIO)
 import qualified Network.HTTP.Types            as H
 import qualified Network.Wai                   as W
@ -238,7 +232,6 @@ import qualified Data.IORef                    as I
 import           Data.Maybe                    (listToMaybe, mapMaybe)
 import           Data.Typeable                 (Typeable)
 import           Web.PathPieces                (PathPiece(..))
 import           Yesod.Core.Class.Handler
 import           Yesod.Core.Types
 import           Yesod.Routes.Class            (Route)
 import           Data.ByteString.Builder (Builder)
@ -251,38 +244,44 @@ import           Data.Conduit (ConduitT, transPipe, Flush (Flush), yield, Void)
 import qualified Yesod.Core.TypeCache as Cache
 import qualified Data.Word8 as W8
 import qualified Data.Foldable as Fold
-import           Control.Monad.Logger (MonadLogger, logWarnS)
+import           RIO
 type HandlerT site (m :: * -> *) = HandlerFor site
 {-# DEPRECATED HandlerT "Use HandlerFor directly" #-}
-get :: MonadHandler m => m GHState
+get :: HasHandler env => RIO env GHState
-get = liftHandler $ HandlerFor $ I.readIORef . handlerState
+get = do
  ref <- view $ handlerL.to handlerState
  readIORef ref
-put :: MonadHandler m => GHState -> m ()
+put :: HasHandler env => GHState -> RIO env ()
-put x = liftHandler $ HandlerFor $ flip I.writeIORef x . handlerState
+put x = do
  ref <- view $ handlerL.to handlerState
  writeIORef ref $! x
-modify :: MonadHandler m => (GHState -> GHState) -> m ()
+modify :: HasHandler env => (GHState -> GHState) -> RIO env ()
-modify f = liftHandler $ HandlerFor $ flip I.modifyIORef f . handlerState
+modify f = do
  ref <- view $ handlerL.to handlerState
  modifyIORef' ref f
-tell :: MonadHandler m => Endo [Header] -> m ()
+tell :: HasHandler env => Endo [Header] -> RIO env ()
 tell hs = modify $ \g -> g { ghsHeaders = ghsHeaders g `mappend` hs }
-handlerError :: MonadHandler m => HandlerContents -> m a
+handlerError :: HasHandler env => HandlerContents -> RIO env a
-handlerError = liftIO . throwIO
+handlerError = throwIO
-hcError :: MonadHandler m => ErrorResponse -> m a
+hcError :: HasHandler env => ErrorResponse -> RIO env a
 hcError = handlerError . HCError
-getRequest :: MonadHandler m => m YesodRequest
+getRequest :: HasHandler env => RIO env YesodRequest
-getRequest = liftHandler $ HandlerFor $ return . handlerRequest
+getRequest = view $ handlerL.to handlerRequest
-runRequestBody :: MonadHandler m => m RequestBodyContents
+runRequestBody :: HasHandler env => RIO env RequestBodyContents
 runRequestBody = do
    HandlerData
        { handlerEnv = RunHandlerEnv {..}
        , handlerRequest = req
-        } <- liftHandler $ HandlerFor return
+        } <- view handlerL
    let len = W.requestBodyLength $ reqWaiRequest req
        upload = rheUpload len
    x <- get
@ -321,28 +320,28 @@ rbHelper' backend mkFI req =
            | otherwise = a'
    go = decodeUtf8With lenientDecode
-askHandlerEnv :: MonadHandler m => m (RunHandlerEnv (HandlerSite m))
+askHandlerEnv :: HasHandler env => RIO env (RunHandlerEnv (HandlerSite env))
-askHandlerEnv = liftHandler $ HandlerFor $ return . handlerEnv
+askHandlerEnv = view $ handlerL.to handlerEnv
 -- | Get the master site application argument.
-getYesod :: MonadHandler m => m (HandlerSite m)
+getYesod :: HasHandler env => RIO env (HandlerSite env)
 getYesod = rheSite <$> askHandlerEnv
 -- | Get a specific component of the master site application argument.
 --   Analogous to the 'gets' function for operating on 'StateT'.
-getsYesod :: MonadHandler m => (HandlerSite m -> a) -> m a
+getsYesod :: HasHandler env => (HandlerSite env -> a) -> RIO env a
 getsYesod f = (f . rheSite) <$> askHandlerEnv
 -- | Get the URL rendering function.
-getUrlRender :: MonadHandler m => m (Route (HandlerSite m) -> Text)
+getUrlRender :: HasHandler env => RIO env (Route (HandlerSite env) -> Text)
 getUrlRender = do
    x <- rheRender <$> askHandlerEnv
    return $ flip x []
 -- | The URL rendering function with query-string parameters.
 getUrlRenderParams
-    :: MonadHandler m
+    :: HasHandler env
-    => m (Route (HandlerSite m) -> [(Text, Text)] -> Text)
+    => RIO env (Route (HandlerSite env) -> [(Text, Text)] -> Text)
 getUrlRenderParams = rheRender <$> askHandlerEnv
 -- | Get all the post parameters passed to the handler. To also get
@ -351,15 +350,15 @@ getUrlRenderParams = rheRender <$> askHandlerEnv
 --
 -- @since 1.4.33
 getPostParams
-  :: MonadHandler m
+  :: HasHandler env
-  => m [(Text, Text)]
+  => RIO env [(Text, Text)]
 getPostParams = do
  reqBodyContent <- runRequestBody
  return $ fst reqBodyContent
 -- | Get the route requested by the user. If this is a 404 response- where the
 -- user requested an invalid route- this function will return 'Nothing'.
-getCurrentRoute :: MonadHandler m => m (Maybe (Route (HandlerSite m)))
+getCurrentRoute :: HasHandler env => RIO env (Maybe (Route (HandlerSite env)))
 getCurrentRoute = rheRoute <$> askHandlerEnv
 -- | Returns a function that runs 'HandlerT' actions inside @IO@.
@ -398,9 +397,11 @@ getCurrentRoute = rheRoute <$> askHandlerEnv
 -- This allows the inner 'GHandler' to outlive the outer
 -- 'GHandler' (e.g., on the @forkIO@ example above, a response
 -- may be sent to the client without killing the new thread).
-handlerToIO :: MonadIO m => HandlerFor site (HandlerFor site a -> m a)
+handlerToIO :: (MonadIO m, HasHandler env)
-handlerToIO =
+            => RIO env (HandlerFor (HandlerSite env) a -> m a)
-  HandlerFor $ \oldHandlerData -> do
+handlerToIO = do
  oldHandlerData <- view handlerL
  liftIO $ do
    -- Take just the bits we need from oldHandlerData.
    let newReq = oldReq { reqWaiRequest = newWaiReq }
          where
@ -422,12 +423,11 @@ handlerToIO =
    liftIO $ evaluate (newReq `seq` oldEnv `seq` newState `seq` ())
    -- Return GHandler running function.
-    return $ \(HandlerFor f) ->
+    return $ \f ->
-      liftIO $
+      liftIO $ runResourceT $ withInternalState $ \resState -> do
      runResourceT $ withInternalState $ \resState -> do
        -- The state IORef needs to be created here, otherwise it
        -- will be shared by different invocations of this function.
-        newStateIORef <- liftIO (I.newIORef newState)
+        newStateIORef <- newIORef newState
        let newHandlerData =
              HandlerData
                { handlerRequest  = newReq
@ -435,7 +435,7 @@ handlerToIO =
                , handlerState    = newStateIORef
                , handlerResource = resState
                }
-        liftIO (f newHandlerData)
+        runRIO newHandlerData f
 -- | forkIO for a Handler (run an action in the background)
 --
@ -458,8 +458,8 @@ forkHandler onErr handler = do
 --
 -- If you want direct control of the final status code, or need a different
 -- status code, please use 'redirectWith'.
-redirect :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
+redirect :: (HasHandler env, RedirectUrl (HandlerSite env) url)
-         => url -> m a
+         => url -> RIO env a
 redirect url = do
    req <- waiRequest
    let status =
@ -469,10 +469,10 @@ redirect url = do
    redirectWith status url
 -- | Redirect to the given URL with the specified status code.
-redirectWith :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
+redirectWith :: (HasHandler env, RedirectUrl (HandlerSite env) url)
             => H.Status
             -> url
-             -> m a
+             -> RIO env a
 redirectWith status url = do
    urlText <- toTextUrl url
    handlerError $ HCRedirect status urlText
@ -484,9 +484,9 @@ ultDestKey = "_ULT"
 --
 -- An ultimate destination is stored in the user session and can be loaded
 -- later by 'redirectUltDest'.
-setUltDest :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
+setUltDest :: (HasHandler env, RedirectUrl (HandlerSite env) url)
           => url
-           -> m ()
+           -> RIO env ()
 setUltDest url = do
    urlText <- toTextUrl url
    setSession ultDestKey urlText
@ -495,7 +495,7 @@ setUltDest url = do
 --
 -- If this is a 404 handler, there is no current page, and then this call does
 -- nothing.
-setUltDestCurrent :: MonadHandler m => m ()
+setUltDestCurrent :: HasHandler env => RIO env ()
 setUltDestCurrent = do
    route <- getCurrentRoute
    case route of
@ -507,7 +507,7 @@ setUltDestCurrent = do
 -- | Sets the ultimate destination to the referer request header, if present.
 --
 -- This function will not overwrite an existing ultdest.
-setUltDestReferer :: MonadHandler m => m ()
+setUltDestReferer :: HasHandler env => RIO env ()
 setUltDestReferer = do
    mdest <- lookupSession ultDestKey
    maybe
@ -524,16 +524,16 @@ setUltDestReferer = do
 --
 -- This function uses 'redirect', and thus will perform a temporary redirect to
 -- a GET request.
-redirectUltDest :: (RedirectUrl (HandlerSite m) url, MonadHandler m)
+redirectUltDest :: (RedirectUrl (HandlerSite env) url, HasHandler env)
                => url -- ^ default destination if nothing in session
-                -> m a
+                -> RIO env a
 redirectUltDest defaultDestination = do
    mdest <- lookupSession ultDestKey
    deleteSession ultDestKey
    maybe (redirect defaultDestination) redirect mdest
 -- | Remove a previously set ultimate destination. See 'setUltDest'.
-clearUltDest :: MonadHandler m => m ()
+clearUltDest :: HasHandler env => RIO env ()
 clearUltDest = deleteSession ultDestKey
 msgKey :: Text
@ -544,10 +544,10 @@ msgKey = "_MSG"
 -- See 'getMessages'.
 --
 -- @since 1.4.20
-addMessage :: MonadHandler m
+addMessage :: HasHandler env
           => Text -- ^ status
           -> Html -- ^ message
-           -> m ()
+           -> RIO env ()
 addMessage status msg = do
    val <- lookupSessionBS msgKey
    setSessionBS msgKey $ addMsg val
@ -562,8 +562,8 @@ addMessage status msg = do
 -- See 'getMessages'.
 --
 -- @since 1.4.20
-addMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg)
+addMessageI :: (HasHandler env, RenderMessage (HandlerSite env) msg)
-            => Text -> msg -> m ()
+            => Text -> msg -> RIO env ()
 addMessageI status msg = do
    mr <- getMessageRender
    addMessage status $ toHtml $ mr msg
@ -573,7 +573,7 @@ addMessageI status msg = do
 -- See 'addMessage'.
 --
 -- @since 1.4.20
-getMessages :: MonadHandler m => m [(Text, Html)]
+getMessages :: HasHandler env => RIO env [(Text, Html)]
 getMessages = do
    bs <- lookupSessionBS msgKey
    let ms = maybe [] enlist bs
@ -587,33 +587,33 @@ getMessages = do
    decode = decodeUtf8With lenientDecode
 -- | Calls 'addMessage' with an empty status
-setMessage :: MonadHandler m => Html -> m ()
+setMessage :: HasHandler env => Html -> RIO env ()
 setMessage = addMessage ""
 -- | Calls 'addMessageI' with an empty status
-setMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg)
+setMessageI :: (HasHandler env, RenderMessage (HandlerSite env) msg)
-            => msg -> m ()
+            => msg -> RIO env ()
 setMessageI = addMessageI ""
 -- | Gets just the last message in the user's session,
 -- discards the rest and the status
-getMessage :: MonadHandler m => m (Maybe Html)
+getMessage :: HasHandler env => RIO env (Maybe Html)
 getMessage = fmap (fmap snd . headMay) getMessages
 -- | Bypass remaining handler code and output the given file.
 --
 -- For some backends, this is more efficient than reading in the file to
 -- memory, since they can optimize file sending via a system call to sendfile.
-sendFile :: MonadHandler m => ContentType -> FilePath -> m a
+sendFile :: HasHandler env => ContentType -> FilePath -> RIO env a
 sendFile ct fp = handlerError $ HCSendFile ct fp Nothing
 -- | Same as 'sendFile', but only sends part of a file.
-sendFilePart :: MonadHandler m
+sendFilePart :: HasHandler env
             => ContentType
             -> FilePath
             -> Integer -- ^ offset
             -> Integer -- ^ count
-             -> m a
+             -> RIO env a
 sendFilePart ct fp off count = do
    fs <- liftIO $ PC.getFileStatus fp
    handlerError $ HCSendFile ct fp $ Just W.FilePart
@ -624,24 +624,24 @@ sendFilePart ct fp off count = do
 -- | Bypass remaining handler code and output the given content with a 200
 -- status code.
-sendResponse :: (MonadHandler m, ToTypedContent c) => c -> m a
+sendResponse :: (HasHandler env, ToTypedContent c) => c -> RIO env a
 sendResponse = handlerError . HCContent H.status200 . toTypedContent
 -- | Bypass remaining handler code and output the given content with the given
 -- status code.
-sendResponseStatus :: (MonadHandler m, ToTypedContent c) => H.Status -> c -> m a
+sendResponseStatus :: (HasHandler env, ToTypedContent c) => H.Status -> c -> RIO env a
 sendResponseStatus s = handlerError . HCContent s . toTypedContent
 -- | Bypass remaining handler code and output the given JSON with the given
 -- status code.
 --
 -- @since 1.4.18
-sendStatusJSON :: (MonadHandler m, ToJSON c) => H.Status -> c -> m a
+sendStatusJSON :: (HasHandler env, ToJSON c) => H.Status -> c -> RIO env a
 sendStatusJSON s v = sendResponseStatus s (toEncoding v)
 -- | Send a 201 "Created" response with the given route as the Location
 -- response header.
-sendResponseCreated :: MonadHandler m => Route (HandlerSite m) -> m a
+sendResponseCreated :: HasHandler env => Route (HandlerSite env) -> RIO env a
 sendResponseCreated url = do
    r <- getUrlRender
    handlerError $ HCCreated $ r url
@ -651,13 +651,13 @@ sendResponseCreated url = do
 -- that you have already specified. This function short-circuits. It should be
 -- considered only for very specific needs. If you are not sure if you need it,
 -- you don't.
-sendWaiResponse :: MonadHandler m => W.Response -> m b
+sendWaiResponse :: HasHandler env => W.Response -> RIO env b
 sendWaiResponse = handlerError . HCWai
 -- | Switch over to handling the current request with a WAI @Application@.
 --
 -- @since 1.2.17
-sendWaiApplication :: MonadHandler m => W.Application -> m b
+sendWaiApplication :: HasHandler env => W.Application -> RIO env b
 sendWaiApplication = handlerError . HCWaiApp
 -- | Send a raw response without conduit. This is used for cases such as
@ -666,9 +666,9 @@ sendWaiApplication = handlerError . HCWaiApp
 --
 -- @since 1.2.16
 sendRawResponseNoConduit
-    :: (MonadHandler m, MonadUnliftIO m)
+    :: HasHandler env
-    => (IO S8.ByteString -> (S8.ByteString -> IO ()) -> m ())
+    => (IO S8.ByteString -> (S8.ByteString -> IO ()) -> RIO env ())
-    -> m a
+    -> RIO env a
 sendRawResponseNoConduit raw = withRunInIO $ \runInIO ->
    liftIO $ throwIO $ HCWai $ flip W.responseRaw fallback
    $ \src sink -> void $ runInIO (raw src sink)
@ -682,9 +682,9 @@ sendRawResponseNoConduit raw = withRunInIO $ \runInIO ->
 --
 -- @since 1.2.7
 sendRawResponse
-  :: (MonadHandler m, MonadUnliftIO m)
+  :: HasHandler env
-  => (ConduitT () S8.ByteString IO () -> ConduitT S8.ByteString Void IO () -> m ())
+  => (ConduitT () S8.ByteString IO () -> ConduitT S8.ByteString Void IO () -> RIO env ())
-  -> m a
+  -> RIO env a
 sendRawResponse raw = withRunInIO $ \runInIO ->
    liftIO $ throwIO $ HCWai $ flip W.responseRaw fallback
    $ \src sink -> void $ runInIO $ raw (src' src) (CL.mapM_ sink)
@ -701,41 +701,41 @@ sendRawResponse raw = withRunInIO $ \runInIO ->
 -- action.
 --
 -- @since 1.4.4
-notModified :: MonadHandler m => m a
+notModified :: HasHandler env => RIO env a
 notModified = sendWaiResponse $ W.responseBuilder H.status304 [] mempty
 -- | Return a 404 not found page. Also denotes no handler available.
-notFound :: MonadHandler m => m a
+notFound :: HasHandler env => RIO env a
 notFound = hcError NotFound
 -- | Return a 405 method not supported page.
-badMethod :: MonadHandler m => m a
+badMethod :: HasHandler env => RIO env a
 badMethod = do
    w <- waiRequest
    hcError $ BadMethod $ W.requestMethod w
 -- | Return a 401 status code
-notAuthenticated :: MonadHandler m => m a
+notAuthenticated :: HasHandler env => RIO env a
 notAuthenticated = hcError NotAuthenticated
 -- | Return a 403 permission denied page.
-permissionDenied :: MonadHandler m => Text -> m a
+permissionDenied :: HasHandler env => Text -> RIO env a
 permissionDenied = hcError . PermissionDenied
 -- | Return a 403 permission denied page.
-permissionDeniedI :: (RenderMessage (HandlerSite m) msg, MonadHandler m)
+permissionDeniedI :: (RenderMessage (HandlerSite env) msg, HasHandler env)
                  => msg
-                  -> m a
+                  -> RIO env a
 permissionDeniedI msg = do
    mr <- getMessageRender
    permissionDenied $ mr msg
 -- | Return a 400 invalid arguments page.
-invalidArgs :: MonadHandler m => [Text] -> m a
+invalidArgs :: HasHandler env => [Text] -> RIO env a
 invalidArgs = hcError . InvalidArgs
 -- | Return a 400 invalid arguments page.
-invalidArgsI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => [msg] -> m a
+invalidArgsI :: (HasHandler env, RenderMessage (HandlerSite env) msg) => [msg] -> RIO env a
 invalidArgsI msg = do
    mr <- getMessageRender
    invalidArgs $ map mr msg
@ -743,7 +743,7 @@ invalidArgsI msg = do
 ------- Headers
 -- | Set the cookie on the client.
-setCookie :: MonadHandler m => SetCookie -> m ()
+setCookie :: HasHandler env => SetCookie -> RIO env ()
 setCookie sc = do
  addHeaderInternal (DeleteCookie name path)
  addHeaderInternal (AddCookie sc)
@ -763,16 +763,16 @@ getExpires m = do
 --
 -- Note: although the value used for key and path is 'Text', you should only
 -- use ASCII values to be HTTP compliant.
-deleteCookie :: MonadHandler m
+deleteCookie :: HasHandler env
             => Text -- ^ key
             -> Text -- ^ path
-             -> m ()
+             -> RIO env ()
 deleteCookie a = addHeaderInternal . DeleteCookie (encodeUtf8 a) . encodeUtf8
 -- | Set the language in the user session. Will show up in 'languages' on the
 -- next request.
-setLanguage :: MonadHandler m => Text -> m ()
+setLanguage :: HasHandler env => Text -> RIO env ()
 setLanguage = setSession langKey
 -- | Set an arbitrary response header.
@ -781,11 +781,11 @@ setLanguage = setSession langKey
 -- ASCII value to be HTTP compliant.
 --
 -- @since 1.2.0
-addHeader :: MonadHandler m => Text -> Text -> m ()
+addHeader :: HasHandler env => Text -> Text -> RIO env ()
 addHeader a = addHeaderInternal . Header (CI.mk $ encodeUtf8 a) . encodeUtf8
 -- | Deprecated synonym for addHeader.
-setHeader :: MonadHandler m => Text -> Text -> m ()
+setHeader :: HasHandler env => Text -> Text -> RIO env ()
 setHeader = addHeader
 {-# DEPRECATED setHeader "Please use addHeader instead" #-}
@ -796,7 +796,7 @@ setHeader = addHeader
 -- ASCII value to be HTTP compliant.
 --
 -- @since 1.4.36
-replaceOrAddHeader :: MonadHandler m => Text -> Text -> m ()
+replaceOrAddHeader :: HasHandler env => Text -> Text -> RIO env ()
 replaceOrAddHeader a b =
  modify $ \g -> g {ghsHeaders = replaceHeader (ghsHeaders g)}
  where
@ -825,7 +825,7 @@ replaceOrAddHeader a b =
 -- | Set the Cache-Control header to indicate this response should be cached
 -- for the given number of seconds.
-cacheSeconds :: MonadHandler m => Int -> m ()
+cacheSeconds :: HasHandler env => Int -> RIO env ()
 cacheSeconds i = setHeader "Cache-Control" $ T.concat
    [ "max-age="
    , T.pack $ show i
@ -834,7 +834,7 @@ cacheSeconds i = setHeader "Cache-Control" $ T.concat
 -- | Set the Expires header to some date in 2037. In other words, this content
 -- is never (realistically) expired.
-neverExpires :: MonadHandler m => m ()
+neverExpires :: HasHandler env => RIO env ()
 neverExpires = do
    setHeader "Expires" . rheMaxExpires =<< askHandlerEnv
    cacheSeconds oneYear
@ -844,11 +844,11 @@ neverExpires = do
 -- | Set an Expires header in the past, meaning this content should not be
 -- cached.
-alreadyExpired :: MonadHandler m => m ()
+alreadyExpired :: HasHandler env => RIO env ()
 alreadyExpired = setHeader "Expires" "Thu, 01 Jan 1970 05:05:05 GMT"
 -- | Set an Expires header to the given date.
-expiresAt :: MonadHandler m => UTCTime -> m ()
+expiresAt :: HasHandler env => UTCTime -> RIO env ()
 expiresAt = setHeader "Expires" . formatRFC1123
 data Etag
@ -872,7 +872,7 @@ data Etag
 -- function.
 --
 -- @since 1.4.4
-setEtag :: MonadHandler m => Text -> m ()
+setEtag :: HasHandler env => Text -> RIO env ()
 setEtag etag = do
    mmatch <- lookupHeader "if-none-match"
    let matches = maybe [] parseMatch mmatch
@ -916,7 +916,7 @@ parseMatch =
 -- function.
 --
 -- @since 1.4.37
-setWeakEtag :: MonadHandler m => Text -> m ()
+setWeakEtag :: HasHandler env => Text -> RIO env ()
 setWeakEtag etag = do
    mmatch <- lookupHeader "if-none-match"
    let matches = maybe [] parseMatch mmatch
@ -929,40 +929,40 @@ setWeakEtag etag = do
 -- The session is handled by the clientsession package: it sets an encrypted
 -- and hashed cookie on the client. This ensures that all data is secure and
 -- not tampered with.
-setSession :: MonadHandler m
+setSession :: HasHandler env
           => Text -- ^ key
           -> Text -- ^ value
-           -> m ()
+           -> RIO env ()
 setSession k = setSessionBS k . encodeUtf8
 -- | Same as 'setSession', but uses binary data for the value.
-setSessionBS :: MonadHandler m
+setSessionBS :: HasHandler env
             => Text
             -> S.ByteString
-             -> m ()
+             -> RIO env ()
 setSessionBS k = modify . modSession . Map.insert k
 -- | Unsets a session variable. See 'setSession'.
-deleteSession :: MonadHandler m => Text -> m ()
+deleteSession :: HasHandler env => Text -> RIO env ()
 deleteSession = modify . modSession . Map.delete
 -- | Clear all session variables.
 --
 -- @since: 1.0.1
-clearSession :: MonadHandler m => m ()
+clearSession :: HasHandler env => RIO env ()
 clearSession = modify $ \x -> x { ghsSession = Map.empty }
 modSession :: (SessionMap -> SessionMap) -> GHState -> GHState
 modSession f x = x { ghsSession = f $ ghsSession x }
 -- | Internal use only, not to be confused with 'setHeader'.
-addHeaderInternal :: MonadHandler m => Header -> m ()
+addHeaderInternal :: HasHandler env => Header -> RIO env ()
 addHeaderInternal = tell . Endo . (:)
 -- | Some value which can be turned into a URL for redirects.
 class RedirectUrl master a where
    -- | Converts the value to the URL and a list of query-string parameters.
-    toTextUrl :: (MonadHandler m, HandlerSite m ~ master) => a -> m Text
+    toTextUrl :: (HasHandler env, HandlerSite env ~ master) => a -> RIO env Text
 instance RedirectUrl master Text where
    toTextUrl = return
@ -996,21 +996,21 @@ instance (RedirectUrl master a, PathPiece b) => RedirectUrl master (Fragment a b
 -- | Lookup for session data.
-lookupSession :: MonadHandler m => Text -> m (Maybe Text)
+lookupSession :: HasHandler env => Text -> RIO env (Maybe Text)
 lookupSession = (fmap . fmap) (decodeUtf8With lenientDecode) . lookupSessionBS
 -- | Lookup for session data in binary format.
-lookupSessionBS :: MonadHandler m => Text -> m (Maybe S.ByteString)
+lookupSessionBS :: HasHandler env => Text -> RIO env (Maybe S.ByteString)
 lookupSessionBS n = do
    m <- fmap ghsSession get
    return $ Map.lookup n m
 -- | Get all session variables.
-getSession :: MonadHandler m => m SessionMap
+getSession :: HasHandler env => RIO env SessionMap
 getSession = fmap ghsSession get
 -- | Get a unique identifier.
-newIdent :: MonadHandler m => m Text
+newIdent :: HasHandler env => RIO env Text
 newIdent = do
    x <- get
    let i' = ghsIdent x + 1
@ -1023,9 +1023,9 @@ newIdent = do
 -- POST form, and some Javascript to automatically submit the form. This can be
 -- useful when you need to post a plain link somewhere that needs to cause
 -- changes on the server.
-redirectToPost :: (MonadHandler m, RedirectUrl (HandlerSite m) url)
+redirectToPost :: (HasHandler env, RedirectUrl (HandlerSite env) url)
               => url
-               -> m a
+               -> RIO env a
 redirectToPost url = do
    urlText <- toTextUrl url
    req <- getRequest
@ -1046,16 +1046,16 @@ $doctype 5
 |] >>= sendResponse
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
-hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html
+hamletToRepHtml :: HasHandler env => HtmlUrl (Route (HandlerSite env)) -> RIO env Html
 hamletToRepHtml = withUrlRenderer
 {-# DEPRECATED hamletToRepHtml "Use withUrlRenderer instead" #-}
 -- | Deprecated synonym for 'withUrlRenderer'.
 --
 -- @since 1.2.0
-giveUrlRenderer :: MonadHandler m
+giveUrlRenderer :: HasHandler env
-                => ((Route (HandlerSite m) -> [(Text, Text)] -> Text) -> output)
+                => ((Route (HandlerSite env) -> [(Text, Text)] -> Text) -> output)
-                -> m output
+                -> RIO env output
 giveUrlRenderer = withUrlRenderer
 {-# DEPRECATED giveUrlRenderer "Use withUrlRenderer instead" #-}
@ -1063,19 +1063,19 @@ giveUrlRenderer = withUrlRenderer
 -- result. Useful for processing Shakespearean templates.
 --
 -- @since 1.2.20
-withUrlRenderer :: MonadHandler m
+withUrlRenderer :: HasHandler env
-                => ((Route (HandlerSite m) -> [(Text, Text)] -> Text) -> output)
+                => ((Route (HandlerSite env) -> [(Text, Text)] -> Text) -> output)
-                -> m output
+                -> RIO env output
 withUrlRenderer f = do
    render <- getUrlRenderParams
    return $ f render
 -- | Get the request\'s 'W.Request' value.
-waiRequest :: MonadHandler m => m W.Request
+waiRequest :: HasHandler env => RIO env W.Request
 waiRequest = reqWaiRequest <$> getRequest
-getMessageRender :: (MonadHandler m, RenderMessage (HandlerSite m) message)
+getMessageRender :: (HasHandler env, RenderMessage (HandlerSite env) message)
-                 => m (message -> Text)
+                 => RIO env (message -> Text)
 getMessageRender = do
    env <- askHandlerEnv
    l <- languages
@ -1091,9 +1091,9 @@ getMessageRender = do
 -- See the original announcement: <http://www.yesodweb.com/blog/2013/03/yesod-1-2-cleaner-internals>
 --
 -- @since 1.2.0
-cached :: (MonadHandler m, Typeable a)
+cached :: (HasHandler env, Typeable a)
-       => m a
+       => RIO env a
-       -> m a
+       -> RIO env a
 cached action = do
    cache <- ghsCache <$> get
    eres <- Cache.cached cache action
@ -1115,7 +1115,7 @@ cached action = do
 -- For example, caching a lookup of a Link by a token where multiple token lookups might be performed.
 --
 -- @since 1.4.0
-cachedBy :: (MonadHandler m, Typeable a) => S.ByteString -> m a -> m a
+cachedBy :: (HasHandler env, Typeable a) => S.ByteString -> RIO env a -> RIO env a
 cachedBy k action = do
    cache <- ghsCacheBy <$> get
    eres <- Cache.cachedBy cache k action
@ -1144,7 +1144,7 @@ cachedBy k action = do
 -- If a matching language is not found the default language will be used.
 --
 -- This is handled by parseWaiRequest (not exposed).
-languages :: MonadHandler m => m [Text]
+languages :: HasHandler env => RIO env [Text]
 languages = do
    mlang <- lookupSession langKey
    langs <- reqLangs <$> getRequest
@ -1156,13 +1156,13 @@ lookup' a = map snd . filter (\x -> a == fst x)
 -- | Lookup a request header.
 --
 -- @since 1.2.2
-lookupHeader :: MonadHandler m => CI S8.ByteString -> m (Maybe S8.ByteString)
+lookupHeader :: HasHandler env => CI S8.ByteString -> RIO env (Maybe S8.ByteString)
 lookupHeader = fmap listToMaybe . lookupHeaders
 -- | Lookup a request header.
 --
 -- @since 1.2.2
-lookupHeaders :: MonadHandler m => CI S8.ByteString -> m [S8.ByteString]
+lookupHeaders :: HasHandler env => CI S8.ByteString -> RIO env [S8.ByteString]
 lookupHeaders key = do
    req <- waiRequest
    return $ lookup' key $ W.requestHeaders req
@ -1171,7 +1171,7 @@ lookupHeaders key = do
 -- request. Returns user name and password
 --
 -- @since 1.4.9
-lookupBasicAuth :: (MonadHandler m) => m (Maybe (Text, Text))
+lookupBasicAuth :: (HasHandler env) => RIO env (Maybe (Text, Text))
 lookupBasicAuth = fmap (>>= getBA) (lookupHeader "Authorization")
  where
    getBA bs = (decodeUtf8With lenientDecode *** decodeUtf8With lenientDecode)
@ -1181,7 +1181,7 @@ lookupBasicAuth = fmap (>>= getBA) (lookupHeader "Authorization")
 -- request. Returns bearer token value
 --
 -- @since 1.4.9
-lookupBearerAuth :: (MonadHandler m) => m (Maybe Text)
+lookupBearerAuth :: (HasHandler env) => RIO env (Maybe Text)
 lookupBearerAuth = fmap (>>= getBR)
                   (lookupHeader "Authorization")
  where
@ -1190,46 +1190,46 @@ lookupBearerAuth = fmap (>>= getBR)
 -- | Lookup for GET parameters.
-lookupGetParams :: MonadHandler m => Text -> m [Text]
+lookupGetParams :: HasHandler env => Text -> RIO env [Text]
 lookupGetParams pn = do
    rr <- getRequest
    return $ lookup' pn $ reqGetParams rr
 -- | Lookup for GET parameters.
-lookupGetParam :: MonadHandler m => Text -> m (Maybe Text)
+lookupGetParam :: HasHandler env => Text -> RIO env (Maybe Text)
 lookupGetParam = fmap listToMaybe . lookupGetParams
 -- | Lookup for POST parameters.
-lookupPostParams :: (MonadResource m, MonadHandler m) => Text -> m [Text]
+lookupPostParams :: HasHandler env => Text -> RIO env [Text]
 lookupPostParams pn = do
    (pp, _) <- runRequestBody
    return $ lookup' pn pp
-lookupPostParam :: (MonadResource m, MonadHandler m)
+lookupPostParam :: HasHandler env
                => Text
-                -> m (Maybe Text)
+                -> RIO env (Maybe Text)
 lookupPostParam = fmap listToMaybe . lookupPostParams
 -- | Lookup for POSTed files.
-lookupFile :: MonadHandler m
+lookupFile :: HasHandler env
           => Text
-           -> m (Maybe FileInfo)
+           -> RIO env (Maybe FileInfo)
 lookupFile = fmap listToMaybe . lookupFiles
 -- | Lookup for POSTed files.
-lookupFiles :: MonadHandler m
+lookupFiles :: HasHandler env
            => Text
-            -> m [FileInfo]
+            -> RIO env [FileInfo]
 lookupFiles pn = do
    (_, files) <- runRequestBody
    return $ lookup' pn files
 -- | Lookup for cookie data.
-lookupCookie :: MonadHandler m => Text -> m (Maybe Text)
+lookupCookie :: HasHandler env => Text -> RIO env (Maybe Text)
 lookupCookie = fmap listToMaybe . lookupCookies
 -- | Lookup for cookie data.
-lookupCookies :: MonadHandler m => Text -> m [Text]
+lookupCookies :: HasHandler env => Text -> RIO env [Text]
 lookupCookies pn = do
    rr <- getRequest
    return $ lookup' pn $ reqCookies rr
@ -1255,9 +1255,8 @@ lookupCookies pn = do
 -- provided inside this do-block. Should be used together with 'provideRep'.
 --
 -- @since 1.2.0
-selectRep :: MonadHandler m
+selectRep :: Writer.Writer (Endo [ProvidedRep site]) ()
-          => Writer.Writer (Endo [ProvidedRep m]) ()
+          -> HandlerFor site TypedContent
          -> m TypedContent
 selectRep w = do
    -- the content types are already sorted by q values
    -- which have been stripped
@ -1311,15 +1310,15 @@ selectRep w = do
 -- | Internal representation of a single provided representation.
 --
 -- @since 1.2.0
-data ProvidedRep m = ProvidedRep !ContentType !(m Content)
+data ProvidedRep site = ProvidedRep !ContentType !(RIO (HandlerData site) Content)
 -- | Provide a single representation to be used, based on the request of the
 -- client. Should be used together with 'selectRep'.
 --
 -- @since 1.2.0
-provideRep :: (Monad m, HasContentType a)
+provideRep :: HasContentType a
-           => m a
+           => HandlerFor site a
-           -> Writer.Writer (Endo [ProvidedRep m]) ()
+           -> Writer.Writer (Endo [ProvidedRep site]) ()
 provideRep handler = provideRepType (getContentType handler) handler
 -- | Same as 'provideRep', but instead of determining the content type from the
@ -1330,17 +1329,17 @@ provideRep handler = provideRepType (getContentType handler) handler
 -- > provideRepType "application/x-special-format" "This is the content"
 --
 -- @since 1.2.0
-provideRepType :: (Monad m, ToContent a)
+provideRepType :: ToContent a
               => ContentType
-               -> m a
+               -> HandlerFor site a
-               -> Writer.Writer (Endo [ProvidedRep m]) ()
+               -> Writer.Writer (Endo [ProvidedRep site]) ()
 provideRepType ct handler =
    Writer.tell $ Endo (ProvidedRep ct (liftM toContent handler):)
 -- | Stream in the raw request body without any parsing.
 --
 -- @since 1.2.0
-rawRequestBody :: MonadHandler m => ConduitT i S.ByteString m ()
+rawRequestBody :: HasHandler env => ConduitT i S.ByteString (RIO env) ()
 rawRequestBody = do
    req <- lift waiRequest
    let loop = do
@ -1375,12 +1374,13 @@ respond ct = return . TypedContent ct . toContent
 respondSource :: ContentType
              -> ConduitT () (Flush Builder) (HandlerFor site) ()
              -> HandlerFor site TypedContent
-respondSource ctype src = HandlerFor $ \hd ->
+respondSource ctype src = do
    hd <- view handlerL
    -- Note that this implementation relies on the fact that the ResourceT
    -- environment provided by the server is the same one used in HandlerT.
    -- This is a safe assumption assuming the HandlerT is run correctly.
    return $ TypedContent ctype $ ContentSource
-           $ transPipe (lift . flip unHandlerFor hd) src
+           $ transPipe (lift . runRIO hd) src
 -- | In a streaming response, send a single chunk of data. This function works
 -- on most datatypes, such as @ByteString@ and @Html@.
@ -1456,7 +1456,7 @@ defaultCsrfCookieName = "XSRF-TOKEN"
 -- The cookie's path is set to @/@, making it valid for your whole website.
 --
 -- @since 1.4.14
-setCsrfCookie :: MonadHandler m => m ()
+setCsrfCookie :: HasHandler env => RIO env ()
 setCsrfCookie = setCsrfCookieWithCookie defaultSetCookie
  { setCookieName = defaultCsrfCookieName
  , setCookiePath = Just "/"
@ -1467,7 +1467,7 @@ setCsrfCookie = setCsrfCookieWithCookie defaultSetCookie
 -- Make sure to set the 'setCookiePath' to the root path of your application, otherwise you'll generate a new CSRF token for every path of your app. If your app is run from from e.g. www.example.com\/app1, use @app1@. The vast majority of sites will just use @/@.
 --
 -- @since 1.4.14
-setCsrfCookieWithCookie :: MonadHandler m => SetCookie -> m ()
+setCsrfCookieWithCookie :: HasHandler env => SetCookie -> RIO env ()
 setCsrfCookieWithCookie cookie  = do
    mCsrfToken <- reqToken <$> getRequest
    Fold.forM_ mCsrfToken (\token -> setCookie $ cookie { setCookieValue = encodeUtf8 token })
@ -1482,7 +1482,7 @@ defaultCsrfHeaderName = "X-XSRF-TOKEN"
 -- this function throws a 'PermissionDenied' error.
 --
 -- @since 1.4.14
-checkCsrfHeaderNamed :: MonadHandler m => CI S8.ByteString -> m ()
+checkCsrfHeaderNamed :: HasHandler env => CI S8.ByteString -> RIO env ()
 checkCsrfHeaderNamed headerName = do
  (valid, mHeader) <- hasValidCsrfHeaderNamed' headerName
  unless valid (permissionDenied $ csrfErrorMessage [CSRFHeader (decodeUtf8 $ original headerName) mHeader])
@ -1490,11 +1490,11 @@ checkCsrfHeaderNamed headerName = do
 -- | Takes a header name to lookup a CSRF token, and returns whether the value matches the token stored in the session.
 --
 -- @since 1.4.14
-hasValidCsrfHeaderNamed :: MonadHandler m => CI S8.ByteString -> m Bool
+hasValidCsrfHeaderNamed :: HasHandler env => CI S8.ByteString -> RIO env Bool
 hasValidCsrfHeaderNamed headerName = fst <$> hasValidCsrfHeaderNamed' headerName
 -- | Like 'hasValidCsrfHeaderNamed', but also returns the header value to be used in error messages.
-hasValidCsrfHeaderNamed' :: MonadHandler m => CI S8.ByteString -> m (Bool, Maybe Text)
+hasValidCsrfHeaderNamed' :: HasHandler env => CI S8.ByteString -> RIO env (Bool, Maybe Text)
 hasValidCsrfHeaderNamed' headerName = do
  mCsrfToken  <- reqToken <$> getRequest
  mXsrfHeader <- lookupHeader headerName
@ -1513,7 +1513,7 @@ defaultCsrfParamName = "_token"
 -- this function throws a 'PermissionDenied' error.
 --
 -- @since 1.4.14
-checkCsrfParamNamed :: MonadHandler m => Text -> m ()
+checkCsrfParamNamed :: HasHandler env => Text -> RIO env ()
 checkCsrfParamNamed paramName = do
  (valid, mParam) <- hasValidCsrfParamNamed' paramName
  unless valid (permissionDenied $ csrfErrorMessage [CSRFParam paramName mParam])
@ -1521,11 +1521,11 @@ checkCsrfParamNamed paramName = do
 -- | Takes a POST parameter name to lookup a CSRF token, and returns whether the value matches the token stored in the session.
 --
 -- @since 1.4.14
-hasValidCsrfParamNamed :: MonadHandler m => Text -> m Bool
+hasValidCsrfParamNamed :: HasHandler env => Text -> RIO env Bool
 hasValidCsrfParamNamed paramName = fst <$> hasValidCsrfParamNamed' paramName
 -- | Like 'hasValidCsrfParamNamed', but also returns the param value to be used in error messages.
-hasValidCsrfParamNamed' :: MonadHandler m => Text -> m (Bool, Maybe Text)
+hasValidCsrfParamNamed' :: HasHandler env => Text -> RIO env (Bool, Maybe Text)
 hasValidCsrfParamNamed' paramName = do
  mCsrfToken  <- reqToken <$> getRequest
  mCsrfParam <- lookupPostParam paramName
@ -1536,16 +1536,16 @@ hasValidCsrfParamNamed' paramName = do
 -- If the value doesn't match the token stored in the session, this function throws a 'PermissionDenied' error.
 --
 -- @since 1.4.14
-checkCsrfHeaderOrParam :: (MonadHandler m, MonadLogger m)
+checkCsrfHeaderOrParam :: HasHandler env
                       => CI S8.ByteString -- ^ The header name to lookup the CSRF token
                       -> Text -- ^ The POST parameter name to lookup the CSRF token
-                       -> m ()
+                       -> RIO env ()
 checkCsrfHeaderOrParam headerName paramName = do
  (validHeader, mHeader) <- hasValidCsrfHeaderNamed' headerName
  (validParam, mParam) <- hasValidCsrfParamNamed' paramName
  unless (validHeader || validParam) $ do
    let errorMessage = csrfErrorMessage $ [CSRFHeader (decodeUtf8 $ original headerName) mHeader, CSRFParam paramName mParam]
-    $logWarnS "yesod-core" errorMessage
+    logWarnS "yesod-core" (display errorMessage)
    permissionDenied errorMessage
 validCsrf :: Maybe Text -> Maybe S.ByteString -> Bool
--- a/yesod-core/Yesod/Core/Json.hs
+++ b/yesod-core/Yesod/Core/Json.hs
@ -37,7 +37,6 @@ import Data.Monoid (Endo)
 import Yesod.Core.Content (TypedContent)
 import Yesod.Core.Types (reqAccept)
 import Yesod.Core.Class.Yesod (defaultLayout, Yesod)
 import Yesod.Core.Class.Handler
 import Yesod.Core.Widget (WidgetFor)
 import Yesod.Routes.Class
 import qualified Data.Aeson as J
--- a/yesod-core/Yesod/Core/Types.hs
+++ b/yesod-core/Yesod/Core/Types.hs
@ -11,23 +11,11 @@
 module Yesod.Core.Types where
 import qualified Data.ByteString.Builder            as BB
-#if __GLASGOW_HASKELL__ < 710
+import           Control.Monad.Trans.Resource       (InternalState, ResourceT)
 import           Control.Applicative                (Applicative (..))
 import           Control.Applicative                ((<$>))
 import           Data.Monoid                        (Monoid (..))
 #endif
 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.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 (..))
@ -40,28 +28,22 @@ import qualified Data.Text.Lazy.Builder             as TBuilder
 import           Data.Time                          (UTCTime)
 import           Data.Typeable                      (Typeable)
 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           Data.Monoid                        ((<>))
 import Control.DeepSeq (NFData (rnf))
 import Control.DeepSeq.Generics (genericRnf)
 import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
-import Control.Monad.Logger (MonadLoggerIO (..))
+import RIO hiding (LogStr) -- FIXME move over to the new logger stuff
 import Data.Semigroup (Semigroup)
 import UnliftIO (MonadUnliftIO (..), UnliftIO (..))
 -- Sessions
 type SessionMap = Map Text ByteString
@ -180,7 +162,7 @@ data RunHandlerEnv site = RunHandlerEnv
    , rheRoute    :: !(Maybe (Route site))
    , rheSite     :: !site
    , rheUpload   :: !(RequestBodyLength -> FileUpload)
-    , rheLog      :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ())
+    , rheLogFunc  :: !LogFunc
    , rheOnError  :: !(ErrorResponse -> YesodApp)
      -- ^ How to respond when an error is thrown internally.
      --
@ -196,7 +178,7 @@ data HandlerData site = HandlerData
    }
 data YesodRunnerEnv site = YesodRunnerEnv
-    { yreLogger         :: !Logger
+    { yreLogFunc        :: !LogFunc
    , yreSite           :: !site
    , yreSessionBackend :: !(Maybe SessionBackend)
    , yreGen            :: !(IO Int)
@ -217,12 +199,34 @@ type ParentRunner parent
   -> Maybe (Route parent)
   -> W.Application
 class (HasLogFunc env, HasResource env) => HasHandler env where
  type HandlerSite env
  handlerL :: Lens' env (HandlerData (HandlerSite env))
 class HasHandler env => HasWidget env where
  widgetL :: Lens' env (WidgetData (HandlerSite env))
 instance HasResource (HandlerData site) where
  resourceL = lens handlerResource (\x y -> x { handlerResource = y })
 instance HasLogFunc (HandlerData site) where
  logFuncL = lens handlerEnv (\x y -> x { handlerEnv = y })
           . lens rheLogFunc (\x y -> x { rheLogFunc = y })
 instance HasHandler (HandlerData site) where
  type HandlerSite (HandlerData site) = site
  handlerL = id
 instance HasResource (WidgetData site) where
  resourceL = handlerL.resourceL
 instance HasLogFunc (WidgetData site) where
  logFuncL = handlerL.logFuncL
 instance HasHandler (WidgetData site) where
  type HandlerSite (WidgetData site) = site
  handlerL = lens wdHandler (\x y -> x { wdHandler = y })
 instance HasWidget (WidgetData site) where
  widgetL = id
 -- | 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
+type HandlerFor site = RIO (HandlerData site)
    { unHandlerFor :: HandlerData site -> IO a
    }
    deriving Functor
 data GHState = GHState
    { ghsSession :: !SessionMap
@ -241,10 +245,7 @@ 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
+type WidgetFor site = RIO (WidgetData site)
    { unWidgetFor :: WidgetData site -> IO a
    }
    deriving Functor
 data WidgetData site = WidgetData
  { wdRef :: {-# UNPACK #-} !(IORef (GWData (Route site)))
@ -265,8 +266,10 @@ instance a ~ () => IsString (WidgetFor site a) where
    fromString = toWidget . toHtml . T.pack
      where toWidget x = tellWidget mempty { gwdBody = Body (const x) }
-tellWidget :: GWData (Route site) -> WidgetFor site ()
+tellWidget :: HasWidget env => GWData (Route (HandlerSite env)) -> RIO env ()
-tellWidget d = WidgetFor $ \wd -> modifyIORef' (wdRef wd) (<> d)
+tellWidget d = do
  wd <- view widgetL
  modifyIORef' (wdRef wd) (<> d)
 type RY master = Route master -> [(Text, Text)] -> Text
@ -341,16 +344,16 @@ instance NFData Header where
    rnf (Header x y) = x `seq` y `seq` ()
 data Location url = Local !url | Remote !Text
-    deriving (Show, Eq)
+    deriving (Show, Eq, Ord)
 -- | 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 { scriptLocation :: !(Location url), scriptAttributes :: ![(Text, Text)] }
-    deriving (Show, Eq)
+    deriving (Show, Eq, Ord)
 data Stylesheet url = Stylesheet { styleLocation :: !(Location url), styleAttributes :: ![(Text, Text)] }
-    deriving (Show, Eq)
+    deriving (Show, Eq, Ord)
 newtype Title = Title { unTitle :: Html }
 newtype Head url = Head (HtmlUrl url)
@ -404,71 +407,6 @@ instance Show HandlerContents where
    show (HCWaiApp _) = "HCWaiApp"
 instance Exception HandlerContents
 -- Instances for WidgetFor
 instance Applicative (WidgetFor site) where
    pure = WidgetFor . const . pure
    (<*>) = ap
 instance Monad (WidgetFor site) where
    return = pure
    WidgetFor x >>= f = WidgetFor $ \wd -> do
        a <- x wd
        unWidgetFor (f a) wd
 instance MonadIO (WidgetFor site) where
    liftIO = WidgetFor . const
 -- | @since 1.4.38
 instance MonadUnliftIO (WidgetFor site) where
  {-# INLINE askUnliftIO #-}
  askUnliftIO = WidgetFor $ \wd ->
                return (UnliftIO (flip unWidgetFor wd))
 instance MonadReader (WidgetData site) (WidgetFor site) where
    ask = WidgetFor return
    local f (WidgetFor g) = WidgetFor $ g . f
 instance MonadThrow (WidgetFor site) where
    throwM = liftIO . throwM
 instance MonadResource (WidgetFor site) where
    liftResourceT f = WidgetFor $ runInternalState f . handlerResource . wdHandler
 instance MonadLogger (WidgetFor site) where
    monadLoggerLog a b c d = WidgetFor $ \wd ->
        rheLog (handlerEnv $ wdHandler wd) a b c (toLogStr d)
 instance MonadLoggerIO (WidgetFor site) where
    askLoggerIO = WidgetFor $ return . rheLog . handlerEnv . wdHandler
 -- Instances for HandlerT
 instance Applicative (HandlerFor site) where
    pure = HandlerFor . const . return
    (<*>) = ap
 instance Monad (HandlerFor site) where
    return = pure
    HandlerFor x >>= f = HandlerFor $ \r -> x r >>= \x' -> unHandlerFor (f x') r
 instance MonadIO (HandlerFor site) where
    liftIO = HandlerFor . const
 instance MonadReader (HandlerData site) (HandlerFor site) where
    ask = HandlerFor return
    local f (HandlerFor g) = HandlerFor $ g . f
 -- | @since 1.4.38
 instance MonadUnliftIO (HandlerFor site) where
  {-# INLINE askUnliftIO #-}
  askUnliftIO = HandlerFor $ \r ->
                return (UnliftIO (flip unHandlerFor r))
 instance MonadThrow (HandlerFor site) where
    throwM = liftIO . throwM
 instance MonadResource (HandlerFor site) where
    liftResourceT f = HandlerFor $ runInternalState f . handlerResource
 instance MonadLogger (HandlerFor site) where
    monadLoggerLog a b c d = HandlerFor $ \hd ->
        rheLog (handlerEnv hd) a b c (toLogStr d)
 instance MonadLoggerIO (HandlerFor site) where
    askLoggerIO = HandlerFor $ \hd -> return (rheLog (handlerEnv hd))
 instance Monoid (UniqueList x) where
    mempty = UniqueList id
    UniqueList x `mappend` UniqueList y = UniqueList $ x . y
@ -491,11 +429,3 @@ instance RenderRoute WaiSubsiteWithAuth where
 instance ParseRoute WaiSubsiteWithAuth where
  parseRoute (x, y) = Just $ WaiSubsiteWithAuthRoute x y
 data Logger = Logger
    { loggerSet :: !LoggerSet
    , loggerDate :: !DateCacheGetter
    }
 loggerPutStr :: Logger -> LogStr -> IO ()
 loggerPutStr (Logger ls _) = pushLogStr ls
--- a/yesod-core/Yesod/Core/Widget.hs
+++ b/yesod-core/Yesod/Core/Widget.hs
@ -57,9 +57,6 @@ import Text.Cassius
 import Text.Julius
 import Yesod.Routes.Class
 import Yesod.Core.Handler (getMessageRender, getUrlRenderParams)
 #if __GLASGOW_HASKELL__ < 710
 import Control.Applicative ((<$>))
 #endif
 import Text.Shakespeare.I18N (RenderMessage)
 import Data.Text (Text)
 import qualified Data.Map as Map
@ -73,7 +70,7 @@ import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TB
 import Yesod.Core.Types
-import Yesod.Core.Class.Handler
+import RIO
 type WidgetT site (m :: * -> *) = WidgetFor site
 {-# DEPRECATED WidgetT "Use WidgetFor directly" #-}
@ -82,24 +79,26 @@ preEscapedLazyText :: TL.Text -> Html
 preEscapedLazyText = preEscapedToMarkup
 class ToWidget site a where
-    toWidget :: (MonadWidget m, HandlerSite m ~ site) => a -> m ()
+    toWidget :: (HasWidget env, HandlerSite env ~ site) => a -> RIO env ()
 instance render ~ RY site => ToWidget site (render -> Html) where
-    toWidget x = tell $ GWData (Body x) mempty mempty mempty mempty mempty mempty
+    toWidget x = tellWidget $ GWData (Body x) mempty mempty mempty mempty mempty mempty
 instance render ~ RY site => ToWidget site (render -> Css) where
    toWidget x = toWidget $ CssBuilder . fromLazyText . renderCss . x
 instance ToWidget site Css where
    toWidget x = toWidget $ CssBuilder . fromLazyText . renderCss . const x
 instance render ~ RY site => ToWidget site (render -> CssBuilder) where
-    toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . x) mempty mempty
+    toWidget x = tellWidget $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . x) mempty mempty
 instance ToWidget site CssBuilder where
-    toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . const x) mempty mempty
+    toWidget x = tellWidget $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . const x) mempty mempty
 instance render ~ RY site => ToWidget site (render -> Javascript) where
-    toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty
+    toWidget x = tellWidget $ GWData mempty mempty mempty mempty mempty (Just x) mempty
 instance ToWidget site Javascript where
-    toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just $ const x) mempty
+    toWidget x = tellWidget $ GWData mempty mempty mempty mempty mempty (Just $ const x) mempty
 instance (site' ~ site, a ~ ()) => ToWidget site' (WidgetFor site a) where
-    toWidget = liftWidget
+    toWidget f = do
      wd <- view widgetL
      runRIO wd f
 instance ToWidget site Html where
    toWidget = toWidget . const
 -- | @since 1.4.28
@ -119,21 +118,21 @@ class ToWidgetMedia site a where
    -- | Add the given content to the page, but only for the given media type.
    --
    -- Since 1.2
-    toWidgetMedia :: (MonadWidget m, HandlerSite m ~ site)
+    toWidgetMedia :: (HasWidget env, HandlerSite env ~ site)
                  => Text -- ^ media value
                  -> a
-                  -> m ()
+                  -> RIO env ()
 instance render ~ RY site => ToWidgetMedia site (render -> Css) where
    toWidgetMedia media x = toWidgetMedia media $ CssBuilder . fromLazyText . renderCss . x
 instance ToWidgetMedia site Css where
    toWidgetMedia media x = toWidgetMedia media $ CssBuilder . fromLazyText . renderCss . const x
 instance render ~ RY site => ToWidgetMedia site (render -> CssBuilder) where
-    toWidgetMedia media x = tell $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . x) mempty mempty
+    toWidgetMedia media x = tellWidget $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . x) mempty mempty
 instance ToWidgetMedia site CssBuilder where
-    toWidgetMedia media x = tell $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . const x) mempty mempty
+    toWidgetMedia media x = tellWidget $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . const x) mempty mempty
 class ToWidgetBody site a where
-    toWidgetBody :: (MonadWidget m, HandlerSite m ~ site) => a -> m ()
+    toWidgetBody :: (HasWidget env, HandlerSite env ~ site) => a -> RIO env ()
 instance render ~ RY site => ToWidgetBody site (render -> Html) where
    toWidgetBody = toWidget
@ -145,10 +144,10 @@ instance ToWidgetBody site Html where
    toWidgetBody = toWidget
 class ToWidgetHead site a where
-    toWidgetHead :: (MonadWidget m, HandlerSite m ~ site) => a -> m ()
+    toWidgetHead :: (HasWidget env, HandlerSite env ~ site) => a -> RIO env ()
 instance render ~ RY site => ToWidgetHead site (render -> Html) where
-    toWidgetHead = tell . GWData mempty mempty mempty mempty mempty mempty . Head
+    toWidgetHead = tellWidget . GWData mempty mempty mempty mempty mempty mempty . Head
 instance render ~ RY site => ToWidgetHead site (render -> Css) where
    toWidgetHead = toWidget
 instance ToWidgetHead site Css where
@ -166,60 +165,60 @@ instance ToWidgetHead site Html where
 -- | Set the page title. Calling 'setTitle' multiple times overrides previously
 -- set values.
-setTitle :: MonadWidget m => Html -> m ()
+setTitle :: HasWidget env => Html -> RIO env ()
-setTitle x = tell $ GWData mempty (Last $ Just $ Title x) mempty mempty mempty mempty mempty
+setTitle x = tellWidget $ GWData mempty (Last $ Just $ Title x) mempty mempty mempty mempty mempty
 -- | Set the page title. Calling 'setTitle' multiple times overrides previously
 -- set values.
-setTitleI :: (MonadWidget m, RenderMessage (HandlerSite m) msg) => msg -> m ()
+setTitleI :: (HasWidget env, RenderMessage (HandlerSite env) msg) => msg -> RIO env ()
 setTitleI msg = do
    mr <- getMessageRender
    setTitle $ toHtml $ mr msg
 -- | Link to the specified local stylesheet.
-addStylesheet :: MonadWidget m => Route (HandlerSite m) -> m ()
+addStylesheet :: HasWidget env => Route (HandlerSite env) -> RIO env ()
 addStylesheet = flip addStylesheetAttrs []
 -- | Link to the specified local stylesheet.
-addStylesheetAttrs :: MonadWidget m
+addStylesheetAttrs :: HasWidget env
-                   => Route (HandlerSite m)
+                   => Route (HandlerSite env)
                   -> [(Text, Text)]
-                   -> m ()
+                   -> RIO env ()
-addStylesheetAttrs x y = tell $ GWData mempty mempty mempty (toUnique $ Stylesheet (Local x) y) mempty mempty mempty
+addStylesheetAttrs x y = tellWidget $ GWData mempty mempty mempty (toUnique $ Stylesheet (Local x) y) mempty mempty mempty
 -- | Link to the specified remote stylesheet.
-addStylesheetRemote :: MonadWidget m => Text -> m ()
+addStylesheetRemote :: HasWidget env => Text -> RIO env ()
 addStylesheetRemote = flip addStylesheetRemoteAttrs []
 -- | Link to the specified remote stylesheet.
-addStylesheetRemoteAttrs :: MonadWidget m => Text -> [(Text, Text)] -> m ()
+addStylesheetRemoteAttrs :: HasWidget env => Text -> [(Text, Text)] -> RIO env ()
-addStylesheetRemoteAttrs x y = tell $ GWData mempty mempty mempty (toUnique $ Stylesheet (Remote x) y) mempty mempty mempty
+addStylesheetRemoteAttrs x y = tellWidget $ GWData mempty mempty mempty (toUnique $ Stylesheet (Remote x) y) mempty mempty mempty
-addStylesheetEither :: MonadWidget m
+addStylesheetEither :: HasWidget env
-                    => Either (Route (HandlerSite m)) Text
+                    => Either (Route (HandlerSite env)) Text
-                    -> m ()
+                    -> RIO env ()
 addStylesheetEither = either addStylesheet addStylesheetRemote
-addScriptEither :: MonadWidget m
+addScriptEither :: HasWidget env
-                => Either (Route (HandlerSite m)) Text
+                => Either (Route (HandlerSite env)) Text
-                -> m ()
+                -> RIO env ()
 addScriptEither = either addScript addScriptRemote
 -- | Link to the specified local script.
-addScript :: MonadWidget m => Route (HandlerSite m) -> m ()
+addScript :: HasWidget env => Route (HandlerSite env) -> RIO env ()
 addScript = flip addScriptAttrs []
 -- | Link to the specified local script.
-addScriptAttrs :: MonadWidget m => Route (HandlerSite m) -> [(Text, Text)] -> m ()
+addScriptAttrs :: HasWidget env => Route (HandlerSite env) -> [(Text, Text)] -> RIO env ()
-addScriptAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Local x) y) mempty mempty mempty mempty
+addScriptAttrs x y = tellWidget $ GWData mempty mempty (toUnique $ Script (Local x) y) mempty mempty mempty mempty
 -- | Link to the specified remote script.
-addScriptRemote :: MonadWidget m => Text -> m ()
+addScriptRemote :: HasWidget env => Text -> RIO env ()
 addScriptRemote = flip addScriptRemoteAttrs []
 -- | Link to the specified remote script.
-addScriptRemoteAttrs :: MonadWidget m => Text -> [(Text, Text)] -> m ()
+addScriptRemoteAttrs :: HasWidget env => Text -> [(Text, Text)] -> RIO env ()
-addScriptRemoteAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty
+addScriptRemoteAttrs x y = tellWidget $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty
 whamlet :: QuasiQuoter
 whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings
@ -251,28 +250,27 @@ rules = do
    return $ NP.HamletRules ah ur $ \_ b -> return $ ah `AppE` b
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
-ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
+ihamletToRepHtml :: (HasHandler env, RenderMessage (HandlerSite env) message)
-                 => HtmlUrlI18n message (Route (HandlerSite m))
+                 => HtmlUrlI18n message (Route (HandlerSite env))
-                 -> m Html
+                 -> RIO env Html
 ihamletToRepHtml = ihamletToHtml
 {-# DEPRECATED ihamletToRepHtml "Please use ihamletToHtml instead" #-}
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
 --
 -- Since 1.2.1
-ihamletToHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
+ihamletToHtml :: (HasHandler env, RenderMessage (HandlerSite env) message)
-              => HtmlUrlI18n message (Route (HandlerSite m))
+              => HtmlUrlI18n message (Route (HandlerSite env))
-              -> m Html
+              -> RIO env Html
 ihamletToHtml ih = do
    urender <- getUrlRenderParams
    mrender <- getMessageRender
    return $ ih (toHtml . mrender) urender
 tell :: MonadWidget m => GWData (Route (HandlerSite m)) -> m ()
 tell = liftWidget . tellWidget
 toUnique :: x -> UniqueList x
 toUnique = UniqueList . (:)
 handlerToWidget :: HandlerFor site a -> WidgetFor site a
-handlerToWidget (HandlerFor f) = WidgetFor $ f . wdHandler
+handlerToWidget f = do
  hd <- view handlerL
  runRIO hd f
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@ -45,9 +45,6 @@ library
                   , directory             >= 1
                   , vector                >= 0.9      && < 0.13
                   , aeson                 >= 1.0
                   , fast-logger           >= 2.2
                   , wai-logger            >= 0.2
                   , monad-logger          >= 0.3.10   && < 0.4
                   , conduit               >= 1.3
                   , resourcet             >= 1.2
                   , blaze-html            >= 0.5
@ -64,6 +61,7 @@ library
                   , semigroups
                   , byteable
                   , unliftio
                   , rio
    exposed-modules: Yesod.Core
                     Yesod.Core.Content
@ -77,7 +75,6 @@ library
                     Yesod.Routes.TH.Types
    other-modules:   Yesod.Core.Internal.Session
                     Yesod.Core.Internal.Request
                     Yesod.Core.Class.Handler
                     Yesod.Core.Internal.Util
                     Yesod.Core.Internal.Response
                     Yesod.Core.Internal.Run