Compile with newest Hamlet

Yesod/Contrib/Formable.hs

@@ -2,11 +2,11 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 module Yesod.Contrib.Formable where
 
 import Text.Formlets
 import Text.Hamlet
-import Text.Hamlet.Monad (htmlContentToByteString)
 import Data.Time (Day)
 import Control.Applicative
 import Control.Applicative.Error
@@ -26,31 +26,28 @@ class Fieldable a where
     fieldable :: (Functor m, Applicative m, Monad m)
               => String -> Formlet (Hamlet url) m a
 
-pack' :: String -> HtmlContent
-pack' = Unencoded . cs
-
 instance Fieldable [Char] where
     fieldable label = input' go
       where
         go name val = [$hamlet|
 %tr
-    %th $pack'.label$
+    %th $string.label$
     %td
-        %input!type=text!name=$pack'.name$!value=$pack'.val$
+        %input!type=text!name=$string.name$!value=$string.val$
 |]
 
-instance Fieldable HtmlContent where
+instance Fieldable Html where
     fieldable label =
-        fmap (Encoded . cs)
+        fmap preEscapedString
       . input' go
-      . fmap (cs . htmlContentToByteString)
+      . fmap (cs . renderHtml)
       where
         go name val = [$hamlet|
 %tr
-    %th $pack'.label$
+    %th $string.label$
     %td
-        %textarea!name=$pack'.name$
+        %textarea!name=$string.name$
-            $pack'.val$
+            $string.val$
 |]
 
 instance Fieldable Day where
@@ -58,9 +55,9 @@ instance Fieldable Day where
       where
         go name val = [$hamlet|
 %tr
-    %th $pack'.label$
+    %th $string.label$
     %td
-        %input!type=date!name=$pack'.name$!value=$pack'.val$
+        %input!type=date!name=$string.name$!value=$string.val$
 |]
         asDay s = maybeRead' s "Invalid day"
 
@@ -72,9 +69,9 @@ instance Fieldable Slug where
       where
         go name val = [$hamlet|
 %tr
-    %th $pack'.label$
+    %th $string.label$
     %td
-        %input!type=text!name=$pack'.name$!value=$pack'.val$
+        %input!type=text!name=$string.name$!value=$string.val$
 |]
         asSlug [] = Failure ["Slug must be non-empty"]
         asSlug x'

Yesod/Hamlet.hs

@@ -5,10 +5,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Yesod.Hamlet
     ( -- * Hamlet library
-      Hamlet
+      module Text.Hamlet
-    , hamlet
-    , HtmlContent (..)
-    , htmlContentToByteString
       -- * Convert to something displayable
     , hamletToContent
     , hamletToRepHtml
@@ -18,8 +15,6 @@ module Yesod.Hamlet
     where
 
 import Text.Hamlet
-import Text.Hamlet.Monad ( outputHtml, hamletToByteString
-                         , htmlContentToByteString)
 import Yesod.Content
 import Yesod.Handler
 import Data.Convertible.Text
@@ -30,7 +25,7 @@ import Web.Routes.Quasi (Routes)
 --
 -- > PageContent url -> Hamlet url
 data PageContent url = PageContent
-    { pageTitle :: HtmlContent
+    { pageTitle :: Html
     , pageHead :: Hamlet url
     , pageBody :: Hamlet url
     }
@@ -40,13 +35,13 @@ data PageContent url = PageContent
 hamletToContent :: Hamlet (Routes master) -> GHandler sub master Content
 hamletToContent h = do
     render <- getUrlRender
-    return $ toContent $ hamletToByteString render h
+    return $ toContent $ renderHamlet render h
 
 -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
 hamletToRepHtml :: Hamlet (Routes master) -> GHandler sub master RepHtml
 hamletToRepHtml = fmap RepHtml . hamletToContent
 
 instance ConvertSuccess String (Hamlet url) where
-    convertSuccess = outputHtml . Unencoded . cs
+    convertSuccess = const . string
-instance ConvertSuccess String HtmlContent where
+instance ConvertSuccess String Html where
-    convertSuccess = Unencoded . cs
+    convertSuccess = string

Yesod/Handler.hs

@@ -70,7 +70,6 @@ import Yesod.Content
 import Yesod.Internal
 import Web.Routes.Quasi (Routes)
 import Data.List (foldl', intercalate)
-import Text.Hamlet.Monad (htmlContentToByteString)
 
 import Control.Exception hiding (Handler, catch)
 import qualified Control.Exception as E
@@ -326,17 +325,17 @@ msgKey = "_MSG"
 -- | Sets a message in the user's session.
 --
 -- See 'getMessage'.
-setMessage :: HtmlContent -> GHandler sub master ()
+setMessage :: Html -> GHandler sub master ()
-setMessage = setSession msgKey . cs . htmlContentToByteString
+setMessage = setSession msgKey . cs . renderHtml
 
 -- | Gets the message in the user's session, if available, and then clears the
 -- variable.
 --
 -- See 'setMessage'.
-getMessage :: GHandler sub master (Maybe HtmlContent)
+getMessage :: GHandler sub master (Maybe Html)
 getMessage = do
     clearSession msgKey
-    fmap (fmap $ Encoded . cs) $ lookupSession msgKey
+    fmap (fmap $ preEscapedString . cs) $ lookupSession msgKey
 
 -- | Bypass remaining handler code and output the given file.
 --

Yesod/Helpers/AtomFeed.hs

@@ -24,8 +24,6 @@ module Yesod.Helpers.AtomFeed
 
 import Yesod
 import Data.Time.Clock (UTCTime)
-import Text.Hamlet.Monad
-import Text.Hamlet.Quasi
 
 newtype RepAtom = RepAtom Content
 instance HasReps RepAtom where
@@ -46,10 +44,10 @@ data AtomFeedEntry url = AtomFeedEntry
     { atomEntryLink :: url
     , atomEntryUpdated :: UTCTime
     , atomEntryTitle :: String
-    , atomEntryContent :: HtmlContent
+    , atomEntryContent :: Html
     }
 
-xmlns :: AtomFeed url -> HtmlContent
+xmlns :: AtomFeed url -> Html
 xmlns _ = cs "http://www.w3.org/2005/Atom"
 
 template :: AtomFeed url -> Hamlet url

Yesod/Helpers/Sitemap.hs

@@ -50,7 +50,7 @@ data SitemapUrl url = SitemapUrl
     , priority :: Double
     }
 
-sitemapNS :: HtmlContent
+sitemapNS :: Html
 sitemapNS = cs "http://www.sitemaps.org/schemas/sitemap/0.9"
 
 template :: [SitemapUrl url] -> Hamlet url

Yesod/Json.hs

@@ -16,7 +16,6 @@ module Yesod.Json
     )
     where
 
-import Text.Hamlet.Monad
 import qualified Data.ByteString.Char8 as S8
 import Data.Char (isControl)
 import Yesod.Hamlet
@@ -25,6 +24,7 @@ import Web.Routes.Quasi (Routes)
 import Numeric (showHex)
 import Data.Monoid (Monoid (..))
 import Data.Convertible.Text (cs)
+import Text.Hamlet
 
 #if TEST
 import Test.Framework (testGroup, Test)
@@ -43,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 = Json { unJson :: Hamlet url }
+newtype Json = Json { unJson :: Html }
     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 -> GHandler sub master Content
-jsonToContent = hamletToContent . unJson
+jsonToContent = return . toContent . renderHtml . unJson
 
 -- | Wraps the 'Content' generated by 'jsonToContent' in a 'RepJson'.
-jsonToRepJson :: Json (Routes master) -> GHandler sub master RepJson
+jsonToRepJson :: Json -> GHandler sub master RepJson
 jsonToRepJson = fmap RepJson . jsonToContent
 
 -- | Outputs a single scalar. This function essentially:
@@ -63,14 +63,14 @@ jsonToRepJson = fmap RepJson . jsonToContent
 -- * Performs JSON encoding.
 --
 -- * Wraps the resulting string in quotes.
-jsonScalar :: HtmlContent -> Json url
+jsonScalar :: Html -> Json
 jsonScalar s = Json $ mconcat
-    [ outputString "\""
+    [ preEscapedString "\""
-    , output $ encodeJson $ htmlContentToByteString s
+    , preEscapedString $ encodeJson $ cs $ renderHtml s
-    , outputString "\""
+    , preEscapedString "\""
     ]
   where
-    encodeJson = S8.concatMap (S8.pack . encodeJsonChar)
+    encodeJson = concatMap encodeJsonChar
 
     encodeJsonChar '\b' = "\\b"
     encodeJsonChar '\f' = "\\f"
@@ -88,31 +88,31 @@ jsonScalar s = Json $ mconcat
     encodeJsonChar c = [c]
 
 -- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"].
-jsonList :: [Json url] -> Json url
+jsonList :: [Json] -> Json
-jsonList [] = Json $ outputOctets "[]"
+jsonList [] = Json $ preEscapedString "[]"
 jsonList (x:xs) = mconcat
-    [ Json $ outputOctets "["
+    [ Json $ preEscapedString "["
     , x
     , mconcat $ map go xs
-    , Json $ outputOctets "]"
+    , Json $ preEscapedString "]"
     ]
   where
-    go j = mappend (Json $ outputOctets ",") j
+    go j = mappend (Json $ preEscapedString ",") j
 
 -- | Outputs a JSON map, eg {\"foo\":\"bar\",\"baz\":\"bin\"}.
-jsonMap :: [(String, Json url)] -> Json url
+jsonMap :: [(String, Json)] -> Json
-jsonMap [] = Json $ outputOctets "{}"
+jsonMap [] = Json $ preEscapedString "{}"
 jsonMap (x:xs) = mconcat
-    [ Json $ outputOctets "{"
+    [ Json $ preEscapedString "{"
     , go x
     , mconcat $ map go' xs
-    , Json $ outputOctets "}"
+    , Json $ preEscapedString "}"
     ]
   where
-    go' y = mappend (Json $ outputOctets ",") $ go y
+    go' y = mappend (Json $ preEscapedString ",") $ go y
     go (k, v) = mconcat
-        [ jsonScalar $ Unencoded $ cs k
+        [ jsonScalar $ string k
-        , Json $ outputOctets ":"
+        , Json $ preEscapedString ":"
         , v
         ]
 

Yesod/Yesod.hs

@@ -110,7 +110,7 @@ applyLayoutJson :: Yesod master
                 => String -- ^ title
                 -> Hamlet (Routes master) -- ^ head
                 -> Hamlet (Routes master) -- ^ body
-                -> Json (Routes master)
+                -> Json
                 -> GHandler sub master RepHtmlJson
 applyLayoutJson t h html json = do
     html' <- defaultLayout PageContent
@@ -135,7 +135,7 @@ defaultErrorHandler NotFound = do
     r <- waiRequest
     applyLayout' "Not Found" $ [$hamlet|
 %h1 Not Found
-%p $Unencoded.cs.pathInfo.r$
+%p $string.cs.pathInfo.r$
 |]
   where
     pathInfo = W.pathInfo