blaze-json-0.1.0: tests/tasty.hs

{-# LANGUAGE CPP #-}

import Control.Monad

import Test.QuickCheck
import Test.Tasty
import Test.Tasty.QuickCheck

import qualified Data.Aeson as A
import Data.Scientific
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as H

import qualified Text.Blaze.JSON as B

config :: B.EncodeConfig
#if MIN_VERSION_aeson(0,8,0)
config = B.def
#else
config = B.def { B.escapeHtml = True }
#endif


fromAeson :: A.Value -> B.JSON
fromAeson (A.Object o) = B.object . map (fmap fromAeson) $ H.toList o
fromAeson (A.Array  a) = B.array $ fmap fromAeson a
fromAeson (A.String t) = B.text t
fromAeson (A.Number n) = either B.double B.integral (floatingOrInteger n :: Either Double Int)
fromAeson (A.Bool   b) = B.bool b
fromAeson A.Null       = B.null

text :: Gen T.Text
text = sized $ \n -> do
    k <- choose (0, n)
    s <- sequence
        [ oneof
            [ oneof $ map return "\\\""
            , oneof $ map return ['\0' .. '\x20']
            , toEnum `fmap` choose (0, 0xffff)
            ]
        | _ <- [1 .. k]
        ]
    return $ T.pack s

scolar :: Gen A.Value
scolar = oneof
     [ return A.Null
     , A.Bool `fmap` arbitrary
     , (A.Number . normalize . fromIntegral) `fmap` (arbitrary :: Gen Int)
     , (A.Number . normalize . fromFloatDigits) `fmap` (arbitrary :: Gen Double)
     , fmap A.String text
     ]

arbit :: Int -> Gen A.Value
arbit 0 = scolar
arbit d = oneof
    [ scolar
    , sized $ \l ->
        fmap (A.Array . V.fromList) $ vectorOf l (arbit $ d-1)
    , sized $ \l ->
        fmap (A.Object . H.fromList) $ vectorOf l ((,) `fmap` text `ap` arbit (d-1))
    ]

newtype Aeson = Aeson A.Value deriving Show

instance Arbitrary Aeson where
    arbitrary = Aeson `fmap` arbit 2

main :: IO ()
main = defaultMain $ testGroup ""
    [ testProperty "same to aeson" $ \(Aeson value) ->
        A.encode value === B.encodeWith config (fromAeson value)
    ]