From a2d2192b9c188174d1bda7fc7a5374bd96347685 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 8 Jun 2010 21:51:55 +0300 Subject: [PATCH] Compile with newest Hamlet --- Yesod/Contrib/Formable.hs | 29 ++++++++++++-------------- Yesod/Hamlet.hs | 17 ++++++--------- Yesod/Handler.hs | 9 ++++---- Yesod/Helpers/AtomFeed.hs | 6 ++---- Yesod/Helpers/Sitemap.hs | 2 +- Yesod/Json.hs | 44 +++++++++++++++++++-------------------- Yesod/Yesod.hs | 4 ++-- 7 files changed, 50 insertions(+), 61 deletions(-) diff --git a/Yesod/Contrib/Formable.hs b/Yesod/Contrib/Formable.hs index 5e2f0264..8e0dbeea 100644 --- a/Yesod/Contrib/Formable.hs +++ b/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$ - $pack'.val$ + %textarea!name=$string.name$ + $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' diff --git a/Yesod/Hamlet.hs b/Yesod/Hamlet.hs index 34222a33..e2c7f971 100644 --- a/Yesod/Hamlet.hs +++ b/Yesod/Hamlet.hs @@ -5,10 +5,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Yesod.Hamlet ( -- * Hamlet library - Hamlet - , hamlet - , HtmlContent (..) - , htmlContentToByteString + module Text.Hamlet -- * 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 -instance ConvertSuccess String HtmlContent where - convertSuccess = Unencoded . cs + convertSuccess = const . string +instance ConvertSuccess String Html where + convertSuccess = string diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index d79a99dd..5a09a08c 100644 --- a/Yesod/Handler.hs +++ b/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 = setSession msgKey . cs . htmlContentToByteString +setMessage :: Html -> GHandler sub master () +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. -- diff --git a/Yesod/Helpers/AtomFeed.hs b/Yesod/Helpers/AtomFeed.hs index 85cd0bbc..2eb8514a 100644 --- a/Yesod/Helpers/AtomFeed.hs +++ b/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 diff --git a/Yesod/Helpers/Sitemap.hs b/Yesod/Helpers/Sitemap.hs index 077d038b..89890e32 100644 --- a/Yesod/Helpers/Sitemap.hs +++ b/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 diff --git a/Yesod/Json.hs b/Yesod/Json.hs index 4f63fd28..51716943 100644 --- a/Yesod/Json.hs +++ b/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 = hamletToContent . unJson +jsonToContent :: Json -> GHandler sub master Content +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 "\"" - , output $ encodeJson $ htmlContentToByteString s - , outputString "\"" + [ preEscapedString "\"" + , preEscapedString $ encodeJson $ cs $ renderHtml s + , 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 $ outputOctets "[]" +jsonList :: [Json] -> Json +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 [] = Json $ outputOctets "{}" +jsonMap :: [(String, Json)] -> Json +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 - , Json $ outputOctets ":" + [ jsonScalar $ string k + , Json $ preEscapedString ":" , v ] diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index be3679ee..6afa19fc 100644 --- a/Yesod/Yesod.hs +++ b/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