Migration to hamlet 3

Yesod/Hamlet.hs

@@ -8,7 +8,7 @@ module Yesod.Hamlet
       Hamlet
     , hamlet
     , HtmlContent (..)
-    , htmlContentToText
+    , htmlContentToByteString
       -- * Convert to something displayable
     , hamletToContent
     , hamletToRepHtml
@@ -18,7 +18,8 @@ module Yesod.Hamlet
     where
 
 import Text.Hamlet
-import Text.Hamlet.Monad (outputHtml, htmlContentToText)
+import Text.Hamlet.Monad ( outputHtml, hamletToByteString
+                         , htmlContentToByteString)
 import Yesod.Content
 import Yesod.Handler
 import Data.Convertible.Text
@@ -27,32 +28,25 @@ import Web.Routes.Quasi (Routes)
 -- | Content for a web page. By providing this datatype, we can easily create
 -- generic site templates, which would have the type signature:
 --
--- > PageContent url -> Hamlet url IO ()
+-- > PageContent url -> Hamlet url
 data PageContent url = PageContent
     { pageTitle :: HtmlContent
-    , pageHead :: Hamlet url IO ()
+    , pageHead :: Hamlet url
-    , pageBody :: Hamlet url IO ()
+    , pageBody :: Hamlet url
     }
 
 -- | Converts the given Hamlet template into 'Content', which can be used in a
 -- Yesod 'Response'.
-hamletToContent :: Hamlet (Routes master) IO () -> GHandler sub master Content
+hamletToContent :: Hamlet (Routes master) -> GHandler sub master Content
 hamletToContent h = do
     render <- getUrlRender
-    return $ ContentEnum $ go render
+    return $ toContent $ hamletToByteString render h
-  where
-    go render iter seed = do
-        res <- runHamlet h render seed $ iter' iter
-        case res of
-            Left x -> return $ Left x
-            Right ((), x) -> return $ Right x
-    iter' iter seed text = iter seed $ cs text
 
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
-hamletToRepHtml :: Hamlet (Routes master) IO () -> GHandler sub master RepHtml
+hamletToRepHtml :: Hamlet (Routes master) -> GHandler sub master RepHtml
 hamletToRepHtml = fmap RepHtml . hamletToContent
 
-instance Monad m => ConvertSuccess String (Hamlet url m ()) where
+instance ConvertSuccess String (Hamlet url) where
     convertSuccess = outputHtml . Unencoded . cs
 instance ConvertSuccess String HtmlContent where
     convertSuccess = Unencoded . cs

Yesod/Handler.hs

@@ -70,7 +70,7 @@ import Yesod.Content
 import Yesod.Internal
 import Web.Routes.Quasi (Routes)
 import Data.List (foldl', intercalate)
-import Text.Hamlet.Monad (htmlContentToText)
+import Text.Hamlet.Monad (htmlContentToByteString)
 
 import Control.Exception hiding (Handler, catch)
 import qualified Control.Exception as E
@@ -331,7 +331,7 @@ msgKey = "_MSG"
 --
 -- See 'getMessage'.
 setMessage :: HtmlContent -> GHandler sub master ()
-setMessage = setSession msgKey . cs . htmlContentToText
+setMessage = setSession msgKey . cs . htmlContentToByteString
 
 -- | Gets the message in the user's session, if available, and then clears the
 -- variable.

Yesod/Helpers/AtomFeed.hs

@@ -52,7 +52,7 @@ data AtomFeedEntry url = AtomFeedEntry
 xmlns :: AtomFeed url -> HtmlContent
 xmlns _ = cs "http://www.w3.org/2005/Atom"
 
-template :: AtomFeed url -> Hamlet url IO ()
+template :: AtomFeed url -> Hamlet url
 template arg = [$xhamlet|
 <?xml version="1.0" encoding="utf-8"?>
 %feed!xmlns=$xmlns.arg$
@@ -65,7 +65,7 @@ template arg = [$xhamlet|
         ^entryTemplate.entry^
 |]
 
-entryTemplate :: AtomFeedEntry url -> Hamlet url IO ()
+entryTemplate :: AtomFeedEntry url -> Hamlet url
 entryTemplate arg = [$xhamlet|
 %entry
     %id @atomEntryLink.arg@

Yesod/Helpers/Auth.hs

@@ -49,6 +49,7 @@ import Control.Applicative
 import Control.Concurrent.MVar
 import System.IO
 import Control.Monad.Attempt
+import Data.Monoid (mempty)
 
 class Yesod master => YesodAuth master where
     -- | Default destination on successful login or logout, if no other
@@ -165,7 +166,7 @@ getOpenIdR = do
         (x:_) -> setUltDestString x
     rtom <- getRouteToMaster
     message <- getMessage
-    applyLayout "Log in via OpenID" (return ()) [$hamlet|
+    applyLayout "Log in via OpenID" mempty [$hamlet|
 $maybe message msg
     %p.message $msg$
 %form!method=get!action=@rtom.OpenIdForward@
@@ -247,8 +248,7 @@ getDisplayName extra =
 getCheck :: Yesod master => GHandler Auth master RepHtmlJson
 getCheck = do
     creds <- maybeCreds
-    applyLayoutJson "Authentication Status"
+    applyLayoutJson "Authentication Status" mempty (html creds) (json creds)
-        (return ()) (html creds) (json creds)
   where
     html creds = [$hamlet|
 %h1 Authentication Status
@@ -289,7 +289,7 @@ getEmailRegisterR :: Yesod master => GHandler Auth master RepHtml
 getEmailRegisterR = do
     _ae <- getAuthEmailSettings
     toMaster <- getRouteToMaster
-    applyLayout "Register a new account" (return ()) [$hamlet|
+    applyLayout "Register a new account" mempty [$hamlet|
 %p Enter your e-mail address below, and a confirmation e-mail will be sent to you.
 %form!method=post!action=@toMaster.EmailRegisterR@
     %label!for=email E-mail
@@ -314,7 +314,7 @@ postEmailRegisterR = do
     tm <- getRouteToMaster
     let verUrl = render $ tm $ EmailVerifyR lid verKey
     liftIO $ sendVerifyEmail ae email verKey verUrl
-    applyLayout "Confirmation e-mail sent" (return ()) [$hamlet|
+    applyLayout "Confirmation e-mail sent" mempty [$hamlet|
 %p A confirmation e-mail has been sent to $cs.email$.
 |]
 
@@ -333,7 +333,7 @@ getEmailVerifyR lid key = do
             setCreds (Creds email AuthEmail (Just email) Nothing (Just lid)) []
             toMaster <- getRouteToMaster
             redirect RedirectTemporary $ toMaster EmailPasswordR
-        _ -> applyLayout "Invalid verification key" (return ()) [$hamlet|
+        _ -> applyLayout "Invalid verification key" mempty [$hamlet|
 %p I'm sorry, but that was an invalid verification key.
         |]
 
@@ -342,7 +342,7 @@ getEmailLoginR = do
     _ae <- getAuthEmailSettings
     toMaster <- getRouteToMaster
     msg <- getMessage
-    applyLayout "Login" (return ()) [$hamlet|
+    applyLayout "Login" mempty [$hamlet|
 $maybe msg ms
     %p.message $ms$
 %p Please log in to your account.
@@ -396,7 +396,7 @@ getEmailPasswordR = do
             setMessage $ cs "You must be logged in to set a password"
             redirect RedirectTemporary $ toMaster EmailLoginR
     msg <- getMessage
-    applyLayout "Set password" (return ()) [$hamlet|
+    applyLayout "Set password" mempty [$hamlet|
 $maybe msg ms
     %p.message $ms$
 %h3 Set a new password

Yesod/Helpers/Sitemap.hs

@@ -53,7 +53,7 @@ data SitemapUrl url = SitemapUrl
 sitemapNS :: HtmlContent
 sitemapNS = cs "http://www.sitemaps.org/schemas/sitemap/0.9"
 
-template :: [SitemapUrl url] -> Hamlet url IO ()
+template :: [SitemapUrl url] -> Hamlet url
 template urls = [$hamlet|
 %urlset!xmlns=$sitemapNS$
     $forall urls url

Yesod/Json.hs

@@ -9,9 +9,7 @@ module Yesod.Json
       -- * Generate Json output
     , jsonScalar
     , jsonList
-    , jsonList'
     , jsonMap
-    , jsonMap'
 #if TEST
     , testSuite
 #endif
@@ -19,15 +17,14 @@ module Yesod.Json
     where
 
 import Text.Hamlet.Monad
-import Control.Applicative
+import qualified Data.ByteString.Char8 as S8
-import Data.Text (pack)
-import qualified Data.Text as T
 import Data.Char (isControl)
 import Yesod.Hamlet
-import Control.Monad (when)
 import Yesod.Handler
 import Web.Routes.Quasi (Routes)
 import Numeric (showHex)
+import Data.Monoid (Monoid (..))
+import Data.Convertible.Text (cs)
 
 #if TEST
 import Test.Framework (testGroup, Test)
@@ -46,17 +43,17 @@ import Yesod.Content
 -- This is an opaque type to avoid any possible insertion of non-JSON content.
 -- Due to the limited nature of the JSON format, you can create any valid JSON
 -- document you wish using only 'jsonScalar', 'jsonList' and 'jsonMap'.
-newtype Json url a = Json { unJson :: Hamlet url IO a }
+newtype Json url = Json { unJson :: Hamlet url }
-    deriving (Functor, Applicative, Monad)
+    deriving Monoid
 
 -- | Extract the final result from the given 'Json' value.
 --
 -- See also: applyLayoutJson in "Yesod.Yesod".
-jsonToContent :: Json (Routes master) () -> GHandler sub master Content
+jsonToContent :: Json (Routes master) -> GHandler sub master Content
 jsonToContent = hamletToContent . unJson
 
 -- | Wraps the 'Content' generated by 'jsonToContent' in a 'RepJson'.
-jsonToRepJson :: Json (Routes master) () -> GHandler sub master RepJson
+jsonToRepJson :: Json (Routes master) -> GHandler sub master RepJson
 jsonToRepJson = fmap RepJson . jsonToContent
 
 -- | Outputs a single scalar. This function essentially:
@@ -66,13 +63,14 @@ jsonToRepJson = fmap RepJson . jsonToContent
 -- * Performs JSON encoding.
 --
 -- * Wraps the resulting string in quotes.
-jsonScalar :: HtmlContent -> Json url ()
+jsonScalar :: HtmlContent -> Json url
-jsonScalar s = Json $ do
+jsonScalar s = Json $ mconcat
-    outputString "\""
+    [ outputString "\""
-    output $ encodeJson $ htmlContentToText s
+    , output $ encodeJson $ htmlContentToByteString s
-    outputString "\""
+    , outputString "\""
+    ]
   where
-    encodeJson = T.concatMap (T.pack . encodeJsonChar)
+    encodeJson = S8.concatMap (S8.pack . encodeJsonChar)
 
     encodeJsonChar '\b' = "\\b"
     encodeJsonChar '\f' = "\\f"
@@ -90,38 +88,33 @@ jsonScalar s = Json $ do
     encodeJsonChar c = [c]
 
 -- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"].
-jsonList :: [Json url ()] -> Json url ()
+jsonList :: [Json url] -> Json url
-jsonList = jsonList' . fromList
+jsonList [] = Json $ outputOctets "[]"
-
+jsonList (x:xs) = mconcat
--- | Same as 'jsonList', but uses an 'Enumerator' for input.
+    [ Json $ outputOctets "["
-jsonList' :: Enumerator (Json url ()) (Json url) -> Json url ()
+    , x
-jsonList' (Enumerator enum) = do
+    , mconcat $ map go xs
-    Json $ outputString "["
+    , Json $ outputOctets "]"
-    _ <- enum go False
+    ]
-    Json $ outputString "]"
   where
-    go putComma j = do
+    go j = mappend (Json $ outputOctets ",") j
-        when putComma $ Json $ outputString ","
-        () <- j
-        return $ Right True
 
 -- | Outputs a JSON map, eg {\"foo\":\"bar\",\"baz\":\"bin\"}.
-jsonMap :: [(String, Json url ())] -> Json url ()
+jsonMap :: [(String, Json url)] -> Json url
-jsonMap = jsonMap' . fromList
+jsonMap [] = Json $ outputOctets "{}"
-
+jsonMap (x:xs) = mconcat
--- | Same as 'jsonMap', but uses an 'Enumerator' for input.
+    [ Json $ outputOctets "{"
-jsonMap' :: Enumerator (String, Json url ()) (Json url) -> Json url ()
+    , go x
-jsonMap' (Enumerator enum) = do
+    , mconcat $ map go' xs
-    Json $ outputString "{"
+    , Json $ outputOctets "}"
-    _ <- enum go False
+    ]
-    Json $ outputString "}"
   where
-    go putComma (k, v) = do
+    go' y = mappend (Json $ outputOctets ",") $ go y
-        when putComma $ Json $ outputString ","
+    go (k, v) = mconcat
-        jsonScalar $ Unencoded $ pack k
+        [ jsonScalar $ Unencoded $ cs k
-        Json $ outputString ":"
+        , Json $ outputOctets ":"
-        () <- v
+        , v
-        return $ Right True
+        ]
 
 #if TEST
 

Yesod/Yesod.hs

@@ -21,6 +21,7 @@ import qualified Network.Wai as W
 import Yesod.Json
 import Yesod.Internal
 import Web.ClientSession (getKey, defaultKeyFile, Key)
+import Data.Monoid (mempty)
 
 import Web.Routes.Quasi (QuasiSite (..), Routes)
 
@@ -93,8 +94,8 @@ class Yesod a where
 -- | Apply the default layout ('defaultLayout') to the given title and body.
 applyLayout :: Yesod master
             => String -- ^ title
-            -> Hamlet (Routes master) IO () -- ^ head
+            -> Hamlet (Routes master) -- ^ head
-            -> Hamlet (Routes master) IO () -- ^ body
+            -> Hamlet (Routes master) -- ^ body
             -> GHandler sub master RepHtml
 applyLayout t h b =
     RepHtml `fmap` defaultLayout PageContent
@@ -107,9 +108,9 @@ applyLayout t h b =
 -- the default layout for the HTML output ('defaultLayout').
 applyLayoutJson :: Yesod master
                 => String -- ^ title
-                -> Hamlet (Routes master) IO () -- ^ head
+                -> Hamlet (Routes master) -- ^ head
-                -> Hamlet (Routes master) IO () -- ^ body
+                -> Hamlet (Routes master) -- ^ body
-                -> Json (Routes master) ()
+                -> Json (Routes master)
                 -> GHandler sub master RepHtmlJson
 applyLayoutJson t h html json = do
     html' <- defaultLayout PageContent
@@ -122,9 +123,9 @@ applyLayoutJson t h html json = do
 
 applyLayout' :: Yesod master
              => String -- ^ title
-             -> Hamlet (Routes master) IO () -- ^ body
+             -> Hamlet (Routes master) -- ^ body
              -> GHandler sub master ChooseRep
-applyLayout' s = fmap chooseRep . applyLayout s (return ())
+applyLayout' s = fmap chooseRep . applyLayout s mempty
 
 -- | The default error handler for 'errorHandler'.
 defaultErrorHandler :: Yesod y

yesod.cabal

@@ -1,5 +1,5 @@
 name:            yesod
-version:         0.2.1
+version:         0.3.0
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
@@ -42,7 +42,7 @@ library
                      template-haskell >= 2.4 && < 2.5,
                      web-routes >= 0.22 && < 0.23,
                      web-routes-quasi >= 0.3 && < 0.4,
-                     hamlet >= 0.2.2 && < 0.3,
+                     hamlet >= 0.3.0 && < 0.4,
                      transformers >= 0.1 && < 0.3,
                      clientsession >= 0.4.0 && < 0.5,
                      MonadCatchIO-transformers >= 0.1 && < 0.3,