fix warnings

just needed to compile hamlet down to blaze

sources.txt

@@ -1,4 +1,5 @@
 ./yesod-core
+./yesod-shakespeare
 ./yesod-static
 ./yesod-persistent
 ./yesod-newsfeed

stack.yaml

@@ -13,5 +13,6 @@ packages:
   - ./yesod
   - ./yesod-eventsource
   - ./yesod-websockets
+  - ./yesod-shakespeare
 extra-deps:
   - wai-app-static-3.1.0

yesod-auth-oauth/Yesod/Auth/OAuth.hs

@@ -24,6 +24,7 @@ import           Web.Authenticate.OAuth
 import           Yesod.Auth
 import           Yesod.Form
 import           Yesod.Core
+import           Yesod.Shakespeare
 
 data YesodOAuthException = CredentialError String Credential
                          | SessionError String

yesod-auth-oauth/yesod-auth-oauth.cabal

@@ -24,6 +24,7 @@ library
     build-depends:   authenticate-oauth      >= 1.5       && < 1.6
                    , bytestring              >= 0.9.1.4
                    , yesod-core              >= 1.4       && < 1.5
+                   , yesod-shakespeare       >= 1.5       && < 1.6
                    , yesod-auth              >= 1.4       && < 1.5
                    , text                    >= 0.7
                    , yesod-form              >= 1.4       && < 1.5

yesod-auth/Yesod/Auth.hs

@@ -63,6 +63,7 @@ import qualified Network.Wai as W
 
 import Yesod.Core
 import Yesod.Persist
+import Yesod.Shakespeare
 import Yesod.Auth.Message (AuthMessage, defaultMessage)
 import qualified Yesod.Auth.Message as Msg
 import Yesod.Form (FormMessage)
@@ -146,7 +147,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
     authPlugins :: master -> [AuthPlugin master]
 
     -- | What to show on the login page.
-    -- 
+    --
     -- Default handler concatenates plugin widgets and wraps the result
     -- in 'authLayout'. Override if you need fancy widget containers
     -- or entirely custom page.

yesod-auth/Yesod/Auth/Email.hs

@@ -61,6 +61,7 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
 import Data.Text (Text)
 import Yesod.Core
+import Yesod.Shakespeare
 import qualified Yesod.PasswordStore as PS
 import qualified Text.Email.Validate
 import qualified Yesod.Auth.Message as Msg

yesod-auth/Yesod/Auth/GoogleEmail.hs

@@ -21,6 +21,7 @@ import Yesod.Auth
 import qualified Web.Authenticate.OpenId as OpenId
 
 import Yesod.Core
+import Yesod.Shakespeare
 import Data.Text (Text)
 import qualified Yesod.Auth.Message as Msg
 import qualified Data.Text as T

yesod-auth/Yesod/Auth/GoogleEmail2.hs

@@ -83,8 +83,9 @@ import           Yesod.Core               (HandlerSite, MonadHandler,
                                            getYesod, invalidArgs, lift,
                                            lookupGetParam,
                                            lookupSession, notFound, redirect,
-                                           setSession, whamlet, (.:),
+                                           setSession, (.:),
                                            TypedContent, HandlerT, liftIO)
+import           Yesod.Shakespeare        (whamlet)
 
 pid :: Text
 pid = "googleemail2"

yesod-auth/Yesod/Auth/OpenId.hs

@@ -17,6 +17,7 @@ import qualified Web.Authenticate.OpenId as OpenId
 
 import Yesod.Form
 import Yesod.Core
+import Yesod.Shakespeare
 import Text.Cassius (cassius)
 import Data.Text (Text, isPrefixOf)
 import qualified Yesod.Auth.Message as Msg
@@ -92,7 +93,7 @@ completeHelper idType gets' = do
     eres <- try $ OpenId.authenticateClaimed gets' (authHttpManager master)
     either onFailure onSuccess eres
   where
-    onFailure err = do 
+    onFailure err = do
         tm <- getRouteToParent
         lift $ loginErrorMessage (tm LoginR) $ T.pack $
                 show (err :: SomeException)

yesod-auth/yesod-auth.cabal

@@ -24,6 +24,7 @@ library
                    , authenticate            >= 1.3
                    , bytestring              >= 0.9.1.4
                    , yesod-core              >= 1.4       && < 1.5
+                   , yesod-shakespeare       >= 1.5       && < 1.6
                    , wai                     >= 1.4
                    , template-haskell
                    , base16-bytestring

yesod-core/Yesod/Core.hs

@@ -28,7 +28,6 @@ module Yesod.Core
     , authorizationCheck
       -- * Data types
     , AuthResult (..)
-    , unauthorizedI
       -- * Logging
     , defaultMakeLogger
     , defaultMessageLoggerSource
@@ -57,9 +56,6 @@ module Yesod.Core
     , clientSessionDateCacher
     , loadClientSession
     , Header(..)
-    -- * JS loaders
-    , ScriptLoadPosition (..)
-    , BottomOfHeadAsync
       -- * Subsites
     , MonadHandler (..)
     , MonadWidget (..)
@@ -79,7 +75,6 @@ module Yesod.Core
     , 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 (..)
@@ -93,21 +88,6 @@ module Yesod.Core
       -- * Utilities
     , showIntegral
     , readIntegral
-      -- * Shakespeare
-      -- ** Hamlet
-    , hamlet
-    , shamlet
-    , xhamlet
-    , HtmlUrl
-      -- ** Julius
-    , julius
-    , JavascriptUrl
-    , renderJavascriptUrl
-      -- ** Cassius/Lucius
-    , cassius
-    , lucius
-    , CssUrl
-    , renderCssUrl
     ) where
 
 import Yesod.Core.Content
@@ -117,7 +97,6 @@ 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)
 
@@ -139,10 +118,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) =>
@@ -154,12 +129,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
 

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

@@ -7,12 +7,9 @@
 {-# LANGUAGE UndecidableInstances #-}
 module Yesod.Core.Class.Handler
     ( MonadHandler (..)
-    , MonadWidget (..)
     ) where
 
 import Yesod.Core.Types
-import Data.Monoid (mempty)
-import Control.Monad (liftM)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Resource (MonadResource, MonadResourceBase)
 import Control.Monad.Trans.Class (lift)
@@ -43,11 +40,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 +57,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

@@ -5,6 +5,7 @@
 {-# LANGUAGE CPP               #-}
 module Yesod.Core.Class.Yesod where
 
+import           Control.Monad                      (mplus)
 import           Control.Monad.Logger               (logErrorS)
 import           Yesod.Core.Content
 import           Yesod.Core.Handler
@@ -15,24 +16,22 @@ import           Blaze.ByteString.Builder           (Builder)
 import           Blaze.ByteString.Builder.Char.Utf8 (fromText)
 import           Control.Arrow                      ((***), second)
 import           Control.Exception                  (bracket)
-import           Control.Monad                      (forM, when, void)
+import           Control.Monad                      (when, void)
 import           Control.Monad.IO.Class             (MonadIO (liftIO))
 import           Control.Monad.Logger               (LogLevel (LevelInfo, LevelOther),
                                                      LogSource)
 import           Control.Monad.Trans.Resource       (InternalState, createInternalState, closeInternalState)
+import qualified Data.Aeson as J
 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
 import           Data.Text                          (Text)
 import qualified Data.Text                          as T
 import qualified Data.Text.Encoding                 as TE
 import qualified Data.Text.Encoding.Error           as TEE
-import           Data.Text.Lazy.Builder             (toLazyText)
-import           Data.Text.Lazy.Encoding            (encodeUtf8)
 import           Data.Word                          (Word64)
 import           Language.Haskell.TH.Syntax         (Loc (..))
 import           Network.HTTP.Types                 (encodePath)
@@ -42,19 +41,18 @@ import           Network.Wai.Parse                  (lbsBackEnd,
                                                      tempFileBackEnd)
 import           Network.Wai.Logger                 (ZonedDate, clockDateCacher)
 import           System.Log.FastLogger
-import           Text.Blaze                         (customAttribute, textTag,
+import           Text.Blaze.Html                    (Html)
-                                                     toValue, (!))
-import           Text.Blaze                         (preEscapedToMarkup)
 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)
+-- for jsLoader and defaultErrorHandler
+import           Yesod.Core.Widget (WidgetT, toWidget, setTitle, PageContent(..), ScriptLoadPosition(BottomOfBody), getMessage, widgetToPageContentUnbound)
+import qualified Data.Foldable
+
 
 -- | Define settings for a Yesod applications. All methods have intelligent
 -- defaults, and therefore no implementation is required.
@@ -83,21 +81,7 @@ class RenderRoute site => Yesod site where
 
     -- | Applies some form of layout to the contents of a page.
     defaultLayout :: WidgetT site IO () -> HandlerT site IO Html
-    defaultLayout w = do
+    defaultLayout = defaultDefaultLayout
-        p <- widgetToPageContent w
-        mmsg <- getMessage
-        withUrlRenderer [hamlet|
-            $newline never
-            $doctype 5
-            <html>
-                <head>
-                    <title>#{pageTitle p}
-                    ^{pageHead p}
-                <body>
-                    $maybe msg <- mmsg
-                        <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
@@ -411,103 +395,74 @@ authorizationCheck = do
                               void $ notAuthenticated
             Unauthorized s' -> permissionDenied s'
 
--- | Convert a widget to a 'PageContent'.
-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
+-- templating types
-    let renderLoc x =
+type Render url = url -> [(Text, Text)] -> Text
-            case x of
+type HtmlUrl url = Render url -> Html
-                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
+maybeH :: Monad m => Maybe a -> (a -> m ()) -> Maybe (m ()) -> m ()
-    -- the asynchronous loader means your page doesn't have to wait for all the js to load
+maybeH mv f mm = fromMaybe (return ()) $ fmap f mv `mplus` mm
-    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 $
+widgetToPageContent
-        case jsLoader master of
+  :: (Yesod site, Eq (Route site))
-            BottomOfBody -> bodyScript
+  => WidgetT site IO ()
-            _ -> body
+  -> HandlerT site IO (PageContent (Route site))
+widgetToPageContent = widgetToPageContentUnbound addStaticContent jsLoader
+
+
+-- | 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
+
+
+defaultDefaultLayout :: Yesod site => WidgetT site IO () -> HandlerT site IO Html
+defaultDefaultLayout w = do
+    p <- widgetToPageContent w
+    mmsg <- getMessage
+    withUrlRenderer $ htmlTemplate p mmsg
   where
-    renderLoc' render' (Local url) = render' url []
+    asHtmlUrl :: HtmlUrl url -> HtmlUrl url
-    renderLoc' _ (Remote s) = s
+    asHtmlUrl = id
 
-    addAttr x (y, z) = x ! customAttribute (textTag y) (toValue z)
+    -- equivalent to
-    mkScriptTag (Script loc attrs) render' =
+    -- [hamlet|
-        foldl' addAttr TBH.script (("src", renderLoc' render' loc) : attrs) $ return ()
+    --    $newline never
-    mkLinkTag (Stylesheet loc attrs) render' =
+    --    $doctype 5
-        foldl' addAttr TBH.link
+    --    <html>
-            ( ("rel", "stylesheet")
+    --        <head>
-            : ("href", renderLoc' render' loc)
+    --            <title>#{pageTitle p}
-            : attrs
+    --            ^{pageHead p}
-            )
+    --        <body>
+    --            $maybe msg <- mmsg
+    --                <p .message>#{msg}
+    --            ^{pageBody p}
+    --    |]
+    htmlTemplate p mmsg = \_render_afYl -> do
+        TBH.preEscapedText $ T.pack "<!DOCTYPE html>\n<html><head><title>"
+        TBH.toHtml (pageTitle p)
+        TBH.preEscapedText $ T.pack "</title>"
+        asHtmlUrl (pageHead p) _render_afYl
+        TBH.preEscapedText $ T.pack "</head><body>"
+        maybeH
+          mmsg
+          (\ msg_afYm
+             -> do { id ((TBH.preEscapedText . T.pack) "<p class=\"message\">");
+                     id (TBH.toHtml msg_afYm);
+                     id ((TBH.preEscapedText . T.pack) "</p>") })
+          Nothing
+        asHtmlUrl (pageBody p) _render_afYl
+        (TBH.preEscapedText . T.pack) "</body></html>"
 
-    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
@@ -516,11 +471,19 @@ defaultErrorHandler NotFound = selectRep $ do
         r <- waiRequest
         let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
         setTitle "Not Found"
-        toWidget [hamlet|
+        toWidget $ htmlTemplate path'
-            <h1>Not Found
-            <p>#{path'}
-        |]
     provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
+  where
+    -- equivalent to
+    --
+    --    [hamlet|
+    --        <h1>Not Found
+    --        <p>#{path'}
+    --    |]
+     htmlTemplate path' = \_renderer -> do
+       TBH.preEscapedText $ T.pack "<h1>Not Found</h1>\n<p>"
+       TBH.toHtml path'
+       TBH.preEscapedText $ T.pack "</p>"
 
 -- For API requests.
 -- For a user with a browser,
@@ -529,10 +492,7 @@ defaultErrorHandler NotFound = selectRep $ do
 defaultErrorHandler NotAuthenticated = selectRep $ do
     provideRep $ defaultLayout $ do
         setTitle "Not logged in"
-        toWidget [hamlet|
+        toWidget htmlTemplate
-            <h1>Not logged in
-            <p style="display:none;">Set the authRoute and the user will be redirected there.
-        |]
 
     provideRep $ do
         -- 401 *MUST* include a WWW-Authenticate header
@@ -550,70 +510,97 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
           case authRoute site of
               Nothing -> []
               Just url -> ["authentication_url" .= rend url]
+  where
+    -- equivalent to
+    --   [hamlet|
+    --      <h1>Not logged in
+    --        <p style="display:none;">Set the authRoute and the user will be redirected there.
+    --   |]
+    htmlTemplate = \_renderer -> TBH.preEscapedText $ T.pack
+      "<h1>Not logged in</h1>\n<p style=\"display:none;\">Set the authRoute and the user will be redirected there.</p>"
+
 
 defaultErrorHandler (PermissionDenied msg) = selectRep $ do
     provideRep $ defaultLayout $ do
         setTitle "Permission Denied"
-        toWidget [hamlet|
+        toWidget htmlTemplate
-            <h1>Permission denied
-            <p>#{msg}
-        |]
     provideRep $
         return $ object $ [
           "message" .= ("Permission Denied. " <> msg)
           ]
+  where
+    -- equivalent to
+    --
+    --    [hamlet|
+    --        <h1>Permission denied
+    --        <p>#{msg}
+    --    |]
+    htmlTemplate = \_renderer -> do
+      TBH.preEscapedText $ T.pack "<h1>Permission denied</h1>\n<p>"
+      TBH.toHtml msg
+      TBH.preEscapedText $ T.pack "</p>"
+
 
 defaultErrorHandler (InvalidArgs ia) = selectRep $ do
     provideRep $ defaultLayout $ do
         setTitle "Invalid Arguments"
-        toWidget [hamlet|
+        toWidget htmlTemplate
-            <h1>Invalid Arguments
-            <ul>
-                $forall msg <- ia
-                    <li>#{msg}
-        |]
     provideRep $ return $ object ["message" .= ("Invalid Arguments" :: Text), "errors" .= ia]
+  where
+    -- equivalent to
+    -- [hamlet|
+    --        <h1>Invalid Arguments
+    --        <ul>
+    --            $forall msg <- ia
+    --               <li>#{msg}
+    --    |]
+    htmlTemplate = \_renderer -> do
+      (TBH.preEscapedText . T.pack) "<h1>Invalid Arguments</h1>\n<ul>"
+      Data.Foldable.mapM_
+                (\ msg_afNn
+                   -> do { (TBH.preEscapedText . T.pack) "<li>";
+                           TBH.toHtml msg_afNn;
+                           (TBH.preEscapedText . T.pack) "</li>" })
+                ia;
+      (TBH.preEscapedText . T.pack) "</ul>"
+
+
 defaultErrorHandler (InternalError e) = do
     $logErrorS "yesod-core" e
     selectRep $ do
         provideRep $ defaultLayout $ do
             setTitle "Internal Server Error"
-            toWidget [hamlet|
+            toWidget htmlTemplate
-                <h1>Internal Server Error
-                <pre>#{e}
-            |]
         provideRep $ return $ object ["message" .= ("Internal Server Error" :: Text), "error" .= e]
+  where
+    -- equivalent to
+    --        [hamlet|
+    --            <h1>Internal Server Error
+    --            <pre>#{e}
+    --        |]
+    htmlTemplate = \_renderer -> do
+      (TBH.preEscapedText . T.pack) "<h1>Internal Server Error</h1>\n<pre>"
+      TBH.toHtml e
+      (TBH.preEscapedText . T.pack) "</pre>"
+
 defaultErrorHandler (BadMethod m) = selectRep $ do
     provideRep $ defaultLayout $ do
         setTitle"Bad Method"
-        toWidget [hamlet|
+        toWidget $ htmlTemplate
-            <h1>Method Not Supported
-            <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
+    -- equivalent to
-    scripts'' =
+    --
-        case jsLoc of
+    --    [hamlet|
-            Just s -> scripts' ++ [s]
+    --        <h1>Method Not Supported
-            Nothing -> scripts'
+    --        <p>Method <code>#{S8.unpack m}</code> not supported
-    goScript (Script (Local url) _) = render url []
+    --    |]
-    goScript (Script (Remote s) _) = s
+    htmlTemplate = \ _render -> do
-    mcomplete =
+        TBH.preEscapedText $ T.pack
-        case jsLoc of
+             "<h1>Method Not Supported</h1>\n<p>Method <code>"
-            Just{} -> Nothing
+        TBH.toHtml (S8.unpack m)
-            Nothing ->
+        TBH.preEscapedText $ T.pack "</code> not supported</p>"
-                case jscript of
+
-                    Nothing -> Nothing
-                    Just j -> Just $ jelper j
 
 -- | Default formatting for log messages.
 --
@@ -704,20 +691,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
@@ -178,8 +166,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
@@ -190,11 +176,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)
@@ -482,34 +466,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
@@ -624,24 +580,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.
 
@@ -838,36 +780,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
@@ -892,13 +804,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.
@@ -1234,12 +1139,6 @@ sendChunkText = sendChunk
 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
-
 -- | Converts a child handler to a parent handler
 --
 -- Exported since 1.4.11

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

@@ -7,6 +7,7 @@ import Data.Monoid
 import Yesod.Core.Class.Yesod
 import Yesod.Core.Class.Dispatch
 import Yesod.Core.Types
+import Yesod.Core.Widget (WidgetT)
 import Yesod.Core.Content
 import Data.Text (Text)
 import Web.PathPieces

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

@@ -22,6 +22,7 @@ import Yesod.Core.Types
 import Yesod.Core.Content
 import Yesod.Core.Class.Dispatch
 import Yesod.Core.Internal.Run
+import Yesod.Core.Widget (WidgetT)
 
 -- | Generates URL datatype and site function for the given 'Resource's. This
 -- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.

yesod-core/Yesod/Core/Json.hs

@@ -27,14 +27,12 @@ module Yesod.Core.Json
     , acceptsJson
     ) where
 
-import Yesod.Core.Handler (HandlerT, getRequest, invalidArgs, redirect, selectRep, provideRep, rawRequestBody, ProvidedRep)
+import Yesod.Core.Handler (getRequest, invalidArgs, redirect,  provideRep, rawRequestBody, ProvidedRep)
 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 (defaultLayoutJson)
 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,36 +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
-
+type BuilderUrl url = (url -> [(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
@@ -383,51 +320,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 +328,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,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE CPP #-}
@@ -13,22 +17,27 @@
 -- generator, allowing you to create truly modular HTML components.
 module Yesod.Core.Widget
     ( -- * Datatype
-      WidgetT
+      WidgetT(..)
     , PageContent (..)
-      -- * Special Hamlet quasiquoter/TH for Widgets
-    , whamlet
-    , whamletFile
-    , ihamletToRepHtml
-    , ihamletToHtml
       -- * Convert to Widget
     , ToWidget (..)
     , ToWidgetHead (..)
     , ToWidgetBody (..)
     , ToWidgetMedia (..)
+
+      -- Formerly Yesod.Core.Types
+    , ScriptLoadPosition(..)
+    , BottomOfHeadAsync
+    , GWData(..)
+    , Head(..)
+    , Body(..)
+
+      -- Formerly Yesod.Core
+    , MonadWidget (..)
+
       -- * Creating
       -- ** Head of page
     , setTitle
-    , setTitleI
       -- ** CSS
     , addStylesheet
     , addStylesheetAttrs
@@ -46,57 +55,115 @@ module Yesod.Core.Widget
     , widgetToParentWidget
     , handlerToWidget
       -- * Internal
-    , whamletFileWithSettings
     , asWidgetT
+    , tellWidget
+
+      -- Formerly Yesod.Core.Class.Yesod
+      -- *
+    , jelper
+    , asyncHelper
+    , jsToHtml
+    , widgetToPageContentUnbound
+
+      -- Formerly Yesod.Core.Handler
+      -- * Redirecting
+    , redirectToPost
+      -- * Streaming
+    , sendChunkHtml
+      -- * Messages
+    , setMessage
+    , getMessage
+      -- * Hamlet
+    , hamletToRepHtml
+
     ) where
 
+import           Control.Applicative                (Applicative(..))
+import           Control.Monad                      (liftM, ap, forM, mplus)
+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 Blaze.ByteString.Builder (Builder)
+import qualified Data.ByteString.Lazy               as L
+import           Data.Conduit                       (Flush (Chunk), Producer, ConduitM)
+import Data.Conduit.Internal (Pipe(..))
+import Data.Conduit.Lazy (MonadActive, monadActive)
 import Data.Monoid
-import qualified Text.Blaze.Html5 as H
+import Data.Semigroup (Semigroup)
-import Text.Hamlet
+import qualified Data.Text                          as T
-import Text.Cassius
+import qualified Text.Blaze.Html.Renderer.Text as RenderText
-import Text.Julius
+import           Text.Blaze.Html               (preEscapedToMarkup, Html)
+import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
 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           Data.Maybe                         (fromMaybe)
 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           System.Log.FastLogger              (toLogStr)
-import Data.Text.Lazy.Builder (fromLazyText)
-import Text.Blaze.Html (toHtml, preEscapedToMarkup)
 import qualified Data.Text.Lazy as TL
 
 import Yesod.Core.Types
+import Yesod.Core.Handler (sendResponse, RedirectUrl(..))
 import Yesod.Core.Class.Handler
+import Yesod.Core.Handler (setSession, lookupSession, deleteSession, withUrlRenderer, sendChunk, getUrlRenderParams, getYesod)
+import Yesod.Core.Content (ToContent(..), ToTypedContent(..), HasContentType(..), ToFlushBuilder(..), typeHtml)
+import           Data.List                          (foldl', nub)
+import           Data.Map                           (Map, unionWith)
+import           Data.Text.Lazy.Builder (toLazyText)
+import qualified Data.Text.Lazy.Builder as TLB
+import           Data.Text.Lazy.Encoding (encodeUtf8)
+import qualified Data.Foldable
+import qualified Data.Text
+import qualified Text.Blaze.Html5                   as TBH
+import qualified Text.Blaze.Html5 as H
 
-preEscapedLazyText :: TL.Text -> Html
+-- templating types
-preEscapedLazyText = preEscapedToMarkup
+type Render url = url -> [(Text, Text)] -> Text
+type HtmlUrl url = Render url -> Html
 
+
+------------------------------------
+-- Original Yesod.Core.Widget
+------------------------------------
 class ToWidget site a where
     toWidget :: (MonadWidget m, HandlerSite m ~ site) => a -> m ()
 
 instance render ~ RY site => ToWidget site (render -> Html) where
-    toWidget x = tell $ GWData (Body x) mempty mempty mempty mempty mempty mempty
+    toWidget x = tellWidget $ GWData (Body x) mempty mempty mempty mempty mempty mempty
-instance render ~ RY site => ToWidget site (render -> Css) where
-    toWidget x = toWidget $ CssBuilder . fromLazyText . renderCss . x
-instance ToWidget site Css where
-    toWidget x = toWidget $ CssBuilder . fromLazyText . renderCss . const x
 instance render ~ RY site => ToWidget site (render -> CssBuilder) where
-    toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . x) mempty mempty
+    toWidget x = tellWidget $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . x) mempty mempty
 instance ToWidget site CssBuilder where
-    toWidget x = tell $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . const x) mempty mempty
+    toWidget x = tellWidget $ GWData mempty mempty mempty mempty (Map.singleton Nothing $ unCssBuilder . const x) mempty mempty
-instance render ~ RY site => ToWidget site (render -> Javascript) where
-    toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just x) mempty
-instance ToWidget site Javascript where
-    toWidget x = tell $ GWData mempty mempty mempty mempty mempty (Just $ const x) mempty
 instance (site' ~ site, IO ~ m, a ~ ()) => ToWidget site' (WidgetT site m a) where
     toWidget = liftWidgetT
 instance ToWidget site Html where
     toWidget = toWidget . const
+instance ToWidgetHead site Html where
+    toWidgetHead = toWidgetHead . const
+instance render ~ RY site => ToWidgetHead site (render -> CssBuilder) where
+    toWidgetHead = toWidget
+instance ToWidgetHead site CssBuilder where
+    toWidgetHead = toWidget
 
 -- | Allows adding some CSS to the page with a specific media type.
 --
@@ -109,24 +176,16 @@ class ToWidgetMedia site a where
                   => Text -- ^ media value
                   -> a
                   -> m ()
-instance render ~ RY site => ToWidgetMedia site (render -> Css) where
-    toWidgetMedia media x = toWidgetMedia media $ CssBuilder . fromLazyText . renderCss . x
-instance ToWidgetMedia site Css where
-    toWidgetMedia media x = toWidgetMedia media $ CssBuilder . fromLazyText . renderCss . const x
 instance render ~ RY site => ToWidgetMedia site (render -> CssBuilder) where
-    toWidgetMedia media x = tell $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . x) mempty mempty
+    toWidgetMedia media x = tellWidget $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . x) mempty mempty
 instance ToWidgetMedia site CssBuilder where
-    toWidgetMedia media x = tell $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . const x) mempty mempty
+    toWidgetMedia media x = tellWidget $ GWData mempty mempty mempty mempty (Map.singleton (Just media) $ unCssBuilder . const x) mempty mempty
 
 class ToWidgetBody site a where
     toWidgetBody :: (MonadWidget m, HandlerSite m ~ site) => a -> m ()
 
 instance render ~ RY site => ToWidgetBody site (render -> Html) where
     toWidgetBody = toWidget
-instance render ~ RY site => ToWidgetBody site (render -> Javascript) where
-    toWidgetBody j = toWidget $ \r -> H.script $ preEscapedLazyText $ renderJavascriptUrl r j
-instance ToWidgetBody site Javascript where
-    toWidgetBody j = toWidget $ \_ -> H.script $ preEscapedLazyText $ renderJavascript j
 instance ToWidgetBody site Html where
     toWidgetBody = toWidget
 
@@ -134,33 +193,12 @@ class ToWidgetHead site a where
     toWidgetHead :: (MonadWidget m, HandlerSite m ~ site) => a -> m ()
 
 instance render ~ RY site => ToWidgetHead site (render -> Html) where
-    toWidgetHead = tell . GWData mempty mempty mempty mempty mempty mempty . Head
+    toWidgetHead = tellWidget . GWData mempty mempty mempty mempty mempty mempty . Head
-instance render ~ RY site => ToWidgetHead site (render -> Css) where
-    toWidgetHead = toWidget
-instance ToWidgetHead site Css where
-    toWidgetHead = toWidget
-instance render ~ RY site => ToWidgetHead site (render -> CssBuilder) where
-    toWidgetHead = toWidget
-instance ToWidgetHead site CssBuilder where
-    toWidgetHead = toWidget
-instance render ~ RY site => ToWidgetHead site (render -> Javascript) where
-    toWidgetHead j = toWidgetHead $ \r -> H.script $ preEscapedLazyText $ renderJavascriptUrl r j
-instance ToWidgetHead site Javascript where
-    toWidgetHead j = toWidgetHead $ \_ -> H.script $ preEscapedLazyText $ renderJavascript j
-instance ToWidgetHead site Html where
-    toWidgetHead = toWidgetHead . const
 
 -- | Set the page title. Calling 'setTitle' multiple times overrides previously
 -- set values.
 setTitle :: MonadWidget m => Html -> m ()
-setTitle x = tell $ GWData mempty (Last $ Just $ Title x) mempty mempty mempty mempty mempty
+setTitle x = tellWidget $ GWData mempty (Last $ Just $ Title x) mempty mempty mempty mempty mempty
-
--- | Set the page title. Calling 'setTitle' multiple times overrides previously
--- set values.
-setTitleI :: (MonadWidget m, RenderMessage (HandlerSite m) msg) => msg -> m ()
-setTitleI msg = do
-    mr <- getMessageRender
-    setTitle $ toHtml $ mr msg
 
 -- | Link to the specified local stylesheet.
 addStylesheet :: MonadWidget m => Route (HandlerSite m) -> m ()
@@ -171,7 +209,7 @@ addStylesheetAttrs :: MonadWidget m
                    => Route (HandlerSite m)
                    -> [(Text, Text)]
                    -> m ()
-addStylesheetAttrs x y = tell $ GWData mempty mempty mempty (toUnique $ Stylesheet (Local x) y) mempty mempty mempty
+addStylesheetAttrs x y = tellWidget $ GWData mempty mempty mempty (toUnique $ Stylesheet (Local x) y) mempty mempty mempty
 
 -- | Link to the specified remote stylesheet.
 addStylesheetRemote :: MonadWidget m => Text -> m ()
@@ -179,7 +217,7 @@ addStylesheetRemote = flip addStylesheetRemoteAttrs []
 
 -- | Link to the specified remote stylesheet.
 addStylesheetRemoteAttrs :: MonadWidget m => Text -> [(Text, Text)] -> m ()
-addStylesheetRemoteAttrs x y = tell $ GWData mempty mempty mempty (toUnique $ Stylesheet (Remote x) y) mempty mempty mempty
+addStylesheetRemoteAttrs x y = tellWidget $ GWData mempty mempty mempty (toUnique $ Stylesheet (Remote x) y) mempty mempty mempty
 
 addStylesheetEither :: MonadWidget m
                     => Either (Route (HandlerSite m)) Text
@@ -197,7 +235,7 @@ addScript = flip addScriptAttrs []
 
 -- | Link to the specified local script.
 addScriptAttrs :: MonadWidget m => Route (HandlerSite m) -> [(Text, Text)] -> m ()
-addScriptAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Local x) y) mempty mempty mempty mempty
+addScriptAttrs x y = tellWidget $ GWData mempty mempty (toUnique $ Script (Local x) y) mempty mempty mempty mempty
 
 -- | Link to the specified remote script.
 addScriptRemote :: MonadWidget m => Text -> m ()
@@ -205,57 +243,10 @@ addScriptRemote = flip addScriptRemoteAttrs []
 
 -- | Link to the specified remote script.
 addScriptRemoteAttrs :: MonadWidget m => Text -> [(Text, Text)] -> m ()
-addScriptRemoteAttrs x y = tell $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty
+addScriptRemoteAttrs x y = tellWidget $ GWData mempty mempty (toUnique $ Script (Remote x) y) mempty mempty mempty mempty
 
-whamlet :: QuasiQuoter
+tellWidget :: MonadWidget m => GWData (Route (HandlerSite m)) -> m ()
-whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings
+tellWidget w = liftWidgetT $ WidgetT $ const $ return ((), w)
-
-whamletFile :: FilePath -> Q Exp
-whamletFile = NP.hamletFileWithSettings rules NP.defaultHamletSettings
-
-whamletFileWithSettings :: NP.HamletSettings -> FilePath -> Q Exp
-whamletFileWithSettings = NP.hamletFileWithSettings rules
-
-asWidgetT :: WidgetT site m () -> WidgetT site m ()
-asWidgetT = id
-
-rules :: Q NP.HamletRules
-rules = do
-    ah <- [|asWidgetT . toWidget|]
-    let helper qg f = do
-            x <- newName "urender"
-            e <- f $ VarE x
-            let e' = LamE [VarP x] e
-            g <- qg
-            bind <- [|(>>=)|]
-            return $ InfixE (Just g) bind (Just e')
-    let ur f = do
-            let env = NP.Env
-                    (Just $ helper [|getUrlRenderParams|])
-                    (Just $ helper [|liftM (toHtml .) getMessageRender|])
-            f env
-    return $ NP.HamletRules ah ur $ \_ b -> return $ ah `AppE` b
-
--- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
-ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
-                 => HtmlUrlI18n message (Route (HandlerSite m))
-                 -> m Html
-ihamletToRepHtml = ihamletToHtml
-{-# DEPRECATED ihamletToRepHtml "Please use ihamletToHtml instead" #-}
-
--- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
---
--- Since 1.2.1
-ihamletToHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
-              => HtmlUrlI18n message (Route (HandlerSite m))
-              -> m Html
-ihamletToHtml ih = do
-    urender <- getUrlRenderParams
-    mrender <- getMessageRender
-    return $ ih (toHtml . mrender) urender
-
-tell :: MonadWidget m => GWData (Route (HandlerSite m)) -> m ()
-tell w = liftWidgetT $ WidgetT $ const $ return ((), w)
 
 toUnique :: x -> UniqueList x
 toUnique = UniqueList . (:)
@@ -297,3 +288,499 @@ 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 (BuilderUrl 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)
+
+asWidgetT :: WidgetT site m () -> WidgetT site m ()
+asWidgetT = id
+
+
+-- | 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 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 HasContentType Html where
+    getContentType _ = typeHtml
+
+------------------------------------
+-- 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
+
+-- | 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
+
+-- | 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" #-}
+
+-- | 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 (htmlTemplate urlText) >>= sendResponse
+  where
+    {- equivalent to
+          [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">
+    |]
+    -}
+    htmlTemplate urlText = \_render_abxV -> do
+       (H.preEscapedText . Data.Text.pack) "<!DOCTYPE html>\n<html><head><title>Redirecting...</title></head><body onload=\"document.getElementById('form').submit()\"><form id=\"form\" method=\"post\" action=\""
+       H.toHtml urlText
+       (H.preEscapedText . Data.Text.pack) "\"><noscript><p>Javascript has been disabled; please click on the button below to be redirected.</p></noscript><input type=\"submit\" value=\"Continue\"></form></body></html>"
+
+
+-- | Type-specialized version of 'sendChunk' for @Html@s.
+--
+-- Since 1.2.0
+sendChunkHtml :: Monad m => Html -> Producer m (Flush Builder)
+sendChunkHtml = sendChunk
+
+
+maybeH :: Monad m => Maybe a -> (a -> m ()) -> Maybe (m ()) -> m ()
+maybeH mv f mm = fromMaybe (return ()) $ fmap f mv `mplus` mm
+
+type AddStaticContent site m = Text -- ^ filename extension
+                            -> Text -- ^ mime-type
+                            -> L.ByteString -- ^ content
+                            -> HandlerT site m (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 m
+  -> (site -> ScriptLoadPosition site)
+  -> WidgetT site m ()
+  -> 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 $ toLazyText $ s render
+                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
+        scriptLoad = regularScriptLoad scripts jscript jsLoc
+        headAll = headContent head' stylesheets css master asyncScripts mcomplete scriptLoad
+
+    let bodyScript = bodyScriptLoad body scriptLoad
+
+    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 []
+
+    -- equivalent to
+    --
+    --   [hamlet|
+    --        $newline never
+    --        ^{body}
+    --        ^{scriptLoad}
+    --    |]
+    bodyScriptLoad body scriptLoad = \renderer -> do
+        asHtmlUrl body renderer
+        asHtmlUrl scriptLoad renderer
+
+    -- equivalent to
+    --
+    --  [hamlet|
+    --    $newline never
+    --    $forall s <- scripts
+    --        ^{mkScriptTag s}
+    --    $maybe j <- jscript
+    --        $maybe s <- jsLoc
+    --            <script src="#{s}">
+    --        $nothing
+    --            <script>^{jelper j}
+    -- |]
+    regularScriptLoad scripts jscript jsLoc = \_render_ahpp -> do
+       { Data.Foldable.mapM_
+            (\ s_ahpq -> asHtmlUrl (mkScriptTag s_ahpq) _render_ahpp) scripts;
+         maybeH
+            jscript
+            (\ j_ahpr
+               -> maybeH
+                    jsLoc
+                    (\ s_ahps
+                       -> do { id ((H.preEscapedText . Data.Text.pack) "<script src=\"");
+                               id (TBH.toHtml s_ahps);
+                               id ((H.preEscapedText . Data.Text.pack) "\"></script>") })
+                    (Just
+                       (do { id ((H.preEscapedText . Data.Text.pack) "<script>");
+                             asHtmlUrl (jelper j_ahpr) _render_ahpp;
+                             id ((H.preEscapedText . Data.Text.pack) "</script>") })))
+            Nothing }
+
+    -- equivalent to
+    --
+    -- [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
+    --          ^{scriptLoad}
+    -- |]
+    headContent head' stylesheets css master asyncScripts mcomplete scriptLoad = \_render_ahmq -> do
+      { asHtmlUrl head' _render_ahmq;
+        Data.Foldable.mapM_
+          (\ s_ahmr -> asHtmlUrl (mkLinkTag s_ahmr) _render_ahmq)
+          stylesheets;
+        Data.Foldable.mapM_
+          (\ s_ahms
+             -> do { maybeH
+                       (right (snd s_ahms))
+                       (\ t_ahmt
+                          -> maybeH
+                               (fst s_ahms)
+                               (\ media_ahmu
+                                  -> do { id
+                                            ((H.preEscapedText . Data.Text.pack)
+                                               "<link rel=\"stylesheet\" media=\"");
+                                          id (TBH.toHtml media_ahmu);
+                                          id
+                                            ((H.preEscapedText . Data.Text.pack)
+                                               "\" href=\"");
+                                          id (TBH.toHtml t_ahmt);
+                                          id ((H.preEscapedText . Data.Text.pack) "\">") })
+                               (Just
+                                  (do { id
+                                          ((H.preEscapedText . Data.Text.pack)
+                                             "<link rel=\"stylesheet\" href=\"");
+                                        id (TBH.toHtml t_ahmt);
+                                        id ((H.preEscapedText . Data.Text.pack) "\">") })))
+                       Nothing;
+                     maybeH
+                       (left (snd s_ahms))
+                       (\ content_ahmv
+                          -> maybeH
+                               (fst s_ahms)
+                               (\ media_ahmw
+                                  -> do { id
+                                            ((H.preEscapedText . Data.Text.pack)
+                                               "<style media=\"");
+                                          id (TBH.toHtml media_ahmw);
+                                          id ((H.preEscapedText . Data.Text.pack) "\">");
+                                          id (TBH.toHtml content_ahmv);
+                                          id
+                                            ((H.preEscapedText . Data.Text.pack)
+                                               "</style>") })
+                               (Just
+                                  (do { id ((H.preEscapedText . Data.Text.pack) "<style>");
+                                        id (TBH.toHtml content_ahmv);
+                                        id
+                                          ((H.preEscapedText . Data.Text.pack)
+                                             "</style>") })))
+                       Nothing })
+          css;
+        case jsLoader master of
+          BottomOfBody -> return ()
+          BottomOfHeadAsync asyncJsLoader_ahmx -> asHtmlUrl (asyncJsLoader_ahmx asyncScripts mcomplete) _render_ahmq
+          BottomOfHeadBlocking -> asHtmlUrl scriptLoad _render_ahmq
+      }
+
+
+asyncHelper :: (url -> [x] -> Text)
+         -> [Script (url)]
+         -> Maybe (BuilderUrl 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 :: TLB.Builder -> Html
+jsToHtml b = preEscapedToMarkup $ toLazyText b
+
+jelper :: (Render url -> TLB.Builder) -> 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
+
+asHtmlUrl :: HtmlUrl url -> HtmlUrl url
+asHtmlUrl = id

yesod-core/test/YesodCoreTest.hs

@@ -1,10 +1,8 @@
 {-# LANGUAGE CPP                        #-}
-module YesodCoreTest (specs) where 
+module YesodCoreTest (specs) where
 
 import YesodCoreTest.CleanPath
 import YesodCoreTest.Exceptions
-import YesodCoreTest.Widget
-import YesodCoreTest.Media
 import YesodCoreTest.Links
 import YesodCoreTest.NoOverloadedStrings
 import YesodCoreTest.InternalRequest
@@ -28,8 +26,6 @@ specs :: Spec
 specs = do
       cleanPathTest
       exceptionsTest
-      widgetTest
-      mediaTest
       linksTest
       noOverloadedTest
       internalRequestTest

yesod-core/test/YesodCoreTest/Auth.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses #-}
-module YesodCoreTest.Auth (specs, Widget) where
+module YesodCoreTest.Auth (specs) where
 
 import Yesod.Core
 import Test.Hspec

yesod-core/test/YesodCoreTest/Cache.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-module YesodCoreTest.Cache (cacheTest, Widget) where
+module YesodCoreTest.Cache (cacheTest) where
 
 import Test.Hspec
 
@@ -13,8 +13,6 @@ import Yesod.Core
 import Data.IORef.Lifted
 import Data.Typeable (Typeable)
 import qualified Data.ByteString.Lazy.Char8 as L8
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
 
 data C = C
 

yesod-core/test/YesodCoreTest/CleanPath.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances, ViewPatterns #-}
 {-# LANGUAGE CPP #-}
-module YesodCoreTest.CleanPath (cleanPathTest, Widget) where
+module YesodCoreTest.CleanPath (cleanPathTest) where
 
 import Test.Hspec
 

yesod-core/test/YesodCoreTest/ErrorHandling.hs

@@ -3,13 +3,12 @@
 {-# LANGUAGE ViewPatterns #-}
 module YesodCoreTest.ErrorHandling
     ( errorHandlingTest
-    , Widget
     ) where
 import Yesod.Core
+import Text.Hamlet (hamlet)
 import Test.Hspec
 import Network.Wai
 import Network.Wai.Test
-import Text.Hamlet (hamlet)
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Char8 as S8
 import Control.Exception (SomeException, try)
@@ -80,7 +79,7 @@ postAfterRunRequestBodyR = do
 getErrorInBodyR :: Handler Html
 getErrorInBodyR = do
     let foo = error "error in body 19328" :: String
-    defaultLayout [whamlet|#{foo}|]
+    defaultLayout $ toWidget [hamlet|#{foo}|]
 
 getErrorInBodyNoEvalR :: Handler (DontFullyEvaluate Html)
 getErrorInBodyNoEvalR = fmap DontFullyEvaluate getErrorInBodyR

yesod-core/test/YesodCoreTest/Exceptions.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances #-}
-module YesodCoreTest.Exceptions (exceptionsTest, Widget) where
+module YesodCoreTest.Exceptions (exceptionsTest) where
 
 import Test.Hspec
 

yesod-core/test/YesodCoreTest/JsLoaderSites/Bottom.hs

@@ -1,9 +1,10 @@
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances #-}
-module YesodCoreTest.JsLoaderSites.Bottom (B(..), Widget) where
+module YesodCoreTest.JsLoaderSites.Bottom (B(..)) where
 
 import Yesod.Core
+import Yesod.Core.Widget
 
 data B = B
 mkYesod "B" [parseRoutes|

yesod-core/test/YesodCoreTest/Json.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses, ViewPatterns #-}
-module YesodCoreTest.Json (specs, Widget) where
+module YesodCoreTest.Json (specs) where
 
 import Yesod.Core
 import Test.Hspec

yesod-core/test/YesodCoreTest/Links.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances, ViewPatterns #-}
-module YesodCoreTest.Links (linksTest, Widget) where
+module YesodCoreTest.Links (linksTest) where
 
 import Test.Hspec
 

yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs

@@ -7,8 +7,9 @@ import Test.Hspec
 import YesodCoreTest.NoOverloadedStringsSub
 
 import Yesod.Core
-import Network.Wai
+import Text.Hamlet (hamlet)
 import Network.Wai.Test
+import Network.Wai (pathInfo)
 import Data.Monoid (mempty)
 import qualified Data.Text as T
 import qualified Data.ByteString.Lazy.Char8 as L8
@@ -20,11 +21,11 @@ getBarR :: Monad m => m T.Text
 getBarR = return $ T.pack "BarR"
 
 getBazR :: Yesod master => HandlerT Subsite (HandlerT master IO) Html
-getBazR = lift $ defaultLayout [whamlet|Used Default Layout|]
+getBazR = lift $ defaultLayout $ toWidget [hamlet|Used Default Layout|]
 
 getBinR :: Yesod master => HandlerT Subsite (HandlerT master IO) Html
 getBinR = do
-    widget <- widgetToParentWidget [whamlet|
+    widget <- widgetToParentWidget $ toWidget [hamlet|
         <p>Used defaultLayoutT
         <a href=@{BazR}>Baz
     |]
@@ -48,10 +49,8 @@ mkYesod "Y" [parseRoutes|
 
 instance Yesod Y
 
-getRootR :: Handler ()
+getRootR, getFooR :: Handler ()
 getRootR = return ()
-
-getFooR :: Handler ()
 getFooR = return ()
 
 runner :: Session () -> IO ()
@@ -88,7 +87,7 @@ case_deflayoutT = runner $ do
 
 noOverloadedTest :: Spec
 noOverloadedTest = describe "Test.NoOverloadedStrings" $ do
-      it "sanity" case_sanity
+    it "sanity" case_sanity
-      it "subsite" case_subsite
+    it "subsite" case_subsite
-      it "deflayout" case_deflayout
+    it "deflayout" case_deflayout
-      it "deflayoutT" case_deflayoutT
+    it "deflayoutT" case_deflayoutT

yesod-core/test/YesodCoreTest/NoOverloadedStringsSub.hs

@@ -8,7 +8,6 @@
 module YesodCoreTest.NoOverloadedStringsSub where
 
 import Yesod.Core
-import Network.Wai
 import Yesod.Core.Types
 
 data Subsite = Subsite (forall master. Yesod master => YesodSubRunnerEnv Subsite master (HandlerT master IO) -> Application)

yesod-core/test/YesodCoreTest/RawResponse.hs

@@ -1,13 +1,9 @@
 {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses, ScopedTypeVariables #-}
-module YesodCoreTest.RawResponse (specs, Widget) where
+module YesodCoreTest.RawResponse (specs) where
 
 import Yesod.Core
 import Test.Hspec
-import qualified Data.Map as Map
-import Network.Wai.Test
 import Network.Wai (responseStream)
-import Data.Text (Text)
-import Data.ByteString.Lazy (ByteString)
 import qualified Data.Conduit.List as CL
 import qualified Data.ByteString.Char8 as S8
 import Data.Conduit

yesod-core/test/YesodCoreTest/Redirect.hs

@@ -1,5 +1,7 @@
-{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
-module YesodCoreTest.Redirect (specs, Widget) where
+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+module YesodCoreTest.Redirect (specs) where
 
 import YesodCoreTest.YesodTest
 import Yesod.Core.Handler (redirectWith, setEtag)

yesod-core/test/YesodCoreTest/Reps.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses, ViewPatterns #-}
+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-module YesodCoreTest.Reps (specs, Widget) where
+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, ViewPatterns, OverloadedStrings #-}
+module YesodCoreTest.Reps (specs) where
 
 import Yesod.Core
 import Test.Hspec

yesod-core/test/YesodCoreTest/RequestBodySize.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances #-}
-module YesodCoreTest.RequestBodySize (specs, Widget) where
+module YesodCoreTest.RequestBodySize (specs) where
 
 import Test.Hspec
 

yesod-core/test/YesodCoreTest/StubSslOnly.hs

@@ -2,6 +2,7 @@
 module YesodCoreTest.StubSslOnly ( App ( App ) ) where
 
 import Yesod.Core
+import Text.Hamlet (hamlet)
 import qualified Web.ClientSession                  as CS
 
 data App = App
@@ -16,8 +17,8 @@ instance Yesod App where
         fmap Just $ defaultClientSessionBackend 120 CS.defaultKeyFile
 
 getHomeR :: Handler Html
-getHomeR = defaultLayout
+getHomeR = defaultLayout $ toWidget
-    [whamlet|
+    [hamlet|
         <p>
             Welcome to my test application.
     |]

yesod-core/test/YesodCoreTest/StubUnsecured.hs

@@ -2,6 +2,7 @@
 module YesodCoreTest.StubUnsecured ( App ( App ) ) where
 
 import Yesod.Core
+import Text.Hamlet (hamlet)
 
 data App = App
 
@@ -12,8 +13,8 @@ mkYesod "App" [parseRoutes|
 instance Yesod App
 
 getHomeR :: Handler Html
-getHomeR = defaultLayout
+getHomeR = defaultLayout $ toWidget
-    [whamlet|
+    [hamlet|
         <p>
             Welcome to my test application.
     |]

yesod-core/test/YesodCoreTest/WaiSubsite.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-}
-module YesodCoreTest.WaiSubsite (specs, Widget) where
+module YesodCoreTest.WaiSubsite (specs) where
 
 import YesodCoreTest.YesodTest
 import Yesod.Core

yesod-core/yesod-core.cabal

@@ -16,7 +16,6 @@ extra-source-files:
   test/YesodCoreTest.hs
   test/YesodCoreTest/*.hs
   test/YesodCoreTest/JsLoaderSites/Bottom.hs
-  test/en.msg
   test/test.hs
   ChangeLog.md
   README.md
@@ -30,7 +29,6 @@ library
                    , text                  >= 0.7
                    , template-haskell
                    , path-pieces           >= 0.1.2    && < 0.3
-                   , shakespeare           >= 2.0
                    , blaze-builder         >= 0.2.1.4  && < 0.5
                    , transformers          >= 0.2.2
                    , mtl
@@ -163,22 +161,9 @@ test-suite tests
                   , wai-extra
                   , mwc-random
                   , cookie >= 0.4.1    && < 0.5
-    ghc-options:     -Wall
+    ghc-options: -Wall -fno-warn-unused-binds
     extensions: TemplateHaskell
 
-benchmark widgets
-    type: exitcode-stdio-1.0
-    hs-source-dirs: bench
-    build-depends:  base
-                  , criterion
-                  , bytestring
-                  , text
-                  , transformers
-                  , yesod-core
-                  , blaze-html
-    main-is:        widget.hs
-    ghc-options:    -Wall -O2
-
 source-repository head
   type:     git
   location: https://github.com/yesodweb/yesod

yesod-form/Yesod/Form/Bootstrap3.hs

@@ -33,6 +33,7 @@ import Control.Monad (liftM)
 import Data.Text (Text)
 import Data.String (IsString(..))
 import Yesod.Core
+import Yesod.Shakespeare
 
 import qualified Data.Text as T
 
@@ -314,4 +315,4 @@ bootstrapSubmitId = "b:ootstrap___unique__:::::::::::::::::submit-id"
 -- >        <$> areq textField nameSettings Nothing
 -- >      where nameSettings = withAutofocus $
 -- >                           withPlaceholder "First name" $
--- >                           (bfs ("Name" :: Text))
+-- >                           (bfs ("Name" :: Text))

yesod-form/Yesod/Form/Fields.hs

@@ -62,6 +62,7 @@ import Yesod.Form.Types
 import Yesod.Form.I18n.English
 import Yesod.Form.Functions (parseHelper)
 import Yesod.Core
+import Yesod.Shakespeare
 import Text.Hamlet
 import Text.Blaze (ToMarkup (toMarkup), unsafeByteString)
 #define ToHtml ToMarkup
@@ -91,7 +92,7 @@ import qualified Data.ByteString.Lazy as L
 import Data.Text as T ( Text, append, concat, cons, head
                       , intercalate, isPrefixOf, null, unpack, pack, splitOn
                       )
-import qualified Data.Text as T (drop, dropWhile)  
+import qualified Data.Text as T (drop, dropWhile)
 import qualified Data.Text.Read
 
 import qualified Data.Map as Map
@@ -161,15 +162,15 @@ timeField = timeFieldTypeText
 {-# DEPRECATED timeField "'timeField' currently defaults to an input of type=\"text\". In the next major release, it will default to type=\"time\". To opt in to the new functionality, use 'timeFieldTypeTime'. To keep the existing behavior, use 'timeFieldTypeText'. See 'https://github.com/yesodweb/yesod/pull/874' for details." #-}
 
 -- | 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'.
--- 
+--
 -- 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 :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m 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).
--- 
+--
 -- Add the @time@ package and import the "Data.Time.LocalTime" module to use this function.
 --
 -- Since 1.4.2
@@ -205,7 +206,7 @@ $newline never
   where showVal = either id (pack . renderHtml)
 
 -- | A newtype wrapper around a 'Text' whose 'ToMarkup' instance converts newlines to HTML @\<br>@ tags.
--- 
+--
 -- (When text is entered into a @\<textarea>@, newline characters are used to separate lines.
 -- If this text is then placed verbatim into HTML, the lines won't be separated, thus the need for replacing with @\<br>@ tags).
 -- If you don't need this functionality, simply use 'unTextarea' to access the raw text.
@@ -333,7 +334,7 @@ timeParser = do
         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 = Field
@@ -525,7 +526,7 @@ $newline never
 --
 -- If this field is optional, the first radio button is labeled "\<None>", the second \"Yes" and the third \"No".
 --
--- If this field is required, the first radio button is labeled \"Yes" and the second \"No". 
+-- 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
@@ -559,7 +560,7 @@ $newline never
       t -> Left $ SomeMessage $ MsgInvalidBool t
     showVal = either (\_ -> False)
 
--- | Creates an input with @type="checkbox"@. 
+-- | Creates an input with @type="checkbox"@.
 --   While the default @'boolField'@ implements a radio button so you
 --   can differentiate between an empty response (@Nothing@) and a no
 --   response (@Just False@), this simpler checkbox field returns an empty
@@ -814,7 +815,7 @@ prependZero t0 = if T.null t1
 
 -- $optionsOverview
 -- These functions create inputs where one or more options can be selected from a list.
--- 
+--
 -- The basic datastructure used is an 'Option', which combines a user-facing display value, the internal Haskell value being selected, and an external 'Text' stored as the @value@ in the form (used to map back to the internal value). A list of these, together with a function mapping from an external value back to a Haskell value, form an 'OptionList', which several of these functions take as an argument.
--- 
+--
 -- Typically, you won't need to create an 'OptionList' directly and can instead make one with functions like 'optionsPairs' or 'optionsEnum'. Alternatively, you can use functions like 'selectFieldList', which use their @[(msg, a)]@ parameter to create an 'OptionList' themselves.

yesod-form/Yesod/Form/Functions.hs

@@ -59,6 +59,7 @@ import Text.Blaze (Markup, toMarkup)
 #define Html Markup
 #define toHtml toMarkup
 import Yesod.Core
+import Yesod.Shakespeare
 import Network.Wai (requestMethod)
 import Text.Hamlet (shamlet)
 import Data.Monoid (mempty)

yesod-form/Yesod/Form/Input.hs

@@ -17,6 +17,7 @@ import Yesod.Form.Types
 import Data.Text (Text)
 import Control.Applicative (Applicative (..))
 import Yesod.Core
+import Yesod.Shakespeare
 import Control.Monad (liftM, (<=<))
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)

yesod-form/Yesod/Form/Jquery.hs

@@ -15,6 +15,7 @@ module Yesod.Form.Jquery
     ) where
 
 import Yesod.Core
+import Yesod.Shakespeare
 import Yesod.Form
 import Data.Time (Day)
 import Data.Default

yesod-form/Yesod/Form/MassInput.hs

@@ -13,6 +13,7 @@ import Yesod.Form.Types
 import Yesod.Form.Functions
 import Yesod.Form.Fields (checkBoxField)
 import Yesod.Core
+import Yesod.Shakespeare
 import Control.Monad.Trans.RWS (get, put, ask)
 import Data.Maybe (fromMaybe)
 import Data.Text.Read (decimal)

yesod-form/Yesod/Form/Types.hs

@@ -33,6 +33,7 @@ import Control.Monad (liftM)
 import Control.Monad.Trans.Class
 import Data.String (IsString (..))
 import Yesod.Core
+import Yesod.Shakespeare
 import qualified Data.Map as Map
 import Data.Semigroup (Semigroup, (<>))
 

yesod-form/yesod-form.cabal

@@ -22,6 +22,7 @@ library
     build-depends:   base                  >= 4        && < 5
                    , yesod-core            >= 1.4      && < 1.5
                    , yesod-persistent      >= 1.4      && < 1.5
+                   , yesod-shakespeare     >= 1.5      && < 1.6
                    , time                  >= 1.1.4
                    , shakespeare           >= 2.0
                    , persistent

yesod-shakespeare/ChangeLog.md

@@ -0,0 +1,3 @@
+## 1.5
+
+* split off from yesod-core

yesod-shakespeare/LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

yesod-shakespeare/README.md

@@ -0,0 +1,6 @@
+## yesod-shakespeare
+
+This package adds shakespeare integration on top of yesod-core.
+The yesod package automatically adds in shakespeare functionality. 
+
+Yesod is well documented on [its website](http://www.yesodweb.com/).

yesod-shakespeare/Yesod/Shakespeare.hs

@@ -0,0 +1,214 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings                   #-}
+{-# LANGUAGE QuasiQuotes                         #-}
+{-# LANGUAGE TypeFamilies                        #-}
+module Yesod.Shakespeare (
+      whamlet
+    , whamletFile
+      -- * Special Hamlet quasiquoter/TH for Widgets
+    , ihamletToRepHtml
+    , ihamletToHtml
+      -- * Internal
+    , whamletFileWithSettings
+      -- * Creating
+      -- ** Head of page
+    , setTitleI
+      -- ** Errors
+    , permissionDeniedI
+    , invalidArgsI
+    , unauthorizedI
+      -- ** Messages
+    , setMessageI
+      -- * i18n
+    , getMessageRender
+
+      -- * Shakespeare
+      -- ** Hamlet
+    , hamlet
+    , shamlet
+    , xhamlet
+    , HtmlUrl
+      -- ** Julius
+    , julius
+    , JavascriptUrl
+    , renderJavascriptUrl
+      -- ** Cassius/Lucius
+    , cassius
+    , lucius
+    , CssUrl
+    , renderCssUrl
+
+    , module Text.Shakespeare.I18N
+) where
+
+import           Control.Monad                      (liftM)
+import Text.Shakespeare.I18N
+import           Text.Blaze.Html               (preEscapedToMarkup, toHtml, Html)
+import qualified Text.Blaze.Html5 as H
+import Language.Haskell.TH.Quote (QuasiQuoter)
+import Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE, AppE), Pat (VarP), newName)
+import Data.Text (Text)
+import qualified Data.Text.Lazy as TL
+import Data.Text.Lazy.Builder (fromLazyText, toLazyText)
+import Data.Monoid (mempty)
+
+import qualified Text.Hamlet as NP
+import Text.Julius (Javascript(..), JavascriptUrl, renderJavascript, renderJavascriptUrl, julius)
+import Text.Hamlet (hamlet, shamlet, xhamlet)
+import Text.Lucius (Css, renderCss, CssUrl, renderCssUrl, lucius)
+import Text.Cassius (cassius)
+
+import Yesod.Core ( HandlerSite, MonadHandler
+                  , getUrlRenderParams, invalidArgs, permissionDenied,  getRequest, getYesod
+                  , ToContent(..), ToTypedContent(..), HasContentType(..), typeJavascript, typeCss
+                  , Route
+                  , ToWidget(..), ToWidgetBody(..), ToWidgetMedia(..), ToWidgetHead(..), MonadWidget(..), asWidgetT, tellWidget, GWData(..), setMessage, setTitle
+                  )
+import Yesod.Core.Types
+
+type Translate msg = msg -> Html
+type HtmlUrlI18n msg url = Translate msg -> Render url -> Html
+type Render url = url -> [(Text, Text)] -> Text
+type HtmlUrl url = Render url -> Html
+
+preEscapedLazyText :: TL.Text -> Html
+preEscapedLazyText = preEscapedToMarkup
+
+whamlet :: QuasiQuoter
+whamlet = NP.hamletWithSettings rules NP.defaultHamletSettings
+
+whamletFile :: FilePath -> Q Exp
+whamletFile = NP.hamletFileWithSettings rules NP.defaultHamletSettings
+
+whamletFileWithSettings :: NP.HamletSettings -> FilePath -> Q Exp
+whamletFileWithSettings = NP.hamletFileWithSettings rules
+
+rules :: Q NP.HamletRules
+rules = do
+    ah <- [|asWidgetT . toWidget|]
+    let helper qg f = do
+            x <- newName "urender"
+            e <- f $ VarE x
+            let e' = LamE [VarP x] e
+            g <- qg
+            bind <- [|(>>=)|]
+            return $ InfixE (Just g) bind (Just e')
+    let ur f = do
+            let env = NP.Env
+                    (Just $ helper [|getUrlRenderParams|])
+                    (Just $ helper [|liftM (toHtml .) getMessageRender|])
+            f env
+    return $ NP.HamletRules ah ur $ \_ b -> return $ ah `AppE` b
+
+-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
+ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
+                 => HtmlUrlI18n message (Route (HandlerSite m))
+                 -> m Html
+ihamletToRepHtml = ihamletToHtml
+{-# DEPRECATED ihamletToRepHtml "Please use ihamletToHtml instead" #-}
+
+-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
+--
+-- Since 1.2.1
+ihamletToHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
+              => HtmlUrlI18n message (Route (HandlerSite m))
+              -> m Html
+ihamletToHtml ih = do
+    urender <- getUrlRenderParams
+    mrender <- getMessageRender
+    return $ ih (toHtml . mrender) urender
+
+------------------------------------
+-- Formerly Yesod.Core.Content
+------------------------------------
+instance ToContent Css where
+    toContent = toContent . renderCss
+instance ToContent Javascript where
+    toContent = toContent . toLazyText . unJavascript
+instance HasContentType Css where
+    getContentType _ = typeCss
+instance HasContentType Javascript where
+    getContentType _ = typeJavascript
+instance ToTypedContent Css where
+    toTypedContent = TypedContent typeCss . toContent
+instance ToTypedContent Javascript where
+    toTypedContent = TypedContent typeJavascript . toContent
+
+------------------------------------
+-- Formerly Yesod.Core.Widget
+------------------------------------
+instance render ~ RY site => ToWidget site (render -> Css) where
+    toWidget x = toWidget $ CssBuilder . fromLazyText . renderCss . x
+instance ToWidget site Css where
+    toWidget x = toWidget $ CssBuilder . fromLazyText . renderCss . const x
+instance render ~ RY site => ToWidget site (render -> Javascript) where
+    toWidget x = tellWidget $ GWData mempty mempty mempty mempty mempty (Just $ unJavascript . x) mempty
+instance ToWidget site Javascript where
+    toWidget x = tellWidget $ GWData mempty mempty mempty mempty mempty (Just $ const $ unJavascript x) mempty
+instance render ~ RY site => ToWidgetMedia site (render -> Css) where
+    toWidgetMedia media x = toWidgetMedia media $ CssBuilder . fromLazyText . renderCss . x
+instance ToWidgetMedia site Css where
+    toWidgetMedia media x = toWidgetMedia media $ CssBuilder . fromLazyText . renderCss . const x
+instance render ~ RY site => ToWidgetHead site (render -> Css) where
+    toWidgetHead = toWidget
+instance render ~ RY site => ToWidgetHead site (render -> Javascript) where
+    toWidgetHead j = toWidgetHead $ \r -> H.script $ preEscapedLazyText $ renderJavascriptUrl r j
+instance ToWidgetHead site Javascript where
+    toWidgetHead j = toWidgetHead $ \_ -> H.script $ preEscapedLazyText $ renderJavascript j
+instance render ~ RY site => ToWidgetBody site (render -> Javascript) where
+    toWidgetBody j = toWidget $ \r -> H.script $ preEscapedLazyText $ renderJavascriptUrl r j
+instance ToWidgetBody site Javascript where
+    toWidgetBody j = toWidget $ \_ -> H.script $ preEscapedLazyText $ renderJavascript j
+instance ToWidgetHead site Css where
+    toWidgetHead = toWidget
+
+-- | Set the page title. Calling 'setTitle' multiple times overrides previously
+-- set values.
+setTitleI :: (MonadWidget m, RenderMessage (HandlerSite m) msg) => msg -> m ()
+setTitleI msg = do
+    mr <- getMessageRender
+    setTitle $ toHtml $ mr msg
+
+
+-- | 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
+
+-- | 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
+
+
+getMessageRender :: (MonadHandler m, RenderMessage (HandlerSite m) message)
+                 => m (message -> Text)
+getMessageRender = do
+    site <- getYesod
+    l <- reqLangs `liftM` getRequest
+    return $ renderMessage site l
+
+-----------------------------
+-- 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
+

yesod-shakespeare/bench/widget.hs

@@ -5,7 +5,7 @@
 module Main where
 
 import Criterion.Main
-import Text.Hamlet
+import Yesod.Shakespeare
 import Numeric (showInt)
 import qualified Data.ByteString.Lazy as L
 import qualified Text.Blaze.Html.Renderer.Utf8 as Utf8

yesod-shakespeare/test/YesodShakespeareTest/Media.hs

@@ -2,14 +2,14 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances, ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-module YesodCoreTest.Media (mediaTest, Widget) where
+module YesodShakespeareTest.Media (mediaTest, Widget) where
 
 import Test.Hspec
 import Yesod.Core
+import Yesod.Shakespeare
 import Network.Wai
 import Network.Wai.Test
-import Text.Lucius
+import YesodShakespeareTest.MediaData
-import YesodCoreTest.MediaData
 
 mkYesodDispatch "Y" resourcesY
 

yesod-shakespeare/test/YesodShakespeareTest/MediaData.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances #-}
-module YesodCoreTest.MediaData where
+module YesodShakespeareTest.MediaData where
 
 import Yesod.Core
 

yesod-shakespeare/test/YesodShakespeareTest/Widget.hs

@@ -1,14 +1,12 @@
 {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances, ViewPatterns #-}
-module YesodCoreTest.Widget (widgetTest) where
+module YesodShakespeareTest.Widget (widgetTest) where
 
 import Test.Hspec
 
 import Yesod.Core
-import Text.Julius
+import Yesod.Shakespeare
-import Text.Lucius
-import Text.Hamlet
 
 import Network.Wai
 import Network.Wai.Test

yesod-shakespeare/test/test.hs

@@ -0,0 +1,11 @@
+import Test.Hspec
+import YesodShakespeareTest.Widget
+import YesodShakespeareTest.Media
+
+main :: IO ()
+main = hspec specs
+
+specs :: Spec
+specs = do
+    widgetTest
+    mediaTest

yesod-shakespeare/yesod-shakespeare.cabal

@@ -0,0 +1,73 @@
+name:            yesod-shakespeare
+version:         1.5
+license:         MIT
+license-file:    LICENSE
+author:          Michael Snoyman <michael@snoyman.com>
+maintainer:      Michael Snoyman <michael@snoyman.com>
+synopsis:        Creation of type-safe, RESTful web applications.
+description:     API docs and the README are available at <http://www.stackage.org/package/yesod-core>
+category:        Web, Yesod
+stability:       Stable
+cabal-version:   >= 1.8
+build-type:      Simple
+homepage:        http://www.yesodweb.com/
+extra-source-files:
+  test/YesodShakespeareTest/*.hs
+  test/en.msg
+  test/test.hs
+  ChangeLog.md
+  README.md
+
+library
+    build-depends:   base                  >= 4.3      && < 5
+                   , shakespeare
+                   , yesod-core >= 1.4
+                   , text                  >= 0.7
+                   , template-haskell
+                   , bytestring            >= 0.9.1.4
+                   , transformers          >= 0.2.2
+                   , blaze-html            >= 0.5
+                   , containers            >= 0.2
+
+    exposed-modules: Yesod.Shakespeare
+
+    ghc-options:     -Wall
+    -- Following line added due to: https://github.com/yesodweb/yesod/issues/545
+    -- This looks like a GHC bug
+    extensions:      MultiParamTypeClasses
+
+    -- Workaround for: http://ghc.haskell.org/trac/ghc/ticket/8443
+    extensions:      TemplateHaskell
+
+test-suite tests
+    type: exitcode-stdio-1.0
+    main-is: test.hs
+    hs-source-dirs: test
+
+    cpp-options:   -DTEST
+    build-depends: base
+                  ,hspec >= 1.3
+                  ,hspec-expectations
+                  ,yesod-core
+                  ,yesod-shakespeare
+                  ,wai
+                  ,wai-extra
+    ghc-options: -Wall -fno-warn-unused-binds
+    extensions: TemplateHaskell
+
+benchmark widgets
+    type: exitcode-stdio-1.0
+    hs-source-dirs: bench
+    build-depends:  base
+                  , yesod-shakespeare
+                  , yesod-core
+                  , transformers
+                  , blaze-html
+                  , bytestring
+                  , criterion
+    main-is:        widget.hs
+    ghc-options:    -Wall -O2
+
+source-repository head
+  type:     git
+  location: https://github.com/yesodweb/yesod

yesod-static/test/EmbedProductionTest.hs

@@ -11,6 +11,7 @@ import Network.Wai.Test (SResponse(simpleHeaders))
 import Test.HUnit (assertFailure, assertBool)
 import Test.Hspec (Spec)
 import Yesod.Core
+import Yesod.Shakespeare
 import Yesod.EmbeddedStatic
 import Yesod.Test
 import qualified Data.ByteString as B

yesod-static/yesod-static.cabal

@@ -80,6 +80,7 @@ test-suite tests
     build-depends:   base
                    , hspec >= 1.3
                    , yesod-test >= 1.4
+                   , yesod-shakespeare >= 1.5
                    , wai-extra
                    , HUnit
 

yesod-test/test/main.hs

@@ -7,6 +7,7 @@ import Test.Hspec
 
 import Yesod.Core
 import Yesod.Form
+import Yesod.Shakespeare
 import Yesod.Test
 import Yesod.Test.CssQuery
 import Yesod.Test.TransversingCSS

yesod-test/yesod-test.cabal

@@ -57,6 +57,7 @@ test-suite test
                           , containers
                           , html-conduit
                           , yesod-core
+                          , yesod-shakespeare
                           , yesod-form
                           , text
                           , wai

yesod/Yesod.hs

@@ -4,10 +4,12 @@
 module Yesod
     ( -- * Re-exports from yesod-core
       module Yesod.Core
+    , module Yesod.Shakespeare
     , module Yesod.Form
     , module Yesod.Persist
     ) where
 
 import Yesod.Core
+import Yesod.Shakespeare
 import Yesod.Form
 import Yesod.Persist

yesod/Yesod/Default/Util.hs

@@ -17,6 +17,7 @@ module Yesod.Default.Util
 import qualified Data.ByteString.Lazy as L
 import Data.Text (Text, pack, unpack)
 import Yesod.Core -- purposely using complete import so that Haddock will see addStaticContent
+import Yesod.Shakespeare
 import Control.Monad (when, unless)
 import System.Directory (doesFileExist, createDirectoryIfMissing)
 import Language.Haskell.TH.Syntax

yesod/yesod.cabal

@@ -19,6 +19,7 @@ library
 
     build-depends:   base                      >= 4.3      && < 5
                    , yesod-core                >= 1.4      && < 1.5
+                   , yesod-shakespeare         >= 1.5      && < 1.6
                    , yesod-auth                >= 1.4      && < 1.5
                    , yesod-persistent          >= 1.4      && < 1.5
                    , yesod-form                >= 1.4      && < 1.5