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