Removed Yesod.Json, using json-types

This commit is contained in:
Michael Snoyman 2010-12-24 08:17:21 +02:00
parent 2211503e02
commit e2ace86bb9
5 changed files with 15 additions and 150 deletions

View File

@ -7,7 +7,6 @@ module Yesod
, module Yesod.Handler
, module Yesod.Dispatch
, module Yesod.Hamlet
, module Yesod.Json
, module Yesod.Widget
, Application
, lift
@ -20,13 +19,11 @@ module Yesod
#if TEST
import Yesod.Content hiding (testSuite)
import Yesod.Json hiding (testSuite)
import Yesod.Dispatch hiding (testSuite)
import Yesod.Yesod hiding (testSuite)
import Yesod.Handler hiding (runHandler, testSuite)
#else
import Yesod.Content
import Yesod.Json
import Yesod.Dispatch
import Yesod.Yesod
import Yesod.Handler hiding (runHandler)

View File

@ -73,6 +73,9 @@ import Data.Enumerator (Enumerator)
import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)
import Data.Monoid (mempty)
import qualified Data.JSON.Types as J
import qualified Text.JSON.Enumerator as J
data Content = ContentBuilder Builder
| ContentEnum (forall a. Enumerator Builder IO a)
| ContentFile FilePath
@ -98,6 +101,8 @@ instance ToContent Text where
toContent = toContent . Data.Text.Lazy.Encoding.encodeUtf8
instance ToContent String where
toContent = toContent . T.pack
instance ToContent J.Value where
toContent = ContentBuilder . J.renderValue
-- | A function which gives targetted representations of content based on the
-- content-types the user accepts.

View File

@ -1,141 +0,0 @@
-- | Efficient generation of JSON documents.
-- FIXME remove this module, possibly make a blaze-json
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Yesod.Json
( -- * Monad
Json
, jsonToContent
, jsonToRepJson
-- * Generate Json output
, jsonScalar
, jsonList
, jsonMap
, jsonRaw
#if TEST
, testSuite
#endif
)
where
import qualified Data.ByteString.Char8 as S
import Data.Char (isControl)
import Yesod.Handler (GHandler)
import Numeric (showHex)
import Data.Monoid (Monoid (..))
import Blaze.ByteString.Builder
import Blaze.ByteString.Builder.Char.Utf8 (writeChar)
import Blaze.ByteString.Builder.Internal.Write (fromWriteList)
#if TEST
import Test.Framework (testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
import Data.ByteString.Lazy.Char8 (unpack)
import Yesod.Content hiding (testSuite)
#else
import Yesod.Content
#endif
-- | 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 :: 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 . toLazyByteString . unJson
-- | Wraps the 'Content' generated by 'jsonToContent' in a 'RepJson'.
jsonToRepJson :: Json -> GHandler sub master RepJson
jsonToRepJson = fmap RepJson . jsonToContent
-- | Outputs a single scalar. This function essentially:
--
-- * Performs JSON encoding.
--
-- * Wraps the resulting string in quotes.
jsonScalar :: String -> Json
jsonScalar s = Json $ mconcat
[ fromByteString "\""
, fromWriteList writeJsonChar s
, fromByteString "\""
]
where
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) ""
writeJsonChar c = writeChar c
writeString = writeByteString . S.pack
-- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"].
jsonList :: [Json] -> Json
jsonList [] = Json $ fromByteString "[]"
jsonList (x:xs) = mconcat
[ Json $ fromByteString "["
, x
, mconcat $ map go xs
, Json $ fromByteString "]"
]
where
go = mappend (Json $ fromByteString ",")
-- | Outputs a JSON map, eg {\"foo\":\"bar\",\"baz\":\"bin\"}.
jsonMap :: [(String, Json)] -> Json
jsonMap [] = Json $ fromByteString "{}"
jsonMap (x:xs) = mconcat
[ Json $ fromByteString "{"
, go x
, mconcat $ map go' xs
, Json $ fromByteString "}"
]
where
go' y = mappend (Json $ fromByteString ",") $ go y
go (k, v) = mconcat
[ jsonScalar k
, Json $ fromByteString ":"
, v
]
-- | Outputs raw JSON data without performing any escaping. Use with caution:
-- this is the only function in this module that allows you to create broken
-- JSON documents.
jsonRaw :: S.ByteString -> Json
jsonRaw = Json . fromByteString
#if TEST
testSuite :: Test
testSuite = testGroup "Yesod.Json"
[ testCase "simple output" caseSimpleOutput
]
caseSimpleOutput :: Assertion
caseSimpleOutput = do
let j = do
jsonMap
[ ("foo" , jsonList
[ jsonScalar "bar"
, jsonScalar "baz"
])
]
"{\"foo\":[\"bar\",\"baz\"]}" @=? unpack (toLazyByteString $ unJson j)
#endif

View File

@ -18,6 +18,7 @@ module Yesod.Yesod
, maybeAuthorized
, widgetToPageContent
, defaultLayoutJson
, jsonToRepJson
, redirectToPost
-- * Defaults
, defaultErrorHandler
@ -32,12 +33,10 @@ module Yesod.Yesod
#if TEST
import Yesod.Content hiding (testSuite)
import Yesod.Json hiding (testSuite)
import Yesod.Handler hiding (testSuite)
import qualified Data.ByteString.UTF8 as BSU
#else
import Yesod.Content
import Yesod.Json
import Yesod.Handler
#endif
@ -60,6 +59,7 @@ import Text.Hamlet
import Text.Cassius
import Text.Julius
import Web.Routes
import qualified Data.JSON.Types as J
#if TEST
import Test.Framework (testGroup, Test)
@ -302,12 +302,15 @@ breadcrumbs = do
-- the default layout for the HTML output ('defaultLayout').
defaultLayoutJson :: Yesod master
=> GWidget sub master ()
-> Json
-> J.Value
-> GHandler sub master RepHtmlJson
defaultLayoutJson w json = do
RepHtml html' <- defaultLayout w
json' <- jsonToContent json
return $ RepHtmlJson html' json'
return $ RepHtmlJson html' $ toContent json
-- | Wraps the 'Content' generated by 'jsonToContent' in a 'RepJson'.
jsonToRepJson :: J.Value -> GHandler sub master RepJson
jsonToRepJson = return . RepJson . toContent
applyLayout' :: Yesod master
=> Html -- ^ title

View File

@ -56,12 +56,13 @@ library
, monad-peel >= 0.1 && < 0.2
, enumerator >= 0.4 && < 0.5
, cookie >= 0.0 && < 0.1
, json-enumerator >= 0.0 && < 0.1
, json-types >= 0.1 && < 0.2
exposed-modules: Yesod
Yesod.Content
Yesod.Dispatch
Yesod.Hamlet
Yesod.Handler
Yesod.Json
Yesod.Request
Yesod.Widget
Yesod.Yesod