Minor refactorings

This commit is contained in:
Michael Snoyman 2010-08-08 23:55:34 +03:00
parent 0ce3740c64
commit 6b8eb05ae1
3 changed files with 41 additions and 23 deletions

View File

@ -5,9 +5,24 @@
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Yesod.Hamlet module Yesod.Hamlet
( -- * Hamlet library ( -- * Hamlet library
module Text.Hamlet -- ** Hamlet
hamlet
, xhamlet
, Hamlet
, Html
, renderHamlet
, renderHtml
, string
, preEscapedString
, cdata
-- ** Jamlet
, jamlet , jamlet
, Jamlet
, renderJamlet
-- ** Camlet
, camlet , camlet
, Camlet
, renderCamlet
-- * Convert to something displayable -- * Convert to something displayable
, hamletToContent , hamletToContent
, hamletToRepHtml , hamletToRepHtml
@ -16,7 +31,7 @@ module Yesod.Hamlet
) )
where where
import Text.Hamlet hiding (hamletFile) import Text.Hamlet
import Text.Camlet import Text.Camlet
import Text.Jamlet import Text.Jamlet
import Yesod.Content import Yesod.Content

View File

@ -1,6 +1,7 @@
-- | Efficient generation of JSON documents, with HTML-entity encoding handled via types. -- | Efficient generation of JSON documents, with HTML-entity encoding handled via types.
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Yesod.Json module Yesod.Json
( -- * Monad ( -- * Monad
Json Json
@ -20,10 +21,11 @@ module Yesod.Json
import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char (isControl) import Data.Char (isControl)
import Yesod.Hamlet
import Yesod.Handler import Yesod.Handler
import Numeric (showHex) import Numeric (showHex)
import Data.Monoid (Monoid (..)) import Data.Monoid (Monoid (..))
import Text.Blaze.Builder.Core
import Text.Blaze (Html, renderHtml, string)
#if TEST #if TEST
import Test.Framework (testGroup, Test) import Test.Framework (testGroup, Test)
@ -35,21 +37,20 @@ import Yesod.Content hiding (testSuite)
import Yesod.Content import Yesod.Content
#endif #endif
-- | A monad for generating Json output. In truth, it is just a newtype wrapper -- | A monad for generating Json output. It wraps the Builder monoid from the
-- around 'Html'; we thereby get the benefits of BlazeHtml (type safety and -- blaze-builder package.
-- speed) without accidently mixing non-JSON content.
-- --
-- This is an opaque type to avoid any possible insertion of non-JSON 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 -- Due to the limited nature of the JSON format, you can create any valid JSON
-- document you wish using only 'jsonScalar', 'jsonList' and 'jsonMap'. -- document you wish using only 'jsonScalar', 'jsonList' and 'jsonMap'.
newtype Json = Json { unJson :: Html () } newtype Json = Json { unJson :: Builder }
deriving Monoid deriving Monoid
-- | Extract the final result from the given 'Json' value. -- | Extract the final result from the given 'Json' value.
-- --
-- See also: applyLayoutJson in "Yesod.Yesod". -- See also: applyLayoutJson in "Yesod.Yesod".
jsonToContent :: Json -> GHandler sub master Content jsonToContent :: Json -> GHandler sub master Content
jsonToContent = return . toContent . renderHtml . unJson jsonToContent = return . toContent . toLazyByteString . unJson
-- | Wraps the 'Content' generated by 'jsonToContent' in a 'RepJson'. -- | Wraps the 'Content' generated by 'jsonToContent' in a 'RepJson'.
jsonToRepJson :: Json -> GHandler sub master RepJson jsonToRepJson :: Json -> GHandler sub master RepJson
@ -64,9 +65,10 @@ jsonToRepJson = fmap RepJson . jsonToContent
-- * Wraps the resulting string in quotes. -- * Wraps the resulting string in quotes.
jsonScalar :: Html () -> Json jsonScalar :: Html () -> Json
jsonScalar s = Json $ mconcat jsonScalar s = Json $ mconcat
[ preEscapedString "\"" [ fromByteString "\""
, unsafeByteString $ S.concat $ L.toChunks $ encodeJson $ renderHtml s -- FIXME the following line can be optimized after blaze-html 0.2
, preEscapedString "\"" , fromByteString $ S.concat $ L.toChunks $ encodeJson $ renderHtml s
, fromByteString "\""
] ]
where where
encodeJson = L.concatMap (L.pack . encodeJsonChar) encodeJson = L.concatMap (L.pack . encodeJsonChar)
@ -88,30 +90,30 @@ jsonScalar s = Json $ mconcat
-- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"]. -- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"].
jsonList :: [Json] -> Json jsonList :: [Json] -> Json
jsonList [] = Json $ preEscapedString "[]" jsonList [] = Json $ fromByteString "[]"
jsonList (x:xs) = mconcat jsonList (x:xs) = mconcat
[ Json $ preEscapedString "[" [ Json $ fromByteString "["
, x , x
, mconcat $ map go xs , mconcat $ map go xs
, Json $ preEscapedString "]" , Json $ fromByteString "]"
] ]
where where
go = mappend (Json $ preEscapedString ",") go = mappend (Json $ fromByteString ",")
-- | Outputs a JSON map, eg {\"foo\":\"bar\",\"baz\":\"bin\"}. -- | Outputs a JSON map, eg {\"foo\":\"bar\",\"baz\":\"bin\"}.
jsonMap :: [(String, Json)] -> Json jsonMap :: [(String, Json)] -> Json
jsonMap [] = Json $ preEscapedString "{}" jsonMap [] = Json $ fromByteString "{}"
jsonMap (x:xs) = mconcat jsonMap (x:xs) = mconcat
[ Json $ preEscapedString "{" [ Json $ fromByteString "{"
, go x , go x
, mconcat $ map go' xs , mconcat $ map go' xs
, Json $ preEscapedString "}" , Json $ fromByteString "}"
] ]
where where
go' y = mappend (Json $ preEscapedString ",") $ go y go' y = mappend (Json $ fromByteString ",") $ go y
go (k, v) = mconcat go (k, v) = mconcat
[ jsonScalar $ string k [ jsonScalar $ string k
, Json $ preEscapedString ":" , Json $ fromByteString ":"
, v , v
] ]
@ -119,7 +121,7 @@ jsonMap (x:xs) = mconcat
-- this is the only function in this module that allows you to create broken -- this is the only function in this module that allows you to create broken
-- JSON documents. -- JSON documents.
jsonRaw :: S.ByteString -> Json jsonRaw :: S.ByteString -> Json
jsonRaw bs = Json $ unsafeByteString bs jsonRaw = Json . fromByteString
#if TEST #if TEST
@ -133,8 +135,8 @@ caseSimpleOutput = do
let j = do let j = do
jsonMap jsonMap
[ ("foo" , jsonList [ ("foo" , jsonList
[ jsonScalar $ preEscapedString "bar" [ jsonScalar $ fromByteString "bar"
, jsonScalar $ preEscapedString "baz" , jsonScalar $ fromByteString "baz"
]) ])
] ]
"{\"foo\":[\"bar\",\"baz\"]}" @=? unpack (renderHtml $ unJson j) "{\"foo\":[\"bar\",\"baz\"]}" @=? unpack (renderHtml $ unJson j)

View File

@ -34,6 +34,7 @@ library
web-routes-quasi >= 0.6 && < 0.7, web-routes-quasi >= 0.6 && < 0.7,
hamlet >= 0.5.0 && < 0.6, hamlet >= 0.5.0 && < 0.6,
blaze-html >= 0.1.1 && < 0.2, blaze-html >= 0.1.1 && < 0.2,
blaze-builder >= 0.1 && < 0.2,
transformers >= 0.2 && < 0.3, transformers >= 0.2 && < 0.3,
clientsession >= 0.4.0 && < 0.5, clientsession >= 0.4.0 && < 0.5,
pureMD5 >= 1.1.0.0 && < 1.2, pureMD5 >= 1.1.0.0 && < 1.2,