Widget is a Writer

yesod-core/Yesod/Internal/Core.hs

@@ -46,7 +46,7 @@ import qualified Web.ClientSession as CS
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Lazy as L
 import Data.Monoid
-import Control.Monad.Trans.RWS
+import Control.Monad.Trans.Writer (runWriterT)
 import Text.Hamlet
 import Text.Julius
 import Text.Blaze ((!), customAttribute, textTag, toValue, unsafeLazyByteString)
@@ -501,7 +501,7 @@ widgetToPageContent :: (Eq (Route master), Yesod master)
                     -> GHandler sub master (PageContent (Route master))
 widgetToPageContent (GWidget w) = do
     master <- getYesod
-    ((), _, GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- runRWST w () 0
+    ((), GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- runWriterT w
     let title = maybe mempty unTitle mTitle
     let scripts = runUniqueList scripts'
     let stylesheets = runUniqueList stylesheets'

yesod-core/Yesod/Widget.hs

@@ -57,7 +57,7 @@ module Yesod.Widget
     ) where
 
 import Data.Monoid
-import Control.Monad.Trans.RWS
+import Control.Monad.Trans.Writer
 import qualified Text.Blaze.Html5 as H
 import Text.Hamlet
 import Text.Cassius
@@ -103,10 +103,11 @@ instance MonadBase b m => MonadBase b (GGWidget master m) where
     liftBase = lift . liftBase
 #if MIN_VERSION_monad_control(0, 3, 0)
 instance MonadTransControl (GGWidget master) where
-    newtype StT (GGWidget master) a = StRWS {unStRWS :: (a, Int, GWData (Route master))}
+    newtype StT (GGWidget master) a =
-    liftWith f = GWidget $ RWST $ \r s -> liftM (\x -> (x, s, mempty))
+       StWidget {unStWidget :: StT (GWInner master) a}
-                                     (f $ \t -> liftM StRWS $ runRWST (unGWidget t) r s)
+    liftWith f = GWidget $ liftWith $ \run ->
-    restoreT mSt = GWidget $ RWST $ \_ _ -> liftM unStRWS mSt
+                  f $ liftM StWidget . run . unGWidget
+    restoreT = GWidget . restoreT . liftM unStWidget
     {-# INLINE liftWith #-}
     {-# INLINE restoreT #-}
 instance MonadBaseControl b m => MonadBaseControl b (GGWidget master m) where
@@ -119,7 +120,7 @@ instance MonadTrans (GGWidget m) where
     lift = GWidget . lift
 
 type GWidget s m = GGWidget m (GHandler s m)
-type GWInner master = RWST () (GWData (Route master)) Int
+type GWInner master = WriterT (GWData (Route master))
 
 instance (Monad monad, a ~ ()) => Monoid (GGWidget master monad a) where
     mempty = return ()
@@ -129,9 +130,7 @@ addSubWidget :: (YesodSubRoute sub master) => sub -> GWidget sub master a -> GWi
 addSubWidget sub (GWidget w) = do
     master <- lift getYesod
     let sr = fromSubRoute sub master
-    s <- GWidget get
+    (a, w') <- lift $ toMasterHandlerMaybe sr (const sub) Nothing $ runWriterT w
-    (a, s', w') <- lift $ toMasterHandlerMaybe sr (const sub) Nothing $ runRWST w () s
-    GWidget $ put s'
     GWidget $ tell w'
     return a
 
@@ -299,9 +298,9 @@ addCoffeeBody c = do
 -- manipulations. It can be easier to use this sometimes than 'wrapWidget'.
 extractBody :: Monad mo => GGWidget m mo () -> GGWidget m mo (HtmlUrl (Route m))
 extractBody (GWidget w) =
-    GWidget $ mapRWST (liftM go) w
+    GWidget $ mapWriterT (liftM go) w
   where
-    go ((), s, GWData (Body h) b c d e f g) = (h, s, GWData (Body mempty) b c d e f g)
+    go ((), GWData (Body h) b c d e f g) = (h, GWData (Body mempty) b c d e f g)
 
 -- | Content for a web page. By providing this datatype, we can easily create
 -- generic site templates, which would have the type signature: