{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Validity.Binary
( binarySpec,
binarySpecOnArbitrary,
binarySpecOnGen,
neverFailsToEncodeOnGen,
encodeAndDecodeAreInversesOnGen,
)
where
import Control.DeepSeq (deepseq)
import Control.Exception (evaluate)
import Data.Binary (Binary)
import qualified Data.Binary as Binary
import Data.GenValidity
import Data.Typeable
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Utils
binarySpec ::
forall a.
(Show a, Eq a, Typeable a, GenValid a, Binary a) =>
Spec
binarySpec :: Spec
binarySpec = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a, Binary a) =>
Gen a -> String -> (a -> [a]) -> Spec
binarySpecOnGen (GenValid a => Gen a
forall a. GenValid a => Gen a
genValid @a) String
"valid" a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid
binarySpecOnArbitrary ::
forall a.
(Show a, Eq a, Typeable a, Arbitrary a, Binary a) =>
Spec
binarySpecOnArbitrary :: Spec
binarySpecOnArbitrary = Gen a -> String -> (a -> [a]) -> Spec
forall a.
(Show a, Eq a, Typeable a, Binary a) =>
Gen a -> String -> (a -> [a]) -> Spec
binarySpecOnGen (Arbitrary a => Gen a
forall a. Arbitrary a => Gen a
arbitrary @a) String
"arbitrary" a -> [a]
forall a. Arbitrary a => a -> [a]
shrink
binarySpecOnGen ::
forall a.
(Show a, Eq a, Typeable a, Binary a) =>
Gen a ->
String ->
(a -> [a]) ->
Spec
binarySpecOnGen :: Gen a -> String -> (a -> [a]) -> Spec
binarySpecOnGen 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
"Binary " 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.Lazy.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, Binary 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.Lazy.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, Binary a) =>
Gen a -> (a -> [a]) -> Property
encodeAndDecodeAreInversesOnGen Gen a
gen a -> [a]
s
neverFailsToEncodeOnGen :: (Show a, Binary 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. Binary a => a -> ByteString
Binary.encode a
a) ()) Expectation -> () -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` ()
encodeAndDecodeAreInversesOnGen ::
(Show a, Eq a, Binary 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) ->
case ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Binary a =>
ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Binary.decodeOrFail (a -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode a
a) of
Right (ByteString
_, ByteOffset
_, a
b) -> a
b a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
a
Left (ByteString
_, ByteOffset
_, String
s_) ->
HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$
[String] -> String
unwords [String
"decode of encode is not identity:", String
s_]