{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Standard test `Spec`s and raw `Property`s for `Serialize` instances.
--
-- You will need @TypeApplications@ to use these.
module Test.Validity.Cereal
  ( serializeSpec,
    serializeSpecOnArbitrary,
    serializeSpecOnGen,
    neverFailsToEncodeOnGen,
    encodeAndDecodeAreInversesOnGen,
  )
where

import Control.DeepSeq (deepseq)
import Control.Exception (evaluate)
import Data.GenValidity
import Data.Serialize (Serialize)
import qualified Data.Serialize as Serialize
import Data.Typeable
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Utils

-- | Standard test spec for properties of 'Serialize'-related functions for valid values
--
-- Example usage:
--
-- > serializeSpec @Int
serializeSpec ::
  forall a.
  (Show a, Eq a, Typeable a, GenValid a, Serialize a) =>
  Spec
serializeSpec :: Spec
serializeSpec = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a, Serialize a) =>
Gen a -> String -> (a -> [a]) -> Spec
serializeSpecOnGen (GenValid a => Gen a
forall a. GenValid a => Gen a
genValid @a) String
"valid" a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

-- | Standard test spec for properties of 'Serialize'-related functions for arbitrary values
--
-- Example usage:
--
-- > serializeSpecOnArbitrary @Int
serializeSpecOnArbitrary ::
  forall a.
  (Show a, Eq a, Typeable a, Arbitrary a, Serialize a) =>
  Spec
serializeSpecOnArbitrary :: Spec
serializeSpecOnArbitrary = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a, Serialize a) =>
Gen a -> String -> (a -> [a]) -> Spec
serializeSpecOnGen (Arbitrary a => Gen a
forall a. Arbitrary a => Gen a
arbitrary @a) String
"arbitrary" a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

-- | Standard test spec for properties of 'Serialize'-related functions for a given generator (and a name for that generator).
--
-- Example usage:
--
-- > serializeSpecOnGen (genListOf $ pure 'a') "sequence of 'a's"
serializeSpecOnGen ::
  forall a.
  (Show a, Eq a, Typeable a, Serialize a) =>
  Gen a ->
  String ->
  (a -> [a]) ->
  Spec
serializeSpecOnGen :: Gen a -> String -> (a -> [a]) -> Spec
serializeSpecOnGen Gen a
gen String
genname a -> [a]
s =
  Spec -> Spec
forall a. SpecWith a -> SpecWith a
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 a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"Serialize " 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 a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"encode :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> Data.ByteString.ByteString") (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
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 -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ Gen a -> (a -> [a]) -> Property
forall a. (Show a, Serialize a) => Gen a -> (a -> [a]) -> Property
neverFailsToEncodeOnGen Gen a
gen a -> [a]
s
      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"decode :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> Data.ByteString.ByteString") (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
        String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
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 -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ Gen a -> (a -> [a]) -> Property
forall a.
(Show a, Eq a, Serialize a) =>
Gen a -> (a -> [a]) -> Property
encodeAndDecodeAreInversesOnGen Gen a
gen a -> [a]
s

-- |
--
-- prop> neverFailsToEncodeOnGen @Bool arbitrary shrink
-- prop> neverFailsToEncodeOnGen @Bool genValid shrinkValid
-- prop> neverFailsToEncodeOnGen @Bool genValid shrinkValid
-- prop> neverFailsToEncodeOnGen @Int arbitrary shrink
-- prop> neverFailsToEncodeOnGen @Int genValid shrinkValid
-- prop> neverFailsToEncodeOnGen @Int genValid shrinkValid
neverFailsToEncodeOnGen ::
  (Show a, Serialize a) => Gen a -> (a -> [a]) -> Property
neverFailsToEncodeOnGen :: Gen a -> (a -> [a]) -> Property
neverFailsToEncodeOnGen Gen a
gen a -> [a]
s =
  Gen a -> (a -> [a]) -> (a -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> Expectation) -> Property) -> (a -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) ->
    () -> Expectation
forall a. a -> IO a
evaluate (ByteString -> () -> ()
forall a b. NFData a => a -> b -> b
deepseq (a -> ByteString
forall a. Serialize a => a -> ByteString
Serialize.encode a
a) ()) Expectation -> () -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` ()

-- |
--
-- prop> encodeAndDecodeAreInversesOnGen @Bool arbitrary shrink
-- prop> encodeAndDecodeAreInversesOnGen @Bool genValid shrinkValid
-- prop> encodeAndDecodeAreInversesOnGen @Bool genValid shrinkValid
-- prop> encodeAndDecodeAreInversesOnGen @Int arbitrary shrink
-- prop> encodeAndDecodeAreInversesOnGen @Int genValid shrinkValid
-- prop> encodeAndDecodeAreInversesOnGen @Int genValid shrinkValid
encodeAndDecodeAreInversesOnGen ::
  (Show a, Eq a, Serialize a) => Gen a -> (a -> [a]) -> Property
encodeAndDecodeAreInversesOnGen :: Gen a -> (a -> [a]) -> Property
encodeAndDecodeAreInversesOnGen Gen a
gen a -> [a]
s =
  Gen a -> (a -> [a]) -> (a -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> Expectation) -> Property) -> (a -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) ->
    ByteString -> Either String a
forall a. Serialize a => ByteString -> Either String a
Serialize.decode (a -> ByteString
forall a. Serialize a => a -> ByteString
Serialize.encode a
a) Either String a -> Either String a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a -> Either String a
forall a b. b -> Either a b
Right a
a