{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Test.Validity.Aeson
( jsonSpecOnValid
, jsonSpec
, jsonSpecOnArbitrary
, jsonSpecOnGen
, neverFailsToEncodeOnGen
, encodeAndDecodeAreInversesOnGen
) where
import Data.GenValidity
import Control.DeepSeq (deepseq)
import Control.Exception (evaluate)
import Control.Monad
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as JSON
import Data.Typeable
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Utils
jsonSpecOnValid ::
forall a. (Show a, Eq a, Typeable a, GenValid a, FromJSON a, ToJSON a)
=> Spec
jsonSpecOnValid = jsonSpecOnGen (genValid @a) "valid" shrinkValid
jsonSpec ::
forall a.
(Show a, Eq a, Typeable a, GenUnchecked a, FromJSON a, ToJSON a)
=> Spec
jsonSpec = jsonSpecOnGen (genUnchecked @a) "unchecked" shrinkUnchecked
jsonSpecOnArbitrary ::
forall a. (Show a, Eq a, Typeable a, Arbitrary a, FromJSON a, ToJSON a)
=> Spec
jsonSpecOnArbitrary = jsonSpecOnGen (arbitrary @a) "arbitrary" shrink
jsonSpecOnGen ::
forall a. (Show a, Eq a, Typeable a, FromJSON a, ToJSON a)
=> Gen a
-> String
-> (a -> [a])
-> Spec
jsonSpecOnGen gen genname s =
parallel $ do
let name = nameOf @a
describe ("JSON " ++ name ++ " (" ++ genname ++ ")") $ do
describe
("encode :: " ++ name ++ " -> Data.ByteString.Lazy.ByteString") $
it
(unwords
[ "never fails to encode a"
, "\"" ++ genname
, name ++ "\""
]) $
neverFailsToEncodeOnGen gen s
describe
("decode :: Data.ByteString.Lazy.ByteString -> Either String " ++
name) $
it
(unwords
[ "ensures that encode and decode are inverses for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
encodeAndDecodeAreInversesOnGen gen s
neverFailsToEncodeOnGen :: (Show a, ToJSON a) => Gen a -> (a -> [a]) -> Property
neverFailsToEncodeOnGen gen s =
forAllShrink gen s $ \(a :: a) ->
evaluate (deepseq (JSON.encode a) ()) `shouldReturn` ()
encodeAndDecodeAreInversesOnGen ::
(Show a, Eq a, FromJSON a, ToJSON a) => Gen a -> (a -> [a]) -> Property
encodeAndDecodeAreInversesOnGen gen s =
forAllShrink gen s $ \(a :: a) ->
let encoded = JSON.encode a
errOrDecoded = JSON.eitherDecode encoded
in case errOrDecoded of
Left err ->
expectationFailure $
unlines
[ "Decoding failed with error"
, err
, "instead of decoding to"
, show a
, "'encode' encoded it to the json"
, show encoded
]
Right decoded ->
unless (decoded == a) $
expectationFailure $
unlines
[ "Decoding succeeded, but the decoded value"
, show decoded
, "differs from expected decoded value"
, show a
, "'encode' encoded it to the json"
, show encoded
]