module Yesod.Json
(
Json
, jsonToContent
, jsonToRepJson
, jsonScalar
, jsonList
, jsonMap
, jsonRaw
#if TEST
, testSuite
#endif
)
where
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 (..))
#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
newtype Json = Json { unJson :: Html () }
deriving Monoid
jsonToContent :: Json -> GHandler sub master Content
jsonToContent = return . toContent . renderHtml . unJson
jsonToRepJson :: Json -> GHandler sub master RepJson
jsonToRepJson = fmap RepJson . jsonToContent
jsonScalar :: Html () -> Json
jsonScalar s = Json $ mconcat
[ preEscapedString "\""
, unsafeByteString $ S.concat $ L.toChunks $ encodeJson $ renderHtml s
, preEscapedString "\""
]
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
where hexxs = showHex (fromEnum c) ""
encodeJsonChar c = [c]
jsonList :: [Json] -> Json
jsonList [] = Json $ preEscapedString "[]"
jsonList (x:xs) = mconcat
[ Json $ preEscapedString "["
, x
, mconcat $ map go xs
, Json $ preEscapedString "]"
]
where
go = mappend (Json $ preEscapedString ",")
jsonMap :: [(String, Json)] -> Json
jsonMap [] = Json $ preEscapedString "{}"
jsonMap (x:xs) = mconcat
[ Json $ preEscapedString "{"
, go x
, mconcat $ map go' xs
, Json $ preEscapedString "}"
]
where
go' y = mappend (Json $ preEscapedString ",") $ go y
go (k, v) = mconcat
[ jsonScalar $ string k
, Json $ preEscapedString ":"
, v
]
jsonRaw :: S.ByteString -> Json
jsonRaw bs = Json $ unsafeByteString bs
#if TEST
testSuite :: Test
testSuite = testGroup "Yesod.Json"
[ testCase "simple output" caseSimpleOutput
]
caseSimpleOutput :: Assertion
caseSimpleOutput = do
let j = do
jsonMap
[ ("foo" , jsonList
[ jsonScalar $ preEscapedString "bar"
, jsonScalar $ preEscapedString "baz"
])
]
"{\"foo\":[\"bar\",\"baz\"]}" @=? unpack (renderHtml $ unJson j)
#endif