diff --git a/yesod-core/Yesod/Internal/Core.hs b/yesod-core/Yesod/Internal/Core.hs index e21580d2..29e1355a 100644 --- a/yesod-core/Yesod/Internal/Core.hs +++ b/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' diff --git a/yesod-core/Yesod/Widget.hs b/yesod-core/Yesod/Widget.hs index a47d58cd..24918358 100644 --- a/yesod-core/Yesod/Widget.hs +++ b/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))} - liftWith f = GWidget $ RWST $ \r s -> liftM (\x -> (x, s, mempty)) - (f $ \t -> liftM StRWS $ runRWST (unGWidget t) r s) - restoreT mSt = GWidget $ RWST $ \_ _ -> liftM unStRWS mSt + newtype StT (GGWidget master) a = + StWidget {unStWidget :: StT (GWInner master) a} + liftWith f = GWidget $ liftWith $ \run -> + 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, s', w') <- lift $ toMasterHandlerMaybe sr (const sub) Nothing $ runRWST w () s - GWidget $ put s' + (a, w') <- lift $ toMasterHandlerMaybe sr (const sub) Nothing $ runWriterT w 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: