Minor refactorings
This commit is contained in:
parent
0ce3740c64
commit
6b8eb05ae1
@ -5,9 +5,24 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Yesod.Hamlet
|
||||
( -- * Hamlet library
|
||||
module Text.Hamlet
|
||||
-- ** Hamlet
|
||||
hamlet
|
||||
, xhamlet
|
||||
, Hamlet
|
||||
, Html
|
||||
, renderHamlet
|
||||
, renderHtml
|
||||
, string
|
||||
, preEscapedString
|
||||
, cdata
|
||||
-- ** Jamlet
|
||||
, jamlet
|
||||
, Jamlet
|
||||
, renderJamlet
|
||||
-- ** Camlet
|
||||
, camlet
|
||||
, Camlet
|
||||
, renderCamlet
|
||||
-- * Convert to something displayable
|
||||
, hamletToContent
|
||||
, hamletToRepHtml
|
||||
@ -16,7 +31,7 @@ module Yesod.Hamlet
|
||||
)
|
||||
where
|
||||
|
||||
import Text.Hamlet hiding (hamletFile)
|
||||
import Text.Hamlet
|
||||
import Text.Camlet
|
||||
import Text.Jamlet
|
||||
import Yesod.Content
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
-- | Efficient generation of JSON documents, with HTML-entity encoding handled via types.
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Yesod.Json
|
||||
( -- * Monad
|
||||
Json
|
||||
@ -20,10 +21,11 @@ module Yesod.Json
|
||||
import qualified Data.ByteString.Char8 as S
|
||||
import qualified Data.ByteString.Lazy.Char8 as L
|
||||
import Data.Char (isControl)
|
||||
import Yesod.Hamlet
|
||||
import Yesod.Handler
|
||||
import Numeric (showHex)
|
||||
import Data.Monoid (Monoid (..))
|
||||
import Text.Blaze.Builder.Core
|
||||
import Text.Blaze (Html, renderHtml, string)
|
||||
|
||||
#if TEST
|
||||
import Test.Framework (testGroup, Test)
|
||||
@ -35,21 +37,20 @@ import Yesod.Content hiding (testSuite)
|
||||
import Yesod.Content
|
||||
#endif
|
||||
|
||||
-- | A monad for generating Json output. In truth, it is just a newtype wrapper
|
||||
-- around 'Html'; we thereby get the benefits of BlazeHtml (type safety and
|
||||
-- speed) without accidently mixing non-JSON content.
|
||||
-- | A monad for generating Json output. It wraps the Builder monoid from the
|
||||
-- blaze-builder package.
|
||||
--
|
||||
-- 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 = Json { unJson :: Html () }
|
||||
newtype Json = Json { unJson :: Builder }
|
||||
deriving Monoid
|
||||
|
||||
-- | Extract the final result from the given 'Json' value.
|
||||
--
|
||||
-- See also: applyLayoutJson in "Yesod.Yesod".
|
||||
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'.
|
||||
jsonToRepJson :: Json -> GHandler sub master RepJson
|
||||
@ -64,9 +65,10 @@ jsonToRepJson = fmap RepJson . jsonToContent
|
||||
-- * Wraps the resulting string in quotes.
|
||||
jsonScalar :: Html () -> Json
|
||||
jsonScalar s = Json $ mconcat
|
||||
[ preEscapedString "\""
|
||||
, unsafeByteString $ S.concat $ L.toChunks $ encodeJson $ renderHtml s
|
||||
, preEscapedString "\""
|
||||
[ fromByteString "\""
|
||||
-- FIXME the following line can be optimized after blaze-html 0.2
|
||||
, fromByteString $ S.concat $ L.toChunks $ encodeJson $ renderHtml s
|
||||
, fromByteString "\""
|
||||
]
|
||||
where
|
||||
encodeJson = L.concatMap (L.pack . encodeJsonChar)
|
||||
@ -88,30 +90,30 @@ jsonScalar s = Json $ mconcat
|
||||
|
||||
-- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"].
|
||||
jsonList :: [Json] -> Json
|
||||
jsonList [] = Json $ preEscapedString "[]"
|
||||
jsonList [] = Json $ fromByteString "[]"
|
||||
jsonList (x:xs) = mconcat
|
||||
[ Json $ preEscapedString "["
|
||||
[ Json $ fromByteString "["
|
||||
, x
|
||||
, mconcat $ map go xs
|
||||
, Json $ preEscapedString "]"
|
||||
, Json $ fromByteString "]"
|
||||
]
|
||||
where
|
||||
go = mappend (Json $ preEscapedString ",")
|
||||
go = mappend (Json $ fromByteString ",")
|
||||
|
||||
-- | Outputs a JSON map, eg {\"foo\":\"bar\",\"baz\":\"bin\"}.
|
||||
jsonMap :: [(String, Json)] -> Json
|
||||
jsonMap [] = Json $ preEscapedString "{}"
|
||||
jsonMap [] = Json $ fromByteString "{}"
|
||||
jsonMap (x:xs) = mconcat
|
||||
[ Json $ preEscapedString "{"
|
||||
[ Json $ fromByteString "{"
|
||||
, go x
|
||||
, mconcat $ map go' xs
|
||||
, Json $ preEscapedString "}"
|
||||
, Json $ fromByteString "}"
|
||||
]
|
||||
where
|
||||
go' y = mappend (Json $ preEscapedString ",") $ go y
|
||||
go' y = mappend (Json $ fromByteString ",") $ go y
|
||||
go (k, v) = mconcat
|
||||
[ jsonScalar $ string k
|
||||
, Json $ preEscapedString ":"
|
||||
, Json $ fromByteString ":"
|
||||
, v
|
||||
]
|
||||
|
||||
@ -119,7 +121,7 @@ jsonMap (x:xs) = mconcat
|
||||
-- this is the only function in this module that allows you to create broken
|
||||
-- JSON documents.
|
||||
jsonRaw :: S.ByteString -> Json
|
||||
jsonRaw bs = Json $ unsafeByteString bs
|
||||
jsonRaw = Json . fromByteString
|
||||
|
||||
#if TEST
|
||||
|
||||
@ -133,8 +135,8 @@ caseSimpleOutput = do
|
||||
let j = do
|
||||
jsonMap
|
||||
[ ("foo" , jsonList
|
||||
[ jsonScalar $ preEscapedString "bar"
|
||||
, jsonScalar $ preEscapedString "baz"
|
||||
[ jsonScalar $ fromByteString "bar"
|
||||
, jsonScalar $ fromByteString "baz"
|
||||
])
|
||||
]
|
||||
"{\"foo\":[\"bar\",\"baz\"]}" @=? unpack (renderHtml $ unJson j)
|
||||
|
||||
@ -34,6 +34,7 @@ library
|
||||
web-routes-quasi >= 0.6 && < 0.7,
|
||||
hamlet >= 0.5.0 && < 0.6,
|
||||
blaze-html >= 0.1.1 && < 0.2,
|
||||
blaze-builder >= 0.1 && < 0.2,
|
||||
transformers >= 0.2 && < 0.3,
|
||||
clientsession >= 0.4.0 && < 0.5,
|
||||
pureMD5 >= 1.1.0.0 && < 1.2,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user