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

    module Hedgehog.Classes.Binary (binaryLaws) where

    import Hedgehog
    import Hedgehog.Classes.Common
    import Data.Binary (Binary)
    import qualified Data.Binary as Binary

    -- | Tests the following 'Binary' laws:
    --
    -- [__Encoding Partial Isomorphism__]: @'Binary.decode' '.' 'Binary.encode'@ ≡ @'id'@
    binaryLaws :: (Binary a, Eq a, Show a) => Gen a -> Laws
    binaryLaws :: forall a. (Binary a, Eq a, Show a) => Gen a -> Laws
    binaryLaws Gen a
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Binary"
      [ (String
    "Partial Isomorphism", Gen a -> Property
    forall a. (Binary a, Show a, Eq a) => Gen a -> Property
    binaryPartialIsomorphism Gen a
    gen)
      ]

    binaryPartialIsomorphism :: forall a. (Binary a, Show a, Eq a) => Gen a -> Property
    binaryPartialIsomorphism :: forall a. (Binary a, Show a, Eq a) => Gen a -> Property
    binaryPartialIsomorphism Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      x <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      let encoded = a -> ByteString
    forall a. Binary a => a -> ByteString
    Binary.encode a
    x
      let lhs = forall a. Binary a => ByteString -> a
    Binary.decode @a ByteString
    encoded
      let rhs = a
    x
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Partial Isomorphism", lawContextTcName :: String
    lawContextTcName = String
    "Binary"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "decode . encode" String -> String -> String
    `congruency` String
    "id"
            , lawContextTcProp :: String
    lawContextTcProp =
                let showX :: String
    showX = a -> String
    forall a. Show a => a -> String
    show a
    x
                    showEncoded :: String
    showEncoded = ByteString -> String
    forall a. Show a => a -> String
    show ByteString
    encoded
                in [String] -> String
    lawWhere
                  [ String
    "decode . encode $ x" String -> String -> String
    `congruency` String
    "x, where"
                  , String
    "x = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showX
                  , String
    "encode x = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showEncoded
                  ]
            , lawContextReduced :: String
    lawContextReduced = a -> a -> String
    forall a. Show a => a -> a -> String
    reduced a
    lhs a
    rhs
            }
      heqCtx lhs rhs ctx