From 9d47aa24dab2ce9086383de085d9aa1a7e37b666 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 26 Feb 2019 11:33:11 +0200
Subject: [PATCH] More things work with rio

---
 yesod-eventsource/Yesod/EventSource.hs  |   2 +-
 yesod-form/Yesod/Form/Bootstrap3.hs     |  10 +-
 yesod-form/Yesod/Form/Fields.hs         | 175 +++++++------
 yesod-form/Yesod/Form/Functions.hs      | 310 ++++++++++++------------
 yesod-form/Yesod/Form/Input.hs          |  61 ++---
 yesod-form/Yesod/Form/Jquery.hs         |  16 +-
 yesod-form/Yesod/Form/MassInput.hs      |  37 +--
 yesod-form/Yesod/Form/Nic.hs            |   6 +-
 yesod-form/Yesod/Form/Types.hs          |  96 ++++----
 yesod-form/yesod-form.cabal             |   4 +-
 yesod-newsfeed/Yesod/AtomFeed.hs        |  10 +-
 yesod-newsfeed/Yesod/Feed.hs            |   4 +-
 yesod-newsfeed/Yesod/RssFeed.hs         |  10 +-
 yesod-sitemap/Yesod/Sitemap.hs          |   6 +-
 yesod-websockets/Yesod/WebSockets.hs    | 116 ++++-----
 yesod-websockets/yesod-websockets.cabal |   1 +
 16 files changed, 444 insertions(+), 420 deletions(-)

diff --git a/yesod-eventsource/Yesod/EventSource.hs b/yesod-eventsource/Yesod/EventSource.hs
index 21310b19..0f73f65c 100644
--- a/yesod-eventsource/Yesod/EventSource.hs
+++ b/yesod-eventsource/Yesod/EventSource.hs
@@ -22,7 +22,7 @@ import qualified Network.Wai.EventSource.EventStream as ES
 
 -- | (Internal) Find out the request's 'EventSourcePolyfill' and
 -- set any necessary headers.
-prepareForEventSource :: MonadHandler m => m EventSourcePolyfill
+prepareForEventSource :: HasHandlerData env => RIO env EventSourcePolyfill
 prepareForEventSource = do
   reqWith <- lookup "X-Requested-With" . W.requestHeaders Data.Functor.<$> waiRequest
   let polyfill | reqWith == Just "XMLHttpRequest" = Remy'sESPolyfill
diff --git a/yesod-form/Yesod/Form/Bootstrap3.hs b/yesod-form/Yesod/Form/Bootstrap3.hs
index e99f82ba..cc41de29 100644
--- a/yesod-form/Yesod/Form/Bootstrap3.hs
+++ b/yesod-form/Yesod/Form/Bootstrap3.hs
@@ -140,7 +140,7 @@ data BootstrapFormLayout =
 -- | Render the given form using Bootstrap v3 conventions.
 --
 -- Since: yesod-form 1.3.8
-renderBootstrap3 :: Monad m => BootstrapFormLayout -> FormRender m a
+renderBootstrap3 :: BootstrapFormLayout -> FormRender site a
 renderBootstrap3 formLayout aform fragment = do
     (res, views') <- aFormToForm aform
     let views = views' []
@@ -223,8 +223,8 @@ instance IsString msg => IsString (BootstrapSubmit msg) where
 --
 -- Since: yesod-form 1.3.8
 bootstrapSubmit
-    :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
-    => BootstrapSubmit msg -> AForm m ()
+    :: RenderMessage site msg
+    => BootstrapSubmit msg -> AForm site ()
 bootstrapSubmit = formToAForm . liftM (second return) . mbootstrapSubmit
 
 
@@ -234,8 +234,8 @@ bootstrapSubmit = formToAForm . liftM (second return) . mbootstrapSubmit
 --
 -- Since: yesod-form 1.3.8
 mbootstrapSubmit
-    :: (RenderMessage site msg, HandlerSite m ~ site, MonadHandler m)
-    => BootstrapSubmit msg -> MForm m (FormResult (), FieldView site)
+    :: RenderMessage site msg
+    => BootstrapSubmit msg -> MForm site (FormResult (), FieldView site)
 mbootstrapSubmit (BootstrapSubmit msg classes attrs) =
     let res = FormSuccess ()
         widget = [whamlet|<button class="btn #{classes}" type=submit *{attrs}>_{msg}|]
diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs
index ab27544f..ebf4cbbd 100644
--- a/yesod-form/Yesod/Form/Fields.hs
+++ b/yesod-form/Yesod/Form/Fields.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -60,11 +61,13 @@ module Yesod.Form.Fields
     , optionsEnum
     ) where
 
+import RIO
 import Yesod.Form.Types
 import Yesod.Form.I18n.English
 import Yesod.Form.Functions (parseHelper)
 import Yesod.Core
 import Text.Blaze (ToMarkup (toMarkup), unsafeByteString)
+import Prelude (zipWith)
 #define ToHtml ToMarkup
 #define toHtml toMarkup
 #define preEscapedText preEscapedToMarkup
@@ -117,10 +120,10 @@ defaultFormMessage :: FormMessage -> Text
 defaultFormMessage = englishFormMessage
 
 -- | Creates a input with @type="number"@ and @step=1@.
-intField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Field m i
+intField :: (Integral i, RenderMessage site FormMessage) => Field site i
 intField = Field
     { fieldParse = parseHelper $ \s ->
-        case Data.Text.Read.signed Data.Text.Read.decimal s of
+        case Data.Text.Read.signed Data.Text.Read.decimal s of -- FIXME it overflows
             Right (a, "") -> Right a
             _ -> Left $ MsgInvalidInteger s
 
@@ -135,7 +138,7 @@ $newline never
     showI x = show (fromIntegral x :: Integer)
 
 -- | Creates a input with @type="number"@ and @step=any@.
-doubleField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Double
+doubleField :: RenderMessage site FormMessage => Field site Double
 doubleField = Field
     { fieldParse = parseHelper $ \s ->
         case Data.Text.Read.double (prependZero s) of
@@ -153,7 +156,7 @@ $newline never
 -- | Creates an input with @type="date"@, validating the input using the 'parseDate' function.
 --
 -- Add the @time@ package and import the "Data.Time.Calendar" module to use this function.
-dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day
+dayField :: RenderMessage site FormMessage => Field site Day
 dayField = Field
     { fieldParse = parseHelper $ parseDate . unpack
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
@@ -165,7 +168,7 @@ $newline never
   where showVal = either id (pack . show)
 
 -- | An alias for 'timeFieldTypeTime'.
-timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay
+timeField :: RenderMessage site FormMessage => Field site TimeOfDay
 timeField = timeFieldTypeTime
 
 -- | Creates an input with @type="time"@. <http://caniuse.com/#search=time%20input%20type Browsers not supporting this type> will fallback to a text field, and Yesod will parse the time as described in 'timeFieldTypeText'.
@@ -173,7 +176,7 @@ timeField = timeFieldTypeTime
 -- Add the @time@ package and import the "Data.Time.LocalTime" module to use this function.
 --
 -- Since 1.4.2
-timeFieldTypeTime :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay  
+timeFieldTypeTime :: RenderMessage site FormMessage => Field site TimeOfDay  
 timeFieldTypeTime = timeFieldOfType "time"
 
 -- | Creates an input with @type="text"@, parsing the time from an [H]H:MM[:SS] format, with an optional AM or PM (if not given, AM is assumed for compatibility with the 24 hour clock system).
@@ -183,10 +186,10 @@ timeFieldTypeTime = timeFieldOfType "time"
 -- Add the @time@ package and import the "Data.Time.LocalTime" module to use this function.
 --
 -- Since 1.4.2
-timeFieldTypeText :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay
+timeFieldTypeText :: RenderMessage site FormMessage => Field site TimeOfDay
 timeFieldTypeText = timeFieldOfType "text"
 
-timeFieldOfType :: Monad m => RenderMessage (HandlerSite m) FormMessage => Text -> Field m TimeOfDay
+timeFieldOfType :: RenderMessage site FormMessage => Text -> Field site TimeOfDay
 timeFieldOfType inputType = Field
     { fieldParse = parseHelper parseTime
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
@@ -203,7 +206,7 @@ $newline never
         fullSec = fromInteger $ floor $ todSec tod
 
 -- | Creates a @\<textarea>@ tag whose input is sanitized to prevent XSS attacks and is validated for having balanced tags.
-htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html
+htmlField :: RenderMessage site FormMessage => Field site Html
 htmlField = Field
     { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
@@ -239,7 +242,7 @@ instance ToHtml Textarea where
         writeHtmlEscapedChar c    = B.writeHtmlEscapedChar c
 
 -- | Creates a @\<textarea>@ tag whose returned value is wrapped in a 'Textarea'; see 'Textarea' for details.
-textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea
+textareaField :: RenderMessage site FormMessage => Field site Textarea
 textareaField = Field
     { fieldParse = parseHelper $ Right . Textarea
     , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
@@ -250,8 +253,8 @@ $newline never
     }
 
 -- | Creates an input with @type="hidden"@; you can use this to store information in a form that users shouldn't see (for example, Yesod stores CSRF tokens in a hidden field).
-hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)
-            => Field m p
+hiddenField :: (PathPiece p, RenderMessage site FormMessage)
+            => Field site p
 hiddenField = Field
     { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece
     , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
@@ -262,7 +265,7 @@ $newline never
     }
 
 -- | Creates a input with @type="text"@.
-textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
+textField :: RenderMessage site FormMessage => Field site Text
 textField = Field
     { fieldParse = parseHelper $ Right
     , fieldView = \theId name attrs val isReq ->
@@ -273,7 +276,7 @@ $newline never
     , fieldEnctype = UrlEncoded
     }
 -- | Creates an input with @type="password"@.
-passwordField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
+passwordField :: RenderMessage site FormMessage => Field site Text
 passwordField = Field
     { fieldParse = parseHelper $ Right
     , fieldView = \theId name attrs _ isReq -> toWidget [hamlet|
@@ -283,15 +286,10 @@ $newline never
     , fieldEnctype = UrlEncoded
     }
 
-readMay :: Read a => String -> Maybe a
-readMay s = case filter (Prelude.null . snd) $ reads s of
-                (x, _):_ -> Just x
-                [] -> Nothing
-
 -- | Parses a 'Day' from a 'String'.
 parseDate :: String -> Either FormMessage Day
 parseDate = maybe (Left MsgInvalidDay) Right
-              . readMay . replace '/' '-'
+              . readMaybe . replace '/' '-'
 
 -- | Replaces all instances of a value in a list by another value.
 -- from http://hackage.haskell.org/packages/archive/cgi/3001.1.7.1/doc/html/src/Network-CGI-Protocol.html#replace
@@ -299,7 +297,7 @@ replace :: Eq a => a -> a -> [a] -> [a]
 replace x y = map (\z -> if z == x then y else z)
 
 parseTime :: Text -> Either FormMessage TimeOfDay
-parseTime = either (Left . fromMaybe MsgInvalidTimeFormat . readMay . drop 2 . dropWhile (/= ':')) Right . parseOnly timeParser
+parseTime = either (Left . fromMaybe MsgInvalidTimeFormat . readMaybe . drop 2 . dropWhile (/= ':')) Right . parseOnly timeParser
 
 timeParser :: Parser TimeOfDay
 timeParser = do
@@ -331,7 +329,10 @@ timeParser = do
         x <- digit
         y <- (return Control.Applicative.<$> digit) <|> return []
         let xy = x : y
-        let i = read xy
+        let i =
+              case readMaybe xy of
+                Just i' -> i'
+                Nothing -> error $ "The impossible happened parsing: " ++ show xy
         if i < 0 || i >= 24
             then fail $ show $ MsgInvalidHour $ pack xy
             else return i
@@ -340,13 +341,16 @@ timeParser = do
         x <- digit
         y <- digit <|> fail (show $ msg $ pack [x])
         let xy = [x, y]
-        let i = read xy
+        let i =
+              case readMaybe xy of
+                Just i' -> i'
+                Nothing -> error $ "The impossible happened parsing: " ++ show xy
         if i < 0 || i >= 60
             then fail $ show $ msg $ pack xy
             else return $ fromIntegral (i :: Int)
             
 -- | Creates an input with @type="email"@. Yesod will validate the email's correctness according to RFC5322 and canonicalize it by removing comments and whitespace (see "Text.Email.Validate").
-emailField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
+emailField :: RenderMessage site FormMessage => Field site Text
 emailField = Field
     { fieldParse = parseHelper $
         \s ->
@@ -363,7 +367,7 @@ $newline never
 -- | Creates an input with @type="email"@ with the <http://w3c.github.io/html/sec-forms.html#the-multiple-attribute multiple> attribute; browsers might implement this as taking a comma separated list of emails. Each email address is validated as described in 'emailField'.
 --
 -- Since 1.3.7
-multiEmailField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m [Text]
+multiEmailField :: RenderMessage site FormMessage => Field site [Text]
 multiEmailField = Field
     { fieldParse = parseHelper $
         \s ->
@@ -387,7 +391,7 @@ $newline never
 
 type AutoFocus = Bool
 -- | Creates an input with @type="search"@. For <http://caniuse.com/#search=autofocus browsers without autofocus support>, a JS fallback is used if @AutoFocus@ is true.
-searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus -> Field m Text
+searchField :: RenderMessage site FormMessage => AutoFocus -> Field site Text
 searchField autoFocus = Field
     { fieldParse = parseHelper Right
     , fieldView = \theId name attrs val isReq -> do
@@ -408,7 +412,7 @@ $newline never
     , fieldEnctype = UrlEncoded
     }
 -- | Creates an input with @type="url"@, validating the URL according to RFC3986.
-urlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
+urlField :: RenderMessage site FormMessage => Field site Text
 urlField = Field
     { fieldParse = parseHelper $ \s ->
         case parseURI $ unpack s of
@@ -424,7 +428,7 @@ urlField = Field
 -- > areq (selectFieldList [("Value 1" :: Text, "value1"),("Value 2", "value2")]) "Which value?" Nothing
 selectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
                 => [(msg, a)]
-                -> Field (HandlerFor site) a
+                -> Field site a
 selectFieldList = selectField . optionsPairs
 
 -- | Creates a @\<select>@ tag for selecting one option. Example usage:
@@ -432,7 +436,7 @@ selectFieldList = selectField . optionsPairs
 -- > areq (selectField $ optionsPairs [(MsgValue1, "value1"),(MsgValue2, "value2")]) "Which value?" Nothing
 selectField :: (Eq a, RenderMessage site FormMessage)
             => HandlerFor site (OptionList a)
-            -> Field (HandlerFor site) a
+            -> Field site a
 selectField = selectFieldHelper
     (\theId name attrs inside -> [whamlet|
 $newline never
@@ -450,15 +454,15 @@ $newline never
 -- | Creates a @\<select>@ tag for selecting multiple options.
 multiSelectFieldList :: (Eq a, RenderMessage site msg)
                      => [(msg, a)]
-                     -> Field (HandlerFor site) [a]
+                     -> Field site [a]
 multiSelectFieldList = multiSelectField . optionsPairs
 
 -- | Creates a @\<select>@ tag for selecting multiple options.
 multiSelectField :: Eq a
                  => HandlerFor site (OptionList a)
-                 -> Field (HandlerFor site) [a]
+                 -> Field site [a]
 multiSelectField ioptlist =
-    Field parse view UrlEncoded
+    Field parse view' UrlEncoded
   where
     parse [] _ = return $ Right Nothing
     parse optlist _ = do
@@ -467,7 +471,7 @@ multiSelectField ioptlist =
              Nothing -> return $ Left "Error parsing values"
              Just res -> return $ Right $ Just res
 
-    view theId name attrs val isReq = do
+    view' theId name attrs val isReq = do
         opts <- fmap olOptions $ handlerToWidget ioptlist
         let selOpts = map (id &&& (optselected val)) opts
         [whamlet|
@@ -482,18 +486,18 @@ multiSelectField ioptlist =
 -- | Creates an input with @type="radio"@ for selecting one option.
 radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
                => [(msg, a)]
-               -> Field (HandlerFor site) a
+               -> Field site a
 radioFieldList = radioField . optionsPairs
 
 -- | Creates an input with @type="checkbox"@ for selecting multiple options.
 checkboxesFieldList :: (Eq a, RenderMessage site msg) => [(msg, a)]
-                     -> Field (HandlerFor site) [a]
+                     -> Field site [a]
 checkboxesFieldList = checkboxesField . optionsPairs
 
 -- | Creates an input with @type="checkbox"@ for selecting multiple options.
 checkboxesField :: Eq a
                  => HandlerFor site (OptionList a)
-                 -> Field (HandlerFor site) [a]
+                 -> Field site [a]
 checkboxesField ioptlist = (multiSelectField ioptlist)
     { fieldView =
         \theId name attrs val _isReq -> do
@@ -511,7 +515,7 @@ checkboxesField ioptlist = (multiSelectField ioptlist)
 -- | Creates an input with @type="radio"@ for selecting one option.
 radioField :: (Eq a, RenderMessage site FormMessage)
            => HandlerFor site (OptionList a)
-           -> Field (HandlerFor site) a
+           -> Field site a
 radioField = selectFieldHelper
     (\theId _name _attrs inside -> [whamlet|
 $newline never
@@ -539,7 +543,7 @@ $newline never
 -- If this field is required, the first radio button is labeled \"Yes" and the second \"No". 
 --
 -- (Exact label titles will depend on localization).
-boolField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool
+boolField :: RenderMessage site FormMessage => Field site Bool
 boolField = Field
       { fieldParse = \e _ -> return $ boolParser e
       , fieldView = \theId name attrs val isReq -> [whamlet|
@@ -578,7 +582,7 @@ $newline never
 --
 --   Note that this makes the field always optional.
 --
-checkBoxField :: Monad m => Field m Bool
+checkBoxField :: Field site Bool
 checkBoxField = Field
     { fieldParse = \e _ -> return $ checkBoxParser e
     , fieldView  = \theId name attrs val _ -> [whamlet|
@@ -623,22 +627,21 @@ data Option a = Option
 
 -- | Since 1.4.6
 instance Functor Option where
-    fmap f (Option display internal external) = Option display (f internal) external
+    fmap f (Option display' internal external) = Option display' (f internal) external
 
 -- | Creates an 'OptionList' from a list of (display-value, internal value) pairs.
-optionsPairs :: (MonadHandler m, RenderMessage (HandlerSite m) msg)
-             => [(msg, a)] -> m (OptionList a)
+optionsPairs :: RenderMessage site msg => [(msg, a)] -> HandlerFor site (OptionList a)
 optionsPairs opts = do
   mr <- getMessageRender
-  let mkOption external (display, internal) =
-          Option { optionDisplay       = mr display
+  let mkOption external (display', internal) =
+          Option { optionDisplay       = mr display'
                  , optionInternalValue = internal
                  , optionExternalValue = pack $ show external
                  }
   return $ mkOptionList (zipWith mkOption [1 :: Int ..] opts)
 
 -- | Creates an 'OptionList' from an 'Enum', using its 'Show' instance for the user-facing value.
-optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a)
+optionsEnum :: (Show a, Enum a, Bounded a) => HandlerFor site (OptionList a)
 optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
 
 -- | Selects a list of 'Entity's with the given 'Filter' and 'SelectOpt's. The @(a -> msg)@ function is then used to derive the display value for an 'OptionList'. Example usage:
@@ -656,33 +659,22 @@ optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
 -- >         <$> areq (selectField countries) "Which country do you live in?" Nothing
 -- >         where
 -- >           countries = optionsPersist [] [Asc CountryName] countryName
-#if MIN_VERSION_persistent(2,5,0)
 optionsPersist :: ( YesodPersist site
                   , PersistQueryRead backend
                   , PathPiece (Key a)
                   , RenderMessage site msg
                   , YesodPersistBackend site ~ backend
                   , PersistRecordBackend a backend
+                  , site ~ HandlerSite env
+                  , HasHandlerData env
                   )
                => [Filter a]
                -> [SelectOpt a]
                -> (a -> msg)
-               -> HandlerFor site (OptionList (Entity a))
-#else
-optionsPersist :: ( YesodPersist site, PersistEntity a
-                  , PersistQuery (PersistEntityBackend a)
-                  , PathPiece (Key a)
-                  , RenderMessage site msg
-                  , YesodPersistBackend site ~ PersistEntityBackend a
-                  )
-               => [Filter a]
-               -> [SelectOpt a]
-               -> (a -> msg)
-               -> HandlerFor site (OptionList (Entity a))
-#endif
+               -> RIO env (OptionList (Entity a))
 optionsPersist filts ords toDisplay = fmap mkOptionList $ do
     mr <- getMessageRender
-    pairs <- runDB $ selectList filts ords
+    pairs <- liftHandler $ runDB $ selectList filts ords
     return $ map (\(Entity key value) -> Option
         { optionDisplay = mr (toDisplay value)
         , optionInternalValue = Entity key value
@@ -693,35 +685,21 @@ optionsPersist filts ords toDisplay = fmap mkOptionList $ do
 -- the entire 'Entity'.
 --
 -- Since 1.3.2
-#if MIN_VERSION_persistent(2,5,0)
 optionsPersistKey
-  :: (YesodPersist site
+  :: ( YesodPersist site
      , PersistQueryRead backend
      , PathPiece (Key a)
      , RenderMessage site msg
      , backend ~ YesodPersistBackend site
+     , site ~ HandlerSite env
      , PersistRecordBackend a backend
+     , HasHandlerData env
      )
   => [Filter a]
   -> [SelectOpt a]
   -> (a -> msg)
-  -> HandlerFor site (OptionList (Key a))
-#else
-optionsPersistKey
-  :: (YesodPersist site
-     , PersistEntity a
-     , PersistQuery (PersistEntityBackend a)
-     , PathPiece (Key a)
-     , RenderMessage site msg
-     , YesodPersistBackend site ~ PersistEntityBackend a
-     )
-  => [Filter a]
-  -> [SelectOpt a]
-  -> (a -> msg)
-  -> HandlerFor site (OptionList (Key a))
-#endif
-
-optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do
+  -> RIO env (OptionList (Key a))
+optionsPersistKey filts ords toDisplay = liftHandler $ fmap mkOptionList $ do
     mr <- getMessageRender
     pairs <- runDB $ selectList filts ords
     return $ map (\(Entity key value) -> Option
@@ -740,7 +718,7 @@ selectFieldHelper
         -> (Text -> Text -> Bool -> WidgetFor site ()) -- ^ An option for None if the field is optional
         -> (Text -> Text -> [(Text, Text)] -> Text -> Bool -> Text -> WidgetFor site ()) -- ^ Other options
         -> HandlerFor site (OptionList a)
-        -> Field (HandlerFor site) a
+        -> Field site a
 selectFieldHelper outside onOpt inside opts' = Field
     { fieldParse = \x _ -> do
         opts <- opts'
@@ -770,8 +748,7 @@ selectFieldHelper outside onOpt inside opts' = Field
                     Just y -> Right $ Just y
 
 -- | Creates an input with @type="file"@.
-fileField :: Monad m
-          => Field m FileInfo
+fileField :: Field site FileInfo
 fileField = Field
     { fieldParse = \_ files -> return $
         case files of
@@ -783,18 +760,23 @@ fileField = Field
     , fieldEnctype = Multipart
     }
 
-fileAFormReq :: (MonadHandler m, RenderMessage (HandlerSite m) FormMessage)
-             => FieldSettings (HandlerSite m) -> AForm m FileInfo
-fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do
+fileAFormReq :: RenderMessage site FormMessage
+             => FieldSettings site -> AForm site FileInfo
+fileAFormReq fs = AForm $ do
+    site <- getYesod
+    langs <- reqLangs <$> getRequest
+    WFormData viewsRef mfd <- view id
+    ints <- readIORef $ mfdInts mfd
     let (name, ints') =
             case fsName fs of
                 Just x -> (x, ints)
                 Nothing ->
                     let i' = incrInts ints
                      in (pack $ 'f' : show i', i')
+    writeIORef (mfdInts mfd) ints'
     id' <- maybe newIdent return $ fsId fs
     let (res, errs) =
-            case menvs of
+            case mfdParams mfd of
                 Nothing -> (FormMissing, Nothing)
                 Just (_, fenv) ->
                     case Map.lookup name fenv of
@@ -813,21 +795,26 @@ $newline never
             , fvErrors = errs
             , fvRequired = True
             }
-    return (res, (fv :), ints', Multipart)
+    writeIORef (mfdEnctype mfd) Multipart
+    modifyIORef viewsRef $ \views -> views . (fv:)
+    return res
 
-fileAFormOpt :: MonadHandler m
-             => FieldSettings (HandlerSite m)
-             -> AForm m (Maybe FileInfo)
-fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
+fileAFormOpt :: FieldSettings site -> AForm site (Maybe FileInfo)
+fileAFormOpt fs = AForm $ do
+    master <- getYesod
+    langs <- reqLangs <$> getRequest
+    WFormData viewsRef mfd <- view id
+    ints <- readIORef $ mfdInts mfd
     let (name, ints') =
             case fsName fs of
                 Just x -> (x, ints)
                 Nothing ->
                     let i' = incrInts ints
                      in (pack $ 'f' : show i', i')
+    writeIORef (mfdInts mfd) ints'
     id' <- maybe newIdent return $ fsId fs
     let (res, errs) =
-            case menvs of
+            case mfdParams mfd of
                 Nothing -> (FormMissing, Nothing)
                 Just (_, fenv) ->
                     case Map.lookup name fenv of
@@ -844,7 +831,9 @@ $newline never
             , fvErrors = errs
             , fvRequired = False
             }
-    return (res, (fv :), ints', Multipart)
+    writeIORef (mfdEnctype mfd) Multipart
+    modifyIORef viewsRef $ \views -> views . (fv:)
+    return res
 
 incrInts :: Ints -> Ints
 incrInts (IntSingle i) = IntSingle $ i + 1
diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs
index 89d6451c..658c2168 100644
--- a/yesod-form/Yesod/Form/Functions.hs
+++ b/yesod-form/Yesod/Form/Functions.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -38,7 +39,6 @@ module Yesod.Form.Functions
     , renderTable
     , renderDivs
     , renderDivsNoLabels
-    , renderBootstrap
     , renderBootstrap2
       -- * Validation
     , check
@@ -55,13 +55,12 @@ module Yesod.Form.Functions
     , removeClass
     ) where
 
+import RIO hiding (ask, local)
 import Yesod.Form.Types
+import Yesod.Core.Types (liftHandler)
 import Data.Text (Text, pack)
 import qualified Data.Text as T
 import Control.Arrow (second)
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST, local, mapRWST)
-import Control.Monad.Trans.Writer (runWriterT, writer)
 import Control.Monad (liftM, join)
 import Data.Byteable (constEqBytes)
 import Text.Blaze (Markup, toMarkup)
@@ -75,8 +74,28 @@ import qualified Data.Map as Map
 import qualified Data.Text.Encoding as TE
 import Control.Arrow (first)
 
+get :: MForm site Ints
+get = view (to mfdInts) >>= readIORef
+
+put :: Ints -> MForm site ()
+put ints = view (to mfdInts) >>= (`writeIORef` ints)
+
+tell :: Enctype -> MForm site ()
+tell ec = view (to mfdEnctype) >>= (`writeIORef` ec)
+
+local
+  :: ( Maybe (Env, FileEnv)
+    -> Maybe (Env, FileEnv)
+     )
+  -> MForm site a
+  -> MForm site a
+local f inner = do
+  mfd <- view id
+  let mfd' = mfd { mfdParams = f $ mfdParams mfd }
+  runRIO mfd' inner
+
 -- | Get a unique identifier.
-newFormIdent :: Monad m => MForm m Text
+newFormIdent :: MForm site Text
 newFormIdent = do
     i <- get
     let i' = incrInts i
@@ -86,43 +105,34 @@ newFormIdent = do
     incrInts (IntSingle i) = IntSingle $ i + 1
     incrInts (IntCons i is) = (i + 1) `IntCons` is
 
-formToAForm :: (HandlerSite m ~ site, Monad m)
-            => MForm m (FormResult a, [FieldView site])
-            -> AForm m a
-formToAForm form = AForm $ \(site, langs) env ints -> do
-    ((a, xmls), ints', enc) <- runRWST form (env, site, langs) ints
-    return (a, (++) xmls, ints', enc)
+formToAForm :: MForm site (FormResult a, [FieldView site]) -> AForm site a
+formToAForm mform = AForm $ do
+  WFormData viewsRef mfd <- view id
+  (a, views) <- runRIO mfd mform
+  modifyIORef' viewsRef $ \front -> front . (views++)
+  pure a
 
-aFormToForm :: (Monad m, HandlerSite m ~ site)
-            => AForm m a
-            -> MForm m (FormResult a, [FieldView site] -> [FieldView site])
-aFormToForm (AForm aform) = do
-    ints <- get
-    (env, site, langs) <- ask
-    (a, xml, ints', enc) <- lift $ aform (site, langs) env ints
-    put ints'
-    tell enc
-    return (a, xml)
+aFormToForm :: AForm site a
+            -> MForm site (FormResult a, [FieldView site] -> [FieldView site])
+aFormToForm (AForm wform) = do
+    (res, views) <- wFormToMForm wform
+    pure (res, (views++))
 
-askParams :: Monad m => MForm m (Maybe Env)
-askParams = do
-    (x, _, _) <- ask
-    return $ liftM fst x
+askParams :: MForm site (Maybe Env)
+askParams = view $ to (fmap fst . mfdParams)
 
-askFiles :: Monad m => MForm m (Maybe FileEnv)
-askFiles = do
-    (x, _, _) <- ask
-    return $ liftM snd x
+askFiles :: MForm site (Maybe FileEnv)
+askFiles = view $ to (fmap snd . mfdParams)
 
 -- | Converts a form field into monadic form 'WForm'. This field requires a
 -- value and will return 'FormFailure' if left empty.
 --
 -- @since 1.4.14
-wreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
-     => Field m a           -- ^ form field
+wreq :: RenderMessage site FormMessage
+     => Field site a        -- ^ form field
      -> FieldSettings site  -- ^ settings for this field
      -> Maybe a             -- ^ optional default value
-     -> WForm m (FormResult a)
+     -> WForm site (FormResult a)
 wreq f fs = mFormToWForm . mreq f fs
 
 -- | Converts a form field into monadic form 'WForm'. This field is optional,
@@ -131,75 +141,78 @@ wreq f fs = mFormToWForm . mreq f fs
 -- value).
 --
 -- @since 1.4.14
-wopt :: (MonadHandler m, HandlerSite m ~ site)
-     => Field m a           -- ^ form field
+wopt :: Field site a        -- ^ form field
      -> FieldSettings site  -- ^ settings for this field
      -> Maybe (Maybe a)     -- ^ optional default value
-     -> WForm m (FormResult (Maybe a))
+     -> WForm site (FormResult (Maybe a))
 wopt f fs = mFormToWForm . mopt f fs
 
 -- | Converts a monadic form 'WForm' into an applicative form 'AForm'.
 --
 -- @since 1.4.14
-wFormToAForm :: MonadHandler m
-             => WForm m (FormResult a)  -- ^ input form
-             -> AForm m a               -- ^ output form
+wFormToAForm
+  :: WForm site (FormResult a)  -- ^ input form
+  -> AForm site a               -- ^ output form
 wFormToAForm = formToAForm . wFormToMForm
 
 -- | Converts a monadic form 'WForm' into another monadic form 'MForm'.
 --
 -- @since 1.4.14
-wFormToMForm :: (MonadHandler m, HandlerSite m ~ site)
-             => WForm m a                      -- ^ input form
-             -> MForm m (a, [FieldView site])  -- ^ output form
-wFormToMForm = mapRWST (fmap group . runWriterT)
-  where
-    group ((a, ints, enctype), views) = ((a, views), ints, enctype)
+wFormToMForm
+  :: WForm site a                      -- ^ input form
+  -> MForm site (a, [FieldView site])  -- ^ output form
+wFormToMForm wform = do
+  viewsRef <- newIORef id
+  mfd <- view id
+  a <- runRIO (WFormData viewsRef mfd) wform
+  views <- readIORef viewsRef
+  pure (a, views [])
 
 -- | Converts a monadic form 'MForm' into another monadic form 'WForm'.
 --
 -- @since 1.4.14
-mFormToWForm :: (MonadHandler m, HandlerSite m ~ site)
-             => MForm m (a, FieldView site)  -- ^ input form
-             -> WForm m a                    -- ^ output form
-mFormToWForm = mapRWST $ \f -> do
-  ((a, view), ints, enctype) <- lift f
-  writer ((a, ints, enctype), [view])
+mFormToWForm
+  :: MForm site (a, FieldView site)  -- ^ input form
+  -> WForm site a                    -- ^ output form
+mFormToWForm mform = do
+  WFormData views mfd <- view id
+  (a, view') <- runRIO mfd mform
+  modifyIORef' views $ \front -> front . (view':)
+  pure a
 
 -- | Converts a form field into monadic form. This field requires a value
 -- and will return 'FormFailure' if left empty.
-mreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
-     => Field m a           -- ^ form field
+mreq :: RenderMessage site FormMessage
+     => Field site a         -- ^ form field
      -> FieldSettings site  -- ^ settings for this field
      -> Maybe a             -- ^ optional default value
-     -> MForm m (FormResult a, FieldView site)
+     -> MForm site (FormResult a, FieldView site)
 mreq field fs mdef = mhelper field fs mdef (\m l -> FormFailure [renderMessage m l MsgValueRequired]) FormSuccess True
 
 -- | Converts a form field into monadic form. This field is optional, i.e.
 -- if filled in, it returns 'Just a', if left empty, it returns 'Nothing'.
 -- Arguments are the same as for 'mreq' (apart from type of default value).
-mopt :: (site ~ HandlerSite m, MonadHandler m)
-     => Field m a
+mopt :: Field site a
      -> FieldSettings site
      -> Maybe (Maybe a)
-     -> MForm m (FormResult (Maybe a), FieldView site)
+     -> MForm site (FormResult (Maybe a), FieldView site)
 mopt field fs mdef = mhelper field fs (join mdef) (const $ const $ FormSuccess Nothing) (FormSuccess . Just) False
 
-mhelper :: (site ~ HandlerSite m, MonadHandler m)
-        => Field m a
+mhelper :: Field site a
         -> FieldSettings site
         -> Maybe a
         -> (site -> [Text] -> FormResult b) -- ^ on missing
         -> (a -> FormResult b) -- ^ on success
         -> Bool -- ^ is it required?
-        -> MForm m (FormResult b, FieldView site)
+        -> MForm site (FormResult b, FieldView site)
 
 mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
     tell fieldEnctype
     mp <- askParams
     name <- maybe newFormIdent return fsName
-    theId <- lift $ maybe newIdent return fsId
-    (_, site, langs) <- ask
+    theId <- maybe newIdent return fsId
+    site <- getYesod
+    langs <- reqLangs <$> getRequest
     let mr2 = renderMessage site langs
     (res, val) <-
         case mp of
@@ -208,7 +221,7 @@ mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
                 mfs <- askFiles
                 let mvals = fromMaybe [] $ Map.lookup name p
                     files = fromMaybe [] $ mfs >>= Map.lookup name
-                emx <- lift $ fieldParse mvals files
+                emx <- liftHandler $ fieldParse mvals files
                 return $ case emx of
                     Left (SomeMessage e) -> (FormFailure [renderMessage site langs e], maybe (Left "") Left (listToMaybe mvals))
                     Right mx ->
@@ -228,28 +241,37 @@ mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
         })
 
 -- | Applicative equivalent of 'mreq'.
-areq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
-     => Field m a
+areq :: RenderMessage site FormMessage
+     => Field site a
      -> FieldSettings site
      -> Maybe a
-     -> AForm m a
+     -> AForm site a
 areq a b = formToAForm . liftM (second return) . mreq a b
 
 -- | Applicative equivalent of 'mopt'.
-aopt :: MonadHandler m
-     => Field m a
-     -> FieldSettings (HandlerSite m)
+aopt :: Field site a
+     -> FieldSettings site
      -> Maybe (Maybe a)
-     -> AForm m (Maybe a)
+     -> AForm site (Maybe a)
 aopt a b = formToAForm . liftM (second return) . mopt a b
 
-runFormGeneric :: Monad m
-               => MForm m a
-               -> HandlerSite m
-               -> [Text]
-               -> Maybe (Env, FileEnv)
-               -> m (a, Enctype)
-runFormGeneric form site langs env = evalRWST form (env, site, langs) (IntSingle 0)
+runFormGeneric
+  :: HasHandlerData env
+  => MForm (HandlerSite env) a
+  -> Maybe (Env, FileEnv)
+  -> RIO env (a, Enctype)
+runFormGeneric mform params = do
+  hd <- liftHandler $ view subHandlerDataL
+  enctypeRef <- newIORef mempty
+  intsRef <- newIORef $! IntSingle 0
+  let mfd = MFormData
+        { mfdHandlerData = hd
+        , mfdEnctype = enctypeRef
+        , mfdParams = params
+        , mfdInts = intsRef
+        }
+  a <- runRIO mfd mform
+  (,) a <$> readIORef enctypeRef
 
 -- | This function is used to both initially render a form and to later extract
 -- results from it. Note that, due to CSRF protection and a few other issues,
@@ -260,17 +282,19 @@ runFormGeneric form site langs env = evalRWST form (env, site, langs) (IntSingle
 -- For example, a common case is displaying a form on a GET request and having
 -- the form submit to a POST page. In such a case, both the GET and POST
 -- handlers should use 'runFormPost'.
-runFormPost :: (RenderMessage (HandlerSite m) FormMessage, MonadResource m, MonadHandler m)
-            => (Html -> MForm m (FormResult a, xml))
-            -> m ((FormResult a, xml), Enctype)
+runFormPost
+  :: (RenderMessage (HandlerSite env) FormMessage, HasHandlerData env)
+  => (Html -> MForm (HandlerSite env) (FormResult a, xml))
+  -> RIO env ((FormResult a, xml), Enctype)
 runFormPost form = do
     env <- postEnv
     postHelper form env
 
-postHelper  :: (MonadHandler m, RenderMessage (HandlerSite m) FormMessage)
-            => (Html -> MForm m (FormResult a, xml))
-            -> Maybe (Env, FileEnv)
-            -> m ((FormResult a, xml), Enctype)
+postHelper
+  :: (HasHandlerData env, RenderMessage (HandlerSite env) FormMessage)
+  => (Html -> MForm (HandlerSite env) (FormResult a, xml))
+  -> Maybe (Env, FileEnv)
+  -> RIO env ((FormResult a, xml), Enctype)
 postHelper form env = do
     req <- getRequest
     let tokenKey = defaultCsrfParamName
@@ -278,15 +302,14 @@ postHelper form env = do
             case reqToken req of
                 Nothing -> Data.Monoid.mempty
                 Just n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|]
-    m <- getYesod
-    langs <- languages
-    ((res, xml), enctype) <- runFormGeneric (form token) m langs env
+    ((res, xml), enctype) <- runFormGeneric (form token) env
+    site <- getYesod
     let res' =
             case (res, env) of
                 (_, Nothing) -> FormMissing
                 (FormSuccess{}, Just (params, _))
                     | not (Map.lookup tokenKey params === reqToken req) ->
-                        FormFailure [renderMessage m langs MsgCsrfWarning]
+                        FormFailure [renderMessage site (reqLangs req) MsgCsrfWarning]
                 _ -> res
             -- It's important to use constant-time comparison (constEqBytes) in order to avoid timing attacks.
             where (Just [t1]) === (Just t2) = TE.encodeUtf8 t1 `constEqBytes` TE.encodeUtf8 t2
@@ -299,12 +322,12 @@ postHelper form env = do
 -- page will both receive and incoming form and produce a new, blank form. For
 -- general usage, you can stick with @runFormPost@.
 generateFormPost
-    :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m)
-    => (Html -> MForm m (FormResult a, xml))
-    -> m (xml, Enctype)
+    :: (RenderMessage (HandlerSite env) FormMessage, HasHandlerData env)
+    => (Html -> MForm (HandlerSite env) (FormResult a, xml))
+    -> RIO env (xml, Enctype)
 generateFormPost form = first snd `liftM` postHelper form Nothing
 
-postEnv :: MonadHandler m => m (Maybe (Env, FileEnv))
+postEnv :: HasHandlerData env => RIO env (Maybe (Env, FileEnv))
 postEnv = do
     req <- getRequest
     if requestMethod (reqWaiRequest req) == "GET"
@@ -314,18 +337,16 @@ postEnv = do
             let p' = Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) p
             return $ Just (p', Map.unionsWith (++) $ map (\(k, v) -> Map.singleton k [v]) f)
 
-runFormPostNoToken :: MonadHandler m
-                   => (Html -> MForm m a)
-                   -> m (a, Enctype)
+runFormPostNoToken :: HasHandlerData env
+                   => (Html -> MForm (HandlerSite env) a)
+                   -> RIO env (a, Enctype)
 runFormPostNoToken form = do
-    langs <- languages
-    m <- getYesod
-    env <- postEnv
-    runFormGeneric (form mempty) m langs env
+    params <- postEnv
+    runFormGeneric (form mempty) params
 
-runFormGet :: MonadHandler m
-           => (Html -> MForm m a)
-           -> m (a, Enctype)
+runFormGet :: HasHandlerData env
+           => (Html -> MForm (HandlerSite env) a)
+           -> RIO env (a, Enctype)
 runFormGet form = do
     gets <- liftM reqGetParams getRequest
     let env =
@@ -339,29 +360,27 @@ runFormGet form = do
 --
 -- Since 1.3.11
 generateFormGet'
-    :: MonadHandler m
-    => (Html -> MForm m (FormResult a, xml))
-    -> m (xml, Enctype)
+    :: HasHandlerData env
+    => (Html -> MForm (HandlerSite env) (FormResult a, xml))
+    -> RIO env (xml, Enctype)
 generateFormGet' form = first snd `liftM` getHelper form Nothing
 
 {-# DEPRECATED generateFormGet "Will require RenderMessage in next version of Yesod" #-}
-generateFormGet :: MonadHandler m
-                => (Html -> MForm m a)
-                -> m (a, Enctype)
+generateFormGet :: HasHandlerData env
+                => (Html -> MForm (HandlerSite env) a)
+                -> RIO env (a, Enctype)
 generateFormGet form = getHelper form Nothing
 
 getKey :: Text
 getKey = "_hasdata"
 
-getHelper :: MonadHandler m
-          => (Html -> MForm m a)
+getHelper :: HasHandlerData env
+          => (Html -> MForm (HandlerSite env) a)
           -> Maybe (Env, FileEnv)
-          -> m (a, Enctype)
-getHelper form env = do
+          -> RIO env (a, Enctype)
+getHelper form params = do
     let fragment = [shamlet|<input type=hidden name=#{getKey}>|]
-    langs <- languages
-    m <- getYesod
-    runFormGeneric (form fragment) m langs env
+    runFormGeneric (form fragment) params
 
 
 -- | Creates a hidden field on the form that identifies it.  This
@@ -386,10 +405,9 @@ getHelper form env = do
 -- even if their number or order change between the HTML
 -- generation and the form submission.
 identifyForm
-  :: Monad m
-  => Text -- ^ Form identification string.
-  -> (Html -> MForm m (FormResult a, WidgetFor (HandlerSite m) ()))
-  -> (Html -> MForm m (FormResult a, WidgetFor (HandlerSite m) ()))
+  :: Text -- ^ Form identification string.
+  -> (Html -> MForm site (FormResult a, WidgetFor site ()))
+  -> (Html -> MForm site (FormResult a, WidgetFor site ()))
 identifyForm identVal form = \fragment -> do
     -- Create hidden <input>.
     let fragment' =
@@ -406,7 +424,7 @@ identifyForm identVal form = \fragment -> do
     -- data is missing, then do not provide any params to the
     -- form, which will turn its result into FormMissing.  Also,
     -- doing this avoids having lots of fields with red errors.
-    let eraseParams | missing   = local (\(_, h, l) -> (Nothing, h, l))
+    let eraseParams | missing   = local (const Nothing)
                     | otherwise = id
     ( res', w) <- eraseParams (form fragment')
 
@@ -418,12 +436,12 @@ identifyFormKey :: Text
 identifyFormKey = "_formid"
 
 
-type FormRender m a =
-       AForm m a
+type FormRender site a =
+       AForm site a
     -> Html
-    -> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
+    -> MForm site (FormResult a, WidgetFor site ())
 
-renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
+renderTable, renderDivs, renderDivsNoLabels :: FormRender env a
 -- | Render a form into a series of tr tags. Note that, in order to allow
 -- you to add extra rows to the table, this function does /not/ wrap up
 -- the resulting HTML in a table tag; you must do that yourself.
@@ -457,7 +475,7 @@ renderDivs = renderDivsMaybeLabels True
 -- | render a field inside a div, not displaying any label
 renderDivsNoLabels = renderDivsMaybeLabels False
 
-renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a
+renderDivsMaybeLabels :: Bool -> FormRender env a
 renderDivsMaybeLabels withLabels aform fragment = do
     (res, views') <- aFormToForm aform
     let views = views' []
@@ -495,7 +513,7 @@ $forall view <- views
 -- >        <input .btn .primary type=submit value=_{MsgSubmit}>
 --
 -- Since 1.3.14
-renderBootstrap2 :: Monad m => FormRender m a
+renderBootstrap2 :: FormRender env a
 renderBootstrap2 aform fragment = do
     (res, views') <- aFormToForm aform
     let views = views' []
@@ -516,26 +534,21 @@ renderBootstrap2 aform fragment = do
                 |]
     return (res, widget)
 
--- | Deprecated synonym for 'renderBootstrap2'.
-renderBootstrap :: Monad m => FormRender m a
-renderBootstrap = renderBootstrap2
-{-# DEPRECATED renderBootstrap "Please use the Yesod.Form.Bootstrap3 module." #-}
-
-check :: (Monad m, RenderMessage (HandlerSite m) msg)
+check :: RenderMessage site msg
       => (a -> Either msg a)
-      -> Field m a
-      -> Field m a
+      -> Field site a
+      -> Field site a
 check f = checkM $ return . f
 
 -- | Return the given error message if the predicate is false.
-checkBool :: (Monad m, RenderMessage (HandlerSite m) msg)
-          => (a -> Bool) -> msg -> Field m a -> Field m a
+checkBool :: RenderMessage site msg
+          => (a -> Bool) -> msg -> Field site a -> Field site a
 checkBool b s = check $ \x -> if b x then Right x else Left s
 
-checkM :: (Monad m, RenderMessage (HandlerSite m) msg)
-       => (a -> m (Either msg a))
-       -> Field m a
-       -> Field m a
+checkM :: RenderMessage site msg
+       => (a -> HandlerFor site (Either msg a))
+       -> Field site a
+       -> Field site a
 checkM f = checkMMap f id
 
 -- | Same as 'checkM', but modifies the datatype.
@@ -544,11 +557,11 @@ checkM f = checkMMap f id
 -- the new datatype to the old one (the second argument to this function).
 --
 -- Since 1.1.2
-checkMMap :: (Monad m, RenderMessage (HandlerSite m) msg)
-          => (a -> m (Either msg b))
+checkMMap :: RenderMessage site msg
+          => (a -> HandlerFor site (Either msg b))
           -> (b -> a)
-          -> Field m a
-          -> Field m b
+          -> Field site a
+          -> Field site b
 checkMMap f inv field = field
     { fieldParse = \ts fs -> do
         e1 <- fieldParse field ts fs
@@ -560,7 +573,7 @@ checkMMap f inv field = field
     }
 
 -- | Allows you to overwrite the error message on parse error.
-customErrorMessage :: Monad m => SomeMessage (HandlerSite m) -> Field m a -> Field m a
+customErrorMessage :: SomeMessage site -> Field site a -> Field site a
 customErrorMessage msg field = field
     { fieldParse = \ts fs ->
         liftM (either (const $ Left msg) Right)
@@ -611,11 +624,10 @@ parseHelperGen f (x:_) _ = return $ either (Left . SomeMessage) (Right . Just) $
 -- > lazyTextField = convertField TL.fromStrict TL.toStrict textField
 --
 -- Since 1.3.16
-convertField :: (Functor m)
-             => (a -> b) -> (b -> a)
-             -> Field m a -> Field m b
-convertField to from (Field fParse fView fEnctype) = let
-  fParse' ts = fmap (fmap (fmap to)) . fParse ts
+convertField :: (a -> b) -> (b -> a)
+             -> Field env a -> Field env b
+convertField to' from (Field fParse fView fEnctype) = let
+  fParse' ts = fmap (fmap (fmap to')) . fParse ts
   fView' ti tn at ei = fView ti tn at (fmap from ei)
   in Field fParse' fView' fEnctype
 
diff --git a/yesod-form/Yesod/Form/Input.hs b/yesod-form/Yesod/Form/Input.hs
index 826b4c60..5609bec1 100644
--- a/yesod-form/Yesod/Form/Input.hs
+++ b/yesod-form/Yesod/Form/Input.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
 -- | Provides for getting input from either GET or POST params without
@@ -26,14 +27,13 @@ type DText = [Text] -> [Text]
 
 -- | Type for a form which parses a value of type @a@ with the base monad @m@
 -- (usually your @Handler@). Can compose this using its @Applicative@ instance.
-newtype FormInput m a = FormInput { unFormInput :: HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a) }
-instance Monad m => Functor (FormInput m) where
-    fmap a (FormInput f) = FormInput $ \c d e e' -> liftM (either Left (Right . a)) $ f c d e e'
-instance Monad m => Control.Applicative.Applicative (FormInput m) where
-    pure = FormInput . const . const . const . const . return . Right
-    (FormInput f) <*> (FormInput x) = FormInput $ \c d e e' -> do
-        res1 <- f c d e e'
-        res2 <- x c d e e'
+newtype FormInput site a = FormInput { unFormInput :: Env -> FileEnv -> HandlerFor site (Either DText a) }
+  deriving Functor
+instance Control.Applicative.Applicative (FormInput site) where
+    pure x = FormInput $ \_env _filenv -> pure $ Right x
+    (FormInput f) <*> (FormInput x) = FormInput $ \env fileEnv -> do
+        res1 <- f env fileEnv
+        res2 <- x env fileEnv
         return $ case (res1, res2) of
             (Left a, Left b) -> Left $ a . b
             (Left a, _) -> Left a
@@ -42,14 +42,16 @@ instance Monad m => Control.Applicative.Applicative (FormInput m) where
 
 -- | Promote a @Field@ into a @FormInput@, requiring that the value be present
 -- and valid.
-ireq :: (Monad m, RenderMessage (HandlerSite m) FormMessage)
-     => Field m a
+ireq :: RenderMessage site FormMessage
+     => Field site a
      -> Text -- ^ name of the field
-     -> FormInput m a
-ireq field name = FormInput $ \m l env fenv -> do
+     -> FormInput site a
+ireq field name = FormInput $ \env fenv -> do
       let filteredEnv = fromMaybe [] $ Map.lookup name env
           filteredFEnv = fromMaybe [] $ Map.lookup name fenv
       emx <- fieldParse field filteredEnv filteredFEnv
+      m <- getYesod
+      l <- reqLangs <$> getRequest
       return $ case emx of
           Left (SomeMessage e) -> Left $ (:) $ renderMessage m l e
           Right Nothing -> Left $ (:) $ renderMessage m l $ MsgInputNotFound name
@@ -57,33 +59,34 @@ ireq field name = FormInput $ \m l env fenv -> do
 
 -- | Promote a @Field@ into a @FormInput@, with its presence being optional. If
 -- the value is present but does not parse correctly, the form will still fail.
-iopt :: Monad m => Field m a -> Text -> FormInput m (Maybe a)
-iopt field name = FormInput $ \m l env fenv -> do
+iopt :: Field site a -> Text -> FormInput site (Maybe a)
+iopt field name = FormInput $ \env fenv -> do
       let filteredEnv = fromMaybe [] $ Map.lookup name env
           filteredFEnv = fromMaybe [] $ Map.lookup name fenv
       emx <- fieldParse field filteredEnv filteredFEnv
-      return $ case emx of
-        Left (SomeMessage e) -> Left $ (:) $ renderMessage m l e
-        Right x -> Right x
+      case emx of
+        Left (SomeMessage e) -> do
+            site <- getYesod
+            l <- reqLangs <$> getRequest
+            pure $ Left $ (:) $ renderMessage site l e
+        Right x -> pure $ Right x
 
 -- | Run a @FormInput@ on the GET parameters (i.e., query string). If parsing
 -- fails, calls 'invalidArgs'.
-runInputGet :: MonadHandler m => FormInput m a -> m a
+runInputGet :: HasHandlerData env => FormInput (HandlerSite env) a -> RIO env a
 runInputGet = either invalidArgs return <=< runInputGetHelper
 
 -- | Run a @FormInput@ on the GET parameters (i.e., query string). Does /not/
 -- throw exceptions on failure.
 --
 -- Since 1.4.1
-runInputGetResult :: MonadHandler m => FormInput m a -> m (FormResult a)
+runInputGetResult :: HasHandlerData env => FormInput (HandlerSite env) a -> RIO env (FormResult a)
 runInputGetResult = fmap (either FormFailure FormSuccess) . runInputGetHelper
 
-runInputGetHelper :: MonadHandler m => FormInput m a -> m (Either [Text] a)
+runInputGetHelper :: HasHandlerData env => FormInput (HandlerSite env) a -> RIO env (Either [Text] a)
 runInputGetHelper (FormInput f) = do
     env <- liftM (toMap . reqGetParams) getRequest
-    m <- getYesod
-    l <- languages
-    emx <- f m l env Map.empty
+    emx <- liftHandler $ f env Map.empty
     return $ either (Left . ($ [])) Right emx
 
 toMap :: [(Text, a)] -> Map.Map Text [a]
@@ -91,17 +94,15 @@ toMap = Map.unionsWith (++) . map (\(x, y) -> Map.singleton x [y])
 
 -- | Run a @FormInput@ on the POST parameters (i.e., request body). If parsing
 -- fails, calls 'invalidArgs'.
-runInputPost :: MonadHandler m => FormInput m a -> m a
+runInputPost :: HasHandlerData env => FormInput (HandlerSite env) a -> RIO env a
 runInputPost = either invalidArgs return <=< runInputPostHelper
 
 -- | Run a @FormInput@ on the POST parameters (i.e., request body). Does /not/
 -- throw exceptions on failure.
-runInputPostResult :: MonadHandler m => FormInput m a -> m (FormResult a)
+runInputPostResult :: HasHandlerData env => FormInput (HandlerSite env) a -> RIO env (FormResult a)
 runInputPostResult = fmap (either FormFailure FormSuccess) . runInputPostHelper
 
-runInputPostHelper :: MonadHandler m => FormInput m a -> m (Either [Text] a)
-runInputPostHelper (FormInput f) = do
+runInputPostHelper :: HasHandlerData env => FormInput (HandlerSite env) a -> RIO env (Either [Text] a)
+runInputPostHelper (FormInput f) = liftHandler $ do
     (env, fenv) <- liftM (toMap *** toMap) runRequestBody
-    m <- getYesod
-    l <- languages
-    fmap (either (Left . ($ [])) Right) $ f m l env fenv
+    fmap (either (Left . ($ [])) Right) $ f env fenv
diff --git a/yesod-form/Yesod/Form/Jquery.hs b/yesod-form/Yesod/Form/Jquery.hs
index 05ca51bb..38a1190c 100644
--- a/yesod-form/Yesod/Form/Jquery.hs
+++ b/yesod-form/Yesod/Form/Jquery.hs
@@ -53,16 +53,16 @@ class YesodJquery a where
     urlJqueryUiDateTimePicker :: a -> Either (Route a) Text
     urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
 
-jqueryDayField :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Field (HandlerFor site) Day
+jqueryDayField :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Field site Day
 jqueryDayField = flip jqueryDayField' "date"
 
 -- | Use jQuery's datepicker as the underlying implementation.
 --
 -- Since 1.4.3
-jqueryDatePickerDayField :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Field (HandlerFor site) Day
+jqueryDatePickerDayField :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Field site Day
 jqueryDatePickerDayField = flip jqueryDayField' "text"
 
-jqueryDayField' :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Text -> Field (HandlerFor site) Day
+jqueryDayField' :: (RenderMessage site FormMessage, YesodJquery site) => JqueryDaySettings -> Text -> Field site Day
 jqueryDayField' jds inputType = Field
     { fieldParse = parseHelper $ maybe
                   (Left MsgInvalidDay)
@@ -107,13 +107,13 @@ $(function(){
         ]
 
 jqueryAutocompleteField :: (RenderMessage site FormMessage, YesodJquery site)
-                        => Route site -> Field (HandlerFor site) Text
+                        => Route site -> Field site Text
 jqueryAutocompleteField = jqueryAutocompleteField' 2
 
 jqueryAutocompleteField' :: (RenderMessage site FormMessage, YesodJquery site)
                          => Int -- ^ autocomplete minimum length
                          -> Route site
-                         -> Field (HandlerFor site) Text
+                         -> Field site Text
 jqueryAutocompleteField' minLen src = Field
     { fieldParse = parseHelper $ Right
     , fieldView = \theId name attrs val isReq -> do
@@ -130,14 +130,14 @@ $(function(){$("##{rawJS theId}").autocomplete({source:"@{src}",minLength:#{toJS
     , fieldEnctype = UrlEncoded
     }
 
-addScript' :: (HandlerSite m ~ site, MonadWidget m) => (site -> Either (Route site) Text) -> m ()
+addScript' :: (site -> Either (Route site) Text) -> WidgetFor site ()
 addScript' f = do
     y <- getYesod
     addScriptEither $ f y
 
-addStylesheet' :: (MonadWidget m, HandlerSite m ~ site)
+addStylesheet' :: (HasWidgetData env, HandlerSite env ~ site)
                => (site -> Either (Route site) Text)
-               -> m ()
+               -> RIO env ()
 addStylesheet' f = do
     y <- getYesod
     addStylesheetEither $ f y
diff --git a/yesod-form/Yesod/Form/MassInput.hs b/yesod-form/Yesod/Form/MassInput.hs
index edc977ad..3b9c2cf8 100644
--- a/yesod-form/Yesod/Form/MassInput.hs
+++ b/yesod-form/Yesod/Form/MassInput.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -11,11 +12,11 @@ module Yesod.Form.MassInput
     , massTable
     ) where
 
+import RIO
 import Yesod.Form.Types
 import Yesod.Form.Functions
 import Yesod.Form.Fields (checkBoxField)
 import Yesod.Core
-import Control.Monad.Trans.RWS (get, put, ask)
 import Data.Maybe (fromMaybe)
 import Data.Text.Read (decimal)
 import Control.Monad (liftM)
@@ -24,43 +25,45 @@ import Data.Traversable (sequenceA)
 import qualified Data.Map as Map
 import Data.Maybe (listToMaybe)
 
-down :: Monad m => Int -> MForm m ()
+down :: Int -> MForm site ()
 down 0 = return ()
 down i | i < 0 = error "called down with a negative number"
 down i = do
-    is <- get
-    put $ IntCons 0 is
+    ref <- view $ to mfdInts
+    is <- readIORef ref
+    writeIORef ref $ IntCons 0 is
     down $ i - 1
 
-up :: Monad m => Int -> MForm m ()
+up :: Int -> MForm site ()
 up 0 = return ()
 up i | i < 0 = error "called down with a negative number"
 up i = do
-    is <- get
+    ref <- view $ to mfdInts
+    is <- readIORef ref
     case is of
         IntSingle _ -> error "up on IntSingle"
-        IntCons _ is' -> put is' >> newFormIdent >> return ()
+        IntCons _ is' -> writeIORef ref is' >> newFormIdent >> return ()
     up $ i - 1
 
 -- | Generate a form that accepts 0 or more values from the user, allowing the
 -- user to specify that a new row is necessary.
-inputList :: (xml ~ WidgetFor site (), RenderMessage site FormMessage)
+inputList :: RenderMessage site FormMessage
           => Html
           -- ^ label for the form
-          -> ([[FieldView site]] -> xml)
+          -> ([[FieldView site]] -> WidgetFor site ())
           -- ^ how to display the rows, usually either 'massDivs' or 'massTable'
-          -> (Maybe a -> AForm (HandlerFor site) a)
+          -> (Maybe a -> AForm site a)
           -- ^ display a single row of the form, where @Maybe a@ gives the
           -- previously submitted value
           -> Maybe [a]
           -- ^ default initial values for the form
-          -> AForm (HandlerFor site) [a]
+          -> AForm site [a]
 inputList label fixXml single mdef = formToAForm $ do
-    theId <- lift newIdent
+    theId <- newIdent
     down 1
     countName <- newFormIdent
     addName <- newFormIdent
-    (menv, _, _) <- ask
+    menv <- view $ to mfdParams
     let readInt t =
             case decimal t of
                 Right (i, "") -> Just i
@@ -94,13 +97,13 @@ $newline never
         , fvRequired = False
         }])
 
-withDelete :: (xml ~ WidgetFor site (), RenderMessage site FormMessage)
-           => AForm (HandlerFor site) a
-           -> MForm (HandlerFor site) (Either xml (FormResult a, [FieldView site]))
+withDelete :: RenderMessage site FormMessage
+           => AForm site a
+           -> MForm site (Either (WidgetFor site ())(FormResult a, [FieldView site]))
 withDelete af = do
     down 1
     deleteName <- newFormIdent
-    (menv, _, _) <- ask
+    menv <- view $ to mfdParams
     res <- case menv >>= Map.lookup deleteName . fst of
         Just ("yes":_) -> return $ Left [whamlet|
 $newline never
diff --git a/yesod-form/Yesod/Form/Nic.hs b/yesod-form/Yesod/Form/Nic.hs
index 71b242ec..e6fc387b 100644
--- a/yesod-form/Yesod/Form/Nic.hs
+++ b/yesod-form/Yesod/Form/Nic.hs
@@ -29,7 +29,7 @@ class Yesod a => YesodNic a where
     urlNicEdit :: a -> Either (Route a) Text
     urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js"
 
-nicHtmlField :: YesodNic site => Field (HandlerFor site) Html
+nicHtmlField :: YesodNic site => Field site Html
 nicHtmlField = Field
     { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e
     , fieldView = \theId name attrs val _isReq -> do
@@ -52,9 +52,9 @@ bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{ra
   where
     showVal = either id (pack . renderHtml)
 
-addScript' :: (MonadWidget m, HandlerSite m ~ site)
+addScript' :: (HasWidgetData env, HandlerSite env ~ site)
            => (site -> Either (Route site) Text)
-           -> m ()
+           -> RIO env ()
 addScript' f = do
     y <- getYesod
     addScriptEither $ f y
diff --git a/yesod-form/Yesod/Form/Types.hs b/yesod-form/Yesod/Form/Types.hs
index bfc3e179..0405de17 100644
--- a/yesod-form/Yesod/Form/Types.hs
+++ b/yesod-form/Yesod/Form/Types.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ExistentialQuantification #-}
@@ -15,6 +17,8 @@ module Yesod.Form.Types
     , WForm
     , MForm
     , AForm (..)
+    , WFormData (..)
+    , MFormData (..)
       -- * Build forms
     , Field (..)
     , FieldSettings (..)
@@ -22,8 +26,8 @@ module Yesod.Form.Types
     , FieldViewFunc
     ) where
 
-import Control.Monad.Trans.RWS (RWST)
-import Control.Monad.Trans.Writer (WriterT)
+import RIO
+import RIO.Orphans
 import Data.Text (Text)
 import Data.Monoid (Monoid (..))
 import Text.Blaze (Markup, ToMarkup (toMarkup), ToValue (toValue))
@@ -31,10 +35,9 @@ import Text.Blaze (Markup, ToMarkup (toMarkup), ToValue (toValue))
 #define ToHtml ToMarkup
 #define toHtml toMarkup
 import Control.Applicative ((<$>), Alternative (..), Applicative (..))
-import Control.Monad (liftM)
-import Control.Monad.Trans.Class
 import Data.String (IsString (..))
 import Yesod.Core
+import Yesod.Core.Types
 import qualified Data.Map as Map
 import Data.Semigroup (Semigroup, (<>))
 import Data.Traversable
@@ -140,46 +143,53 @@ type FileEnv = Map.Map Text [FileInfo]
 -- >   return $ MyForm <$> field1F <*> field2F <*> field3F
 --
 -- @since 1.4.14
-type WForm m a = MForm (WriterT [FieldView (HandlerSite m)] m) a
+type WForm site = RIO (WFormData site)
+data WFormData site = WFormData
+  { wfdViews :: !(IORef ([FieldView site] -> [FieldView site]))
+  , wfdMfd :: !(MFormData site)
+  }
+instance HasHandlerData (WFormData site) where
+  type HandlerSite (WFormData site) = site
+  type SubHandlerSite (WFormData site) = site
+  subHandlerDataL = (lens wfdMfd (\x y -> x { wfdMfd = y })).subHandlerDataL
+instance HasResourceMap (WFormData site) where
+  resourceMapL = subHandlerDataL.resourceMapL
+instance HasLogFunc (WFormData site) where
+  logFuncL = subHandlerDataL.logFuncL
 
-type MForm m a = RWST
-    (Maybe (Env, FileEnv), HandlerSite m, [Lang])
-    Enctype
-    Ints
-    m
-    a
+type MForm site = RIO (MFormData site)
+data MFormData site = MFormData
+  { mfdHandlerData :: !(SubHandlerData site site)
+  , mfdEnctype :: !(IORef Enctype)
+  , mfdParams :: !(Maybe (Env, FileEnv))
+  , mfdInts :: !(IORef Ints)
+  }
+instance HasHandlerData (MFormData site) where
+  type HandlerSite (MFormData site) = site
+  type SubHandlerSite (MFormData site) = site
+  subHandlerDataL = lens mfdHandlerData (\x y -> x { mfdHandlerData = y})
+instance HasResourceMap (MFormData site) where
+  resourceMapL = subHandlerDataL.resourceMapL
+instance HasLogFunc (MFormData site) where
+  logFuncL = subHandlerDataL.logFuncL
 
-newtype AForm m a = AForm
-    { unAForm :: (HandlerSite m, [Text])
-              -> Maybe (Env, FileEnv)
-              -> Ints
-              -> m (FormResult a, [FieldView (HandlerSite m)] -> [FieldView (HandlerSite m)], Ints, Enctype)
-    }
-instance Monad m => Functor (AForm m) where
-    fmap f (AForm a) =
-        AForm $ \x y z -> liftM go $ a x y z
-      where
-        go (w, x, y, z) = (fmap f w, x, y, z)
-instance Monad m => Applicative (AForm m) where
-    pure x = AForm $ const $ const $ \ints -> return (FormSuccess x, id, ints, mempty)
-    (AForm f) <*> (AForm g) = AForm $ \mr env ints -> do
-        (a, b, ints', c) <- f mr env ints
-        (x, y, ints'', z) <- g mr env ints'
-        return (a <*> x, b . y, ints'', c `mappend` z)
-instance (Monad m, Monoid a) => Monoid (AForm m a) where
+newtype AForm site a = AForm (WForm site (FormResult a))
+  deriving Functor
+instance Applicative (AForm site) where
+    pure = AForm . pure . pure
+    (AForm f) <*> (AForm g) = AForm $ do
+        f' <- f
+        g' <- g
+        pure $ f' <*> g'
+instance Monoid a => Monoid (AForm site a) where
     mempty = pure mempty
     mappend a b = mappend <$> a <*> b
-instance (Monad m, Semigroup a) => Semigroup (AForm m a) where
+instance Semigroup a => Semigroup (AForm site a) where
     a <> b = (<>) <$> a <*> b
 
-instance MonadTrans AForm where
-    lift f = AForm $ \_ _ ints -> do
-        x <- f
-        return (FormSuccess x, id, ints, mempty)
-
-data FieldSettings master = FieldSettings
-    { fsLabel :: SomeMessage master
-    , fsTooltip :: Maybe (SomeMessage master)
+data FieldSettings site = FieldSettings
+    { fsLabel :: SomeMessage site
+    , fsTooltip :: Maybe (SomeMessage site)
     , fsId :: Maybe Text
     , fsName :: Maybe Text
     , fsAttrs :: [(Text, Text)]
@@ -197,17 +207,17 @@ data FieldView site = FieldView
     , fvRequired :: Bool
     }
 
-type FieldViewFunc m a
+type FieldViewFunc site a
     = Text -- ^ ID
    -> Text -- ^ Name
    -> [(Text, Text)] -- ^ Attributes
    -> Either Text a -- ^ Either (invalid text) or (legitimate result)
    -> Bool -- ^ Required?
-   -> WidgetFor (HandlerSite m) ()
+   -> WidgetFor site ()
 
-data Field m a = Field
-    { fieldParse :: [Text] -> [FileInfo] -> m (Either (SomeMessage (HandlerSite m)) (Maybe a))
-    , fieldView :: FieldViewFunc m a
+data Field site a = Field
+    { fieldParse :: [Text] -> [FileInfo] -> HandlerFor site (Either (SomeMessage site) (Maybe a))
+    , fieldView :: FieldViewFunc site a
     , fieldEnctype :: Enctype
     }
 
diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal
index 817ef8db..86c856fc 100644
--- a/yesod-form/yesod-form.cabal
+++ b/yesod-form/yesod-form.cabal
@@ -30,7 +30,7 @@ library
                    , containers            >= 0.2
                    , data-default
                    , email-validate        >= 1.0
-                   , persistent
+                   , persistent            >= 2.5
                    , resourcet
                    , semigroups
                    , shakespeare           >= 2.0
@@ -41,6 +41,8 @@ library
                    , xss-sanitize          >= 0.3.0.1
                    , yesod-core            >= 1.6      && < 1.7
                    , yesod-persistent      >= 1.6      && < 1.7
+                   , rio
+                   , rio-orphans
 
     if flag(network-uri)
       build-depends: network-uri >= 2.6
diff --git a/yesod-newsfeed/Yesod/AtomFeed.hs b/yesod-newsfeed/Yesod/AtomFeed.hs
index 49fa2879..008d0e87 100644
--- a/yesod-newsfeed/Yesod/AtomFeed.hs
+++ b/yesod-newsfeed/Yesod/AtomFeed.hs
@@ -42,14 +42,14 @@ instance HasContentType RepAtom where
 instance ToTypedContent RepAtom where
     toTypedContent = TypedContent typeAtom . toContent
 
-atomFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m RepAtom
+atomFeed :: HasHandlerData env => Feed (Route (HandlerSite env)) -> RIO env RepAtom
 atomFeed feed = do
     render <- getUrlRender
     return $ RepAtom $ toContent $ renderLBS def $ template feed render
 
 -- | Same as @'atomFeed'@ but for @'Feed Text'@. Useful for cases where you are
 --   generating a feed of external links.
-atomFeedText :: MonadHandler m => Feed Text -> m RepAtom
+atomFeedText :: HasHandlerData env => Feed Text -> RIO env RepAtom
 atomFeedText feed = return $ RepAtom $ toContent $ renderLBS def $ template feed id
 
 template :: Feed url -> (url -> Text) -> Document
@@ -90,10 +90,10 @@ entryTemplate FeedEntry {..} render = Element "entry" Map.empty $ map NodeElemen
                                           ,("href", render enclosedUrl)]) []]
 
 -- | Generates a link tag in the head of a widget.
-atomLink :: MonadWidget m
-         => Route (HandlerSite m)
+atomLink :: HasWidgetData env
+         => Route (HandlerSite env)
          -> Text -- ^ title
-         -> m ()
+         -> RIO env ()
 atomLink r title = toWidgetHead [hamlet|
     <link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}>
     |]
diff --git a/yesod-newsfeed/Yesod/Feed.hs b/yesod-newsfeed/Yesod/Feed.hs
index 1601cff4..7a680e0a 100644
--- a/yesod-newsfeed/Yesod/Feed.hs
+++ b/yesod-newsfeed/Yesod/Feed.hs
@@ -28,14 +28,14 @@ import Yesod.Core
 
 import Data.Text
 
-newsFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m TypedContent
+newsFeed :: HasHandlerData env => Feed (Route (HandlerSite env)) -> RIO env TypedContent
 newsFeed f = selectRep $ do
     provideRep $ atomFeed f
     provideRep $ rssFeed f
 
 -- | Same as @'newsFeed'@ but for @'Feed Text'@. Useful for cases where you are
 --   generating a feed of external links.
-newsFeedText :: MonadHandler m => Feed Text -> m TypedContent
+newsFeedText :: HasHandlerData env => Feed Text -> RIO env TypedContent
 newsFeedText f = selectRep $ do
     provideRep $ atomFeedText f
     provideRep $ rssFeedText f
diff --git a/yesod-newsfeed/Yesod/RssFeed.hs b/yesod-newsfeed/Yesod/RssFeed.hs
index 6ad098f1..48e8a26b 100644
--- a/yesod-newsfeed/Yesod/RssFeed.hs
+++ b/yesod-newsfeed/Yesod/RssFeed.hs
@@ -39,14 +39,14 @@ instance ToTypedContent RepRss where
     toTypedContent = TypedContent typeRss . toContent
 
 -- | Generate the feed
-rssFeed :: MonadHandler m => Feed (Route (HandlerSite m)) -> m RepRss
+rssFeed :: HasHandlerData env => Feed (Route (HandlerSite env)) -> RIO env RepRss
 rssFeed feed = do
     render <- getUrlRender
     return $ RepRss $ toContent $ renderLBS def $ template feed render
 
 -- | Same as @'rssFeed'@ but for @'Feed Text'@. Useful for cases where you are
 --   generating a feed of external links.
-rssFeedText :: MonadHandler m => Feed Text -> m RepRss
+rssFeedText :: HasHandlerData env => Feed Text -> RIO env RepRss
 rssFeedText feed = return $ RepRss $ toContent $ renderLBS def $ template feed id
 
 template :: Feed url -> (url -> Text) -> Document
@@ -93,10 +93,10 @@ entryTemplate FeedEntry {..} render = Element "item" Map.empty $ map NodeElement
                                   ,("url", render enclosedUrl)]) []]
 
 -- | Generates a link tag in the head of a widget.
-rssLink :: MonadWidget m
-        => Route (HandlerSite m)
+rssLink :: HasWidgetData env
+        => Route (HandlerSite env)
         -> Text -- ^ title
-        -> m ()
+        -> RIO env ()
 rssLink r title = toWidgetHead [hamlet|
     <link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}>
     |]
diff --git a/yesod-sitemap/Yesod/Sitemap.hs b/yesod-sitemap/Yesod/Sitemap.hs
index 6b6a407f..b814670e 100644
--- a/yesod-sitemap/Yesod/Sitemap.hs
+++ b/yesod-sitemap/Yesod/Sitemap.hs
@@ -61,9 +61,9 @@ data SitemapUrl url = SitemapUrl
     }
 
 -- | A basic robots file which just lists the "Sitemap: " line.
-robots :: MonadHandler m
-       => Route (HandlerSite m) -- ^ sitemap url
-       -> m Text
+robots :: HasHandlerData env
+       => Route (HandlerSite env) -- ^ sitemap url
+       -> RIO env Text
 robots smurl = do
     ur <- getUrlRender
     return $ T.unlines
diff --git a/yesod-websockets/Yesod/WebSockets.hs b/yesod-websockets/Yesod/WebSockets.hs
index 5a54c553..20a265cb 100644
--- a/yesod-websockets/Yesod/WebSockets.hs
+++ b/yesod-websockets/Yesod/WebSockets.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 module Yesod.WebSockets
     ( -- * Core API
-      WebSocketsT
-    , webSockets
+      webSockets
     , webSocketsWith
     , webSocketsOptions
     , webSocketsOptionsWith
@@ -39,12 +39,16 @@ import           Conduit
 import qualified Network.Wai.Handler.WebSockets as WaiWS
 import qualified Network.WebSockets             as WS
 import qualified Yesod.Core                     as Y
-import           UnliftIO (SomeException, tryAny, MonadIO, liftIO, MonadUnliftIO, withRunInIO, race, race_, concurrently, concurrently_)
+import           RIO
 
--- | A transformer for a WebSockets handler.
---
--- Since 0.1.0
-type WebSocketsT = ReaderT WS.Connection
+-- FIXME document
+class Y.HasHandlerData env => HasWebsockets env where
+  websocketsL :: Lens' env WS.Connection
+
+data WithWebsockets env = WithWebsockets
+  { wwConnection :: !WS.Connection
+  , wwEnv :: !env
+  }
 
 -- | Attempt to run a WebSockets handler. This function first checks if the
 -- client initiated a WebSockets connection and, if so, runs the provided
@@ -54,9 +58,9 @@ type WebSocketsT = ReaderT WS.Connection
 --
 -- Since 0.1.0
 webSockets
-  :: (MonadUnliftIO m, Y.MonadHandler m)
-  => WebSocketsT m ()
-  -> m ()
+  :: Y.HasHandlerData env
+  => RIO (WithWebsockets env) ()
+  -> RIO env ()
 webSockets = webSocketsOptions WS.defaultConnectionOptions
 
 -- | Varient of 'webSockets' which allows you to specify
@@ -64,26 +68,26 @@ webSockets = webSocketsOptions WS.defaultConnectionOptions
 --
 -- Since 0.2.5
 webSocketsOptions
-  :: (MonadUnliftIO m, Y.MonadHandler m)
+  :: Y.HasHandlerData env
   => WS.ConnectionOptions
-  -> WebSocketsT m ()
-  -> m ()
+  -> RIO (WithWebsockets env) ()
+  -> RIO env ()
 webSocketsOptions opts = webSocketsOptionsWith opts $ const $ return $ Just $ WS.AcceptRequest Nothing []
 
 -- | Varient of 'webSockets' which allows you to specify the 'WS.AcceptRequest'
 -- setttings when upgrading to a websocket connection.
 --
 -- Since 0.2.4
-webSocketsWith :: (MonadUnliftIO m, Y.MonadHandler m)
-               => (WS.RequestHead -> m (Maybe WS.AcceptRequest))
+webSocketsWith :: Y.HasHandlerData env
+               => (WS.RequestHead -> RIO env (Maybe WS.AcceptRequest))
                -- ^ A Nothing indicates that the websocket upgrade request should not happen
                -- and instead the rest of the handler will be called instead.  This allows
                -- you to use 'WS.getRequestSubprotocols' and only accept the request if
                -- a compatible subprotocol is given.  Also, the action runs before upgrading
                -- the request to websockets, so you can also use short-circuiting handler
                -- actions such as 'Y.invalidArgs'.
-               -> WebSocketsT m ()
-               -> m ()
+               -> RIO (WithWebsockets env) ()
+               -> RIO env ()
 webSocketsWith = webSocketsOptionsWith WS.defaultConnectionOptions
 
 -- | Varient of 'webSockets' which allows you to specify both
@@ -91,18 +95,18 @@ webSocketsWith = webSocketsOptionsWith WS.defaultConnectionOptions
 -- setttings when upgrading to a websocket connection.
 --
 -- Since 0.2.5
-webSocketsOptionsWith :: (MonadUnliftIO m, Y.MonadHandler m)
+webSocketsOptionsWith :: Y.HasHandlerData env
                => WS.ConnectionOptions
                -- ^ Custom websockets options
-               -> (WS.RequestHead -> m (Maybe WS.AcceptRequest))
+               -> (WS.RequestHead -> RIO env (Maybe WS.AcceptRequest))
                -- ^ A Nothing indicates that the websocket upgrade request should not happen
                -- and instead the rest of the handler will be called instead.  This allows
                -- you to use 'WS.getRequestSubprotocols' and only accept the request if
                -- a compatible subprotocol is given.  Also, the action runs before upgrading
                -- the request to websockets, so you can also use short-circuiting handler
                -- actions such as 'Y.invalidArgs'.
-               -> WebSocketsT m ()
-               -> m ()
+               -> RIO (WithWebsockets env) ()
+               -> RIO env ()
 webSocketsOptionsWith wsConnOpts buildAr inner = do
     req <- Y.waiRequest
     when (WaiWS.isWebSocketsReq req) $ do
@@ -110,43 +114,45 @@ webSocketsOptionsWith wsConnOpts buildAr inner = do
         mar <- buildAr rhead
         case mar of
             Nothing -> return ()
-            Just ar ->
+            Just ar -> do
+                env <- ask
                 Y.sendRawResponseNoConduit
-                  $ \src sink -> withRunInIO $ \runInIO -> WaiWS.runWebSockets
+                  $ \src sink -> liftIO $ WaiWS.runWebSockets
                     wsConnOpts
                     rhead
                     (\pconn -> do
                         conn <- WS.acceptRequestWith pconn ar
                         WS.forkPingThread conn 30
-                        runInIO $ runReaderT inner conn)
+                        let ww = WithWebsockets conn env
+                        runRIO ww inner)
                     src
                     sink
 
 -- | Wrapper for capturing exceptions
-wrapWSE :: (MonadIO m, MonadReader WS.Connection m)
+wrapWSE :: HasWebsockets env
         => (WS.Connection -> a -> IO ())
         -> a
-        -> m (Either SomeException ())
+        -> RIO env (Either SomeException ())
 wrapWSE ws x = do
-  conn <- ask
+  conn <- view websocketsL
   liftIO $ tryAny $ ws conn x
 
-wrapWS :: (MonadIO m, MonadReader WS.Connection m)
+wrapWS :: HasWebsockets env
        => (WS.Connection -> a -> IO ())
        -> a
-       -> m ()
+       -> RIO env ()
 wrapWS ws x = do
-  conn <- ask
+  conn <- view websocketsL
   liftIO $ ws conn x
 
 -- | Receive a piece of data from the client.
 --
 -- Since 0.1.0
 receiveData
-  :: (MonadIO m, MonadReader WS.Connection m, WS.WebSocketsData a)
-  => m a
+  :: (WS.WebSocketsData a, HasWebsockets env)
+  => RIO env a
 receiveData = do
-  conn <- ask
+  conn <- view websocketsL
   liftIO $ WS.receiveData conn
 
 -- | Receive a piece of data from the client.
@@ -173,9 +179,9 @@ receiveDataMessageE = do
 --
 -- Since 0.1.0
 sendTextData
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  :: (WS.WebSocketsData a, HasWebsockets env)
   => a
-  -> m ()
+  -> RIO env ()
 sendTextData = wrapWS WS.sendTextData
 
 -- | Send a textual message to the client.
@@ -184,45 +190,45 @@ sendTextData = wrapWS WS.sendTextData
 -- `either handle_exception return =<< sendTextDataE ("Welcome" :: Text)`
 -- Since 0.2.2
 sendTextDataE
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  :: (WS.WebSocketsData a, HasWebsockets env)
   => a
-  -> m (Either SomeException ())
+  -> RIO env (Either SomeException ())
 sendTextDataE = wrapWSE WS.sendTextData
 
 -- | Send a binary message to the client.
 --
 -- Since 0.1.0
 sendBinaryData
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  :: (WS.WebSocketsData a, HasWebsockets env)
   => a
-  -> m ()
+  -> RIO env ()
 sendBinaryData = wrapWS WS.sendBinaryData
 
 -- | Send a binary message to the client.
 -- Capture SomeException as the result of operation
 -- Since 0.2.2
 sendBinaryDataE
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  :: (WS.WebSocketsData a, HasWebsockets env)
   => a
-  -> m (Either SomeException ())
+  -> RIO env (Either SomeException ())
 sendBinaryDataE = wrapWSE WS.sendBinaryData
 
 -- | Send a ping message to the client.
 --
 -- Since 0.2.2
 sendPing
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  :: (WS.WebSocketsData a, HasWebsockets env)
   => a
-  -> WebSocketsT m ()
+  -> RIO env ()
 sendPing = wrapWS WS.sendPing
 
 -- | Send a ping message to the client.
 -- Capture SomeException as the result of operation
 -- Since 0.2.2
 sendPingE
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  :: (WS.WebSocketsData a, HasWebsockets env)
   => a
-  -> m (Either SomeException ())
+  -> RIO env (Either SomeException ())
 sendPingE = wrapWSE WS.sendPing
 
 -- | Send a DataMessage to the client.
@@ -240,40 +246,40 @@ sendDataMessageE x = do
 --
 -- Since 0.2.2
 sendClose
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  :: (WS.WebSocketsData a, HasWebsockets env)
   => a
-  -> WebSocketsT m ()
+  -> RIO env ()
 sendClose = wrapWS WS.sendClose
 
 -- | Send a close request to the client.
 -- Capture SomeException as the result of operation
 -- Since 0.2.2
 sendCloseE
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
+  :: (WS.WebSocketsData a, HasWebsockets env)
   => a
-  -> m (Either SomeException ())
+  -> RIO env (Either SomeException ())
 sendCloseE = wrapWSE WS.sendClose
 
 -- | A @Source@ of WebSockets data from the user.
 --
 -- Since 0.1.0
 sourceWS
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
-  => ConduitT i a m ()
+  :: (WS.WebSocketsData a, HasWebsockets env)
+  => ConduitT i a (RIO env) ()
 sourceWS = forever $ lift receiveData >>= yield
 
 -- | A @Sink@ for sending textual data to the user.
 --
 -- Since 0.1.0
 sinkWSText
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
-  => ConduitT a o m ()
+  :: (WS.WebSocketsData a, HasWebsockets env)
+  => ConduitT a o (RIO env) ()
 sinkWSText = mapM_C sendTextData
 
 -- | A @Sink@ for sending binary data to the user.
 --
 -- Since 0.1.0
 sinkWSBinary
-  :: (MonadIO m, WS.WebSocketsData a, MonadReader WS.Connection m)
-  => ConduitT a o m ()
+  :: (WS.WebSocketsData a, HasWebsockets env)
+  => ConduitT a o (RIO env) ()
 sinkWSBinary = mapM_C sendBinaryData
diff --git a/yesod-websockets/yesod-websockets.cabal b/yesod-websockets/yesod-websockets.cabal
index 92633626..32684611 100644
--- a/yesod-websockets/yesod-websockets.cabal
+++ b/yesod-websockets/yesod-websockets.cabal
@@ -22,6 +22,7 @@ library
                      , wai-websockets    >= 2.1
                      , websockets        >= 0.10
                      , yesod-core        >= 1.6
+                     , rio
 
 source-repository head
   type:     git