module Yesod.Json
(
Json
, jsonToContent
, jsonToRepJson
, 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 Text.Blaze.Builder.Core
import Text.Blaze.Builder.Utf8 (writeChar)
#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 :: Builder }
deriving Monoid
jsonToContent :: Json -> GHandler sub master Content
jsonToContent = return . toContent . toLazyByteString . unJson
jsonToRepJson :: Json -> GHandler sub master RepJson
jsonToRepJson = fmap RepJson . jsonToContent
jsonScalar :: String -> Json
jsonScalar s = Json $ mconcat
[ fromByteString "\""
, writeList 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
jsonList :: [Json] -> Json
jsonList [] = Json $ fromByteString "[]"
jsonList (x:xs) = mconcat
[ Json $ fromByteString "["
, x
, mconcat $ map go xs
, Json $ fromByteString "]"
]
where
go = mappend (Json $ fromByteString ",")
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
]
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