diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index d0b71450..f80a8521 100644 --- a/Yesod/Helpers/Auth.hs +++ b/Yesod/Helpers/Auth.hs @@ -266,8 +266,8 @@ $maybe creds c |] json creds = jsonMap - [ ("ident", jsonScalar $ maybe (string "") (string . credsIdent) creds) - , ("displayName", jsonScalar $ string $ fromMaybe "" + [ ("ident", jsonScalar $ maybe "" credsIdent creds) + , ("displayName", jsonScalar $ fromMaybe "" $ creds >>= credsDisplayName) ] diff --git a/Yesod/Json.hs b/Yesod/Json.hs index 82fbb280..0b78fc06 100644 --- a/Yesod/Json.hs +++ b/Yesod/Json.hs @@ -1,4 +1,4 @@ --- | Efficient generation of JSON documents, with HTML-entity encoding handled via types. +-- | Efficient generation of JSON documents. {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} @@ -19,13 +19,12 @@ module Yesod.Json where import qualified Data.ByteString.Char8 as S -import qualified Data.ByteString.Lazy.Char8 as L import Data.Char (isControl) import Yesod.Handler import Numeric (showHex) import Data.Monoid (Monoid (..)) import Text.Blaze.Builder.Core -import Text.Hamlet (Html, renderHtml, string) +import Text.Blaze.Builder.Utf8 (writeChar) #if TEST import Test.Framework (testGroup, Test) @@ -58,35 +57,31 @@ jsonToRepJson = fmap RepJson . jsonToContent -- | Outputs a single scalar. This function essentially: -- --- * Performs HTML entity escaping as necesary. --- -- * Performs JSON encoding. -- -- * Wraps the resulting string in quotes. -jsonScalar :: Html -> Json +jsonScalar :: String -> Json jsonScalar s = Json $ mconcat [ fromByteString "\"" - -- FIXME the following line can be optimized after blaze-html 0.2 - , fromByteString $ S.concat $ L.toChunks $ encodeJson $ renderHtml s + , writeList writeJsonChar s , fromByteString "\"" ] where - encodeJson = L.concatMap (L.pack . encodeJsonChar) - - encodeJsonChar '\b' = "\\b" - encodeJsonChar '\f' = "\\f" - encodeJsonChar '\n' = "\\n" - encodeJsonChar '\r' = "\\r" - encodeJsonChar '\t' = "\\t" - encodeJsonChar '"' = "\\\"" - encodeJsonChar '\\' = "\\\\" - encodeJsonChar c - | not $ isControl c = [c] - | c < '\x10' = '\\' : 'u' : '0' : '0' : '0' : hexxs - | c < '\x100' = '\\' : 'u' : '0' : '0' : hexxs - | c < '\x1000' = '\\' : 'u' : '0' : hexxs + writeJsonChar '\b' = writeByteString "\\b" + writeJsonChar '\f' = writeByteString "\\f" + writeJsonChar '\n' = writeByteString "\\n" + writeJsonChar '\r' = writeByteString "\\r" + writeJsonChar '\t' = writeByteString "\\t" + writeJsonChar '"' = writeByteString "\\\"" + writeJsonChar '\\' = writeByteString "\\\\" + writeJsonChar c + | not $ isControl c = writeChar c + | c < '\x10' = writeString $ '\\' : 'u' : '0' : '0' : '0' : hexxs + | c < '\x100' = writeString $ '\\' : 'u' : '0' : '0' : hexxs + | c < '\x1000' = writeString $ '\\' : 'u' : '0' : hexxs where hexxs = showHex (fromEnum c) "" - encodeJsonChar c = [c] + writeJsonChar c = writeChar c + writeString = writeByteString . S.pack -- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"]. jsonList :: [Json] -> Json @@ -112,7 +107,7 @@ jsonMap (x:xs) = mconcat where go' y = mappend (Json $ fromByteString ",") $ go y go (k, v) = mconcat - [ jsonScalar $ string k + [ jsonScalar k , Json $ fromByteString ":" , v ] diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs index f7ebb99a..6b521f10 100644 --- a/Yesod/Widget.hs +++ b/Yesod/Widget.hs @@ -35,7 +35,8 @@ import Data.List (nub) import Data.Monoid import Control.Monad.Trans.Writer import Control.Monad.Trans.State -import Yesod.Hamlet (Hamlet, hamlet, PageContent (..), Html) +import Yesod.Hamlet (PageContent (..)) +import Text.Hamlet import Text.Camlet import Text.Jamlet import Yesod.Handler (Route, GHandler, getUrlRenderParams) @@ -45,9 +46,6 @@ import Control.Applicative (Applicative) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class (lift) import "MonadCatchIO-transformers" Control.Monad.CatchIO (MonadCatchIO) -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString as S -import Text.Hamlet (unsafeByteString) data Location url = Local url | Remote String deriving (Show, Eq) @@ -178,13 +176,12 @@ widgetToPageContent (GWidget w) = do let scripts = map (locationToHamlet . unScript) $ runUniqueList scripts' let stylesheets = map (locationToHamlet . unStylesheet) $ runUniqueList stylesheets' - -- FIXME the next functions can be optimized once blaze-html switches to - -- blaze-builder - let lbsToHtml = unsafeByteString . S.concat . L.toChunks - let celper :: Camlet url -> Hamlet url - celper c render = lbsToHtml $ renderCamlet render c - let jelper :: Jamlet url -> Hamlet url - jelper j render = lbsToHtml $ renderJamlet render j + let cssToHtml (Css b) = Html b + celper :: Camlet url -> Hamlet url + celper = fmap cssToHtml + jsToHtml (Javascript b) = Html b + jelper :: Jamlet url -> Hamlet url + jelper = fmap jsToHtml render <- getUrlRenderParams let renderLoc x =