remove shakespeare dependency from Yesod.Core

yesod-core/Yesod/Core.hs

@@ -21,14 +21,15 @@ module Yesod.Core
     , ErrorResponse (..)
       -- * Utitlities
     , maybeAuthorized
-    , widgetToPageContent
+    -- FIXME: API breakage
+    -- , widgetToPageContent
       -- * Defaults
-    , defaultErrorHandler
+    -- FIXME: API breakage
+    -- , defaultErrorHandler
     , defaultYesodMiddleware
     , authorizationCheck
       -- * Data types
     , AuthResult (..)
-    , unauthorizedI
       -- * Logging
     , LogLevel (..)
     , logDebug
@@ -53,13 +54,11 @@ module Yesod.Core
     , loadClientSession
     , Header(..)
     -- * JS loaders
-    , ScriptLoadPosition (..)
-    , BottomOfHeadAsync
       -- * Subsites
     , MonadHandler (..)
-    , MonadWidget (..)
     , getRouteToParent
-    , defaultLayoutSub
+    -- FIXME
+    -- , defaultLayoutSub
       -- * Misc
     , yesodVersion
     , yesodRender
@@ -72,9 +71,7 @@ module Yesod.Core
     , module Yesod.Core.Content
     , module Yesod.Core.Dispatch
     , module Yesod.Core.Handler
-    , module Yesod.Core.Widget
     , module Yesod.Core.Json
-    , module Text.Shakespeare.I18N
     , module Yesod.Core.Internal.Util
     , module Text.Blaze.Html
     , MonadTrans (..)
@@ -88,31 +85,30 @@ module Yesod.Core
       -- * Utilities
     , showIntegral
     , readIntegral
+    -- FIXME: API breakage
       -- * Shakespeare
       -- ** Hamlet
-    , hamlet
+    -- , hamlet
-    , shamlet
+    -- , shamlet
-    , xhamlet
+    -- , xhamlet
-    , HtmlUrl
+    -- , HtmlUrl
       -- ** Julius
-    , julius
+    -- , julius
-    , JavascriptUrl
+    -- , JavascriptUrl
-    , renderJavascriptUrl
+    -- , renderJavascriptUrl
       -- ** Cassius/Lucius
-    , cassius
+    -- , cassius
-    , lucius
+    -- , lucius
-    , CssUrl
+    -- , CssUrl
-    , renderCssUrl
+    -- , renderCssUrl
     ) where
 
 import Yesod.Core.Content
 import Yesod.Core.Dispatch
 import Yesod.Core.Handler
 import Yesod.Core.Class.Handler
-import Yesod.Core.Widget
 import Yesod.Core.Json
 import Yesod.Core.Types
-import Text.Shakespeare.I18N
 import Yesod.Core.Internal.Util (formatW3 , formatRFC1123 , formatRFC822)
 import Text.Blaze.Html (Html, toHtml, preEscapedToMarkup)
 
@@ -134,10 +130,6 @@ import Control.Monad.Trans.Control (MonadBaseControl (..))
 
 import Control.Monad.Trans.Resource (MonadResource (..))
 import Yesod.Core.Internal.LiteApp
-import Text.Hamlet
-import Text.Cassius
-import Text.Lucius
-import Text.Julius
 import Network.Wai (Application)
 
 runFakeHandler :: (Yesod site, MonadIO m) =>
@@ -149,12 +141,6 @@ runFakeHandler :: (Yesod site, MonadIO m) =>
 runFakeHandler = Yesod.Core.Internal.Run.runFakeHandler
 {-# DEPRECATED runFakeHandler "import runFakeHandler from Yesod.Core.Unsafe" #-}
 
--- | Return an 'Unauthorized' value, with the given i18n message.
-unauthorizedI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => msg -> m AuthResult
-unauthorizedI msg = do
-    mr <- getMessageRender
-    return $ Unauthorized $ mr msg
-
 yesodVersion :: String
 yesodVersion = showVersion Paths_yesod_core.version
 
@@ -173,10 +159,12 @@ maybeAuthorized r isWrite = do
 getRouteToParent :: Monad m => HandlerT child (HandlerT parent m) (Route child -> Route parent)
 getRouteToParent = HandlerT $ return . handlerToParent
 
+{-
 defaultLayoutSub :: Yesod parent
                  => WidgetT child IO ()
                  -> HandlerT child (HandlerT parent IO) Html
 defaultLayoutSub cwidget = widgetToParentWidget cwidget >>= lift . defaultLayout
+-}
 
 showIntegral :: Integral a => a -> String
 showIntegral x = show (fromIntegral x :: Integer)

yesod-core/Yesod/Core/Class/Handler.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE UndecidableInstances #-}
 module Yesod.Core.Class.Handler
     ( MonadHandler (..)
-    , MonadWidget (..)
     ) where
 
 import Yesod.Core.Types
@@ -43,11 +42,6 @@ instance MonadResourceBase m => MonadHandler (HandlerT site m) where
     liftHandlerT (HandlerT f) = HandlerT $ liftIO . f . replaceToParent
 {-# RULES "liftHandlerT (HandlerT site IO)" liftHandlerT = id #-}
 
-instance MonadResourceBase m => MonadHandler (WidgetT site m) where
-    type HandlerSite (WidgetT site m) = site
-    liftHandlerT (HandlerT f) = WidgetT $ liftIO . liftM (, mempty) . f . replaceToParent
-{-# RULES "liftHandlerT (WidgetT site IO)" forall f. liftHandlerT (HandlerT f) = WidgetT $ liftM (, mempty) . f #-}
-
 #define GO(T) instance MonadHandler m => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandlerT = lift . liftHandlerT
 #define GOX(X, T) instance (X, MonadHandler m) => MonadHandler (T m) where type HandlerSite (T m) = HandlerSite m; liftHandlerT = lift . liftHandlerT
 GO(IdentityT)
@@ -65,26 +59,3 @@ GO(Pipe l i o u)
 GO(ConduitM i o)
 #undef GO
 #undef GOX
-
-class MonadHandler m => MonadWidget m where
-    liftWidgetT :: WidgetT (HandlerSite m) IO a -> m a
-instance MonadResourceBase m => MonadWidget (WidgetT site m) where
-    liftWidgetT (WidgetT f) = WidgetT $ liftIO . f . replaceToParent
-
-#define GO(T) instance MonadWidget m => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
-#define GOX(X, T) instance (X, MonadWidget m) => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
-GO(IdentityT)
-GO(ListT)
-GO(MaybeT)
-GOX(Error e, ErrorT 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

yesod-core/Yesod/Core/Class/Yesod.hs

@@ -23,8 +23,6 @@ import           Control.Monad.Trans.Resource       (InternalState, createIntern
 import qualified Data.ByteString.Char8              as S8
 import qualified Data.ByteString.Lazy               as L
 import Data.Aeson (object, (.=))
-import           Data.List                          (foldl')
-import           Data.List                          (nub)
 import qualified Data.Map                           as Map
 import           Data.Maybe                         (fromMaybe)
 import           Data.Monoid
@@ -46,17 +44,16 @@ import           System.Log.FastLogger
 import           Text.Blaze                         (customAttribute, textTag,
                                                      toValue, (!))
 import           Text.Blaze                         (preEscapedToMarkup)
+import           Text.Blaze.Html                    (Html)
 import qualified Text.Blaze.Html5                   as TBH
-import           Text.Hamlet
-import           Text.Julius
 import qualified Web.ClientSession                  as CS
 import           Web.Cookie                         (parseCookies)
 import           Web.Cookie                         (SetCookie (..))
 import           Yesod.Core.Types
 import           Yesod.Core.Internal.Session
-import           Yesod.Core.Widget
 import Control.Monad.Trans.Class (lift)
 
+
 -- | Define settings for a Yesod applications. All methods have intelligent
 -- defaults, and therefore no implementation is required.
 class RenderRoute site => Yesod site where
@@ -80,10 +77,12 @@ class RenderRoute site => Yesod site where
     --
     -- Default value: 'defaultErrorHandler'.
     errorHandler :: ErrorResponse -> HandlerT site IO TypedContent
-    errorHandler = defaultErrorHandler
+    -- errorHandler = defaultErrorHandler
 
     -- | Applies some form of layout to the contents of a page.
+    {- FIXME
     defaultLayout :: WidgetT site IO () -> HandlerT site IO Html
+    widgetToPageContent = widgetToPageContentUnbound addStaticContent jsLoader
     defaultLayout w = do
         p <- widgetToPageContent w
         mmsg <- getMessage
@@ -99,6 +98,7 @@ class RenderRoute site => Yesod site where
                         <p .message>#{msg}
                     ^{pageBody p}
             |]
+            -}
 
     -- | Override the rendering function for a particular URL. One use case for
     -- this is to offload static hosting to a different domain name to avoid
@@ -236,8 +236,9 @@ class RenderRoute site => Yesod site where
     -- > BottomOfHeadAsync $ loadJsYepnope $ Right $ StaticR js_modernizr_js
     --
     -- Or write your own async js loader.
-    jsLoader :: site -> ScriptLoadPosition site
+    -- FIXME: the type
-    jsLoader _ = BottomOfBody
+    -- jsLoader :: site -> ScriptLoadPosition site
+    -- jsLoader _ = BottomOfBody
 
     -- | Create a session backend. Returning 'Nothing' disables
     -- sessions. If you'd like to change the way that the session
@@ -300,6 +301,7 @@ class RenderRoute site => Yesod site where
     yesodWithInternalState _ _ = bracket createInternalState closeInternalState
     {-# INLINE yesodWithInternalState #-}
 
+
 -- | Default implementation of 'yesodMiddleware'. Adds the response header
 -- \"Vary: Accept, Accept-Language\" and performs authorization checks.
 --
@@ -373,104 +375,7 @@ authorizationCheck = do
                               void $ notAuthenticated
             Unauthorized s' -> permissionDenied s'
 
--- | Convert a widget to a 'PageContent'.
+{- FIXME
-widgetToPageContent :: (Eq (Route site), Yesod site)
-                    => WidgetT site IO ()
-                    -> HandlerT site IO (PageContent (Route site))
-widgetToPageContent w = do
-    master <- getYesod
-    hd <- HandlerT return
-    ((), GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- lift $ unWidgetT w hd
-    let title = maybe mempty unTitle mTitle
-        scripts = runUniqueList scripts'
-        stylesheets = runUniqueList stylesheets'
-
-    render <- getUrlRenderParams
-    let renderLoc x =
-            case x of
-                Nothing -> Nothing
-                Just (Left s) -> Just s
-                Just (Right (u, p)) -> Just $ render u p
-    css <- forM (Map.toList style) $ \(mmedia, content) -> do
-        let rendered = toLazyText $ content render
-        x <- addStaticContent "css" "text/css; charset=utf-8"
-           $ encodeUtf8 rendered
-        return (mmedia,
-            case x of
-                Nothing -> Left $ preEscapedToMarkup rendered
-                Just y -> Right $ either id (uncurry render) y)
-    jsLoc <-
-        case jscript of
-            Nothing -> return Nothing
-            Just s -> do
-                x <- addStaticContent "js" "text/javascript; charset=utf-8"
-                   $ encodeUtf8 $ renderJavascriptUrl render s
-                return $ renderLoc x
-
-    -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
-    -- the asynchronous loader means your page doesn't have to wait for all the js to load
-    let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
-        regularScriptLoad = [hamlet|
-            $newline never
-            $forall s <- scripts
-                ^{mkScriptTag s}
-            $maybe j <- jscript
-                $maybe s <- jsLoc
-                    <script src="#{s}">
-                $nothing
-                    <script>^{jelper j}
-        |]
-
-        headAll = [hamlet|
-            $newline never
-            \^{head'}
-            $forall s <- stylesheets
-                ^{mkLinkTag s}
-            $forall s <- css
-                $maybe t <- right $ snd s
-                    $maybe media <- fst s
-                        <link rel=stylesheet media=#{media} href=#{t}>
-                    $nothing
-                        <link rel=stylesheet href=#{t}>
-                $maybe content <- left $ snd s
-                    $maybe media <- fst s
-                        <style media=#{media}>#{content}
-                    $nothing
-                        <style>#{content}
-            $case jsLoader master
-              $of BottomOfBody
-              $of BottomOfHeadAsync asyncJsLoader
-                  ^{asyncJsLoader asyncScripts mcomplete}
-              $of BottomOfHeadBlocking
-                  ^{regularScriptLoad}
-        |]
-    let bodyScript = [hamlet|
-            $newline never
-            ^{body}
-            ^{regularScriptLoad}
-        |]
-
-    return $ PageContent title headAll $
-        case jsLoader master of
-            BottomOfBody -> bodyScript
-            _ -> body
-  where
-    renderLoc' render' (Local url) = render' url []
-    renderLoc' _ (Remote s) = s
-
-    addAttr x (y, z) = x ! customAttribute (textTag y) (toValue z)
-    mkScriptTag (Script loc attrs) render' =
-        foldl' addAttr TBH.script (("src", renderLoc' render' loc) : attrs) $ return ()
-    mkLinkTag (Stylesheet loc attrs) render' =
-        foldl' addAttr TBH.link
-            ( ("rel", "stylesheet")
-            : ("href", renderLoc' render' loc)
-            : attrs
-            )
-
-    runUniqueList :: Eq x => UniqueList x -> [x]
-    runUniqueList (UniqueList x) = nub $ x []
-
 -- | The default error handler for 'errorHandler'.
 defaultErrorHandler :: Yesod site => ErrorResponse -> HandlerT site IO TypedContent
 defaultErrorHandler NotFound = selectRep $ do
@@ -553,29 +458,7 @@ defaultErrorHandler (BadMethod m) = selectRep $ do
             <p>Method <code>#{S8.unpack m}</code> not supported
         |]
     provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m]
-
+    -}
-asyncHelper :: (url -> [x] -> Text)
-         -> [Script (url)]
-         -> Maybe (JavascriptUrl (url))
-         -> Maybe Text
-         -> (Maybe (HtmlUrl url), [Text])
-asyncHelper render scripts jscript jsLoc =
-    (mcomplete, scripts'')
-  where
-    scripts' = map goScript scripts
-    scripts'' =
-        case jsLoc of
-            Just s -> scripts' ++ [s]
-            Nothing -> scripts'
-    goScript (Script (Local url) _) = render url []
-    goScript (Script (Remote s) _) = s
-    mcomplete =
-        case jsLoc of
-            Just{} -> Nothing
-            Nothing ->
-                case jscript of
-                    Nothing -> Nothing
-                    Just j -> Just $ jelper j
 
 formatLogMessage :: IO ZonedDate
                  -> Loc
@@ -663,20 +546,6 @@ envClientSessionBackend minutes name = do
     (getCachedDate, _closeDateCacher) <- clientSessionDateCacher timeout
     return $ clientSessionBackend key getCachedDate
 
-jsToHtml :: Javascript -> Html
-jsToHtml (Javascript b) = preEscapedToMarkup $ toLazyText b
-
-jelper :: JavascriptUrl url -> HtmlUrl url
-jelper = fmap jsToHtml
-
-left :: Either a b -> Maybe a
-left (Left x) = Just x
-left _ = Nothing
-
-right :: Either a b -> Maybe b
-right (Right x) = Just x
-right _ = Nothing
-
 clientSessionBackend :: CS.Key  -- ^ The encryption key
                      -> IO ClientSessionDateCache -- ^ See 'clientSessionDateCacher'
                      -> SessionBackend

yesod-core/Yesod/Core/Content.hs

@@ -58,8 +58,6 @@ import Control.Monad (liftM)
 import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)
 import Data.Monoid (mempty)
 
-import Text.Hamlet (Html)
-import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
 import Data.Conduit (Source, Flush (Chunk), ResumableSource, mapOutput)
 import Control.Monad.Trans.Resource (ResourceT)
 import Data.Conduit.Internal (ResumableSource (ResumableSource))
@@ -74,8 +72,6 @@ import Data.Aeson.Encode (fromValue)
 import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
 import Data.Text.Lazy.Builder (toLazyText)
 import Yesod.Core.Types
-import Text.Lucius (Css, renderCss)
-import Text.Julius (Javascript, unJavascript)
 
 -- | Zero-length enumerator.
 emptyContent :: Content
@@ -106,8 +102,6 @@ instance ToContent Text where
     toContent = toContent . Blaze.fromLazyText
 instance ToContent String where
     toContent = toContent . Blaze.fromString
-instance ToContent Html where
-    toContent bs = ContentBuilder (renderHtmlBuilder bs) Nothing
 instance ToContent () where
     toContent () = toContent B.empty
 instance ToContent (ContentType, Content) where
@@ -115,11 +109,6 @@ instance ToContent (ContentType, Content) where
 instance ToContent TypedContent where
     toContent (TypedContent _ c) = c
 
-instance ToContent Css where
-    toContent = toContent . renderCss
-instance ToContent Javascript where
-    toContent = toContent . toLazyText . unJavascript
-
 instance ToFlushBuilder builder => ToContent (CI.Pipe () () builder () (ResourceT IO) ()) where
     toContent src = ContentSource $ CI.ConduitM (CI.mapOutput toFlushBuilder src >>=)
 
@@ -145,8 +134,6 @@ instance ToFlushBuilder (Flush T.Text) where toFlushBuilder = fmap Blaze.fromTex
 instance ToFlushBuilder T.Text where toFlushBuilder = Chunk . Blaze.fromText
 instance ToFlushBuilder (Flush String) where toFlushBuilder = fmap Blaze.fromString
 instance ToFlushBuilder String where toFlushBuilder = Chunk . Blaze.fromString
-instance ToFlushBuilder (Flush Html) where toFlushBuilder = fmap renderHtmlBuilder
-instance ToFlushBuilder Html where toFlushBuilder = Chunk . renderHtmlBuilder
 
 repJson :: ToContent a => a -> RepJson
 repJson = RepJson . toContent
@@ -255,21 +242,12 @@ instance ToContent J.Value where
 instance HasContentType J.Value where
     getContentType _ = typeJson
 
-instance HasContentType Html where
-    getContentType _ = typeHtml
-
 instance HasContentType Text where
     getContentType _ = typePlain
 
 instance HasContentType T.Text where
     getContentType _ = typePlain
 
-instance HasContentType Css where
-    getContentType _ = typeCss
-
-instance HasContentType Javascript where
-    getContentType _ = typeJavascript
-
 -- | Any type which can be converted to 'TypedContent'.
 --
 -- Since 1.2.0
@@ -290,8 +268,6 @@ instance ToTypedContent RepXml where
     toTypedContent (RepXml c) = TypedContent typeXml c
 instance ToTypedContent J.Value where
     toTypedContent v = TypedContent typeJson (toContent v)
-instance ToTypedContent Html where
-    toTypedContent h = TypedContent typeHtml (toContent h)
 instance ToTypedContent T.Text where
     toTypedContent t = TypedContent typePlain (toContent t)
 instance ToTypedContent [Char] where
@@ -302,8 +278,3 @@ instance ToTypedContent a => ToTypedContent (DontFullyEvaluate a) where
     toTypedContent (DontFullyEvaluate a) =
         let TypedContent ct c = toTypedContent a
          in TypedContent ct (ContentDontEvaluate c)
-
-instance ToTypedContent Css where
-    toTypedContent = TypedContent typeCss . toContent
-instance ToTypedContent Javascript where
-    toTypedContent = TypedContent typeJavascript . toContent

yesod-core/Yesod/Core/Handler.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE FunctionalDependencies     #-}
 {-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE QuasiQuotes                #-}
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE TupleSections              #-}
 {-# LANGUAGE TypeFamilies               #-}
@@ -72,21 +71,17 @@ module Yesod.Core.Handler
     , sendChunkLBS
     , sendChunkText
     , sendChunkLazyText
-    , sendChunkHtml
       -- ** Redirecting
     , RedirectUrl (..)
     , redirect
     , redirectWith
-    , redirectToPost
     , Fragment(..)
       -- ** Errors
     , notFound
     , badMethod
     , notAuthenticated
     , permissionDenied
-    , permissionDeniedI
     , invalidArgs
-    , invalidArgsI
       -- ** Short-circuit responses.
     , sendFile
     , sendFilePart
@@ -132,13 +127,8 @@ module Yesod.Core.Handler
     , setUltDestReferer
     , redirectUltDest
     , clearUltDest
-      -- ** Messages
-    , setMessage
-    , setMessageI
-    , getMessage
       -- * Helpers for specific content
       -- ** Hamlet
-    , hamletToRepHtml
     , giveUrlRenderer
     , withUrlRenderer
       -- ** Misc
@@ -146,8 +136,6 @@ module Yesod.Core.Handler
       -- * Lifting
     , handlerToIO
     , forkHandler
-      -- * i18n
-    , getMessageRender
       -- * Per-request caching
     , cached
     , cachedBy
@@ -177,8 +165,6 @@ import qualified Data.Text                     as T
 import           Data.Text.Encoding            (decodeUtf8With, encodeUtf8)
 import           Data.Text.Encoding.Error      (lenientDecode)
 import qualified Data.Text.Lazy                as TL
-import qualified Text.Blaze.Html.Renderer.Text as RenderText
-import           Text.Hamlet                   (Html, HtmlUrl, hamlet)
 
 import qualified Data.ByteString               as S
 import qualified Data.ByteString.Lazy          as L
@@ -189,11 +175,9 @@ import qualified Data.ByteString.Char8         as S8
 import           Data.Monoid                   (Endo (..), mappend, mempty)
 import           Data.Text                     (Text)
 import qualified Network.Wai.Parse             as NWP
-import           Text.Shakespeare.I18N         (RenderMessage (..))
 import           Web.Cookie                    (SetCookie (..))
 import           Yesod.Core.Content            (ToTypedContent (..), simpleContentType, contentTypeTypes, HasContentType (..), ToContent (..), ToFlushBuilder (..))
 import           Yesod.Core.Internal.Util      (formatRFC1123)
-import           Text.Blaze.Html               (preEscapedToMarkup, toHtml)
 
 import qualified Data.IORef.Lifted             as I
 import           Data.Maybe                    (listToMaybe, mapMaybe)
@@ -481,34 +465,6 @@ redirectUltDest def = do
 clearUltDest :: MonadHandler m => m ()
 clearUltDest = deleteSession ultDestKey
 
-msgKey :: Text
-msgKey = "_MSG"
-
--- | Sets a message in the user's session.
---
--- See 'getMessage'.
-setMessage :: MonadHandler m => Html -> m ()
-setMessage = setSession msgKey . T.concat . TL.toChunks . RenderText.renderHtml
-
--- | Sets a message in the user's session.
---
--- See 'getMessage'.
-setMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg)
-            => msg -> m ()
-setMessageI msg = do
-    mr <- getMessageRender
-    setMessage $ toHtml $ mr msg
-
--- | Gets the message in the user's session, if available, and then clears the
--- variable.
---
--- See 'setMessage'.
-getMessage :: MonadHandler m => m (Maybe Html)
-getMessage = do
-    mmsg <- liftM (fmap preEscapedToMarkup) $ lookupSession msgKey
-    deleteSession msgKey
-    return mmsg
-
 -- | Bypass remaining handler code and output the given file.
 --
 -- For some backends, this is more efficient than reading in the file to
@@ -623,24 +579,10 @@ notAuthenticated = hcError NotAuthenticated
 permissionDenied :: MonadHandler m => Text -> m a
 permissionDenied = hcError . PermissionDenied
 
--- | Return a 403 permission denied page.
-permissionDeniedI :: (RenderMessage (HandlerSite m) msg, MonadHandler m)
-                  => msg
-                  -> m a
-permissionDeniedI msg = do
-    mr <- getMessageRender
-    permissionDenied $ mr msg
-
 -- | Return a 400 invalid arguments page.
 invalidArgs :: MonadHandler m => [Text] -> m a
 invalidArgs = hcError . InvalidArgs
 
--- | Return a 400 invalid arguments page.
-invalidArgsI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => [msg] -> m a
-invalidArgsI msg = do
-    mr <- getMessageRender
-    invalidArgs $ map mr msg
-
 ------- Headers
 -- | Set the cookie on the client.
 
@@ -837,36 +779,6 @@ newIdent = do
     put x { ghsIdent = i' }
     return $ T.pack $ "hident" ++ show i'
 
--- | Redirect to a POST resource.
---
--- This is not technically a redirect; instead, it returns an HTML page with a
--- 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)
-               => url
-               -> m a
-redirectToPost url = do
-    urlText <- toTextUrl url
-    withUrlRenderer [hamlet|
-$newline never
-$doctype 5
-
-<html>
-    <head>
-        <title>Redirecting...
-    <body onload="document.getElementById('form').submit()">
-        <form id="form" method="post" action=#{urlText}>
-            <noscript>
-                <p>Javascript has been disabled; please click on the button below to be redirected.
-            <input type="submit" value="Continue">
-|] >>= sendResponse
-
--- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
-hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html
-hamletToRepHtml = withUrlRenderer
-{-# DEPRECATED hamletToRepHtml "Use withUrlRenderer instead" #-}
-
 -- | Deprecated synonym for 'withUrlRenderer'.
 --
 -- Since 1.2.0
@@ -891,13 +803,6 @@ withUrlRenderer f = do
 waiRequest :: MonadHandler m => m W.Request
 waiRequest = reqWaiRequest `liftM` getRequest
 
-getMessageRender :: (MonadHandler m, RenderMessage (HandlerSite m) message)
-                 => m (message -> Text)
-getMessageRender = do
-    env <- askHandlerEnv
-    l <- reqLangs `liftM` getRequest
-    return $ renderMessage (rheSite env) l
-
 -- | Use a per-request cache to avoid performing the same action multiple times.
 -- Values are stored by their type, the result of typeOf from Typeable.
 -- Therefore, you should use different newtype wrappers at each cache site.
@@ -1232,9 +1137,3 @@ sendChunkText = sendChunk
 -- Since 1.2.0
 sendChunkLazyText :: Monad m => TL.Text -> Producer m (Flush Builder)
 sendChunkLazyText = sendChunk
-
--- | Type-specialized version of 'sendChunk' for @Html@s.
---
--- Since 1.2.0
-sendChunkHtml :: Monad m => Html -> Producer m (Flush Builder)
-sendChunkHtml = sendChunk

yesod-core/Yesod/Core/Internal/LiteApp.hs

@@ -46,7 +46,7 @@ instance Monoid LiteApp where
     mappend (LiteApp x) (LiteApp y) = LiteApp $ \m ps -> x m ps <|> y m ps
 
 type LiteHandler = HandlerT LiteApp IO
-type LiteWidget = WidgetT LiteApp IO
+-- type LiteWidget = WidgetT LiteApp IO
 
 liteApp :: Writer LiteApp () -> LiteApp
 liteApp = execWriter

yesod-core/Yesod/Core/Internal/TH.hs

@@ -55,8 +55,9 @@ masterTypeSyns :: Type -> [Dec]
 masterTypeSyns site =
     [ TySynD (mkName "Handler") []
       $ ConT ''HandlerT `AppT` site `AppT` ConT ''IO
-    , TySynD (mkName "Widget")  []
+    -- FIXME
-      $ ConT ''WidgetT `AppT` site `AppT` ConT ''IO `AppT` ConT ''()
+    -- , TySynD (mkName "Widget")  []
+    --  $ ConT ''WidgetT `AppT` site `AppT` ConT ''IO `AppT` ConT ''()
     ]
 
 mkYesodGeneral :: String                   -- ^ foundation type

yesod-core/Yesod/Core/Json.hs

@@ -3,8 +3,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Yesod.Core.Json
     ( -- * Convert from a JSON value
-      defaultLayoutJson
+      jsonToRepJson
-    , jsonToRepJson
     , returnJson
     , provideJson
 
@@ -32,9 +31,8 @@ import Control.Monad.Trans.Writer (Writer)
 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.Yesod (Yesod)
 import Yesod.Core.Class.Handler
-import Yesod.Core.Widget (WidgetT)
 import Yesod.Routes.Class
 import qualified Data.Aeson as J
 import qualified Data.Aeson.Parser as JP
@@ -48,19 +46,6 @@ import qualified Data.ByteString.Char8 as B8
 import Data.Maybe (listToMaybe)
 import Control.Monad (liftM)
 
--- | Provide both an HTML and JSON representation for a piece of
--- data, using the default layout for the HTML output
--- ('defaultLayout').
---
--- /Since: 0.3.0/
-defaultLayoutJson :: (Yesod site, J.ToJSON a)
-                  => WidgetT site IO ()  -- ^ HTML
-                  -> HandlerT site IO a  -- ^ JSON
-                  -> HandlerT site IO TypedContent
-defaultLayoutJson w json = selectRep $ do
-    provideRep $ defaultLayout w
-    provideRep $ fmap J.toJSON json
-
 -- | Wraps a data type in a 'RepJson'.  The data type must
 -- support conversion to JSON via 'J.ToJSON'.
 --

yesod-core/Yesod/Core/Types.hs

@@ -27,10 +27,9 @@ import           Data.ByteString                    (ByteString)
 import qualified Data.ByteString.Lazy               as L
 import           Data.Conduit                       (Flush, Source)
 import           Data.IORef                         (IORef)
-import           Data.Map                           (Map, unionWith)
 import qualified Data.Map                           as Map
-import           Data.Monoid                        (Endo (..), Last (..),
+import           Data.Map                           (Map)
-                                                     Monoid (..))
+import           Data.Monoid                        (Endo (..), Monoid (..))
 import           Data.Serialize                     (Serialize (..),
                                                      putByteString)
 import           Data.String                        (IsString (fromString))
@@ -49,8 +48,6 @@ import           System.Log.FastLogger              (LogStr, LoggerSet, toLogStr
 import qualified System.Random.MWC                  as MWC
 import           Network.Wai.Logger                 (DateCacheGetter)
 import           Text.Blaze.Html                    (Html)
-import           Text.Hamlet                        (HtmlUrl)
-import           Text.Julius                        (JavascriptUrl)
 import           Web.Cookie                         (SetCookie)
 import           Yesod.Core.Internal.Util           (getTime, putTime)
 import           Control.Monad.Trans.Class          (MonadTrans (..))
@@ -159,16 +156,6 @@ type ResolvedApproot = Text
 data AuthResult = Authorized | AuthenticationRequired | Unauthorized Text
     deriving (Eq, Show, Read)
 
-data ScriptLoadPosition master
-    = BottomOfBody
-    | BottomOfHeadBlocking
-    | BottomOfHeadAsync (BottomOfHeadAsync master)
-
-type BottomOfHeadAsync master
-       = [Text] -- ^ urls to load asynchronously
-      -> Maybe (HtmlUrl (Route master)) -- ^ widget of js to run on async completion
-      -> (HtmlUrl (Route master)) -- ^ widget to insert at the bottom of <head>
-
 type Texts = [Text]
 
 -- | Wrap up a normal WAI application as a Yesod subsite.
@@ -239,18 +226,6 @@ data GHState = GHState
 -- the 'HandlerT' monad and template haskell code should hide it away.
 type YesodApp = YesodRequest -> ResourceT IO YesodResponse
 
--- | A generic widget, allowing specification of both the subsite and master
--- site datatypes. While this is simply a @WriterT@, we define a newtype for
--- better error messages.
-newtype WidgetT site m a = WidgetT
-    { unWidgetT :: HandlerData site (MonadRoute m) -> m (a, GWData (Route site))
-    }
-
-instance (a ~ (), Monad m) => Monoid (WidgetT site m a) where
-    mempty = return ()
-    mappend x y = x >> y
-instance (a ~ (), Monad m) => Semigroup (WidgetT site m a)
-
 type RY master = Route master -> [(Text, Text)] -> Text
 
 -- | Newtype wrapper allowing injection of arbitrary content into CSS.
@@ -262,16 +237,6 @@ type RY master = Route master -> [(Text, Text)] -> Text
 -- Since: 1.1.3
 newtype CssBuilder = CssBuilder { unCssBuilder :: TBuilder.Builder }
 
--- | Content for a web page. By providing this datatype, we can easily create
--- generic site templates, which would have the type signature:
---
--- > PageContent url -> HtmlUrl url
-data PageContent url = PageContent
-    { pageTitle :: Html
-    , pageHead  :: HtmlUrl url
-    , pageBody  :: HtmlUrl url
-    }
-
 data Content = ContentBuilder !BBuilder.Builder !(Maybe Int) -- ^ The content and optional content length.
              | ContentSource !(Source (ResourceT IO) (Flush BBuilder.Builder))
              | ContentFile !FilePath !(Maybe FilePart)
@@ -332,37 +297,8 @@ data Stylesheet url = Stylesheet { styleLocation :: Location url, styleAttribute
     deriving (Show, Eq)
 newtype Title = Title { unTitle :: Html }
 
-newtype Head url = Head (HtmlUrl url)
-    deriving Monoid
-instance Semigroup (Head a)
-newtype Body url = Body (HtmlUrl url)
-    deriving Monoid
-instance Semigroup (Body a)
-
 type CssBuilderUrl a = (a -> [(Text, Text)] -> Text) -> TBuilder.Builder
 
-data GWData a = GWData
-    { gwdBody        :: !(Body a)
-    , gwdTitle       :: !(Last Title)
-    , gwdScripts     :: !(UniqueList (Script a))
-    , gwdStylesheets :: !(UniqueList (Stylesheet a))
-    , gwdCss         :: !(Map (Maybe Text) (CssBuilderUrl a)) -- media type
-    , gwdJavascript  :: !(Maybe (JavascriptUrl a))
-    , gwdHead        :: !(Head a)
-    }
-instance Monoid (GWData a) where
-    mempty = GWData mempty mempty mempty mempty mempty mempty mempty
-    mappend (GWData a1 a2 a3 a4 a5 a6 a7)
-            (GWData b1 b2 b3 b4 b5 b6 b7) = GWData
-        (a1 `mappend` b1)
-        (a2 `mappend` b2)
-        (a3 `mappend` b3)
-        (a4 `mappend` b4)
-        (unionWith mappend a5 b5)
-        (a6 `mappend` b6)
-        (a7 `mappend` b7)
-instance Semigroup (GWData a)
-
 data HandlerContents =
       HCContent H.Status !TypedContent
     | HCError ErrorResponse
@@ -383,51 +319,6 @@ instance Show HandlerContents where
     show (HCWaiApp _) = "HCWaiApp"
 instance Exception HandlerContents
 
--- Instances for WidgetT
-instance Monad m => Functor (WidgetT site m) where
-    fmap = liftM
-instance Monad m => Applicative (WidgetT site m) where
-    pure = return
-    (<*>) = ap
-instance Monad m => Monad (WidgetT site m) where
-    return a = WidgetT $ const $ return (a, mempty)
-    WidgetT x >>= f = WidgetT $ \r -> do
-        (a, wa) <- x r
-        (b, wb) <- unWidgetT (f a) r
-        return (b, wa `mappend` wb)
-instance MonadIO m => MonadIO (WidgetT site m) where
-    liftIO = lift . liftIO
-instance MonadBase b m => MonadBase b (WidgetT site m) where
-    liftBase = WidgetT . const . liftBase . fmap (, mempty)
-instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where
-#if MIN_VERSION_monad_control(1,0,0)
-    type StM (WidgetT site m) a = StM m (a, GWData (Route site))
-    liftBaseWith f = WidgetT $ \reader' ->
-        liftBaseWith $ \runInBase ->
-            liftM (\x -> (x, mempty))
-            (f $ runInBase . flip unWidgetT reader')
-    restoreM = WidgetT . const . restoreM
-#else
-    data StM (WidgetT site m) a = StW (StM m (a, GWData (Route site)))
-    liftBaseWith f = WidgetT $ \reader' ->
-        liftBaseWith $ \runInBase ->
-            liftM (\x -> (x, mempty))
-            (f $ liftM StW . runInBase . flip unWidgetT reader')
-    restoreM (StW base) = WidgetT $ const $ restoreM base
-#endif
-instance Monad m => MonadReader site (WidgetT site m) where
-    ask = WidgetT $ \hd -> return (rheSite $ handlerEnv hd, mempty)
-    local f (WidgetT g) = WidgetT $ \hd -> g hd
-        { handlerEnv = (handlerEnv hd)
-            { rheSite = f $ rheSite $ handlerEnv hd
-            }
-        }
-
-instance MonadTrans (WidgetT site) where
-    lift = WidgetT . const . liftM (, mempty)
-instance MonadThrow m => MonadThrow (WidgetT site m) where
-    throwM = lift . throwM
-
 instance MonadCatch m => MonadCatch (HandlerT site m) where
   catch (HandlerT m) c = HandlerT $ \r -> m r `catch` \e -> unHandlerT (c e) r
 instance MonadMask m => MonadMask (HandlerT site m) where
@@ -436,29 +327,6 @@ instance MonadMask m => MonadMask (HandlerT site m) where
   uninterruptibleMask a =
     HandlerT $ \e -> uninterruptibleMask $ \u -> unHandlerT (a $ q u) e
       where q u (HandlerT b) = HandlerT (u . b)
-instance MonadCatch m => MonadCatch (WidgetT site m) where
-  catch (WidgetT m) c = WidgetT $ \r -> m r `catch` \e -> unWidgetT (c e) r
-instance MonadMask m => MonadMask (WidgetT site m) where
-  mask a = WidgetT $ \e -> mask $ \u -> unWidgetT (a $ q u) e
-    where q u (WidgetT b) = WidgetT (u . b)
-  uninterruptibleMask a =
-    WidgetT $ \e -> uninterruptibleMask $ \u -> unWidgetT (a $ q u) e
-      where q u (WidgetT b) = WidgetT (u . b)
-
-instance (Applicative m, MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where
-    liftResourceT f = WidgetT $ \hd -> liftIO $ fmap (, mempty) $ runInternalState f (handlerResource hd)
-
-instance MonadIO m => MonadLogger (WidgetT site m) where
-    monadLoggerLog a b c d = WidgetT $ \hd ->
-        liftIO $ fmap (, mempty) $ rheLog (handlerEnv hd) a b c (toLogStr d)
-
-#if MIN_VERSION_monad_logger(0, 3, 10)
-instance MonadIO m => MonadLoggerIO (WidgetT site m) where
-    askLoggerIO = WidgetT $ \hd -> return (rheLog (handlerEnv hd), mempty)
-#endif
-
-instance MonadActive m => MonadActive (WidgetT site m) where
-    monadActive = lift monadActive
 instance MonadActive m => MonadActive (HandlerT site m) where
     monadActive = lift monadActive
 

yesod-core/Yesod/Core/Widget.hs

@@ -1,3 +1,6 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE RankNTypes #-}
@@ -6,6 +9,8 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes                #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE CPP #-}
@@ -13,7 +18,7 @@
 -- generator, allowing you to create truly modular HTML components.
 module Yesod.Core.Widget
     ( -- * Datatype
-      WidgetT
+      WidgetT(..)
     , PageContent (..)
       -- * Special Hamlet quasiquoter/TH for Widgets
     , whamlet
@@ -48,31 +53,113 @@ module Yesod.Core.Widget
       -- * Internal
     , whamletFileWithSettings
     , asWidgetT
+
+      -- * Formerly Yesod.Core.Types
+    , ScriptLoadPosition(..)
+    , BottomOfHeadAsync
+    , GWData(..)
+    , Head(..)
+    , Body(..)
+
+      -- * Formerly Yesod.Core.Class.Yesod
+    , jelper
+    , asyncHelper
+    , jsToHtml
+
+      -- * Formerly Yesod.Core.Class.Handler
+
+      -- * Formerly Yesod.Core.Handler
+      -- ** Streaming
+    , sendChunkHtml
+      -- ** Redirecting
+    , redirectToPost
+      -- ** Errors
+    , permissionDeniedI
+    , invalidArgsI
+    , unauthorizedI
+      -- ** Messages
+    , setMessage
+    , setMessageI
+    , getMessage
+      -- ** Hamlet
+    , hamletToRepHtml
+      -- * i18n
+    , getMessageRender
+
+      -- * Formerly Yesod.Core.Json
+    -- FIXME
+    -- , defaultLayoutJson
+
+      -- * Formerly Yesod.Core
+    , MonadWidget (..)
     ) where
 
+import           Control.Applicative                (Applicative(..))
+import           Control.Monad                      (liftM, ap, forM)
+import           Control.Monad.Base                 (MonadBase (liftBase))
+import           Control.Monad.Catch                (MonadCatch (..))
+import           Control.Monad.Catch                (MonadMask (..))
+import           Control.Monad.Logger               (MonadLogger (..))
+#if MIN_VERSION_monad_logger(0, 3, 10)
+import Control.Monad.Logger (MonadLoggerIO (..))
+#endif
+import           Control.Monad.Reader               (MonadReader (..))
+import           Control.Monad.Trans.Class          (MonadTrans (..))
+import           Control.Monad.Trans.Control        (MonadBaseControl (..))
+import           Control.Monad.Trans.Resource       (MonadResourceBase, MonadResource (..), runInternalState, MonadThrow (..))
+import Control.Monad.Trans.Identity ( IdentityT)
+import Control.Monad.Trans.List     ( ListT    )
+import Control.Monad.Trans.Maybe    ( MaybeT   )
+import Control.Monad.Trans.Error    ( ErrorT, Error)
+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 )
+import qualified Data.ByteString.Lazy               as L
+import Blaze.ByteString.Builder (Builder)
+import           Data.Conduit                       (Flush (Chunk), Producer, ConduitM)
+import Data.Conduit.Internal (Pipe(..))
+import Data.Conduit.Lazy (MonadActive, monadActive)
+import           Data.List                          (foldl', nub)
 import Data.Monoid
+import Data.Semigroup (Semigroup)
+import qualified Data.Text                          as T
+import qualified Text.Blaze.Html.Renderer.Text as RenderText
+import           Text.Blaze.Html               (preEscapedToMarkup, toHtml)
 import qualified Text.Blaze.Html5 as H
+import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
 import Text.Hamlet
 import Text.Cassius
 import Text.Julius
+import Text.Shakespeare.I18N (renderMessage)
 import Yesod.Routes.Class
-import Yesod.Core.Handler (getMessageRender, getUrlRenderParams)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Text.Shakespeare.I18N (RenderMessage)
-import Control.Monad (liftM)
 import Data.Text (Text)
 import qualified Data.Map as Map
 import Language.Haskell.TH.Quote (QuasiQuoter)
 import Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE, AppE), Pat (VarP), newName)
 
 import qualified Text.Hamlet as NP
-import Data.Text.Lazy.Builder (fromLazyText)
+import Data.Text.Lazy.Builder (fromLazyText, toLazyText)
-import Text.Blaze.Html (toHtml, preEscapedToMarkup)
+import           System.Log.FastLogger              (toLogStr)
 import qualified Data.Text.Lazy as TL
+import           Data.Text.Lazy.Encoding            (encodeUtf8)
 
 import Yesod.Core.Types
 import Yesod.Core.Class.Handler
+import Yesod.Core.Class.Yesod (Yesod)
+import Yesod.Core.Handler (getUrlRenderParams, toTextUrl, invalidArgs, permissionDenied, setSession, lookupSession, deleteSession, RedirectUrl, withUrlRenderer, sendChunk, getRequest, getYesod, sendResponse, selectRep, provideRep)
+import Yesod.Core.Content (ToContent(..), ToTypedContent(..), HasContentType(..), ToFlushBuilder(..), typeJavascript, typeHtml, typeCss)
+import           Data.Map                           (Map, unionWith)
+import qualified Data.Aeson as J
 
+------------------------------------
+-- Original Yesod.Core.Widget
+------------------------------------
 preEscapedLazyText :: TL.Text -> Html
 preEscapedLazyText = preEscapedToMarkup
 
@@ -297,3 +384,463 @@ liftGWD tp gwd = GWData
     fixCss f = f . fixRender
 
     fixJS f = f . fixRender
+
+
+
+------------------------------------
+-- Formerly Yesod.Core.Types
+------------------------------------
+data GWData a = GWData
+    { gwdBody        :: !(Body a)
+    , gwdTitle       :: !(Last Title)
+    , gwdScripts     :: !(UniqueList (Script a))
+    , gwdStylesheets :: !(UniqueList (Stylesheet a))
+    , gwdCss         :: !(Map (Maybe Text) (CssBuilderUrl a)) -- media type
+    , gwdJavascript  :: !(Maybe (JavascriptUrl a))
+    , gwdHead        :: !(Head a)
+    }
+instance Monoid (GWData a) where
+    mempty = GWData mempty mempty mempty mempty mempty mempty mempty
+    mappend (GWData a1 a2 a3 a4 a5 a6 a7)
+            (GWData b1 b2 b3 b4 b5 b6 b7) = GWData
+        (a1 `mappend` b1)
+        (a2 `mappend` b2)
+        (a3 `mappend` b3)
+        (a4 `mappend` b4)
+        (unionWith mappend a5 b5)
+        (a6 `mappend` b6)
+        (a7 `mappend` b7)
+instance Semigroup (GWData a)
+
+-- Instances for WidgetT
+instance Monad m => Functor (WidgetT site m) where
+    fmap = liftM
+instance Monad m => Applicative (WidgetT site m) where
+    pure = return
+    (<*>) = ap
+instance Monad m => Monad (WidgetT site m) where
+    return a = WidgetT $ const $ return (a, mempty)
+    WidgetT x >>= f = WidgetT $ \r -> do
+        (a, wa) <- x r
+        (b, wb) <- unWidgetT (f a) r
+        return (b, wa `mappend` wb)
+instance MonadIO m => MonadIO (WidgetT site m) where
+    liftIO = lift . liftIO
+instance MonadBase b m => MonadBase b (WidgetT site m) where
+    liftBase = WidgetT . const . liftBase . fmap (, mempty)
+instance MonadBaseControl b m => MonadBaseControl b (WidgetT site m) where
+#if MIN_VERSION_monad_control(1,0,0)
+    type StM (WidgetT site m) a = StM m (a, GWData (Route site))
+    liftBaseWith f = WidgetT $ \reader' ->
+        liftBaseWith $ \runInBase ->
+            liftM (\x -> (x, mempty))
+            (f $ runInBase . flip unWidgetT reader')
+    restoreM = WidgetT . const . restoreM
+#else
+    data StM (WidgetT site m) a = StW (StM m (a, GWData (Route site)))
+    liftBaseWith f = WidgetT $ \reader' ->
+        liftBaseWith $ \runInBase ->
+            liftM (\x -> (x, mempty))
+            (f $ liftM StW . runInBase . flip unWidgetT reader')
+    restoreM (StW base) = WidgetT $ const $ restoreM base
+#endif
+instance Monad m => MonadReader site (WidgetT site m) where
+    ask = WidgetT $ \hd -> return (rheSite $ handlerEnv hd, mempty)
+    local f (WidgetT g) = WidgetT $ \hd -> g hd
+        { handlerEnv = (handlerEnv hd)
+            { rheSite = f $ rheSite $ handlerEnv hd
+            }
+        }
+
+instance MonadTrans (WidgetT site) where
+    lift = WidgetT . const . liftM (, mempty)
+instance MonadThrow m => MonadThrow (WidgetT site m) where
+    throwM = lift . throwM
+
+instance MonadCatch m => MonadCatch (WidgetT site m) where
+  catch (WidgetT m) c = WidgetT $ \r -> m r `catch` \e -> unWidgetT (c e) r
+instance MonadMask m => MonadMask (WidgetT site m) where
+  mask a = WidgetT $ \e -> mask $ \u -> unWidgetT (a $ q u) e
+    where q u (WidgetT b) = WidgetT (u . b)
+  uninterruptibleMask a =
+    WidgetT $ \e -> uninterruptibleMask $ \u -> unWidgetT (a $ q u) e
+      where q u (WidgetT b) = WidgetT (u . b)
+
+instance (Applicative m, MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where
+    liftResourceT f = WidgetT $ \hd -> liftIO $ fmap (, mempty) $ runInternalState f (handlerResource hd)
+
+instance MonadIO m => MonadLogger (WidgetT site m) where
+    monadLoggerLog a b c d = WidgetT $ \hd ->
+        liftIO $ fmap (, mempty) $ rheLog (handlerEnv hd) a b c (toLogStr d)
+
+#if MIN_VERSION_monad_logger(0, 3, 10)
+instance MonadIO m => MonadLoggerIO (WidgetT site m) where
+    askLoggerIO = WidgetT $ \hd -> return (rheLog (handlerEnv hd), mempty)
+#endif
+
+instance MonadActive m => MonadActive (WidgetT site m) where
+    monadActive = lift monadActive
+
+data ScriptLoadPosition master
+    = BottomOfBody
+    | BottomOfHeadBlocking
+    | BottomOfHeadAsync (BottomOfHeadAsync master)
+
+type BottomOfHeadAsync master
+       = [Text] -- ^ urls to load asynchronously
+      -> Maybe (HtmlUrl (Route master)) -- ^ widget of js to run on async completion
+      -> (HtmlUrl (Route master)) -- ^ widget to insert at the bottom of <head>
+
+-- | 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 WidgetT site m a = WidgetT
+    { unWidgetT :: HandlerData site (MonadRoute m) -> m (a, GWData (Route site))
+    }
+
+instance (a ~ (), Monad m) => Monoid (WidgetT site m a) where
+    mempty = return ()
+    mappend x y = x >> y
+instance (a ~ (), Monad m) => Semigroup (WidgetT site m a)
+
+-- | Content for a web page. By providing this datatype, we can easily create
+-- generic site templates, which would have the type signature:
+--
+-- > PageContent url -> HtmlUrl url
+data PageContent url = PageContent
+    { pageTitle :: Html
+    , pageHead  :: HtmlUrl url
+    , pageBody  :: HtmlUrl url
+    }
+
+newtype Head url = Head (HtmlUrl url)
+    deriving Monoid
+instance Semigroup (Head a)
+newtype Body url = Body (HtmlUrl url)
+    deriving Monoid
+instance Semigroup (Body a)
+
+
+
+------------------------------------
+-- Formerly Yesod.Core.Content
+------------------------------------
+instance ToContent Html where
+    toContent bs = ContentBuilder (renderHtmlBuilder bs) Nothing
+instance ToContent Css where
+    toContent = toContent . renderCss
+instance ToContent Javascript where
+    toContent = toContent . toLazyText . unJavascript
+instance ToTypedContent Html where
+    toTypedContent h = TypedContent typeHtml (toContent h)
+instance ToFlushBuilder (Flush Html) where toFlushBuilder = fmap renderHtmlBuilder
+instance ToFlushBuilder Html where toFlushBuilder = Chunk . renderHtmlBuilder
+instance ToTypedContent Css where
+    toTypedContent = TypedContent typeCss . toContent
+instance ToTypedContent Javascript where
+    toTypedContent = TypedContent typeJavascript . toContent
+
+instance HasContentType Html where
+    getContentType _ = typeHtml
+instance HasContentType Css where
+    getContentType _ = typeCss
+instance HasContentType Javascript where
+    getContentType _ = typeJavascript
+
+------------------------------------
+-- Formerly Yesod.Core.Class.Handler
+------------------------------------
+replaceToParent :: HandlerData site route -> HandlerData site ()
+replaceToParent hd = hd { handlerToParent = const () }
+
+instance MonadResourceBase m => MonadHandler (WidgetT site m) where
+    type HandlerSite (WidgetT site m) = site
+    liftHandlerT (HandlerT f) = WidgetT $ liftIO . liftM (, mempty) . f . replaceToParent
+{-# RULES "liftHandlerT (WidgetT site IO)" forall f. liftHandlerT (HandlerT f) = WidgetT $ liftM (, mempty) . f #-}
+
+class MonadHandler m => MonadWidget m where
+    liftWidgetT :: WidgetT (HandlerSite m) IO a -> m a
+instance MonadResourceBase m => MonadWidget (WidgetT site m) where
+    liftWidgetT (WidgetT f) = WidgetT $ liftIO . f . replaceToParent
+
+#define GO(T) instance MonadWidget m => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
+#define GOX(X, T) instance (X, MonadWidget m) => MonadWidget (T m) where liftWidgetT = lift . liftWidgetT
+GO(IdentityT)
+GO(ListT)
+GO(MaybeT)
+GOX(Error e, ErrorT 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
+
+
+------------------------------------
+-- Formerly Yesod.Core.Handler
+------------------------------------
+msgKey :: Text
+msgKey = T.pack "_MSG"
+-- | Sets a message in the user's session.
+--
+-- See 'getMessage'.
+setMessage :: MonadHandler m => Html -> m ()
+setMessage = setSession msgKey . T.concat . TL.toChunks . RenderText.renderHtml
+
+-- | Sets a message in the user's session.
+--
+-- See 'getMessage'.
+setMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg)
+            => msg -> m ()
+setMessageI msg = do
+    mr <- getMessageRender
+    setMessage $ toHtml $ mr msg
+
+-- | Gets the message in the user's session, if available, and then clears the
+-- variable.
+--
+-- See 'setMessage'.
+getMessage :: MonadHandler m => m (Maybe Html)
+getMessage = do
+    mmsg <- liftM (fmap preEscapedToMarkup) $ lookupSession msgKey
+    deleteSession msgKey
+    return mmsg
+
+-- | Return a 403 permission denied page.
+permissionDeniedI :: (RenderMessage (HandlerSite m) msg, MonadHandler m)
+                  => msg
+                  -> m a
+permissionDeniedI msg = do
+    mr <- getMessageRender
+    permissionDenied $ mr msg
+
+-- | Return a 400 invalid arguments page.
+invalidArgsI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => [msg] -> m a
+invalidArgsI msg = do
+    mr <- getMessageRender
+    invalidArgs $ map mr msg
+
+-- | Redirect to a POST resource.
+--
+-- This is not technically a redirect; instead, it returns an HTML page with a
+-- 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)
+               => url
+               -> m a
+redirectToPost url = do
+    urlText <- toTextUrl url
+    withUrlRenderer [hamlet|
+$newline never
+$doctype 5
+
+<html>
+    <head>
+        <title>Redirecting...
+    <body onload="document.getElementById('form').submit()">
+        <form id="form" method="post" action=#{urlText}>
+            <noscript>
+                <p>Javascript has been disabled; please click on the button below to be redirected.
+            <input type="submit" value="Continue">
+|] >>= sendResponse
+
+
+-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
+hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html
+hamletToRepHtml = withUrlRenderer
+{-# DEPRECATED hamletToRepHtml "Use withUrlRenderer instead" #-}
+
+getMessageRender :: (MonadHandler m, RenderMessage (HandlerSite m) message)
+                 => m (message -> Text)
+getMessageRender = do
+    site <- getYesod
+    l <- reqLangs `liftM` getRequest
+    return $ renderMessage site l
+
+-- | Type-specialized version of 'sendChunk' for @Html@s.
+--
+-- Since 1.2.0
+sendChunkHtml :: Monad m => Html -> Producer m (Flush Builder)
+sendChunkHtml = sendChunk
+
+
+------------------------------
+-- from Yesod.Core.Class.Yesod
+------------------------------
+type AddStaticContent site = Text -- ^ filename extension
+                           -> Text -- ^ mime-type
+                           -> L.ByteString -- ^ content
+                           -> HandlerT site IO (Maybe (Either Text (Route site, [(Text, Text)])))
+
+-- | Convert a widget to a 'PageContent'.
+-- not bound to the Yesod typeclass
+{- widgetToPageContentUnbound
+  :: (MonadBaseControl IO m, MonadThrow m, MonadIO m, Eq (Route site))
+  => AddStaticContent site -> site -> ScriptLoadPosition site -> WidgetT site IO ()
+  -> HandlerT site m (PageContent (Route site))
+  -}
+widgetToPageContentUnbound addStaticContent jsLoader w = do
+    master <- getYesod
+    hd <- HandlerT return
+    ((), GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- lift $ unWidgetT w hd
+    let title = maybe mempty unTitle mTitle
+        scripts = runUniqueList scripts'
+        stylesheets = runUniqueList stylesheets'
+
+    render <- getUrlRenderParams
+    let renderLoc x =
+            case x of
+                Nothing -> Nothing
+                Just (Left s) -> Just s
+                Just (Right (u, p)) -> Just $ render u p
+    css <- forM (Map.toList style) $ \(mmedia, content) -> do
+        let rendered = toLazyText $ content render
+        x <- addStaticContent "css" "text/css; charset=utf-8"
+           $ encodeUtf8 rendered
+        return (mmedia,
+            case x of
+                Nothing -> Left $ preEscapedToMarkup rendered
+                Just y -> Right $ either id (uncurry render) y)
+    jsLoc <-
+        case jscript of
+            Nothing -> return Nothing
+            Just s -> do
+                x <- addStaticContent "js" "text/javascript; charset=utf-8"
+                   $ encodeUtf8 $ renderJavascriptUrl render s
+                return $ renderLoc x
+
+    -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
+    -- the asynchronous loader means your page doesn't have to wait for all the js to load
+    let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
+        regularScriptLoad = [hamlet|
+            $newline never
+            $forall s <- scripts
+                ^{mkScriptTag s}
+            $maybe j <- jscript
+                $maybe s <- jsLoc
+                    <script src="#{s}">
+                $nothing
+                    <script>^{jelper j}
+        |]
+
+        headAll = [hamlet|
+            $newline never
+            \^{head'}
+            $forall s <- stylesheets
+                ^{mkLinkTag s}
+            $forall s <- css
+                $maybe t <- right $ snd s
+                    $maybe media <- fst s
+                        <link rel=stylesheet media=#{media} href=#{t}>
+                    $nothing
+                        <link rel=stylesheet href=#{t}>
+                $maybe content <- left $ snd s
+                    $maybe media <- fst s
+                        <style media=#{media}>#{content}
+                    $nothing
+                        <style>#{content}
+            $case jsLoader master
+              $of BottomOfBody
+              $of BottomOfHeadAsync asyncJsLoader
+                  ^{asyncJsLoader asyncScripts mcomplete}
+              $of BottomOfHeadBlocking
+                  ^{regularScriptLoad}
+        |]
+    let bodyScript = [hamlet|
+            $newline never
+            ^{body}
+            ^{regularScriptLoad}
+        |]
+
+    return $ PageContent title headAll $
+        case jsLoader master of
+            BottomOfBody -> bodyScript
+            _ -> body
+  where
+    renderLoc' render' (Local url) = render' url []
+    renderLoc' _ (Remote s) = s
+
+    addAttr x (y, z) = x H.! H.customAttribute (H.textTag y) (H.toValue z)
+    mkScriptTag (Script loc attrs) render' =
+        foldl' addAttr H.script (("src", renderLoc' render' loc) : attrs) $ return ()
+    mkLinkTag (Stylesheet loc attrs) render' =
+        foldl' addAttr H.link
+            ( ("rel", "stylesheet")
+            : ("href", renderLoc' render' loc)
+            : attrs
+            )
+
+    runUniqueList :: Eq x => UniqueList x -> [x]
+    runUniqueList (UniqueList x) = nub $ x []
+
+asyncHelper :: (url -> [x] -> Text)
+         -> [Script (url)]
+         -> Maybe (JavascriptUrl (url))
+         -> Maybe Text
+         -> (Maybe (HtmlUrl url), [Text])
+asyncHelper render scripts jscript jsLoc =
+    (mcomplete, scripts'')
+  where
+    scripts' = map goScript scripts
+    scripts'' =
+        case jsLoc of
+            Just s -> scripts' ++ [s]
+            Nothing -> scripts'
+    goScript (Script (Local url) _) = render url []
+    goScript (Script (Remote s) _) = s
+    mcomplete =
+        case jsLoc of
+            Just{} -> Nothing
+            Nothing ->
+                case jscript of
+                    Nothing -> Nothing
+                    Just j -> Just $ jelper j
+
+jsToHtml :: Javascript -> Html
+jsToHtml (Javascript b) = preEscapedToMarkup $ toLazyText b
+
+jelper :: JavascriptUrl url -> HtmlUrl url
+jelper = fmap jsToHtml
+
+right :: Either a b -> Maybe b
+right (Right x) = Just x
+right _ = Nothing
+
+left :: Either a b -> Maybe a
+left (Left x) = Just x
+left _ = Nothing
+
+
+-----------------------------
+-- originally from Yesod.Core
+-----------------------------
+-- | Return an 'Unauthorized' value, with the given i18n message.
+unauthorizedI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => msg -> m AuthResult
+unauthorizedI msg = do
+    mr <- getMessageRender
+    return $ Unauthorized $ mr msg
+
+-----------------------------
+-- originally from Yesod.Core.Json
+-----------------------------
+-- | Provide both an HTML and JSON representation for a piece of
+-- data, using the default layout for the HTML output
+-- ('defaultLayout').
+--
+-- /Since: 0.3.0/
+{-
+defaultLayoutJson :: (Yesod site, J.ToJSON a)
+                  => WidgetT site IO ()  -- ^ HTML
+                  -> HandlerT site IO a  -- ^ JSON
+                  -> HandlerT site IO TypedContent
+defaultLayoutJson w json = selectRep $ do
+    provideRep $ defaultLayout w
+    provideRep $ fmap J.toJSON json
+    -}